Add multithreaded version for string functions and remove static vari…

…ables

cobc/ChangeLog

@@ -28,6 +28,18 @@
 	* codegen.c: handle profiling code generation under the
 	  cb_flag_prof guard
 
+2024-02-26  Boris Eng <[email protected]>
+
+	* codegen.c (output_strings_states, codegen_internal):
+	  added structures for the data used by strings functions as local variables
+	  in the C generated code
+	* parser.y (examine_format_variant, inspect_region):
+	  function calls of strings functions have been replaced by calls to
+	  thread-safe versions (using state structures instead of static variables)
+	* typeck.c: a lot of functions have been changed in that file in order to
+	  make them coherent with the above changes and all those changes are
+		omitted for more concision
+
 2024-02-19  Boris Eng <[email protected]>
 
 	* parser.y (screen_value_clause): replaced basic literals by literals

cobc/codegen.c

@@ -2506,6 +2506,28 @@ output_nonlocal_field_cache (void)
 	output_storage ("\n/* End of fields */\n\n");
 }
 
+/* Strings states */
+
+static void
+output_strings_states (struct cb_program *prog)
+{
+	unsigned int strings_used =
+		prog->flag_inspect_used ||
+		prog->flag_string_used ||
+		prog->flag_unstring_used;
+
+	if (strings_used)
+		output_local ("/* States of string statements */\n");
+	if (prog->flag_inspect_used)
+		output_local ("static cob_inspect_state	*inspect_st = NULL;\n");
+	if (prog->flag_string_used)
+		output_local ("static cob_string_state		*string_st = NULL;\n");
+	if (prog->flag_unstring_used)
+		output_local ("static cob_unstring_state *unstring_st = NULL;\n");
+	if (strings_used)
+		output_newline ();
+}
+
 /* Literals, figurative constants and user-defined constants */
 
 static void
@@ -12849,6 +12871,19 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
 	output_line ("\tcob_fatal_error (COB_FERROR_CANCEL);");
 	output_newline ();
 
+	if (prog->flag_inspect_used) {
+		output_line ("if (inspect_st != NULL)");
+		output_line ("\tcob_free (inspect_st);");
+	}
+	if (prog->flag_string_used) {
+		output_line ("if (string_st != NULL)");
+		output_line ("\tcob_free (string_st);");
+	}
+	if (prog->flag_unstring_used) {
+		output_line ("if (unstring_st != NULL)");
+		output_line ("\tcob_free (unstring_st);");
+	}
+
 	if (prog->flag_main) {
 		goto cancel_end;
 	}
@@ -14053,6 +14088,7 @@ codegen_internal (struct cb_program *prog, const int subsequent_call)
 	output_call_parameter_stack_pointers (prog);
 	output_frame_stack (prog);
 	output_dynamic_field_function_id_pointers ();
+	output_strings_states (prog);
 
 	if (prog->report_storage) {
 		output_target = prog->local_include->local_fp;

cobc/parser.y

@@ -14944,7 +14944,11 @@ examine_format_variant:
 		t = cb_build_tallying_value (x, r);
 		break;
 	case EXAMINE_TAL_UNTIL_FIRST:
-		r = cb_list_add (r, CB_BUILD_FUNCALL_1 ("cob_inspect_before", x));
+		r = cb_list_add (r, CB_BUILD_FUNCALL_2 (
+			"cob_inspect_before_r",
+			current_program->inspect_st_ref,
+			x
+		));
 		t = cb_build_tallying_characters (r);
 		break;
 	/* LCOV_EXCL_START */
@@ -14965,7 +14969,11 @@ examine_format_variant:
 			t = cb_build_replacing_leading (x, replacing_to, r);
 			break;
 		case EXAMINE_TAL_UNTIL_FIRST:
-			r = cb_list_add (r, CB_BUILD_FUNCALL_1 ("cob_inspect_before", x));
+			r = cb_list_add (r, CB_BUILD_FUNCALL_2 (
+				"cob_inspect_before_r",
+				current_program->inspect_st_ref,
+				x
+			));
 			t = cb_build_replacing_characters (replacing_to, r);
 			break;
 		}
@@ -14988,7 +14996,11 @@ examine_format_variant:
 		t = cb_build_replacing_first (from, to, r);
 		break;
 	case EXAMINE_REP_UNTIL_FIRST:
-		r = cb_list_add (r, CB_BUILD_FUNCALL_1 ("cob_inspect_before", from));
+		r = cb_list_add (r, CB_BUILD_FUNCALL_2 (
+			"cob_inspect_before_r",
+			current_program->inspect_st_ref,
+			from
+		));
 		t = cb_build_replacing_characters (to, r);
 		break;
 	/* LCOV_EXCL_START */
@@ -15202,14 +15214,22 @@ inspect_region:
 inspect_before:
   BEFORE _initial x
   {
-	$$ = CB_BUILD_FUNCALL_1 ("cob_inspect_before", $3);
+	$$ = CB_BUILD_FUNCALL_2 (
+		"cob_inspect_before_r",
+		current_program->inspect_st_ref,
+		$3
+	);
   }
 ;
 
 inspect_after:
   AFTER _initial x
   {
-	$$ = CB_BUILD_FUNCALL_1 ("cob_inspect_after", $3);
+	$$ = CB_BUILD_FUNCALL_2 (
+		"cob_inspect_after_r",
+		current_program->inspect_st_ref,
+		$3
+	);
   }
 ;
 

cobc/tree.c

@@ -2248,6 +2248,15 @@ cb_build_program (struct cb_program *last_program, const int nest_level)
 			p->flag_recursive = 1;
 		}
 	}
+
+	/* state structure for strings */
+	p->inspect_st_ref = cb_build_direct ("inspect_st", 0);
+	p->string_st_ref = cb_build_direct ("string_st", 0);
+	p->unstring_st_ref = cb_build_direct ("unstring_st", 0);
+	p->flag_inspect_used = 0;
+	p->flag_string_used = 0;
+	p->flag_unstring_used = 0;
+
 	return p;
 }
 

cobc/tree.h

@@ -1897,6 +1897,9 @@ struct cb_program {
 	const char		*extfh;		/* CALLFH for this program */
 
 	int			last_source_line;	/* Line of (implicit) END PROGRAM/FUNCTION */
+	cb_tree			inspect_st_ref;
+	cb_tree			string_st_ref;
+	cb_tree			unstring_st_ref;
 
 	/* Internal variables */
 	int		loop_counter;			/* Loop counters */
@@ -1945,6 +1948,9 @@ struct cb_program {
 	unsigned int	flag_void		: 1;	/* void return for subprogram */
 	unsigned int	flag_decimal_comp	: 1;	/* program group has decimal computations */
 	unsigned int	flag_prototype		: 1;	/* Is a prototype */
+	unsigned int	flag_inspect_used		: 1;
+	unsigned int	flag_string_used		: 1;
+	unsigned int	flag_unstring_used		: 1;
 };
 
 #define CB_PROGRAM(x)	(CB_TREE_CAST (CB_TAG_PROGRAM, struct cb_program, x))