New option --copy COPYBOOK, to include a COPYBOOK before reading the …

…source file

cobc/ChangeLog

@@ -1,4 +1,9 @@
 
+2023-10-11  Fabrice Le Fessant <fabrice.le_fessant@ocamlpro.com>
+
+	* cobc.c, pplex.l: new option --copy COPYBOOK, to include a COPYBOOK
+	  before reading the source file
+
 2023-07-26  Simon Sobisch <simonsobisch@gnu.org>
 
 	* typeck.c (search_set_keys): improving SEARCH ALL syntax checks

cobc/cobc.c

@@ -105,7 +105,8 @@ enum compile_level {
 #define	CB_FLAG_GETOPT_NO_DUMP         13
 #define	CB_FLAG_GETOPT_EBCDIC_TABLE    14
 #define	CB_FLAG_GETOPT_DEFAULT_COLSEQ  15
-#define	CB_FLAG_MEMORY_CHECK           16
+#define	CB_FLAG_GETOPT_MEMORY_CHECK    16
+#define	CB_FLAG_GETOPT_COPY_FILE       17
 
 
 /* Info display limits */
@@ -171,8 +172,8 @@ enum compile_level {
 #define GC_C_VERSION	_("unknown")
 #endif
 
-#define	CB_TEXT_LIST_ADD(y,z)	y = cb_text_list_add (y, z)
-#define	CB_TEXT_LIST_CHK(y,z)	y = cb_text_list_chk (y, z)
+#define	CB_TEXT_LIST_ADD(list,z)	list = cb_text_list_add (list, z)
+#define	CB_TEXT_LIST_CHK(list,z)	list = cb_text_list_chk (list, z)
 
 #ifdef	_MSC_VER
 #define	CB_COPT_0	" /Od"
@@ -232,6 +233,7 @@ const char		*cb_cobc_build_stamp = NULL;
 const char		*demangle_name = NULL;
 const char		*cb_storage_file_name = NULL;
 const char		*cb_call_extfh = NULL;
+struct cb_text_list	*cb_copy_list = NULL;
 struct cb_text_list	*cb_include_list = NULL;
 struct cb_text_list	*cb_depend_list = NULL;
 struct cb_text_list	*cb_intrinsic_list = NULL;
@@ -595,6 +597,7 @@ static const struct option long_options[] = {
 	{"save-temps",		CB_OP_ARG, NULL, '_'},
 	{"std",			CB_RQ_ARG, NULL, '$'},
 	{"conf",		CB_RQ_ARG, NULL, '&'},
+	{"copy",                CB_RQ_ARG, NULL, CB_FLAG_GETOPT_COPY_FILE},
 	{"debug",		CB_NO_ARG, NULL, 'd'},
 	{"ext",			CB_RQ_ARG, NULL, 'e'},	/* note: kept *undocumented* until GC4, will be changed to '.' */
 	{"free",		CB_NO_ARG, NULL, 'F'},	/* note: not assigned directly as this is only valid for */
@@ -3270,12 +3273,12 @@ process_command_line (const int argc, char **argv)
 			cobc_wants_debug = 1;
 			break;
 
-		case 8:
+		case CB_FLAG_GETOPT_DUMP:  /* 8 */
 			/* -fdump=<scope> : Add sections for dump code generation */
 			cobc_def_dump_opts (cob_optarg, 1);
 			break;
 
-		case 13:
+		case CB_FLAG_GETOPT_NO_DUMP: /* 13 */
 			/* -fno-dump=<scope> : Suppress sections in dump code generation */
 			if (cob_optarg) {
 				cobc_def_dump_opts (cob_optarg, 0);
@@ -3878,7 +3881,7 @@ process_command_line (const int argc, char **argv)
 			}
 			break;
 
-		case CB_FLAG_MEMORY_CHECK: /* 16 */
+		case CB_FLAG_GETOPT_MEMORY_CHECK: /* 16 */
 			/* -fmemory-check=<scope> :  */
 			if (!cob_optarg) {
 				cb_flag_memory_check = CB_MEMCHK_ALL;
@@ -3887,6 +3890,14 @@ process_command_line (const int argc, char **argv)
 			}
 			break;
 
+		case CB_FLAG_GETOPT_COPY_FILE: /* 17 */
+			/* --copy=<file> : COPY file at beginning */
+			{
+				char *name = cobc_strdup (cob_optarg);
+				CB_TEXT_LIST_ADD (cb_copy_list, name);
+				break;
+			}
+
 		case 'A':
 			/* -A <xx> : Add options to C compile phase */
 			COBC_ADD_STR (cobc_cflags, " ", cob_optarg, NULL);
@@ -9252,6 +9263,19 @@ main (int argc, char **argv)
 	finish_setup_compiler_env ();
 	finish_setup_internal_env ();
 
+	{
+		struct cb_text_list *l;
+		for (l = cb_copy_list; l; l=l->next){
+			char *name = cobc_strdup(l->text);
+			const int has_ext = (strchr (name, '.') != NULL);
+			const char *filename = cb_copy_find_file (name, has_ext);
+			if (!filename){
+				cobc_err_exit (_("fatal error: could not find --copy argument %s"), name);
+			}
+			cobc_free (name);
+		}
+	}
+
 	/* Reset source format in case text column has been configured manually. */
 	cobc_set_source_format (cobc_get_source_format ());
 

cobc/cobc.h

@@ -473,6 +473,7 @@ extern FILE			*cb_listing_file;
 extern FILE			*cb_src_list_file;
 extern FILE			*cb_depend_file;
 extern struct cb_text_list	*cb_depend_list;
+extern struct cb_text_list	*cb_copy_list;
 extern struct cb_text_list	*cb_include_list;
 extern struct cb_text_list	*cb_intrinsic_list;
 extern struct cb_text_list	*cb_extension_list;
@@ -652,6 +653,7 @@ extern void		cb_plex_error (const size_t,
 					 const char *, ...) COB_A_FORMAT23;
 extern unsigned int	cb_plex_verify (const size_t, const enum cb_support,
 					const char *);
+extern const char *cb_copy_find_file (char *name, int has_ext);
 extern void		configuration_warning (const char *, const int,
 					 const char *, ...) COB_A_FORMAT34;
 extern void		configuration_error (const char *, const int,

cobc/flag.def

@@ -165,7 +165,7 @@ CB_FLAG (cb_flag_stack_check, 1, "stack-check",
 	_("  -fstack-check         PERFORM stack checking\n"
 	  "                        * turned on by --debug/-g"))
 
-CB_FLAG_OP (1, "memory-check", CB_FLAG_MEMORY_CHECK,
+CB_FLAG_OP (1, "memory-check", CB_FLAG_GETOPT_MEMORY_CHECK,
 	_("  -fmemory-check=<scope>     checks for invalid writes to internal storage,\n"
 	  "                        <scope> may be one of: all, pointer, using, none\n"
 	  "                        * default: none, set to all by --debug"))

cobc/help.c

@@ -116,6 +116,7 @@ cobc_print_usage_common_options (void)
 	puts (_("  -X, --Xref            specify cross reference in listing"));
 #endif
 	puts (_("  -I <directory>        add <directory> to copy/include search path"));
+	puts (_("  --copy <copybook>     include <copybook> at beginning of file, as would COPY copybook."));
 	puts (_("  -L <directory>        add <directory> to library search path"));
 	puts (_("  -l <lib>              link the library <lib>"));
 	puts (_("  -K <entry>            generate CALL to <entry> as static"));

cobc/pplex.l

@@ -59,19 +59,21 @@ static int ppwrap (void) {
 	return 1;
 }
 
+static void insert_copy_arg (void);
+
 #define	PPLEX_BUFF_LEN		512
 #define YY_INPUT(buf,result,max_size)	result = ppinput (buf, max_size);
 #define	ECHO				fputs (yytext, yyout)
 
+/* The first --copy COPYBOOK is inserted using this macro. The next
+   ones will be inserted in <<EOF>>, when we come back to the toplevel
+   source file. */
 #define	YY_USER_INIT							\
-	if (!plexbuff1) {						\
-		plexbuff1 = cobc_malloc ((size_t)COB_SMALL_BUFF);	\
-	}								\
-	if (!plexbuff2) {						\
-		plexbuff2 = cobc_malloc ((size_t)COB_SMALL_BUFF);	\
-	}								\
 	requires_listing_line = 1;					\
-	comment_allowed = 1;
+	comment_allowed = 1;						\
+	copy_list_pointer = cb_copy_list;				\
+	insert_copy_arg ();
+
 
 #include "config.h"
 
@@ -177,6 +179,20 @@ static void	output_pending_newlines	(FILE *);
 static struct cb_text_list	*pp_text_list_add (struct cb_text_list *,
 					 const char *, const size_t);
 
+static struct cb_text_list *copy_list_pointer = NULL;
+
+static void insert_copy_arg (void)
+{
+	if (copy_list_pointer != NULL){
+		int ret = ppcopy (copy_list_pointer->text, NULL, NULL);
+		if ( ret < 0 ){ /* This should never happen, as we already test it before */
+			cobc_err_msg (_("fatal error: %s"), "could not find --copy argument");
+			cobc_abort_terminate (0);
+		}
+		copy_list_pointer = copy_list_pointer->next;
+	}
+}
+
 %}
 
 WORD		[_0-9A-Z\x80-\xFF-]+
@@ -1203,6 +1219,13 @@ ENDIF_DIRECTIVE_STATE>{
 	copy_stack = current_copy_info->next;
 	cobc_free (current_copy_info->dname);
 	cobc_free (current_copy_info);
+
+	/* Check whether we are back at the toplevel source file. In this case,
+	   check if there is a pending copy argument (--copy COPYBOOK) waiting
+	   to be inserted. */
+	if (copy_stack->next == NULL){
+		insert_copy_arg();
+	}
 }
 
 %%
@@ -1442,6 +1465,10 @@ ppcopy_try_open (const char *dir, const char *name, int has_ext)
 	const char		*extension = "";
 	struct stat st;
 
+	if (!plexbuff2) {
+		plexbuff2 = cobc_malloc ((size_t)COB_SMALL_BUFF);
+	}
+
 	for (;;) {
 		if (dir) {
 			snprintf (plexbuff2, (size_t)COB_SMALL_MAX, "%s%c%s%s",
@@ -1482,8 +1509,8 @@ ppcopy_try_open (const char *dir, const char *name, int has_ext)
    each with all known copybook extensions:
    1 - as is
    2 - all known copybook directories */
-static const char *
-ppcopy_find_file (char *name, int has_ext)
+const char *
+cb_copy_find_file (char *name, int has_ext)
 {
 	const char *filename;
 	{
@@ -1559,6 +1586,10 @@ ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list)
 		cb_current_file->copy_line = cb_source_line;
 	}
 
+	if (!plexbuff1) {
+		plexbuff1 = cobc_malloc ((size_t)COB_SMALL_BUFF);
+	}
+
 	/* TODO: open with path relative to the current file's path,
 	         if any (applies both to with and without "lib") */
 
@@ -1582,10 +1613,10 @@ ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list)
 					snprintf (plexbuff1, (size_t)COB_SMALL_MAX, "%s%c%s",
 						lib_env, SLASH_CHAR, name);
 					plexbuff1[COB_SMALL_MAX] = 0;
-					filename = ppcopy_find_file (plexbuff1, has_ext);
+					filename = cb_copy_find_file (plexbuff1, has_ext);
 				} else {
 					strcpy (plexbuff1, name);
-					filename = ppcopy_find_file (plexbuff1, has_ext);
+					filename = cb_copy_find_file (plexbuff1, has_ext);
 				}
 			}
 		}
@@ -1596,13 +1627,13 @@ ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list)
 			snprintf (plexbuff1, (size_t)COB_SMALL_MAX, "%s%c%s",
 				lib, SLASH_CHAR, name);
 			plexbuff1[COB_SMALL_MAX] = 0;
-			filename = ppcopy_find_file (plexbuff1, has_ext);
+			filename = cb_copy_find_file (plexbuff1, has_ext);
 		}
 
 		/* try without library name, if not resolved by env */
 		if (!filename && !lib_env) {
 			strcpy (plexbuff1, name);
-			filename = ppcopy_find_file (plexbuff1, has_ext);
+			filename = cb_copy_find_file (plexbuff1, has_ext);
 			if (filename) {
 				cb_plex_warning (COBC_WARN_FILLER, 0,
 					_("copybook not found in library '%s', library-name ignored"),
@@ -1618,7 +1649,7 @@ ppcopy (const char *name, const char *lib, struct cb_replace_list *replace_list)
 		}
 	} else {
 		strcpy (plexbuff1, name);
-		filename = ppcopy_find_file (plexbuff1, has_ext);
+		filename = cb_copy_find_file (plexbuff1, has_ext);
 	}
 
 	/* expected case: filename found */

cobc/replace.c

@@ -193,6 +193,17 @@ STRING_OF_LIST(token)
 /* string_of_text_list (...) */
 STRING_OF_LIST(text)
 
+static void dump_replacement(struct cb_replacement_state* repls)
+{
+	fprintf(stderr, "dump_replacement('%s'):\n", repls->name);
+	struct cb_replace_list  *list = repls->replace_list ;
+	for (;list;list = list->next){
+		fprintf(stderr, "   replace: %s\n", string_of_text_list (list->src->text_list));
+		fprintf(stderr, "        by: %s\n", string_of_text_list (list->new_text));
+	}
+	fprintf(stderr, "=================================================================\n");
+}
+
 #endif /* DEBUG_REPLACE */
 
 /* global state */
@@ -747,6 +758,7 @@ static
 void init_replace( void )
 {
 #ifdef DEBUG_REPLACE_TRACE
+	fprintf (stderr, "init_replace()\n");
 	for(int i=0; i<MAX_DEPTH; i++) depth_buffer[i] = ' ';
 	depth_buffer[MAX_DEPTH]=0;
 #endif
@@ -757,13 +769,19 @@ void init_replace( void )
 static
 void reset_replace (void)
 {
+#ifdef DEBUG_REPLACE_TRACE
+	fprintf (stderr, "reset_replace()\n");
+#endif
 	reset_replacements (copy_repls);
 	reset_replacements (replace_repls);
 }
 
 /* Called by pplex.l at EOF of top file */
 void cb_free_replace( void )
 {
+#ifdef DEBUG_REPLACE_TRACE
+	fprintf (stderr, "cb_free_replace()\n");
+#endif
 	reset_replace ();
 	cobc_free (copy_repls);
 	copy_repls = NULL;
@@ -775,6 +793,10 @@ void cb_free_replace( void )
    stack of active copy-replacing */
 struct cb_replace_list *cb_get_copy_replacing_list (void)
 {
+#ifdef DEBUG_REPLACE_TRACE
+	fprintf (stderr, "cb_get_copy_replacing_list()\n");
+#endif
+
 	if (copy_repls == NULL) {
 		init_replace();
 	}
@@ -841,4 +863,7 @@ cb_set_replace_list (struct cb_replace_list *list, const int is_pushpop)
 	if (cb_src_list_file) {
 		cb_set_print_replace_list (list);
 	}
+#ifdef DEBUG_REPLACE_TRACE
+	dump_replacement(replace_repls);
+#endif
 }

doc/gnucobol.texi

@@ -363,10 +363,14 @@ The following options specify the target type produced by the compiler:
 @table @code
 @item -E
 Preprocess only: compiler directives are executed, comment lines are
-removed and @code{COPY} statements are expanded.
+removed, and @code{COPY} and @code{REPLACE} statements are performed.
 The output is sent to stdout, allowing you to directly use it as input for
 another process. You can manually set an output file using @option{-o}.
 
+@item --copy @var{copybook}
+Include @file{copybook} at the beginning of the source code, as if
+@code{COPY copybook} had been parsed.
+
 @item -C
 Translation only.  COBOL source files are translated into C files.
 The output is saved in file @file{*.c}.