Merge SVN 4332, 4333, 4334

cobc/ChangeLog

@@ -640,6 +640,12 @@
 	  COBOL 202x Message Control System (MCS) statements SEND and RECEIVE
 	* scanner.l: return WORD token if SUPPRESS is not reserved
 
+2021-09-05  Simon Sobisch <[email protected]>
+
+	* cobc.h (cb_exception), cobc.c: add fatal attribute
+	* reserved.c, tree.h, cobc.c, help.c: added cb_list_exceptions /
+	  --list-exceptions
+
 2021-09-02  Simon Sobisch <[email protected]>
 
 	* reserved.c (cb_toupper): extracted and used in different places
@@ -670,6 +676,14 @@
 
 	* general: fix local includes to use "local" instead of <system>
 
+2021-08-28  Simon Sobisch <[email protected]>
+
+	* typeck.c (cb_build_assignment_name): fix SELECT filename ASSIGN filename
+	  to lead to "redefinition of filename" when (the default) dialect option
+	  assign-clause=dynamic is active; identical names are now always seen
+	  as literal (similar to assign-clause=external, but without label
+	  handling), see bug 669
+
 2021-08-26  Ron Norman <[email protected]>
 
 	* codegen.c: Fix to use P_switch when computed-goto is not supported
@@ -693,14 +707,6 @@
 	  own storage area and to have the REPORT field offset and report_column
 	  as computed to be exactly where the data should be in the print line
 
-2021-08-28  Simon Sobisch <[email protected]>
-
-	* typeck.c (cb_build_assignment_name): fix SELECT filename ASSIGN filename
-	  to lead to "redefinition of filename" when (the default) dialect option
-	  assign-clause=dynamic is active; identical names are now always seen
-	  as literal (similar to assign-clause=external, but without label
-	  handling), see bug 669
-
 2021-07-29  Simon Sobisch <[email protected]>
 
 	* parser.y, config.def: changed the auto-setting of the RECURSIVE attribute
@@ -759,6 +765,7 @@
 	* codegen.c: Emit setting of module compile dialect
 
 2021-05-28  Ron Norman <[email protected]>
+
 	* tree.c: Allow PIC clause not handled by precendence table
 	          Count decimals in $.$$ style PICTURE
 	* typeck.c: Format numeric value for display in error message
@@ -790,6 +797,13 @@
 	  section/paragraph/statement comes to not confuse tools like GDB
 	  with the wrong line reference (especially if we have DECLARATIVES)
 
+2021-04-08  Simon Sobisch <[email protected]>
+
+	* cobc.c (print_with_overflow): extracted from print_errors_for_line,
+	  fixed potential overflow on HPUX and MSVC
+	* flag.def, cobc.c: new -ftcmd (cb_listing_cmd) to include command line in
+	  listing summary
+
 2021-04-01  Ron Norman <[email protected]>
 
 	* codegen.c: Use cob_trace_get_stmt to get a number for the statement

cobc/cobc.c

@@ -207,22 +207,21 @@ const size_t COBC_MEM_SIZE =
 	((sizeof(struct cobc_mem_struct) + sizeof(long long) - 1)
 	/ sizeof(long long)) * sizeof(long long);
 
-
-#define	COB_EXCEPTION(code,tag,name,critical) {name, 0x##code, 0, 0},
+#define	COB_EXCEPTION(code,tag,name,fatal) {name, 0x##code, 0, 0, fatal},
 struct cb_exception cb_exception_table[] = {
-	{NULL, 0, 0, 0},	/* CB_EC_ZERO */
+	{NULL, 0, 0, 0, 0},	/* CB_EC_ZERO */
 #include "../libcob/exception.def"
-	{NULL, 0, 0, 0}		/* CB_EC_MAX */
+	{NULL, 0, 0, 0, 0}	/* CB_EC_MAX */
 };
 
 const struct cb_exception cb_io_exception_table[] = {
-	{NULL, 0, 0, 0},
+	{NULL, 0, 0, 0, 0},
 #include "libcob/exception-io.def"
-	{NULL, 0, 0, 0}		/* CB_EC_MAX */
+	{NULL, 0, 0, 0, 0}	/* CB_EC_MAX */
 };
 #undef	COB_EXCEPTION
 const size_t	cb_io_exception_table_len = sizeof (cb_io_exception_table) / sizeof (struct cb_exception);
