cobol: Improved handling of COBOL Special Registers.

COBOL Special Registers (e.g., RETURN-CODE; DEBUG-ITEM) are implemented as
global variables.  These changes define them with the prefix "__ggsr__" in
their variable names so that the GDB-COBOL debugger can identify them.

The creation and handling of such variables has been streamlined with the
introduction of the "register_e" cbl_field_t::attr bit.

gcc/cobol/ChangeLog:

	* genapi.cc (trace1_init): Prepend two internal variables with
	underscore.
	(initialize_variable_internal): Use new register_e attribute.
	(psa_global): Use "__ggsr__" prefix to identify special registers
	(parser_symbol_add): Use new register_e attribute.
	* symbols.cc (cbl_field_attr_str): Likewise.
	(symbol_table_init): Likewise.
	(is_register_field): Eliminated in favor of (attr & register_e).
	* symbols.h (is_register_field): Likewise.

libgcobol/ChangeLog:

	* common-defs.h (enum cbl_field_attr_t): Define register_e.
	* constants.cc (struct cblc_field_t): Define special registers with
	"__ggsr__" prefix.

diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 40b79ba5ce6c2ceb08149ac4eb121040f6914add..11242c19285d809c19de5143e8e2e6a75a00b382 100644 (file)
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -203,8 +203,8 @@ trace1_init()
   if( first_time )
     {
     first_time = false;
-    trace_handle = gg_define_variable(INT, "trace_handle", vs_static);
-    trace_indent = gg_define_variable(INT, "trace_indent", vs_static);
+    trace_handle = gg_define_variable(INT, "_trace_handle", vs_static);
+    trace_indent = gg_define_variable(INT, "_trace_indent", vs_static);
 
     bTRACE1 = getenv("GCOBOL_TRACE") ? getenv("GCOBOL_TRACE") :gv_trace_switch;
 
@@ -1227,7 +1227,7 @@ initialize_variable_internal( cbl_refer_t refer,
     return;
     }
 
-  if( is_register_field( parsed_var) )
+  if( parsed_var->attr & register_e )
     {
     return;
     }
@@ -16374,10 +16374,6 @@ actually_create_the_static_field( cbl_field_t *new_var,
 static void
 psa_global(cbl_field_t *new_var)
   {
-  char *mname = cobol_name_mangler(new_var->name);
-  char ach[2*sizeof(cbl_name_t)];
-  sprintf(ach, "__gg__%s", mname);
-  free(mname);
 
   if( strcmp(new_var->name, "_VERY_TRUE") == 0 )
     {
@@ -16390,10 +16386,20 @@ psa_global(cbl_field_t *new_var)
     return;
     }
 
-  // global variables already have a cblc_field_t defined in constants.cc
+  // global variables already have a cblc_field_t defined in constants.cc.
 
-  strcpy(ach, "__gg__");
-  strcat(ach, new_var->name);
+  // Finding their name is done by converting to lowercase, dashes become
+  // underscores, and "__ggsr__" is prepended.  "filler" gets ignored.
+
+  // To feed GDB-COBOL's requirements, we tack on this variable's index and
+  // this program's index number:
+
+  char ach[2*sizeof(cbl_name_t)];
+
+  snprintf( ach,
+            sizeof(ach),
+            "__ggsr__%s",
+            new_var->name);
   for(size_t i=0; i<strlen(ach); i++)
     {
     ach[i] = _tolower(ach[i]);
@@ -16403,16 +16409,6 @@ psa_global(cbl_field_t *new_var)
       }
     }
 
-  if( strcmp(new_var->name, "RETURN-CODE") == 0 )
-    {
-    strcpy(ach, "__gg__return_code");
-    }
-
-  if( strcmp(new_var->name, "UPSI-0") == 0 )
-    {
-    strcpy(ach, "__gg__upsi");
-    }
-
   new_var->var_decl_node = gg_declare_variable(cblc_field_type_node, ach, NULL, vs_external_reference);
 
   // global variables already have a .data area defined.  We can find that
@@ -16857,7 +16853,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
     {
     cbl_field_type_t incoming_type = new_var->type;
 
-    if( is_register_field(new_var) )
+    if( new_var->attr & register_e )
       {
       psa_global(new_var);
       goto done;

diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index bbe99b6801f6a38c84d2811fd0c97cceb170efd9..205465b2c64dd5e8968dcd763ca72227bdf04bd6 100644 (file)
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -741,7 +741,7 @@ cbl_field_attr_str( cbl_field_attr_t attr ) {
   case function_e: return "function";
   case quoted_e: return "quoted";
   case filler_e: return "filler";
-  case _spare_e: return "temporary";
+  case register_e: return "register";
   case intermediate_e: return "intermediate";
   case embiggened_e: return "embiggened";
   case all_alpha_e: return "all_alpha";
@@ -2153,34 +2153,34 @@ symbol_table_init(void) {
 
   // These should match the definitions in libgcobol/constants.cc
   static cbl_field_t constants[] = {
-    { 0, FldAlphanumeric, FldInvalid, space_value_e | constq, 0, 0, 0, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, space_value_e | constq | register_e, 0, 0, 0, nonarray, 0,
       "SPACE", 0, {}, {1,1,0,0, " \0\xFF"}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, space_value_e | constq , 0, 0, 0, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, space_value_e | constq | register_e, 0, 0, 0, nonarray, 0,
       "SPACES", 0, {}, {1,1,0,0, " \0\xFF"}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, low_value_e | constq, 0, 0, 0, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, low_value_e | constq | register_e, 0, 0, 0, nonarray, 0,
       "LOW_VALUES", 0, {}, {1,1,0,0, "L\0\xFF"}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, zero_value_e | constq, 0, 0, 0, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, zero_value_e | constq | register_e, 0, 0, 0, nonarray, 0,
       "ZEROS", 0, {}, {1,1,0,0, "0"}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, high_value_e | constq, 0, 0, 0, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, high_value_e | constq | register_e, 0, 0, 0, nonarray, 0,
       "HIGH_VALUES", 0, {}, {1,1,0,0, "H\0\xFF"}, NULL },
     // IBM standard: QUOTE is a double-quote unless APOST compiler option
-    { 0, FldAlphanumeric, FldInvalid, quote_value_e | constq , 0, 0, 0, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, quote_value_e | constq | register_e , 0, 0, 0, nonarray, 0,
       "QUOTES", 0, {}, {1,1,0,0, "\"\0\xFF"}, NULL },
-    { 0, FldPointer, FldPointer, constq , 0, 0, 0, nonarray, 0,
+    { 0, FldPointer, FldPointer, constq | register_e , 0, 0, 0, nonarray, 0,
       "NULLS", 0, {}, {8,8,0,0, zeroes_for_null_pointer}, NULL },
     // IBM defines TALLY
     // 01  TALLY GLOBAL PICTURE 9(5) USAGE BINARY VALUE ZERO.
-    { 0, FldNumericBin5, FldInvalid, signable_e, 0, 0, 0, nonarray, 0,
+    { 0, FldNumericBin5, FldInvalid, signable_e | register_e, 0, 0, 0, nonarray, 0,
       "_TALLY", 0, {}, {16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL}, NULL },
     // 01  ARGI is the current index into the argv array
-    { 0, FldNumericBin5, FldInvalid, signable_e, 0, 0, 0, nonarray, 0,
+    { 0, FldNumericBin5, FldInvalid, signable_e | register_e, 0, 0, 0, nonarray, 0,
       "_ARGI", 0, {}, {16, 16, MAX_FIXED_POINT_DIGITS, 0, NULL}, NULL },
 
     // These last two don't require actual storage; they get BOOL var_decl_node
     // in parser_symbol_add()
-    { 0, FldConditional, FldInvalid, constant_e , 0, 0, 0, nonarray, 0,
+    { 0, FldConditional, FldInvalid, constant_e | register_e , 0, 0, 0, nonarray, 0,
       "_VERY_TRUE", 0, {}, {1,1,0,0, ""}, NULL },
-    { 0, FldConditional, FldInvalid, constant_e , 0, 0, 0, nonarray, 0,
+    { 0, FldConditional, FldInvalid, constant_e | register_e , 0, 0, 0, nonarray, 0,
       "_VERY_FALSE", 0, {}, {1,1,0,0, ""}, NULL },
   };
   for( struct cbl_field_t *f = constants;
@@ -2253,29 +2253,29 @@ symbol_table_init(void) {
    **/
 
   static cbl_field_t debug_registers[] = {
-    { 0, FldGroup, FldInvalid, global_e, 0,0,1, nonarray, 0,
+    { 0, FldGroup, FldInvalid, register_e, 0,0,1, nonarray, 0,
       "DEBUG-ITEM", 0, {}, {132,132,0,0, NULL}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, global_e, 0,0,2, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, register_e, 0,0,2, nonarray, 0,
       "DEBUG-LINE", 0, {}, {6,6,0,0, "      "}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, register_e|filler_e, 0,0,2, nonarray, 0,
       "FILLER", 0, {}, {1,1,0,0, " "}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, global_e, 0,0,2, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, register_e, 0,0,2, nonarray, 0,
       "DEBUG-NAME", 0, {}, {30,30,0,0, NULL}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, register_e|filler_e, 0,0,2, nonarray, 0,
       "FILLER", 0, {}, {1,1,0,0, " "}, NULL },
-    { 0, FldNumericDisplay, FldInvalid, signable_e | global_e | leading_e | separate_e, 0,0,2, nonarray, 0,
-      "DEBUG-SUB-1", 0, {}, {5,5,3,0, NULL}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
+    { 0, FldNumericDisplay, FldInvalid, signable_e | register_e | leading_e | separate_e, 0,0,2, nonarray, 0,
+      "DEBUG-SUB-1", 0, {}, {5,5,4,0, NULL}, NULL },
+    { 0, FldAlphanumeric, FldInvalid, register_e|filler_e, 0,0,2, nonarray, 0,
       "FILLER", 0, {}, {1,1,0,0, " "}, NULL },
-    { 0, FldNumericDisplay, FldInvalid, signable_e | global_e | leading_e | separate_e, 0,0,2, nonarray, 0,
-      "DEBUG-SUB-2", 0, {}, {5,5,3,0, NULL}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
+    { 0, FldNumericDisplay, FldInvalid, signable_e | register_e | leading_e | separate_e, 0,0,2, nonarray, 0,
+      "DEBUG-SUB-2", 0, {}, {5,5,4,0, NULL}, NULL },
+    { 0, FldAlphanumeric, FldInvalid, register_e|filler_e, 0,0,2, nonarray, 0,
       "FILLER", 0, {}, {1,1,0,0, " "}, NULL },
-    { 0, FldNumericDisplay, FldInvalid, signable_e | global_e | leading_e | separate_e, 0,0,2, nonarray, 0,
-      "DEBUG-SUB-3", 0, {}, {5,5,3,0, NULL}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, 0, 0,0,2, nonarray, 0,
+    { 0, FldNumericDisplay, FldInvalid, signable_e | register_e | leading_e | separate_e, 0,0,2, nonarray, 0,
+      "DEBUG-SUB-3", 0, {}, {5,5,4,0, NULL}, NULL },
+    { 0, FldAlphanumeric, FldInvalid, register_e|filler_e, 0,0,2, nonarray, 0,
       "FILLER", 0, {}, {1,1,0,0, " "}, NULL },
-    { 0, FldAlphanumeric, FldInvalid, signable_e | global_e, 0,0,2, nonarray, 0,
+    { 0, FldAlphanumeric, FldInvalid, signable_e | register_e, 0,0,2, nonarray, 0,
       "DEBUG-CONTENTS", 0, {}, {76,76,0,0, NULL}, NULL },
   };
 
@@ -2296,21 +2296,21 @@ symbol_table_init(void) {
   std::for_each(debug_start+1, p, parent_elem_set(debug_start - table.elems));
 
   static cbl_field_t special_registers[] = {
-    { 0, FldNumericDisplay, FldInvalid, 0, 0, 0, 0, nonarray, 0, "_FILE_STATUS",
+    { 0, FldNumericDisplay, FldInvalid, register_e, 0, 0, 0, nonarray, 0, "_FILE_STATUS",
       0, {}, {2,2,2,0, NULL}, NULL },
-    { 0, FldNumericBin5, FldInvalid, 0, 0, 0, 0, nonarray, 0, "UPSI-0",
+    { 0, FldNumericBin5, FldInvalid, register_e, 0, 0, 0, nonarray, 0, "UPSI-0",
       0, {}, {2,2,4,0, NULL}, NULL },
-    { 0, FldNumericBin5, FldInvalid, signable_e, 0, 0, 0, nonarray, 0, "RETURN-CODE",
+    { 0, FldNumericBin5, FldInvalid, signable_e|register_e, 0, 0, 0, nonarray, 0, "RETURN-CODE",
       0, {}, {2,2,4,0, NULL}, NULL },
-    { 0, FldNumericBin5, FldInvalid, 0, 0, 0, 0, nonarray, 0, "LINAGE-COUNTER",
+    { 0, FldNumericBin5, FldInvalid, register_e, 0, 0, 0, nonarray, 0, "LINAGE-COUNTER",
       0, {}, {2,2,4,0, NULL}, NULL },
-    { 0, FldLiteralA, FldInvalid, 0, 0, 0, 0, nonarray, 0, "_dev_stdin",
+    { 0, FldLiteralA, FldInvalid, register_e, 0, 0, 0, nonarray, 0, "_dev_stdin",
       0, {}, {0,0,0,0, "/dev/stdin"}, NULL },
-    { 0, FldLiteralA, FldInvalid, constq, 0, 0, 0, nonarray, 0, "_dev_stdout",
+    { 0, FldLiteralA, FldInvalid, constq|register_e, 0, 0, 0, nonarray, 0, "_dev_stdout",
       0, {}, {0,0,0,0, "/dev/stdout"}, NULL },
-    { 0, FldLiteralA, FldInvalid, constq, 0, 0, 0, nonarray, 0, "_dev_stderr",
+    { 0, FldLiteralA, FldInvalid, constq|register_e, 0, 0, 0, nonarray, 0, "_dev_stderr",
       0, {}, {0,0,0,0, "/dev/stderr"}, NULL },
-    { 0, FldLiteralA, FldInvalid, constq, 0, 0, 0, nonarray, 0, "_dev_null",
+    { 0, FldLiteralA, FldInvalid, constq|register_e, 0, 0, 0, nonarray, 0, "_dev_null",
       0, {}, {0,0,0,0, "/dev/null"}, NULL },
   };
 
@@ -4712,21 +4712,6 @@ ast_file_status_between( file_status_t lower, file_status_t upper ) {
   return cond.both;
 }
 
-bool
-is_register_field(const cbl_field_t *field)
-  {
-  // TRUE when the field is an executable-level global variable of the type we
-  // are calling a "register", like RETURN-CODE or UPSI or the like:
-  return
-    (    field->parent == 0
-      && field->level == 0
-      && !(field->attr & intermediate_e)
-      && !(field->attr & filler_e)
-      && field->type != FldClass
-      && field->type != FldBlob
-      );
-  }
-
 bool
 has_value( cbl_field_type_t type ) {
   // Indicates that the field type contains data that can be expressed as

diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index c8ae32f2f60517c31422f3894a0b6ec0d7e74aff..c8b37a61409df4fe2e75a6160576ee4a27f85fe1 100644 (file)
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -817,8 +817,6 @@ is_record_area( const cbl_field_t *field ) {
   return 0 == memcmp(field->name, stem, sizeof(stem)-1);
 }
 
-bool is_register_field( const cbl_field_t *field );
-
 static inline bool
 is_constant( const cbl_field_t *field ) {
   return field->has_attr(constant_e);

diff --git a/libgcobol/common-defs.h b/libgcobol/common-defs.h
index 80e524c1e6662633d0eaf41939e617278bce152a..4180a18da0851ee9badf9820d398693cd8d663eb 100644 (file)
--- a/libgcobol/common-defs.h
+++ b/libgcobol/common-defs.h
@@ -211,7 +211,7 @@ enum cbl_field_attr_t : uint64_t {
   function_e        = 0x0000000100,
   quoted_e          = 0x0000000200,
   filler_e          = 0x0000000400,
-  _spare_e          = 0x0000000800, //
+  register_e        = 0x0000000800, // Data definition is found in constants.cc
   intermediate_e    = 0x0000001000, // Compiler-defined temporary variable
   embiggened_e      = 0x0000002000, // redefined numeric made 64-bit by USAGE POINTER
   all_alpha_e       = 0x0000004000, // FldAlphanumeric, but all A's

diff --git a/libgcobol/constants.cc b/libgcobol/constants.cc
index eebfd218295fee9ec51b3bfb3b375bbb8b84ece0..b5567ed7dc1e57345293720f7ee1c710c52547a6 100644 (file)
--- a/libgcobol/constants.cc
+++ b/libgcobol/constants.cc
@@ -70,7 +70,7 @@ int __gg__globals_are_initialized = 0;
 
 #define INTEGER_CONSTANT1(a) \
 unsigned char __gg__data_##a[1] = {(a)};  \
-struct cblc_field_t __gg___1_##a = {    \
+struct cblc_field_t __ggsr___1_##a = {    \
   .data           =  __gg__data_##a ,         \
   .capacity       = 1 ,                 \
   .allocated      = 1 ,                 \
@@ -81,7 +81,7 @@ struct cblc_field_t __gg___1_##a = {    \
   .parent         = NULL,               \
   .occurs_lower   = 0 ,                 \
   .occurs_upper   = 0 ,                 \
-  .attr           = 0x80 ,              \
+  .attr           = global_e | constant_e , \
   .type           = FldLiteralN ,       \
   .level          = 0 ,                 \
   .digits         = 0 ,                 \
@@ -91,7 +91,7 @@ struct cblc_field_t __gg___1_##a = {    \
 
 #define INTEGER_CONSTANT2(a) \
 unsigned char __gg__data_##a[1] = {(a)};  \
-struct cblc_field_t __gg___2_##a = {    \
+struct cblc_field_t __ggsr___2_##a = {    \
   .data           = __gg__data_##a ,         \
   .capacity       = 1 ,                 \
   .allocate       = 1 ,                 \
@@ -102,7 +102,7 @@ struct cblc_field_t __gg___2_##a = {    \
   .parent         = NULL,               \
   .occurs_lower   = 0 ,                 \
   .occurs_upper   = 0 ,                 \
-  .attr           = 0x80 ,              \
+  .attr           = global_e | constant_e , \
   .type           = FldLiteralN ,       \
   .level          = 0 ,                 \
   .digits         = 0 ,                 \
@@ -111,7 +111,7 @@ struct cblc_field_t __gg___2_##a = {    \
   };
 
 unsigned char __gg__data_space[1] = {' '};
-struct cblc_field_t __gg__space = {
+struct cblc_field_t __ggsr__space = {
   .data           = __gg__data_space ,
   .capacity       = sizeof(__gg__data_space) ,
   .allocated      = sizeof(__gg__data_space) ,
@@ -130,7 +130,7 @@ struct cblc_field_t __gg__space = {
   .dummy          = 0 ,
   };
 
-struct cblc_field_t __gg__spaces = {
+struct cblc_field_t __ggsr__spaces = {
   .data           = __gg__data_space ,
   .capacity       = sizeof(__gg__data_space) ,
   .allocated      = sizeof(__gg__data_space) ,
@@ -150,7 +150,7 @@ struct cblc_field_t __gg__spaces = {
   };
 
 unsigned char __gg__data_low_values[1] = {'\0'};
-struct cblc_field_t __gg__low_values = {
+struct cblc_field_t __ggsr__low_values = {
   .data           = __gg__data_low_values,
   .capacity       = 1 ,
   .allocated      = 1 ,
@@ -170,7 +170,7 @@ struct cblc_field_t __gg__low_values = {
   };
 
 unsigned char __gg__data_zeros[1] = {'0'};
-struct cblc_field_t __gg__zeros = {
+struct cblc_field_t __ggsr__zeros = {
   .data           = __gg__data_zeros ,
   .capacity       = 1 ,
   .allocated      = 1 ,
@@ -190,7 +190,7 @@ struct cblc_field_t __gg__zeros = {
   };
 
 unsigned char __gg__data_high_values[1] = {0xFF};
-struct cblc_field_t __gg__high_values = {
+struct cblc_field_t __ggsr__high_values = {
   .data           = __gg__data_high_values ,
   .capacity       = 1 ,
   .allocated      = 1 ,
@@ -210,7 +210,7 @@ struct cblc_field_t __gg__high_values = {
   };
 
 unsigned char __gg__data_quotes[1] = {0xFF};
-struct cblc_field_t __gg__quotes = {
+struct cblc_field_t __ggsr__quotes = {
   .data           = __gg__data_quotes ,
   .capacity       = 1 ,
   .allocated      = 1 ,
@@ -230,7 +230,7 @@ struct cblc_field_t __gg__quotes = {
   };
 
 unsigned char __gg__data_nulls[8] = {0,0,0,0,0,0,0,0};
-struct cblc_field_t __gg__nulls = {
+struct cblc_field_t __ggsr__nulls = {
   .data           = __gg__data_nulls ,
   .capacity       = 8 ,
   .allocated      = 8 ,
@@ -250,7 +250,7 @@ struct cblc_field_t __gg__nulls = {
   };
 
 unsigned char __gg__data__file_status[2] = {0,0};
-struct cblc_field_t __gg___file_status = {
+struct cblc_field_t __ggsr___file_status = {
   .data           = __gg__data__file_status ,
   .capacity       = 2 ,
   .allocated      = 2 ,
@@ -271,7 +271,7 @@ struct cblc_field_t __gg___file_status = {
 
 
 unsigned char __gg__data_linage_counter[2] = {0,0};
-struct cblc_field_t __gg___14_linage_counter6 = {
+struct cblc_field_t __ggsr___14_linage_counter6 = {
   .data           = __gg__data_linage_counter ,
   .capacity       = 2 ,
   .allocated      = 2 ,
@@ -292,7 +292,7 @@ struct cblc_field_t __gg___14_linage_counter6 = {
 
 
 unsigned char __gg__data_upsi_0[2] = {0,0};
-struct cblc_field_t __gg__upsi = {
+struct cblc_field_t __ggsr__upsi_0 = {
   .data           = __gg__data_upsi_0 ,
   .capacity       = 2 ,
   .allocated      = 2 ,
@@ -312,7 +312,7 @@ struct cblc_field_t __gg__upsi = {
   };
 
 short __gg__data_return_code = 0;
-struct cblc_field_t __gg__return_code = {
+struct cblc_field_t __ggsr__return_code = {
   .data           = (unsigned char *)&__gg__data_return_code ,
   .capacity       = 2 ,
   .allocated      = 2 ,
@@ -332,7 +332,7 @@ struct cblc_field_t __gg__return_code = {
   };
 
 unsigned char __gg___data_dev_stdin[] = "/dev/stdin";
-struct cblc_field_t __gg___dev_stdin = {
+struct cblc_field_t __ggsr___dev_stdin = {
   .data           = __gg___data_dev_stdin ,
   .capacity       = sizeof(__gg___data_dev_stdin)-1 ,
   .allocated       = sizeof(__gg___data_dev_stdin)-1 ,
@@ -352,7 +352,7 @@ struct cblc_field_t __gg___dev_stdin = {
   };
 
  unsigned char __gg___data_dev_stdout[] = "/dev/stdout";
-struct cblc_field_t __gg___dev_stdout = {
+struct cblc_field_t __ggsr___dev_stdout = {
   .data           = __gg___data_dev_stdout ,
   .capacity       = sizeof(__gg___data_dev_stdout)-1 ,
   .allocated      = sizeof(__gg___data_dev_stdout)-1 ,
@@ -372,7 +372,7 @@ struct cblc_field_t __gg___dev_stdout = {
   };
 
 unsigned char __gg___data_dev_stderr[] = "/dev/stderr";
-struct cblc_field_t __gg___dev_stderr = {
+struct cblc_field_t __ggsr___dev_stderr = {
   .data           = __gg___data_dev_stderr ,
   .capacity       = sizeof(__gg___data_dev_stderr)-1 ,
   .allocated      = sizeof(__gg___data_dev_stderr)-1 ,
@@ -392,7 +392,7 @@ struct cblc_field_t __gg___dev_stderr = {
   };
 
 unsigned char __gg___data_dev_null[] = "/dev/null";
-struct cblc_field_t __gg___dev_null = {
+struct cblc_field_t __ggsr___dev_null = {
   .data           = __gg___data_dev_null ,
   .capacity       = sizeof(__gg___data_dev_null)-1 ,
   .allocated      = sizeof(__gg___data_dev_null)-1 ,
@@ -411,6 +411,298 @@ struct cblc_field_t __gg___dev_null = {
   .dummy          = 0 ,
   };
 
+unsigned char __gg__data_tally[] = {0,0};
+struct cblc_field_t __ggsr__tally = {
+  .data           = __gg__data_tally ,
+  .capacity       = 4 ,
+  .allocated      = 4 ,
+  .offset         = 0 ,
+  .name           = "_TALLY" ,
+  .picture        = "" ,
+  .initial        = "" ,
+  .parent         = NULL,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = global_e ,
+  .type           = FldNumericBin5 ,
+  .level          = 0 ,
+  .digits         = 5 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+unsigned char __gg__data_argi[] = {0,0};
+struct cblc_field_t __ggsr__argi = {
+  .data           = __gg__data_argi ,
+  .capacity       = 4 ,
+  .allocated      = 4 ,
+  .offset         = 0 ,
+  .name           = "_ARGI" ,
+  .picture        = "" ,
+  .initial        = "" ,
+  .parent         = NULL,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = global_e ,
+  .type           = FldNumericBin5 ,
+  .level          = 0 ,
+  .digits         = 5 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+/* The following defines storage for the global DEBUG-ITEM:
+
+     01 DEBUG-ITEM.
+        02 DEBUG-LINE PIC X(6).
+        02 FILLER PIC X VALUE SPACE.
+        02 DEBUG-NAME PIC X(30).
+        02 FILLER PIC X VALUE SPACE.
+        02 DEBUG-SUB-1 PIC S9999 SIGN IS LEADING SEPARATE CHARACTER.
+        02 FILLER PIC X VALUE SPACE.
+        02 DEBUG-SUB-2 PIC S9999 SIGN IS LEADING SEPARATE CHARACTER.
+        02 FILLER PIC X VALUE SPACE.
+        02 DEBUG-SUB-3 PIC S9999 SIGN IS LEADING SEPARATE CHARACTER.
+        02 FILLER PIC X VALUE SPACE.
+        02 DEBUG-CONTENTS PIC X(76).
+*/
+
+unsigned char __gg__debug_item_data[132] = 
+                                 "                                      "
+                                 "+0000 +0000 +0000 "
+                                 "                                      "
+                                 "                                     ";
+struct cblc_field_t __ggsr__debug_item = {
+  .data           = __gg__debug_item_data ,
+  .capacity       = 132 ,
+  .allocated      = 132 ,
+  .offset         = 0 ,
+  .name           = "DEBUG-ITEM" ,
+  .picture        = "" ,
+  .initial        =              "                                      "
+                                 "+0000 +0000 +0000 "
+                                 "                                      "
+                                 "                                     " ,
+  .parent         = NULL ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = register_e ,
+  .type           = FldGroup ,
+  .level          = 01 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_line = {
+  .data           = __gg__debug_item_data + 0 ,
+  .capacity       = 6 ,
+  .allocated      = 6 ,
+  .offset         = 0 ,
+  .name           = "DEBUG-LINE" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = register_e ,
+  .type           = FldAlphanumeric ,
+  .level          = 05 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_filler_1 = {
+  .data           = __gg__debug_item_data + 6 ,
+  .capacity       = 1 ,
+  .allocated      = 1 ,
+  .offset         = 6 ,
+  .name           = "FILLER" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = register_e | filler_e ,
+  .type           = FldAlphanumeric ,
+  .level          = 05 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_name = {
+  .data           = __gg__debug_item_data + 7 ,
+  .capacity       = 30 ,
+  .allocated      = 30 ,
+  .offset         = 7 ,
+  .name           = "DEBUG-NAME" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = register_e ,
+  .type           = FldAlphanumeric ,
+  .level          = 05 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_filler_2 = {
+  .data           = __gg__debug_item_data + 37 ,
+  .capacity       = 1 ,
+  .allocated      = 1 ,
+  .offset         = 37 ,
+  .name           = "FILLER" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = register_e | filler_e ,
+  .type           = FldAlphanumeric ,
+  .level          = 05 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_sub_1 = {
+  .data           = __gg__debug_item_data + 38 ,
+  .capacity       = 5 ,
+  .allocated      = 5 ,
+  .offset         = 38 ,
+  .name           = "DEBUG-SUB-1" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = signable_e | register_e | leading_e | separate_e ,
+  .type           = FldNumericDisplay ,
+  .level          = 05 ,
+  .digits         = 4 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_filler_3 = {
+  .data           = __gg__debug_item_data + 43,
+  .capacity       =  1,
+  .allocated      =  1,
+  .offset         =  43,
+  .name           = "FILLER" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = register_e | filler_e ,
+  .type           = FldAlphanumeric ,
+  .level          = 05 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_sub_2 = {
+  .data           = __gg__debug_item_data + 44 ,
+  .capacity       = 5 ,
+  .allocated      = 5 ,
+  .offset         = 44 ,
+  .name           = "DEBUG-SUB-2" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = signable_e | register_e | leading_e | separate_e ,
+  .type           = FldNumericDisplay ,
+  .level          = 05 ,
+  .digits         = 4 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_filler_4 = {
+  .data           = __gg__debug_item_data +  49,
+  .capacity       =  1,
+  .allocated      =  1,
+  .offset         =  49,
+  .name           = "FILLER" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = register_e | filler_e ,
+  .type           = FldAlphanumeric ,
+  .level          = 05 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_sub_3 = {
+  .data           = __gg__debug_item_data + 50 ,
+  .capacity       = 5 ,
+  .allocated      = 5 ,
+  .offset         = 50 ,
+  .name           = "DEBUG-SUB-3" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = signable_e | register_e | leading_e | separate_e ,
+  .type           = FldNumericDisplay ,
+  .level          = 05 ,
+  .digits         = 4 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_filler_5 = {
+  .data           = __gg__debug_item_data + 55,
+  .capacity       =  1,
+  .allocated      =  1,
+  .offset         =  55,
+  .name           = "FILLER" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = register_e | filler_e ,
+  .type           = FldAlphanumeric ,
+  .level          = 05 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
+struct cblc_field_t __ggsr__debug_contents = {
+  .data           = __gg__debug_item_data + 56 ,
+  .capacity       = 76 ,
+  .allocated      = 76 ,
+  .offset         = 56 ,
+  .name           = "DEBUG-CONTENTS" ,
+  .picture        = "" ,
+  .initial        = NULL ,
+  .parent         = &__ggsr__debug_item ,
+  .occurs_lower   = 0 ,
+  .occurs_upper   = 0 ,
+  .attr           = signable_e | register_e | leading_e | separate_e ,
+  .type           = FldAlphanumeric ,
+  .level          = 05 ,
+  .digits         = 0 ,
+  .rdigits        = 0 ,
+  .dummy          = 0 ,
+  };
+
 #pragma GCC diagnostic pop