Merge SVN 5042

cobc/ChangeLog

@@ -50,18 +50,46 @@
 	* typeck.c (cb_emit_sort_init): generate call to cob_file_sort_options
 	* help.c (cobc_print_usage_dialect): extended -fregister help
 
+2023-05-10  Simon Sobisch <[email protected]>
+
+	* field.c (cb_build_field_tree), parser.y: copy SCREEN SECTION
+	  attributes from parent - instead of doing it in the parser
+	* parser.y (validate_screen_attributes): extracted duplicate code
+	* typeck.c (emit_field_accept_display): new function extracted
+	  from (cb_emit_accept), handling both DISPLAY and ACCEPT
+	* typeck.c (cob_field_display): dropped, replaced in the callers
+	  by call to (emit_field_accept_display) for not generating a call to
+	  fixed-attribute "cob_field_display" but to the varargs
+	  function "cob_display_field"
+	* codegen.c (output_screen_init), codeoptim.c (COB_SET_SCREEN):
+	  generate screen init not as separate function "cob_set_screen" but
+	  as macro "COB_SET_SCREEN" (there's no need or use to put all
+	  attributes on the stack)
+
 2023-05-09  Simon Sobisch <[email protected]>
 
 	* codegen.c (output_funcall): backup and restore adjusted static fields,
 	  minor refactoring
 	* codegen.c (output_funcall_item): extracted from (output_funcall)
+	* typeck.c (cb_emit_accept): dropped cb_gen_field_accept and don't generate
+	  call to fixed-attribute "cob_field_accept", instead generate a call to
+	  the varargs function "cob_accept_field" with passing only the attributes
+	  that are set (including the new CONTROL, COLOR and CURSOR)
 
 2023-05-08  Simon Sobisch <[email protected]>
 
 	* tree.c (cb_build_funcall), tree.h (struct cb_funcall): defined
 	  max. parameters for internal function calls as CB_BUILD_FUNCALL_MAX
 	  and increased it to 14
 
+	FR #189 + FR #355 - runtime-adjustable attributes for extended screenio
+	* tree.h (cb_field): new attributes screen_control and screen_color
+	* tree.h (cb_attr_struct): new attributes control, color and cursor
+	* parser.y, typeck.c (validate_attrs, cb_emit_accept, cb_emit_display,
+	  emit_field_display_for_last): add complete parsing for CONTROL,
+	  COLOR and CURSOR and set/read new attributes as appropriate
+	* parser.y: pass COB_SCREEN_CONV to runtime (currently not handled)
+
 2023-05-05  Simon Sobisch <[email protected]>
 
 	* field.c (cb_resolve_redefines): fix #881 wrong REDEFINES error on

cobc/codegen.c

