Merge SVN 4666, 4667, 4668

cobc/ChangeLog

@@ -237,6 +237,37 @@
 	* tree.c (cb_build_picture), tree.h: return cb_picture instead of cb_tree
 	  as all but one caller directly use it that way
 
+2022-07-19  Simon Sobisch <[email protected]>
+
+	* parser.y, typeck.c: temporary adjust source reference when building
+	  registers to not point to an innocent source code
+	* tree.c (cb_build_picture, char_to_precedence_idx): cater for possible
+	  call without a current program
+	* tree.c (cb_build_picture): return cb_picture instead of cb_tree, as
+	  all but one caller directly use it that way
+	* field.c (cb_resolve_redefines): fixed reasonable compiler warning
+	* typeck.c (cb_build_generic_register): finished VALUE definition and
+	  checks, now handling numeric and alphanumeric literals (others prepared)
+	* typeck.c, parser.y, cobc.h: moved external_defined_fields_global and
+	  external_defined_fields_ws to the sole use: typeck.c
+	* typeck.c: first time support for creating registers unknown to cobc
+	  with configuration entry or -fregister, to allow this store the original
+	  pre-validated definition in the new struct external_defined_register
+	  and build the field when parsing for the program starts
+
+2022-07-18  Simon Sobisch <[email protected]>
+
+	* config.c (cb_config_entry): fixed defaultbyte convenience option
+	* field.c (cb_build_full_field_reference): minimal refactoring
+	* reserved.c (add_register): enabled generic register generation
+	* tree.c (cb_build_intrinsic): minimal verification for FUNCTION SUBSTITUTE
+	* typeck.c: add field level 77 to any generated register (previously was 0),
+	  those now show up in the symbol and xref list and dump output if they are
+	  used (including GDB debugging extensions)
+	* typeck.c (cb_build_generic_register): now handles VALUE definition and
+	  checks for "able to parse complete definition"
+	* cobc.c: skip unreferenced special register in listing/xref
+
 2022-07-14  Matthew Remacle <[email protected]>
 
 	* tree.c (literal_for_diagnostic): fixed #844 stack-based buffer overflow
@@ -1080,6 +1111,10 @@
 
 	* tree.h [COB_EXTERNAL_XREF]: fixed define of no-op cobc_xref_call
 
+2021-02-18  Simon Sobisch <[email protected]>
+
+	* error.c, tree.c: fixed bug #707 SIGSEGV in dialect related messages
+
 2021-02-18  Ron Norman <[email protected]>
 
 	* cobc.c: Changes to replace VB-CISAM with V-ISAM
@@ -1131,6 +1166,9 @@
 	* codegen.c (output_stmt): emit cob_nop in C labels to fix
 	  position in the generated assembler which was previously
 	  in the COBOL statement above the label
+	* codeoptim.def, codeoptim.c, typeck.c, cobc.c: optimized check for
+	  linkage and based items (local check prevents function call),
+	  similar optimized no-op
 
 2021-02-01  Ron Norman <[email protected]>
 
@@ -1141,6 +1179,12 @@
 
 	* cobc.c (cobc_error_name): do not write to const parameter
 
+2021-01-25  Simon Sobisch <[email protected]>
+
+	* reserved.c: fixed context attribute of acu-extension POS 
+	* parser.y, reserved.c, tree.h, cobc.h: added acu-extension
+	  MOVE WITH CONVERSION as PENDING
+
 2021-01-28  Ron Norman <[email protected]>
 
 	* sqlxfdgen.c: Added checks for NN - Minutes, JJJ - day of year
@@ -1168,6 +1212,10 @@
 	  names like "FILLER 15" to generate invalid sql names
 	* cobc.c (cobc_print_version): welcome 2021
 
+2021-01-05  Simon Sobisch <[email protected]>
+
+	* field.c (cb_build_full_field_reference): fix bug #
+
 2020-12-30  Simon Sobisch <[email protected]>
 
 	* flag.def, cobc.c: change cb_flag_notrunc to cb_flag_trunc to "fix"
@@ -1181,6 +1229,7 @@
 2020-12-23  Simon Sobisch <[email protected]>
 
 	* codegen.c (output_initialize_compound): special handling for OCCURS 1
+	* codegen.c (output_report_sum_control_field): adjusted for literal source
 
 2020-12-21  Simon Sobisch <[email protected]>
 

cobc/cobc.c