-static const size_t	cb_exception_table_len = sizeof (cb_exception_table) / sizeof (struct cb_exception);
+const size_t	cb_exception_table_len = sizeof (cb_exception_table) / sizeof (struct cb_exception);
 
 struct cb_turn_list	*cb_turn_list = NULL;
 
@@ -467,8 +466,9 @@ static const struct option long_options[] = {
 	{"list-reserved",	CB_NO_ARG, NULL, '5'},
 	{"list-intrinsics",	CB_NO_ARG, NULL, '6'},
 	{"list-mnemonics",	CB_NO_ARG, NULL, '7'},
+	{"list-registers",	CB_NO_ARG, NULL, '9'},
+	{"list-exceptions",	CB_NO_ARG, NULL, 'a'},
 	{"list-system",		CB_NO_ARG, NULL, '8'},
-	{"list-registers",		CB_NO_ARG, NULL, '9'},
 	{"O0",			CB_NO_ARG, NULL, '0'},
 	{"O2",			CB_NO_ARG, NULL, '2'},
 	{"O3",			CB_NO_ARG, NULL, '3'},
@@ -2821,6 +2821,7 @@ process_command_line (const int argc, char **argv)
 	int			list_registers = 0;
 	int			list_intrinsics = 0;
 	int			list_system_names = 0;
+	int			list_exceptions = 0;
 	int			list_system_routines = 0;
 	enum cob_exception_id	i;
 	char			ext[COB_MINI_BUFF];
@@ -2984,6 +2985,12 @@ process_command_line (const int argc, char **argv)
 			exit_option = 1;
 			break;
 
+		case 'a':
+			/* --list-exceptions */
+			list_exceptions = 1;
+			exit_option = 1;
+			break;
+
 		case 'q':
 			/* --brief : reduced reporting */
 			/* resets -verbose and removes the path to cobc in argv[0] */
@@ -3198,6 +3205,8 @@ process_command_line (const int argc, char **argv)
 			/* --list-system */
 		case '9':
 			/* --list-registers */
+		case 'a':
+			/* --list-exceptions */
 			/* These options were all processed in the first getopt-run */
 			break;
 
@@ -3829,6 +3838,9 @@ process_command_line (const int argc, char **argv)
 	if (list_system_names) {
 		cb_list_system_names ();
 	}
+	if (list_exceptions) {
+		cb_list_exceptions ();
+	}
 	if (list_system_routines) {
 		cb_list_system_routines ();
 	}

cobc/cobc.h

@@ -267,6 +267,7 @@ struct cb_exception {
 	const int	code;			/* Exception code */
 	int		enable;			/* If turned on */
 	int		explicit_enable_val;	/* enable has been set explicitly */
+	int		fatal;			/* If recognizing this should abort */
 };
 
 /* >>TURN directive list */
@@ -347,11 +348,13 @@ extern int	cb_max_compx;
 extern struct cb_exception	cb_exception_table[];
 extern const struct cb_exception	cb_io_exception_table[];
 extern const size_t		cb_io_exception_table_len;
+extern const size_t		cb_exception_table_len;
 
 #define CB_EXCEPTION_NAME(id)	cb_exception_table[id].name
 #define CB_EXCEPTION_CODE(id)	cb_exception_table[id].code
 #define CB_EXCEPTION_ENABLE(id)	cb_exception_table[id].enable
 #define CB_EXCEPTION_EXPLICIT(id)	cb_exception_table[id].explicit_enable_val
+#define CB_EXCEPTION_FATAL(id)	cb_exception_table[id].fatal
 
 extern struct cb_turn_list	*cb_turn_list;
 

cobc/codegen.c

@@ -773,9 +773,13 @@ real_field_founder (const struct cb_field *f)
 struct cb_field *
 chk_field_variable_size (struct cb_field *f)
 {
-	struct cb_field		*p;
-	struct cb_field		*fc;
 	if (!f->flag_vsize_done) {
+		/* Note: will always return NULL for RENAMES items as those have no children,
+		   which is fine because of the RENAMES syntax rule:
+		   "None of the items within the range [...] shall be [...] a
+		   variable-length data item, or an occurs-depending table. " */
+		struct cb_field		*p;
+		struct cb_field		*fc;
 		f->vsize = NULL;
 		for (fc = f->children; fc && !fc->redefines; fc = fc->sister) {
 			if (fc->depending) {
@@ -5607,8 +5611,7 @@ output_initialize_one (struct cb_initialize *p, cb_tree x)
 		value = CB_VALUE (f->values);
 		/* Check for non-standard OCCURS */
 		if ((f->level == 1 || f->level == 77)
-		 && f->flag_occurs
-		 && !p->flag_init_statement) {
+		 && f->flag_occurs && !p->flag_init_statement) {
 			init_occurs = 1;
 		} else {
 			init_occurs = 0;
@@ -8610,6 +8613,7 @@ get_ec_code_for_handler (const enum cb_handler_type handler_type)
 	case AT_END_HANDLER:
 		return CB_EXCEPTION_CODE (COB_EC_I_O_AT_END);
 	case EOP_HANDLER:
+		/* FIXME: handler should actually also check for COB_EC_I_O_EOP_OVERFLOW */
 		return CB_EXCEPTION_CODE (COB_EC_I_O_EOP);
 	case INVALID_KEY_HANDLER:
 		return CB_EXCEPTION_CODE (COB_EC_I_O_INVALID_KEY);

cobc/help.c

@@ -90,6 +90,7 @@ cobc_print_usage_common_options (void)
 	        "                        equal to -fstack-check -fec=EC-ALL"));
 	/* duplicated here from flags.def to place it next to -debug */
 	puts (_("  -fec=<exception-name>\tenable code generation for <exception-name>,\n"
+	        "                        see --list-exceptions for the possible values,\n"
 	        "                        sets -fsource-location"));
 	puts (_("  -fno-ec=<exception-name>\tdisable code generation for <exception-name>"));
 	puts (_("  -o <file>             place the output into <file>"));
@@ -123,6 +124,7 @@ cobc_print_usage_common_options (void)
 	puts (_("  --list-reserved       display reserved words"));
 	puts (_("  --list-intrinsics     display intrinsic functions"));
 	puts (_("  --list-mnemonics      display mnemonic names"));
+	puts (_("  --list-exceptions     display exception names"));
 	puts (_("  --list-system         display system routines"));
 	puts (_("  --save-temps[=<dir>]  save intermediate files\n"
 	        "                        * default: current directory"));

cobc/reserved.c

@@ -5041,6 +5041,28 @@ cb_list_intrinsics (void)
 	}
 }
 
+void
+cb_list_exceptions (void)
+{
+	size_t		i;
+
+	putchar ('\n');
+	printf ("%-32s", _("Exception Name"));	/* more to add later */
+	for (i = COB_EC_ALL; i < cb_exception_table_len - 1; ++i) {
+		if (i == COB_EC_ALL) {
+			/* EC-ALL - level-1 EC to set all ECs, no indent */
+			printf ("\n%s", CB_EXCEPTION_NAME (i));
+		} else if ((CB_EXCEPTION_CODE(i) & 0x00FF) == 0) {
+			/* EC level-2 EC, newline and indent by 2 */
+			printf ("\n  %-26s", CB_EXCEPTION_NAME (i));
+		} else {
+			/* individual level-3 EC, including fatal marker */
+			printf ("\n    %s%s", CB_EXCEPTION_NAME (i), CB_EXCEPTION_FATAL (i) ? " (f)" : "");
+		}
+	}
+	putchar ('\n');
+}
+
 static struct register_struct *
 lookup_register_internal (const char *upper_name, const int checkimpl)
 {

cobc/tree.h

@@ -2144,6 +2144,7 @@ extern const char		*cb_get_register_definition (const char *);
 extern void			cb_list_reserved (void);
 extern void			cb_list_intrinsics (void);
 extern void			cb_list_system_names (void);
+extern void			cb_list_exceptions (void);
 extern void			cb_list_registers (void);
 extern void			cb_list_system_routines (void);
 extern int			cb_list_map (cb_tree (*) (cb_tree), cb_tree);

libcob/ChangeLog

@@ -609,6 +609,12 @@
 				than one open file
 	* fextfh.c: Removed update of FCD-NAME-LENGTH
 
+2021-10-06  Simon Sobisch <[email protected]>
+
+	* fileio.c (save_status): only internally distinguish between
+	  COB_EC_I_O_EOP and COB_EC_I_O_EOP_OVERFLOW for now as otherwise
+	  recompilation of modules would be necessary (-> postponed)
+
 2021-10-06  Simon Sobisch <[email protected]>
 
 	* common.c (cob_get_environment, cob_display_environment): move strlen
@@ -741,6 +747,14 @@
 
 	* fextfh.c: Add check for record address being available
 
+2021-09-06  Simon Sobisch <[email protected]>
+
+	* exception.def, exception-io.def: update for COBOL 202x,
+	  also adding some entries from COBOL 2014 and dropping one wrong
+	* fileio.c: handling of COB_EC_I_O_RECORD_CONTENT,
+	  distinguish between COB_EC_I_O_EOP and COB_EC_I_O_EOP_OVERFLOW
+	* fileio.c (update_fcd_to_file): don't set error status at 0x
+
 2021-08-31  Simon Sobisch <[email protected]>
 
 	* intrinsic.c, common.h: implemented (cob_intr_bit_of),

libcob/exception-io.def

@@ -19,13 +19,13 @@
 */
 
 
-/* COB_EXCEPTION (code, tag, name, critical) */
+/* COB_EXCEPTION (code, tag, name, fatal) */
 
 /* input-output exception */
 COB_EXCEPTION  (0500, COB_EC_I_O,
 		"EC-I-O", 0)
 
-/* I-O status "1x" */
+/* I-O status "1x" (COBOL 2014) */
 COB_EXCEPTION  (0501, COB_EC_I_O_AT_END,
 		"EC-I-O-AT-END", 0)
 
@@ -37,30 +37,39 @@ COB_EXCEPTION  (0502, COB_EC_I_O_EOP,
 COB_EXCEPTION  (0503, COB_EC_I_O_EOP_OVERFLOW,
 		"EC-I-O-EOP-OVERFLOW", 0)
 
-/* I-O status "6x" */
+/* I-O status "6x" (COBOL 2014) */
 COB_EXCEPTION  (0504, COB_EC_I_O_FILE_SHARING,
 		"EC-I-O-FILE-SHARING", 0)
 
-/* I-O status "9x" */
+/* I-O status "9x" (COBOL 2014) */
 COB_EXCEPTION  (0505, COB_EC_I_O_IMP,
 		"EC-I-O-IMP", 0)
 
-/* I-O status "2x" */
+/* I-O status "2x" (COBOL 2014) */
 COB_EXCEPTION  (0506, COB_EC_I_O_INVALID_KEY,
 		"EC-I-O-INVALID-KEY", 0)
 
-/* The value of a LINAGE data-item is not within the required range */
+/* The value of a LINAGE data-item is not within the required range
+   (COBOL 2014). */
 COB_EXCEPTION  (0507, COB_EC_I_O_LINAGE,
 		"EC-I-O-LINAGE", 1)
 
-/* I-O status "4x" */
+/* I-O status "4x" (COBOL 2014) */
 COB_EXCEPTION  (0508, COB_EC_I_O_LOGIC_ERROR,
 		"EC-I-O-LOGIC-ERROR", 1)
 
-/* I-O status "3x" */
+/* I-O status "3x" (COBOL 2014) */
 COB_EXCEPTION  (0509, COB_EC_I_O_PERMANENT_ERROR,
 		"EC-I-O-PERMANENT-ERROR", 1)
 
-/* I-O status "5x" */
+/* I-O status "7x" (COBOL 202x) */
+COB_EXCEPTION  (050B, COB_EC_I_O_RECORD_CONTENT,
+		"EC-I-O-RECORD-CONTENT", 1)
+
+/* I-O status "5x" (COBOL 2014) */
 COB_EXCEPTION  (050A, COB_EC_I_O_RECORD_OPERATION,
 		"EC-I-O-RECORD-OPERATION", 0)
+
+/* I-O status "0x" (COBOL 202x) */
+COB_EXCEPTION  (050C, COB_EC_I_O_RECORD_WARNING,
+		"EC-I-O-RECORD-WARNING", 0)