@@ -10341,13 +10341,13 @@ output_screen_definition (struct cb_field *p)
 static void
 output_screen_init (struct cb_field *p, struct cb_field *previous)
 {
-	int	type;
-
-	type = (p->children ? COB_SCREEN_TYPE_GROUP :
+	const int	type = (p->children ? COB_SCREEN_TYPE_GROUP :
 		p->values ? COB_SCREEN_TYPE_VALUE :
 		(p->size > 0) ? COB_SCREEN_TYPE_FIELD : COB_SCREEN_TYPE_ATTRIBUTE);
+
 	output_prefix ();
-	output ("cob_set_screen (&%s%d, ", CB_PREFIX_SCR_FIELD, p->id);
+	output ("COB_SET_SCREEN (%s%d, %d, 0x" CB_FMT_LLX ", ",
+		CB_PREFIX_SCR_FIELD, p->id, type, p->screen_flag);
 
 	if (p->sister && p->sister->level != 1) {
 		output ("&%s%d, ", CB_PREFIX_SCR_FIELD, p->sister->id);
@@ -10379,10 +10379,10 @@ output_screen_init (struct cb_field *p, struct cb_field *previous)
 
 	if (type == COB_SCREEN_TYPE_FIELD) {
 		output_param (cb_build_field_reference (p, NULL), -1);
-		output (", ");
 	} else {
-		output ("NULL, ");
+		output ("NULL");
 	}
+	output (", ");
 
 	output_newline ();
 	output_prefix ();
@@ -10391,53 +10391,51 @@ output_screen_init (struct cb_field *p, struct cb_field *previous)
 	if (type == COB_SCREEN_TYPE_VALUE) {
 		/* Need a field reference here */
 		output_param (cb_build_field_reference (p, NULL), -1);
-		output (", ");
 	} else {
-		output ("NULL, ");
+		output ("NULL");
 	}
+	output (", ");
 
 	if (p->screen_line) {
 		output_param (p->screen_line, 0);
-		output (", ");
 	} else {
-		output ("NULL, ");
+		output ("NULL");
 	}
+	output (", ");
 
 	if (p->screen_column) {
 		output_param (p->screen_column, 0);
-		output (", ");
 	} else {
-		output ("NULL, ");
+		output ("NULL");
 	}
+	output (", ");
 
 	output_newline ();
 	output_prefix ();
 	output ("\t\t  ");
 
 	if (p->screen_foreg) {
 		output_param (p->screen_foreg, 0);
-		output (", ");
 	} else {
-		output ("NULL, ");
+		output ("NULL");
 	}
+	output (", ");
 
 	if (p->screen_backg) {
 		output_param (p->screen_backg, 0);
-		output (", ");
 	} else {
-		output ("NULL, ");
+		output ("NULL");
 	}
+	output (", ");
 
 	if (p->screen_prompt) {
 		output_param (p->screen_prompt, 0);
-		output (", ");
 	} else {
-		output ("NULL, ");
+		output ("NULL");
 	}
+	output (", %d);", p->occurs_min);
 
 	output_newline ();
-	output_line ("\t\t  %d, %d, 0x" CB_FMT_LLX ");",
-		type, p->occurs_min, p->screen_flag);
 
 	/* TODO: pass information for USAGE CONTROL items here */
 
@@ -13492,6 +13490,8 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
 		output_line ("/* Initialize SCREEN items */");
 		/* Initialize items with VALUE */
 		output_initial_values (prog->screen_storage);
+		/* output structure, note: this can be quite complex
+		   and nested, therefore this isn't done in the header */
 		output_screen_init (prog->screen_storage, NULL);
 		output_newline ();
 	}

cobc/codeoptim.c

@@ -56,29 +56,22 @@ cob_gen_optim (const enum cb_optim val)
 	switch (val) {
 
 	case COB_SET_SCREEN:
-		output_storage ("static void COB_NOINLINE");
-		output_storage ("cob_set_screen (cob_screen *s, cob_screen *next,");
-		output_storage ("		cob_screen *prev, cob_screen *child, cob_screen *parent,");
-		output_storage ("		cob_field *field, cob_field *value,");
-		output_storage ("		cob_field *line, cob_field *column,");
-		output_storage ("		cob_field *foreg, cob_field *backg, cob_field *prompt,");
-		output_storage ("		const int type, const int occurs, const int attr)");
-		output_storage ("{");
-		output_storage ("	s->next = next;");
-		output_storage ("	s->prev = prev;");
-		output_storage ("	s->child = child;");
-		output_storage ("	s->parent = parent;");
-		output_storage ("	s->field = field;");
-		output_storage ("	s->value = value;");
-		output_storage ("	s->line = line;");
-		output_storage ("	s->column = column;");
-		output_storage ("	s->foreg = foreg;");
-		output_storage ("	s->backg = backg;");
-		output_storage ("	s->prompt = prompt;");
-		output_storage ("	s->type = type;");
-		output_storage ("	s->occurs = occurs;");
-		output_storage ("	s->attr = attr;");
-		output_storage ("}");
+		output_storage ("#define COB_SET_SCREEN(s,typ,att,nxt,prv,chld,p,fld,val,l,c,fg,bg,prmpt,occ) \\");
+		output_storage ("do{	s.next = nxt;     \\");
+		output_storage ("	s.prev = prv;     \\");
+		output_storage ("	s.child = chld;   \\");
+		output_storage ("	s.parent = p;     \\");
+		output_storage ("	s.field = fld;    \\");
+		output_storage ("	s.value = val;    \\");
+		output_storage ("	s.line = l;       \\");
+		output_storage ("	s.column = c;     \\");
+		output_storage ("	s.foreg = fg;     \\");
+		output_storage ("	s.backg = bg;     \\");
+		output_storage ("	s.prompt = prmpt; \\");
+		output_storage ("	s.type = typ;     \\");
+		output_storage ("	s.occurs = occ;   \\");
+		output_storage ("	s.attr = att;     \\");
+		output_storage ("} ONCE_COB");
 		return;
 
 	case COB_SET_REPORT:

cobc/field.c

@@ -583,6 +583,13 @@ cb_build_field_tree (const int level, cb_tree name, struct cb_field *last_field,
 		if (f->level <= 66) {
 			f->flag_volatile = parent->flag_volatile;
 		}
+		if (f->storage == CB_STORAGE_SCREEN) {
+			f->screen_foreg   = parent->screen_foreg;
+			f->screen_backg   = parent->screen_backg;
+			f->screen_prompt  = parent->screen_prompt;
+			f->screen_control = parent->screen_control;
+			f->screen_color   = parent->screen_color;
+		}
 	}
 
 	if (storage == CB_STORAGE_FILE