@@ -5427,7 +5427,9 @@ print_fields (struct cb_field *top, int *found)
 	const char	*name_or_filler;
 
 	for (; top; top = top->sister) {
-		if (!top->level) {
+		/* hiding internal fields, when not referenced */
+		if (top->level == 0
+		 || (top->flag_internal_register && !top->count)) {
 			continue;
 		}
 		if (*found == 0) {
@@ -5756,10 +5758,9 @@ xref_fields (struct cb_field *top)
 	int		found = 0;
 
 	for (; top; top = top->sister) {
-		/* no entry for internal generated fields
-		   other than used special indexes */
-		if (!top->level || (top->index_type != CB_NORMAL_INDEX
-				    && !top->count)) {
+		/* hiding internal fields, when not referenced */
+		if (top->level == 0
+		 || (top->flag_internal_register && !top->count)) {
 			continue;
 		}
 #if 0 /* FIXME: at least in the context of RW flag_filler is not set correct in

cobc/cobc.h

@@ -505,8 +505,6 @@ extern int			cb_exp_line;
 extern int			functions_are_all;
 extern struct cb_tree_common	*defined_prog_list;
 extern int			current_call_convention;
-extern struct cb_field		*external_defined_fields_ws;
-extern struct cb_field		*external_defined_fields_global;
 
 /* Functions */
 

cobc/config.c

@@ -247,6 +247,9 @@ split_and_iterate_on_comma_separated_str (
 				break;
 			}
 		default:
+			/* TODO: never convert within quotes, needed for
+			         register definitions with VALUE clause:
+			         VALUE "stuff"  /  value N'stuff' */
 			if (transform_case == 1) {
 				word_buff[j++] = (char)cb_toupper ((unsigned char)val[i]);
 			} else if (transform_case == 2) {
@@ -714,6 +717,7 @@ cb_config_entry (char *buff, const char *fname, const int line)
 				return -1;
 			}
 			break;
+
 		} else if (strcmp (name, "binary-size") == 0) {
 			if (strcmp (val, "2-4-8") == 0) {
 				cb_binary_size = CB_BINARY_SIZE_2_4_8;
@@ -726,6 +730,7 @@ cb_config_entry (char *buff, const char *fname, const int line)
 				return -1;
 			}
 			break;
+
 		} else if (strcmp (name, "binary-byteorder") == 0) {
 			if (strcmp (val, "native") == 0) {
 				cb_binary_byteorder = CB_BYTEORDER_NATIVE;
@@ -736,6 +741,7 @@ cb_config_entry (char *buff, const char *fname, const int line)
 				return -1;
 			}
 			break;
+
 		} else if (strcmp (name, "screen-section-rules") == 0) {
 			if (strcmp (val, "acu") == 0) {
 				cb_screen_section_clauses = CB_ACU_SCREEN_RULES;
@@ -754,6 +760,7 @@ cb_config_entry (char *buff, const char *fname, const int line)
 				return -1;
 			}
 			break;
+
 		} else if (strcmp (name, "dpc-in-data") == 0) {
 			if (strcmp (val, "none") == 0) {
 				cb_dpc_in_data = CB_DPC_IN_NONE;
@@ -768,6 +775,7 @@ cb_config_entry (char *buff, const char *fname, const int line)
 				return -1;
 			}
 			break;
+
 		} else if (strcmp (name, "defaultbyte") == 0) {
 			if (strcmp (val, "init") == 0) {
 				/* generate default initialization per INITIALIZE rules */
@@ -792,20 +800,22 @@ cb_config_entry (char *buff, const char *fname, const int line)
 				cb_default_byte = val[1];
 				break;
 			} else
-			/* convert character to number (as quotes will commonly
-			   be removed when given on shell) */
-			if (val[1] == 0 && (val[0] <= '0' || val[0] >= '9')) {
+			/* convert character to number (convenience,
+			   as quotes will commonly be removed when given on shell) */
+			if (val[1] == 0 && (val[0] < '0' || val[0] > '9')) {
 				cb_default_byte = val[0];
 				break;
 			}
 			/* just use decimal as character number */
 			config_table[i].min_value = 0;
 			config_table[i].max_value = 255;
-			/* fall through */
+			/* fall through to integer conversion */
+
 		/* for enums without a string value: set max_value and fall through to CB_INT */
 		} else if (strcmp (name, "standard-define") == 0) {
 			config_table[i].max_value = CB_STD_MAX - 1;
-			/* fall through */
+			/* fall through to integer conversion */
+
 		/* LCOV_EXCL_START */
 		} else {
 			/* note: internal error only (config.def doesn't match config.c),
@@ -814,6 +824,7 @@ cb_config_entry (char *buff, const char *fname, const int line)
 			COBC_ABORT ();
 		}
 		/* LCOV_EXCL_STOP */
+		/* fall through */
 
 	case CB_INT:
 		/* check for number */

cobc/field.c

@@ -595,7 +595,7 @@ cb_build_full_field_reference (struct cb_field* field)
 	cb_tree ret = NULL;
 	cb_tree ref = NULL;
 
-	while (field) {
+	for (; field; field = field->parent) {
 		if (!field->flag_filler) {
 			cb_tree rchain = cb_build_reference (field->name);
 			if (ref) {
@@ -605,7 +605,6 @@ cb_build_full_field_reference (struct cb_field* field)
 			}
 			ref = rchain;
 		}
-		field = field->parent;
 	}
 
 	return ret;
@@ -618,7 +617,7 @@ cb_resolve_redefines (struct cb_field *field, cb_tree redefines)
 	struct cb_reference	*r;
 	const char		*name;
 	cb_tree			x;
-	cb_tree			candidate;
+	cb_tree			candidate = NULL;
 	cb_tree			items;
 
 	r = CB_REFERENCE (redefines);
@@ -3317,8 +3316,8 @@ error_if_invalid_type_in_renames_range (const struct cb_field * const item)
 	while (f) {
 		category = cb_tree_category (CB_TREE (f));
 		if (category == CB_CATEGORY_OBJECT_REFERENCE
-		    || category == CB_CATEGORY_DATA_POINTER
-		    || category == CB_CATEGORY_PROGRAM_POINTER) {
+		 || category == CB_CATEGORY_DATA_POINTER
+		 || category == CB_CATEGORY_PROGRAM_POINTER) {
 			cb_error_x (CB_TREE (item),
 				    _("RENAMES may not contain '%s' as it is a pointer or object reference"),
 				    cb_name (CB_TREE (f)));

cobc/parser.y

@@ -137,8 +137,6 @@ struct cb_program		*current_program = NULL;    /* program in parse/syntax check/
 struct cb_label			*current_section = NULL;
 struct cb_label			*current_paragraph = NULL;
 struct cb_statement		*current_statement = NULL;
-struct cb_field		*external_defined_fields_ws;
-struct cb_field		*external_defined_fields_global;
 cb_tree				defined_prog_list = NULL;
 int				cb_exp_line = 0;
 
@@ -1183,6 +1181,7 @@ setup_program (cb_tree id, cb_tree as_literal, const unsigned char type, const i
 
 	/* finish last program/function */
 	if (!first_prog) {
+		const char *backup_source_file = cb_source_file;
 		if (!current_program->flag_validated) {
 			current_program->flag_validated = 1;
 			cb_validate_program_body (current_program);
@@ -1193,9 +1192,11 @@ setup_program (cb_tree id, cb_tree as_literal, const unsigned char type, const i
 		if (depth) {
 			build_words_for_nested_programs();
 		}
+		cb_source_file = "register-definition";
 		cb_set_intr_when_compiled ();
 		cb_build_registers ();
 		cb_add_external_defined_registers ();
+		cb_source_file = backup_source_file;
 	} else {
 		first_prog = 0;
 	}
@@ -3330,15 +3331,18 @@ set_record_size (cb_tree min, cb_tree max)
 
 start:
   {
+	const char *backup_source_file = cb_source_file;
 	clear_initial_values ();
 	current_program = NULL;
 	defined_prog_list = NULL;
 	cobc_cs_check = 0;
 	main_flag_set = 0;
 	current_program = cb_build_program (NULL, 0);
+	cb_source_file = "register-definition";
 	cb_set_intr_when_compiled ();
 	cb_build_registers ();
 	cb_add_external_defined_registers ();
+	cb_source_file = backup_source_file;
   }
   compilation_group
   {
@@ -7438,7 +7442,7 @@ picture_clause:
   _pic_locale_format
   {
 	check_repeated ("PICTURE", SYN_CLAUSE_4, &check_pic_duplicate);
-	current_field->pic = CB_PICTURE ($1);	/* always returned, invalid picture will have size == 0 */
+	current_field->pic = CB_PICTURE ($1);   /* always returned, invalid picture will have size == 0 */
 
 	if (CB_VALID_TREE ($2)) {
 		if (  (current_field->pic->category != CB_CATEGORY_NUMERIC

cobc/reserved.c

@@ -5098,9 +5098,7 @@ lookup_register (const char *name, const int checkimpl)
 	return lookup_register_internal (upper_name, checkimpl);
 }
 
-/* add an entry to the register list, currently the definition is ignored,
-   TODO: check definition and add a new special register accordingly */
-
+/* add an entry to the register list */
 void
 add_register (const char *name_and_definition, const char *fname, const int line)
 {
@@ -5142,15 +5140,21 @@ add_register (const char *name_and_definition, const char *fname, const int line
 
 	special_register = lookup_register_internal (upper_name, 1);
 	if (!special_register) {
+		const char *backup_source_file = cb_source_file;
 		if (!definition || *definition == 0) {
 			configuration_error (fname, line, 1,
-				_("special register %s is unknown, needs a definition"), name);
+				_("special register '%s' is unknown, needs a definition"), name);
 			return;
 		}
-#if 0	/* must be extended and tested before use... */
-		cb_build_generic_register (name, definition);
+#if 1	/* Note: should be extended and tested also via testsuite... */
+		cb_source_file = fname;
+		if (cb_build_generic_register (name, definition, NULL) != 0) {
+			configuration_error (fname, line, 1,
+				_("special register '%s' has a bad definition: %s"), name, definition);
+		}
+		cb_source_file = backup_source_file;
 #else
-		configuration_error (fname, line, 1, _("special register %s is unknown"), name);
+		configuration_error (fname, line, 1, _("special register '%s' is unknown"), name);
 #endif
 		return;
 	}