]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
cobol: Development round-up. [PR120765, PR119337, PR120794]
authorRobert Dubner <rdubner@symas.com>
Wed, 9 Jul 2025 16:24:38 +0000 (12:24 -0400)
committerRobert Dubner <rdubner@symas.com>
Wed, 9 Jul 2025 19:53:09 +0000 (15:53 -0400)
This collection of changes reflects development by both Jim Lowden and Bob
Dubner.  It includes fixes to the cobcd script; refinements to the multiple-
period syntax; changes to the parser; implementation of DISPLAY/ACCEPT to and
from ENVIRONMENT-NAME, ENVIRONMENT-VALUE, ARGUMENT-NUMBER, ARGUMENT-VALUE and
minor changes to genapi.cc to cut down on the number of cppcheck warnings.

Co-authored-by: James K. Lowden <jklowden@cobolworx.com>
Co-authored-by: Robert Dubner <rdubner@symas.com>
gcc/cobol/ChangeLog:

PR cobol/120765
PR cobol/119337
PR cobol/120794
* Make-lang.in: Take control of the .cc.o rule.
* cbldiag.h (error_msg_direct): New declaration.
(gcc_location_dump): Forward declaration.
(location_dump): Use gcc_location_dump.
* cdf.y: Change some tokens.
* gcobc: Change dialect handling.
* genapi.cc (parser_call_targets_dump): Temporarily remove from service.
(parser_compile_dcls): Combine temporary arrays.
(get_binary_value_from_float): Apply const to one parameter.
(depending_on_value): Localize a boolean variable.
(normal_normal_compare): Likewise.
(cobol_compare): Eliminate cppcheck warning.
(combined_name): Apply const to an input parameter.
(parser_perform): Apply const to a variable.
(parser_accept): Improve handling of special_name_t parameter and
the exception conditions.
(parser_display): Improve handling of speciat_name_t parameter; use the
os_filename[] string when appropriate.
(program_end_stuff): Rename shadowing variable.
(parser_division): Consolidate temporary char[] arrays.
(parser_file_start): Apply const to a parameter.
(inspect_replacing): Likewise.
(parser_program_hierarchy): Rename shadowing variable.
(mh_identical): Apply const to parameters.
(float_type_of): Likewise.
(picky_memcpy): Likewise.
(mh_numeric_display): Likewise.
(mh_little_endian): Likewise.
(mh_source_is_group): Apply static to a variable it.
(move_helper): Quiet a cppcheck warning.
* genapi.h (parser_accept): Add exceptions to declaration.
(parser_accept_under_discussion): Add declaration.
(parser_display): Change to std::vector; add exceptions to declaration.
* lexio.cc (cdf_source_format): Improve source code location handling.
(source_format_t::infer): Likewise.
(is_fixed_format): Likewise.
(is_reference_format): Likewise.
(left_margin): Likewise.
(right_margin): Likewise.
(cobol_set_indicator_column): Likewise.
(include_debug): Likewise.
(continues_at): Likewise.
(indicated): Likewise.
(check_source_format_directive): Likewise.
(cdftext::free_form_reference_format): Likewise.
* parse.y: Tokens; program and function names; DISPLAY and ACCEPT
handling.
* parse_ante.h (class tokenset_t): Removed.
(class current_tokens_t): Removed.
(field_of): Removed.
* scan.l: Token handling.
* scan_ante.h (level_found): Comment.
* scan_post.h (start_condition_str): Remove cast author_state:.
* symbols.cc (symbols_update): Change error message.
(symbol_table_init): Correct and reorder entries.
(symbol_unresolved_file_key): New function definition.
(cbl_file_key_t::deforward): Change error message.
* symbols.h (symbol_unresolved_file_key): New declaration.
(keyword_tok): New function.
(redefined_token): New function.
(class current_tokens_t): New class.
* symfind.cc (symbol_match): Revise error message.
* token_names.h: Reorder and change numbers in comments.
* util.cc (class cdf_directives_t): New class.
(cobol_set_indicator_column): New function.
(cdf_source_format): New function.
(gcc_location_set_impl): Improve column handling in token_location.
(gcc_location_dump): New function.
(class temp_loc_t): Modify constructor.
(error_msg_direct): New function.
* util.h (class source_format_t): New class.

libgcobol/ChangeLog:

* libgcobol.cc (__gg__accept_envar): ACCEPT/DISPLAY environment variables.
(accept_envar): Likewise.
(default_exception_handler): Refine system log entries.
(open_syslog): Likewise.
(__gg__set_env_name): ACCEPT/DISPLAY environment variables.
(__gg__get_env_name): ACCEPT/DISPLAY environment variables.
(__gg__get_env_value): ACCEPT/DISPLAY environment variables.
(__gg__set_env_value): ACCEPT/DISPLAY environment variables.
(__gg__fprintf_stderr): Adjust __attribute__ for printf.
(__gg__set_arg_num): ACCEPT/DISPLAY command-line arguments.
(__gg__accept_arg_value): ACCEPT/DISPLAY command-line arguments.
(__gg__get_file_descriptor): DISPLAY on os_filename[] /dev device.

19 files changed:
gcc/cobol/Make-lang.in
gcc/cobol/cbldiag.h
gcc/cobol/cdf.y
gcc/cobol/gcobc
gcc/cobol/genapi.cc
gcc/cobol/genapi.h
gcc/cobol/lexio.cc
gcc/cobol/parse.y
gcc/cobol/parse_ante.h
gcc/cobol/scan.l
gcc/cobol/scan_ante.h
gcc/cobol/scan_post.h
gcc/cobol/symbols.cc
gcc/cobol/symbols.h
gcc/cobol/symfind.cc
gcc/cobol/token_names.h
gcc/cobol/util.cc
gcc/cobol/util.h
libgcobol/libgcobol.cc

index e884212eb7697e93b75c895373cd7717d360cb08..ee494b86f0cc110256e1107e9bb4390fad6c9e51 100644 (file)
@@ -384,3 +384,23 @@ cobol.stagefeedback: stagefeedback-start
 selftest-cobol:
 
 lang_checks += check-cobol
+
+#
+# Front-end specific flags:  Originally done for the COBOL front end, this
+# scripting applies CXXFLAGS_FOR_COBOL only to compilations of source code in the
+# gcc/cobol source code tree.  Both forms can be used:
+#
+#         CXXFLAGS_FOR_COBOL=xxx ../configure --enable-languages=....
+# and
+#         make <gcc> CXXFLAGS_FOR_COBOL=yyy
+#
+# The second form overrides the first.
+#
+# To apply this feature to other front ends, look for and clone lines
+# containing "CXXFLAGS_FOR_COBOL" in configure.ac, Makefile.tbl, and Makefile.def.
+#
+
+cobol/%.o: cobol/%.cc
+       @echo $(COMPILE) $(CXXFLAGS_FOR_COBOL) $<
+       $(COMPILE) $(CXXFLAGS_FOR_COBOL) $<
+       $(POSTCOMPILE)
index 548b0f25949117477ed137a39370dbd3007b171a..49dc44b83c1ad7ed34fbc7683975370ec9d77756 100644 (file)
@@ -82,6 +82,10 @@ struct YDFLTYPE
 void error_msg( const YYLTYPE& loc, const char gmsgid[], ... )
   ATTRIBUTE_GCOBOL_DIAG(2, 3);
 
+// an error that uses token_location, not yylloc
+void error_msg_direct( const char gmsgid[], ... )
+  ATTRIBUTE_GCOBOL_DIAG(1, 2);
+
 void dialect_error( const YYLTYPE& loc, const char term[], const char dialect[] );
 
 
@@ -104,16 +108,20 @@ void dbgmsg( const char fmt[], ... ) ATTRIBUTE_PRINTF_1;
 
 void gcc_location_set( const YYLTYPE& loc );
 
+void gcc_location_dump();
+
 // tree.h defines yy_flex_debug as a macro because options.h
 #if ! defined(yy_flex_debug)
 template <typename LOC>
 static void
 location_dump( const char func[], int line, const char tag[], const LOC& loc) {
   extern int yy_flex_debug; // cppcheck-suppress shadowVariable
-  if( yy_flex_debug && gcobol_getenv("update_location") )
+  if( yy_flex_debug && gcobol_getenv("update_location") ) {
     fprintf(stderr, "%s:%d: %s location (%d,%d) to (%d,%d)\n",
             func, line, tag,
             loc.first_line, loc.first_column, loc.last_line, loc.last_column);
+    gcc_location_dump();
+  }
 }
 #endif // defined(yy_flex_debug)
 
index 33442713f34ed1e4a76115bbfa4792d5273ce329..f1a791245854b4fbca1f7dc654b6ff6e37426fa5 100644 (file)
@@ -204,15 +204,15 @@ apply_cdf_turn( const exception_turn_t& turn ) {
 %type   <file>         filename
 %type   <files>         filenames
 
-%token BY 478
+%token BY 482
 %token COPY 362
 %token CDF_DISPLAY 384    ">>DISPLAY"
-%token IN 597
+%token IN 601
 %token NAME 286
 %token NUMSTR 305    "numeric literal"
-%token OF 678
-%token PSEUDOTEXT 713
-%token REPLACING 735
+%token OF 682
+%token PSEUDOTEXT 717
+%token REPLACING 739
 %token LITERAL 298
 %token SUPPRESS 376
 
@@ -227,25 +227,25 @@ apply_cdf_turn( const exception_turn_t& turn ) {
 %token CDF_WHEN 389    ">>WHEN"
 %token CDF_END_EVALUATE 390    ">>END-EVALUATE"
 
-%token AS 460  CONSTANT 361  DEFINED 363
+%token AS 464  CONSTANT 361  DEFINED 363
 %type  <boolean>            DEFINED
-%token OTHER 690  PARAMETER_kw 368    "PARAMETER"
-%token OFF 679  OVERRIDE 369
-%token THRU 931
-%token TRUE_kw 805    "True"
+%token OTHER 694  PARAMETER_kw 368    "PARAMETER"
+%token OFF 683  OVERRIDE 369
+%token THRU 935
+%token TRUE_kw 809    "True"
 
 %token CALL_COBOL 391    "CALL"
 %token CALL_VERBATIM 392    "CALL (as C)"
 
-%token TURN 807  CHECKING 488  LOCATION 641  ON 681  WITH 833
+%token TURN 811  CHECKING 492  LOCATION 645  ON 685  WITH 837
 
-%left OR 932
-%left AND 933
-%right NOT 934
-%left '<'  '>'  '='  NE 935  LE 936  GE 937
+%left OR 936
+%left AND 937
+%right NOT 938
+%left '<'  '>'  '='  NE 939  LE 940  GE 941
 %left '-'  '+'
 %left '*'  '/'
-%right NEG 939
+%right NEG 943
 
 %define api.prefix {ydf}
 %define api.token.prefix{YDF_}
index 01c75dd191e4ef8625c2f0b55ba90df7858a4632..fa9f6095d327607dda6d6840f80236823f162255 100755 (executable)
@@ -125,25 +125,24 @@ $0 recognizes the following GnuCOBOL cobc compilation options:
         -std=mvs -std=mvs-strict
         -std=mf  -std=mf-strict
         -std=cobol85 -std=cobol2002 -std=cobol2014
- Options that are the same in gcobol and cobc are passed through verbatim.
- Options that have no analog in gcobol produce a warning message.
- To produce this message, use -HELP.
+Options that are the same in gcobol and cobc are passed through verbatim.
+Options that have no analog in gcobol produce a warning message.
+To produce this message, use -HELP.
 To see the constructed cobc command-line, use -echo.
 To override the default cobc, set the "cobc" environment variable.
 By default, gcobc invokes the gcobol the same directory the gcobc resides.
 To override, set the gcobol environment variable.
- EOF
- }
+EOF
+}
 
-dialect="gnu"
+dialect="mf gnu"
 out_set=""
 first=""
 
- #
- # Simply iterate over the command-line tokens.  We can't use getopts
- # here because it's not designed for single-dash words (e.g. -shared).
 #
-
+# Iterate over the command-line tokens.  We can't use getopts here
+# because it's not designed for single-dash words (e.g. -shared).
+#
 for opt in "$@"
 do
     if [ "$skip_arg" ]
@@ -441,11 +440,13 @@ do
         -std=mvs | -std=mvs-strict | -std=ibm | -std=ibm-strict) dialect=ibm
                   ;;
         -std=mf | -std=mf-strict)  dialect=mf
-                  ;;
-        -std=default)  dialect=gnu  # that's GnuCOBOL's default and GCC's dialect for GnuCOBOL
-                   ;;
-        -std=cobol*)    dialect=""   # GCC COBOL targets COBOL2024 "mostly backward to COBOL85"
-                   ;;
+                                   ;;
+                      # GnuCOBOL's default and GCC's dialect for GnuCOBOL
+        -std=default) dialect=gnu  
+                      ;;
+                      # GCC COBOL targets COBOL2024 "mostly backward to COBOL85"
+        -std=cobol*)  dialect="" 
+                      ;;
         -std=*)
             dialect=""
             warn "$opt (unkown dialect)"
@@ -480,7 +481,8 @@ do
            opts="$opts /dev/stdin"
            ;;
 
-        *) if [ -z "$output_name" ]  # first non-option argument is source file name
+           # First file name argument is default output filename.
+        *) if [ -z "$output_name" -a -e "$opt" ]  
            then
                output_name=$(basename "${opt%.*}")
                case $mode in
@@ -512,6 +514,11 @@ fi
 # To override the default gcobol, set the "gcobol" environment variable.
 gcobol="${gcobol:-${0%/*}/gcobol}"
 
+if [ "$dialect" ]
+then
+    dialect=$(echo $dialect | sed -E 's/[[:alnum:]]+/-dialect &/g')
+fi
+
 if [ "$echo" ]
 then
     echo $gcobol $mode $opts
@@ -523,4 +530,4 @@ then
     set -x
 fi
 
-exec $gcobol $mode $opts
+exec $gcobol $mode $dialect $opts
index 80177886dbc668e5a57164a73c278bfd3fa1b49f..55db870c7de887bd8bfca7a0701360bc0e8e3ffc 100644 (file)
@@ -766,8 +766,9 @@ parser_call_target_convention( tree func )
 void
 parser_call_targets_dump()
   {
-    dbgmsg( "call targets for #" HOST_SIZE_T_PRINT_UNSIGNED,
+    dbgmsg( "call targets for #" HOST_SIZE_T_PRINT_UNSIGNED " NOT dumping",
             (fmt_size_t)current_program_index() );
+    return; // not currently working 
     for( const auto& elem : call_targets ) {
       const auto& k = elem.first;
       const auto& v = elem.second;
@@ -1034,14 +1035,13 @@ parser_compile_dcls( const std::vector<uint64_t>& dcls )
     return NULL_TREE;
     }
 
-  char ach[32];
+  char ach[64];
   static int counter = 1;
   sprintf(ach, "_dcls_table_%d", counter++);
   tree retval =  array_of_long_long(ach, dcls);
   SHOW_IF_PARSE(nullptr)
     {
     SHOW_PARSE_HEADER
-    char ach[64];
     snprintf(ach, sizeof(ach), " Size is %lu; retval is %p",
              gb4(dcls.size()), as_voidp(retval));
     SHOW_PARSE_TEXT(ach);
@@ -1050,7 +1050,6 @@ parser_compile_dcls( const std::vector<uint64_t>& dcls )
   TRACE1
     {
     TRACE1_HEADER
-    char ach[64];
     snprintf(ach, sizeof(ach), " Size is %lu; retval is %p",
              gb4(dcls.size()), as_voidp(retval));
     TRACE1_TEXT_ABC("", ach, "");
@@ -1588,7 +1587,7 @@ parser_initialize(const cbl_refer_t& refer, bool like_parser_symbol_add)
 
 static void
 get_binary_value_from_float(tree         value,
-                            cbl_refer_t &dest,
+                      const cbl_refer_t &dest,
                             cbl_field_t *source,
                             tree         source_offset
                             )
@@ -1682,6 +1681,7 @@ depending_on_value(tree depending_on, cbl_field_t *current_sizer)
 //  gg_assign(occurs_lower, build_int_cst_type(LONG, current_sizer->occurs.bounds.lower));
 //  gg_assign(occurs_upper, build_int_cst_type(LONG, current_sizer->occurs.bounds.upper));
 
+  gcc_assert(current_sizer);
   if( current_sizer->occurs.depending_on )
     {
     get_depending_on_value_from_odo(depending_on, current_sizer);
@@ -1825,16 +1825,12 @@ normal_normal_compare(bool debugging,
               NULL_TREE);
     }
 
-  bool needs_adjusting;
   if( !left_intermediate && !right_intermediate )
     {
     // Yay!  Both sides have fixed rdigit values.
 
-    // Flag needs_adjusting as false, because we are going to do it here:
-    needs_adjusting = false;
     int adjust =   get_scaled_rdigits(left_side_ref->field)
                  - get_scaled_rdigits(right_side_ref->field);
-
     if( adjust > 0 )
       {
       // We need to make right_side bigger to match the scale of left_side
@@ -1849,6 +1845,7 @@ normal_normal_compare(bool debugging,
   else
     {
     // At least one side is right_intermediate
+    bool needs_adjusting;
 
     tree adjust;
     if( !left_intermediate && right_intermediate )
@@ -2357,7 +2354,7 @@ cobol_compare(  tree return_int,
                 build_int_cst_type(INT, rightflags),
                 integer_zero_node,
                 NULL_TREE));
-    compared = true;
+    // compared = true;  // Commented out to quiet cppcheck
     }
 
 //  gg_printf("   result is %d\n", return_int, NULL_TREE);
@@ -2563,7 +2560,7 @@ get_string_from(cbl_field_t *field)
   }
 
 static char *
-combined_name(cbl_label_t *label)
+combined_name(const cbl_label_t *label)
   {
   // This routine returns a pointer to a static, so make sure you use the result
   // before calling the routine again
@@ -2578,7 +2575,7 @@ combined_name(cbl_label_t *label)
     if( label->parent )
       {
       // It's possible for implicit
-      cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent));
+      const cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent));
       sect_name = section_label->name;
       }
     }
@@ -3315,7 +3312,7 @@ parser_perform(cbl_label_t *label, bool suppress_nexting)
   char ach[256];
   if( label->type == LblParagraph )
     {
-    cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent));
+    const cbl_label_t *section_label = cbl_label_of(symbol_at(label->parent));
     para_name = label->name;
     sect_name = section_label->name;
     sprintf(ach,
@@ -4339,67 +4336,182 @@ psa_FldBlob(struct cbl_field_t *var )
   }
 
 void
-parser_accept(  struct cbl_refer_t refer,
-                enum special_name_t special_e )
+parser_accept(struct cbl_refer_t tgt,
+              special_name_t special_e,
+              cbl_label_t *error,
+              cbl_label_t *not_error )
   {
-  Analyze();
   SHOW_PARSE
     {
     SHOW_PARSE_HEADER
-    SHOW_PARSE_REF(" ", refer);
+    if( error )
+      {
+      SHOW_PARSE_LABEL(" error ", error)
+      }
+    if( not_error )
+      {
+      SHOW_PARSE_LABEL(" not_error ", not_error)
+      }
     SHOW_PARSE_END
     }
-  TRACE1
-    {
-    TRACE1_HEADER
-    TRACE1_END
-    }
-
-  /*
-  enum special_name_t
-      {
-        SYSIN_e,
-        SYSIPT_e,
-        SYSOUT_e,
-        SYSLIST_e,
-        SYSLST_e,
-        SYSPUNCH_e,
-        SYSPCH_e,
-        CONSOLE_e,
-        C01_e, C02_e, C03_e, C04_e, C05_e, C06_e,
-        C07_e, C08_e, C09_e, C10_e, C11_e, C12_e,
-        CSP_e,
-        S01_e, S02_e, S03_e, S04_e, S05_e,
-        AFP_5A_e,
-  };
-  */
 
   // The ISO spec describes the valid special names for ACCEPT as implementation
   // dependent.  We are following IBM's lead.
 
   tree environment = build_int_cst_type(INT, special_e);
 
-  switch( special_e )
+  const char *function_to_call = NULL;
+
+  switch(special_e)
     {
+    case STDIN_e:
     case CONSOLE_e:
     case SYSIPT_e:
     case SYSIN_e:
-      break;
-    default:
-      dbgmsg("%s(): We don't know what to do with special_name_t %d,", __func__, special_e);
-      dbgmsg("%s(): so we are ignoring it.", __func__);
-      yywarn("unrecognized SPECIAL NAME ignored");
+      // This is ordinary input from from the stdin:
+      gg_call(VOID,
+              "__gg__accept",
+              environment,
+              gg_get_address_of(tgt.field->var_decl_node),
+              refer_offset(tgt),
+              refer_size_dest(tgt),
+              NULL_TREE);
       return;
       break;
-    }
 
-  gg_call(VOID,
-          "__gg__accept",
-          environment,
-          gg_get_address_of(refer.field->var_decl_node),
-          refer_offset(refer),
-          refer_size_dest(refer),
-          NULL_TREE);
+    case C01_e:
+    case C02_e:
+    case C03_e:
+    case C04_e:
+    case C05_e:
+    case C06_e:
+    case C07_e:
+    case C08_e:
+    case C09_e:
+    case C10_e:
+    case C11_e:
+    case C12_e:
+    case CSP_e:
+    case S01_e:
+    case S02_e:
+    case S03_e:
+    case S04_e:
+    case S05_e:
+    case AFP_5A_e:
+    case STDOUT_e:
+    case SYSOUT_e:
+    case SYSLIST_e:
+    case SYSLST_e:
+    case STDERR_e:
+    case SYSPUNCH_e:
+    case SYSPCH_e:
+    case SYSERR_e:
+      cbl_internal_error("Not valid for ACCEPT statement.");
+      break;
+
+    case ARG_NUM_e:
+      // This ACCEPT statement wants the number of argv values:
+      gg_call(VOID,
+              "__gg__get_argc",
+              gg_get_address_of(tgt.field->var_decl_node),
+              refer_offset(tgt),
+              refer_size_source(tgt),
+              NULL_TREE);
+       return;
+       break;
+
+    case ENV_NAME_e:
+      // This fetches the environment name set by DISPLAY... UPON ENV_NAME_e
+      gg_call(VOID,
+              "__gg__get_env_name",
+              gg_get_address_of(tgt.field->var_decl_node),
+              refer_offset(tgt),
+              refer_size_source(tgt),
+              NULL_TREE);
+       return;
+       break;
+
+    case ENV_VALUE_e:
+      // This fetches the environment value associated with the previously
+      // esablished name
+      function_to_call = "__gg__get_env_value";
+      break;
+
+    case ARG_VALUE_e:
+      // We are fetching the variable whose index was established by a prior
+      // DISPLAY UPON ARGUMENT-NUMBER.  After the fetch, the value will be 
+      // incremented by one.
+      function_to_call = "__gg__accept_arg_value";
+      break;
+    }
+  if( function_to_call )
+    {
+    tree erf = gg_define_int();
+    gg_assign(erf,
+              gg_call_expr(  INT,
+                            function_to_call,
+                            gg_get_address_of(tgt.field->var_decl_node),
+                            refer_offset(tgt),
+                            refer_size_dest(tgt),
+                            NULL_TREE));
+    if( error )
+      {
+      // There is an ON EXCEPTION phrase:
+      IF( erf, ne_op, integer_zero_node )
+        {
+        SHOW_PARSE
+          {
+          SHOW_PARSE_INDENT
+          SHOW_PARSE_TEXT("Laying down GOTO     error->INTO for_argv")
+          SHOW_PARSE_LABEL(" ", error)
+          }
+        gg_append_statement( error->structs.arith_error->into.go_to );
+        }
+      ELSE
+        {
+        }
+        ENDIF
+      }
+    if( not_error )
+      {
+      // There is an NOT ON EXCEPTION phrase:
+      IF( erf, eq_op, integer_zero_node )
+        {
+        SHOW_PARSE
+          {
+          SHOW_PARSE_INDENT
+          SHOW_PARSE_TEXT("Laying down GOTO not_error->INTO for_argv")
+          SHOW_PARSE_LABEL(" ", not_error)
+          }
+        gg_append_statement( not_error->structs.arith_error->into.go_to );
+        }
+      ELSE
+        {
+        }
+        ENDIF
+      }
+    if( error )
+      {
+      SHOW_PARSE
+        {
+        SHOW_PARSE_INDENT
+        SHOW_PARSE_TEXT("Laying down LABEL     error->bottom")
+        SHOW_PARSE_LABEL(" ", error)
+        }
+      gg_append_statement( error->structs.arith_error->bottom.label );
+      }
+    if( not_error )
+      {
+      SHOW_PARSE
+        {
+        SHOW_PARSE_INDENT
+        SHOW_PARSE_TEXT("Laying down LABEL not_error->bottom")
+        SHOW_PARSE_LABEL(" ", not_error)
+        SHOW_PARSE_END
+        }
+      gg_append_statement( not_error->structs.arith_error->bottom.label );
+      }
+    }
   }
 
 // TODO: update documentation.
@@ -5250,22 +5362,29 @@ parser_display_field(cbl_field_t *field)
                                 DISPLAY_NO_ADVANCE);
   }
 
-/*
- * The first parameter to parser_display is the "device" upon which to display
- * the data. Besides normal devices, these may include elements that define the
- * Unix command line and environment:
- *  1.  ARG_NUM_e, the ARGUMENT-NUMBER
- *  2.  ARG_VALUE_e, the ARGUMENT-VALUE
- *  3.  ENV_NAME_e, the ENVIRONMENT-NAME
- *  4.  ENV_VALUE_e, the ENVIRONMENT-VALUE
- * that need special care and feeding.
- */
 void
 parser_display( const struct cbl_special_name_t *upon,
-                struct cbl_refer_t refs[],
-                size_t n,
-                bool advance )
+                std::vector<cbl_refer_t> refs, 
+                bool advance, 
+                cbl_label_t *not_error, 
+                cbl_label_t *error )
   {
+  const size_t n = refs.size();
+  /*
+   * The first parameter to parser_display is the "device" upon which to display
+   * the data. Besides normal devices, these may include elements that define the
+   * Unix command line and environment:
+   *  1.  ARG_NUM_e, the ARGUMENT-NUMBER
+   *  2.  ARG_VALUE_e, the ARGUMENT-VALUE
+   *  3.  ENV_NAME_e, the ENVIRONMENT-NAME
+   *  4.  ENV_VALUE_e, the ENVIRONMENT-VALUE
+   * that need special care and feeding.
+   */
+
+  // At the present time, I am not sure what not_error and error are for
+  gcc_assert(!not_error);
+  gcc_assert(!error);
+
   Analyze();
   SHOW_PARSE
     {
@@ -5274,7 +5393,7 @@ parser_display( const struct cbl_special_name_t *upon,
     for(size_t i=0; i<n; i++)
       {
       SHOW_PARSE_INDENT
-      SHOW_PARSE_REF("", refs[i]);
+      SHOW_PARSE_REF("", refs.at(i));
       }
     if( advance )
       {
@@ -5306,23 +5425,81 @@ parser_display( const struct cbl_special_name_t *upon,
     {
     switch(upon->id)
       {
+      // See table 5 in the IBM Cobol For Linux x86 1.2 document.
+
+      case STDIN_e:
+      case SYSIN_e:
+      case SYSIPT_e:
+        cbl_internal_error("Attempting to send to an input device.");
+        break;
+
+      case C01_e:
+      case C02_e:
+      case C03_e:
+      case C04_e:
+      case C05_e:
+      case C06_e:
+      case C07_e:
+      case C08_e:
+      case C09_e:
+      case C10_e:
+      case C11_e:
+      case C12_e:
+      case CSP_e:
+      case S01_e:
+      case S02_e:
+      case S03_e:
+      case S04_e:
+      case S05_e:
+      case AFP_5A_e:
+      case ARG_VALUE_e:
+        cbl_internal_error("Not valid for DISPLAY statement.");
+        break;
+
       case STDOUT_e:
-      case SYSOUT_e:
-      case SYSLIST_e:
-      case SYSLST_e:
       case CONSOLE_e:
+        // These are inarguably stdout
         gg_assign(file_descriptor, integer_one_node);
         break;
 
       case STDERR_e:
+      case SYSERR_e:
+        // These are inarguably stderr
+        gg_assign(file_descriptor, integer_two_node);
+        break;
+
+      case SYSOUT_e:
+      case SYSLIST_e:
+      case SYSLST_e:
       case SYSPUNCH_e:
       case SYSPCH_e:
-        gg_assign(file_descriptor, integer_two_node);
+        // In the 21st century, when there are no longer valid assumptions to
+        // be made about the existence of line printers, and where things
+        // formerly-ubiquitous card punches no longer exist, there is a need
+        // for the possibility of assigning these "devices" to externally-
+        // determined Unix gadgetry in /dev:
+        gg_assign(file_descriptor,
+                  gg_call_expr( INT,
+                                "__gg__get_file_descriptor",
+                                gg_string_literal(upon->os_filename),
+                                NULL_TREE));
+        needs_closing = true;
         break;
 
+      case ARG_NUM_e:
+        // Set the index number for a subsequent ACCEPT FROM ARG_VALUE_e
+        gg_call(VOID,
+                "__gg__set_arg_num",
+                gg_get_address_of(refs[0].field->var_decl_node),
+                refer_offset(refs[0]),
+                refer_size_source(refs[0]),
+                NULL_TREE);
+         return;
+         break;
+
       case ENV_NAME_e:
-        // This Part I of the slightly absurd method of using DISPLAY...UPON
-        // to fetch, or set, environment variables.
+        // Establish the name of an environment variable for later use with
+        // in either DISPLAY UPON or ACCEPT FROM
         gg_call(VOID,
                 "__gg__set_env_name",
                 gg_get_address_of(refs[0].field->var_decl_node),
@@ -5332,19 +5509,16 @@ parser_display( const struct cbl_special_name_t *upon,
          return;
          break;
 
-      default:
-        if( upon->os_filename[0] )
-          {
-          tree topen = gg_open( gg_string_literal(upon->os_filename),
-                                build_int_cst_type(INT, O_APPEND|O_WRONLY));
-          gg_assign(file_descriptor, topen);
-          needs_closing = true;
-          }
-        else
-          {
-          fprintf(stderr, "We don't know what to do in parser_display\n");
-          gcc_unreachable();
-          }
+      case ENV_VALUE_e:
+        // Set the contents of the environment variable named with ENV_NAME_e
+        gg_call(VOID,
+                "__gg__set_env_value",
+                gg_get_address_of(refs[0].field->var_decl_node),
+                refer_offset(refs[0]),
+                refer_size_source(refs[0]),
+                NULL_TREE);
+         return;
+         break;
       }
     }
   else
@@ -5359,12 +5533,9 @@ parser_display( const struct cbl_special_name_t *upon,
     }
   CHECK_FIELD(refs[n-1].field);
   parser_display_internal(file_descriptor, refs[n-1], advance ? DISPLAY_ADVANCE : DISPLAY_NO_ADVANCE);
-
   if( needs_closing )
     {
-    tree tclose = gg_close(file_descriptor);
-    // We are ignoring the close() return value
-    gg_append_statement(tclose);
+    gg_close(file_descriptor);
     }
 
   cursor_at_sol = advance;
@@ -6240,12 +6411,12 @@ program_end_stuff(cbl_refer_t refer, ec_type_t ec)
 
       tree array_type = build_array_type_nelts(UCHAR,
                                     returner->data.capacity);
-      tree retval     =  gg_define_variable(array_type, vs_static);
-      gg_memcpy(gg_get_address_of(retval),
+      tree array     =  gg_define_variable(array_type, vs_static);
+      gg_memcpy(gg_get_address_of(array),
                 member(returner->var_decl_node, "data"),
                 member(returner->var_decl_node, "capacity"));
 
-      tree actual = gg_cast(COBOL_FUNCTION_RETURN_TYPE, gg_get_address_of(retval));
+      tree actual = gg_cast(COBOL_FUNCTION_RETURN_TYPE, gg_get_address_of(array));
 
       restore_local_variables();
       gg_return(actual);
@@ -6876,7 +7047,6 @@ parser_division(cbl_division_t division,
       // expected formal parameter and tacks it onto the end of the
       // function's arguments chain.
 
-      char ach[2*sizeof(cbl_name_t)];
       sprintf(ach, "_p_%s", args[i].refer.field->name);
 
       size_t nbytes = 0;
@@ -9947,8 +10117,8 @@ parser_file_start(struct cbl_file_t *file,
     // A key has a number of fields
     for(size_t ifield=0; ifield<file->keys[key_number].nfield; ifield++)
       {
-      size_t field_index = file->keys[key_number].fields[ifield];
-      cbl_field_t *field = cbl_field_of(symbol_at(field_index));
+      size_t nfield = file->keys[key_number].fields[ifield];
+      cbl_field_t *field = cbl_field_of(symbol_at(nfield));
       combined_length += field->data.capacity;
       }
     gg_assign(length, build_int_cst_type(SIZE_T, combined_length));
@@ -9975,7 +10145,7 @@ parser_file_start(struct cbl_file_t *file,
 
 static void
 inspect_tally(bool backward,
-              cbl_refer_t identifier_1,
+        const cbl_refer_t &identifier_1,
               cbl_inspect_opers_t& identifier_2)
   {
   Analyze();
@@ -10175,8 +10345,8 @@ inspect_tally(bool backward,
 
 static void
 inspect_replacing(int backward,
-                  cbl_refer_t identifier_1,
-                  cbl_inspect_opers_toperations)
+            const cbl_refer_t &identifier_1,
+                  cbl_inspect_opers_t &operations)
   {
   Analyze();
   // This is an INSPECT FORMAT 2
@@ -13510,9 +13680,9 @@ parser_program_hierarchy( const cbl_prog_hier_t& hier )
     // are also accessible by us.  Go find them.
     std::vector<const hier_node *>uncles;
     find_uncles(nodes[i], uncles);
-    for( size_t i=0; i<uncles.size(); i++ )
+    for( size_t j=0; j<uncles.size(); j++ )
       {
-      const hier_node *uncle = uncles[i];
+      const hier_node *uncle = uncles[j];
       if( map_of_sets[caller].find(uncle->name) == map_of_sets[caller].end() )
         {
         // We have a COMMON uncle or sibling we haven't seen before.
@@ -13550,7 +13720,6 @@ parser_program_hierarchy( const cbl_prog_hier_t& hier )
       if( callers.find(caller) == callers.end() )
         {
         // We haven't seen this caller before
-        callers.insert(caller);
 
         char ach[3*sizeof(cbl_name_t)];
         tree names_table_type = build_array_type_nelts(CHAR_P, mol->second.size()+1);
@@ -13617,6 +13786,8 @@ parser_program_hierarchy( const cbl_prog_hier_t& hier )
                 (fmt_size_t)caller);
         tree accessible_programs_decl = gg_trans_unit_var_decl(ach);
         gg_assign( accessible_programs_decl, gg_get_address_of(the_constructed_table) );
+
+        callers.insert(caller);
         }
       }
     }
@@ -13883,8 +14054,8 @@ conditional_abs(tree source, const cbl_field_t *field)
 
 static bool
 mh_identical(cbl_refer_t &destref,
-             cbl_refer_t &sourceref,
-             TREEPLET    &tsource)
+       const cbl_refer_t &sourceref,
+       const TREEPLET    &tsource)
   {
   // Check to see if the two variables are identical types, thus allowing
   // for a simple byte-for-byte copy of the data areas:
@@ -14224,7 +14395,7 @@ float_type_of(const cbl_field_t *field)
   }
 
 static tree
-float_type_of(cbl_refer_t *refer)
+float_type_of(const cbl_refer_t *refer)
   {
   return float_type_of(refer->field);
   }
@@ -14456,7 +14627,7 @@ picky_memset(tree &dest_p, unsigned char value, size_t length)
   }
 
 static void
-picky_memcpy(tree &dest_p, tree &source_p, size_t length)
+picky_memcpy(tree &dest_p, const tree &source_p, size_t length)
   {
   if( length )
     {
@@ -14476,8 +14647,8 @@ picky_memcpy(tree &dest_p, tree &source_p, size_t length)
 
 static bool
 mh_numeric_display( cbl_refer_t &destref,
-                    cbl_refer_t &sourceref,
-                    TREEPLET    &tsource,
+              const cbl_refer_t &sourceref,
+              const TREEPLET    &tsource,
                     tree size_error)
   {
   bool moved = false;
@@ -14965,8 +15136,8 @@ mh_numeric_display( cbl_refer_t &destref,
 
 static bool
 mh_little_endian( cbl_refer_t &destref,
-                  cbl_refer_t &sourceref,
-                  TREEPLET    &tsource,
+            const cbl_refer_t &sourceref,
+            const TREEPLET    &tsource,
                   bool check_for_error,
                   tree size_error)
   {
@@ -15037,8 +15208,8 @@ mh_little_endian( cbl_refer_t &destref,
 
 static bool
 mh_source_is_group( cbl_refer_t &destref,
-                    cbl_refer_t &sourceref,
-                    TREEPLET    &tsrc)
+              const cbl_refer_t &sourceref,
+              const TREEPLET    &tsrc)
   {
   bool retval = false;
   if( sourceref.field->type == FldGroup && !(destref.field->attr & rjust_e) )
@@ -15103,7 +15274,7 @@ move_helper(tree size_error,        // This is an INT
     {
     // We are creating a copy of the original destination in case we clobber it
     // and have to restore it because of a computational error.
-    bool first_time = true;
+    static bool first_time = true;
     static size_t stash_size = 1024;
     if( first_time )
       {
@@ -15341,7 +15512,7 @@ move_helper(tree size_error,        // This is an INT
       gg_attribute_bit_clear(destref.field, refmod_e);
       }
 
-    moved = true;
+    // moved = true; // commented out to quiet cppcheck
     }
 
   if( restore_on_error )
index 36d947bcab7f6c1dd3dff2e211c7d6c9cff359ab..ab76856275bce86d1e17a5805fab2147e55b5416 100644 (file)
@@ -52,10 +52,13 @@ void parser_division( cbl_division_t division,
 void parser_enter_program(const char *funcname, bool is_function, int *retval);
 void parser_leave_program();
 
-void parser_accept( cbl_refer_t refer, special_name_t special_e);
+void parser_accept( cbl_refer_t refer, special_name_t special_e, 
+                    cbl_label_t *error, cbl_label_t *not_error );
 void parser_accept_exception( cbl_label_t *name );
 void parser_accept_exception_end( cbl_label_t *name );
 
+void parser_accept_under_discussion(struct cbl_refer_t tgt, special_name_t special,
+                                    cbl_label_t *error, cbl_label_t *not_error );
 void parser_accept_envar( cbl_refer_t refer, cbl_refer_t envar,
                           cbl_label_t *error, cbl_label_t *not_error );
 void parser_set_envar( cbl_refer_t envar, cbl_refer_t refer );
@@ -263,8 +266,10 @@ void parser_exit_program(void); // exits back to COBOL only, else continue
 
 void
 parser_display( const struct cbl_special_name_t *upon,
-                struct cbl_refer_t args[], size_t n,
-                bool advance = DISPLAY_ADVANCE );
+                std::vector<cbl_refer_t> args, 
+                bool advance = DISPLAY_ADVANCE, 
+                cbl_label_t *not_error = nullptr,
+                cbl_label_t *compute_error = nullptr );
 
 void parser_display_field(cbl_field_t *fld);
 
index 2d9fb72709f0e4c929564edd56c01b6695e20fd6..4a50441f24a28249612dc29f50d78ee1cc5a46ea 100644 (file)
 
 extern int yy_flex_debug;
 
-static struct {
-  bool first_file, explicitly;
-  int column, right_margin;
-  bool inference_pending() {
-    bool tf = first_file && !explicitly;
-    first_file = false;
-    return tf;
-  }
-  inline bool is_fixed() const { return column == 7; }
-  inline bool is_reffmt() const { return is_fixed() && right_margin == 73; }
-  inline bool is_free() const { return ! is_fixed(); }
-  
-  const char * description() const {
-    if( is_reffmt() ) return "REFERENCE";
-    if( is_fixed() ) return "FIXED";
-    if( is_free() ) return "FREE";
-    gcc_unreachable();
-  }    
-} indicator = { true, false, 0, 0 };
+source_format_t& cdf_source_format();
+
+void
+source_format_t::infer( const char *bol, bool want_reference_format ) {
+  if( bol ) {
+    left = 7;
+    if( want_reference_format ) {
+      right = 73;
+    }
+  }
+  dbgmsg("%s:%d: %s format detected", __func__, __LINE__,
+         description());
+}
+
 
 // public source format test functions
-bool is_fixed_format() { return indicator.is_fixed(); }
-bool is_reference_format() { return indicator.is_reffmt(); }
+bool is_fixed_format() { return cdf_source_format().is_fixed(); }
+bool is_reference_format() { return cdf_source_format().is_reffmt(); }
 
 static bool debug_mode = false;
 
@@ -76,11 +71,10 @@ static bool debug_mode = false;
 */
 
 static inline int left_margin() {
-  return indicator.column == 0? indicator.column : indicator.column - 1;
+  return cdf_source_format().left_margin();
 }
 static inline int right_margin() {
-  return indicator.right_margin == 0?
-    indicator.right_margin : indicator.right_margin - 1;
+  return cdf_source_format().right_margin();
 }
 
 /*
@@ -89,18 +83,9 @@ static inline int right_margin() {
  *   When setting back to 0 (free), the right margin is also reset to 0.
  */
 void
-cobol_set_indicator_column( int column )
-{
-  indicator.explicitly = true;
-  if( column == 0 ) indicator.right_margin = 0;
-  if( column < 0 ) {
-    column = -column;
-    indicator.right_margin = 73;
-  }
-  indicator.column = column;
-}
+cobol_set_indicator_column( int column );
 
-bool include_debug()      { return indicator.column == 7 && debug_mode; }
+bool include_debug()      { return is_fixed_format() && debug_mode; }
 bool set_debug( bool tf ) { return debug_mode = tf && is_fixed_format(); }
 
 static bool nonblank( const char ch ) { return !isblank(ch); }
@@ -114,7 +99,7 @@ start_of_line( char *bol, char *eol ) {
 
 static inline char *
 continues_at( char *bol, char *eol ) {
-  if( indicator.column == 0 ) return NULL;  // cannot continue in free format
+  if( cdf_source_format().is_free() ) return NULL;  // cannot continue in free format
   bol += left_margin();
   if( *bol != '-' ) return NULL; // not a continuation line
   return start_of_line(++bol, eol);
@@ -124,7 +109,7 @@ continues_at( char *bol, char *eol ) {
 // NULL means no indicator column or tested value not present.
 static inline char *
 indicated( char *bol, const char *eol, char ch = '\0' ) {
-  if( indicator.column == 0 && *bol != '*' ) {
+  if( cdf_source_format().left_margin() == 0 && *bol != '*' ) {
     return NULL;  // no indicator column in free format, except for comments
   }
   gcc_assert(bol != NULL);
@@ -365,9 +350,9 @@ check_source_format_directive( filespan_t& mfile ) {
 
     dbgmsg( "%s:%d: %s format set, on line " HOST_SIZE_T_PRINT_UNSIGNED,
             __func__, __LINE__,
-            indicator.column == 7? "FIXED" : "FREE",
+            cdf_source_format().description(), 
             (fmt_size_t)mfile.lineno() );
-    char *bol = indicator.is_fixed()? mfile.cur : const_cast<char*>(cm[0].first);
+    char *bol = cdf_source_format().is_fixed()? mfile.cur : const_cast<char*>(cm[0].first);
     erase_line(bol, const_cast<char*>(cm[0].second));
     mfile.cur = const_cast<char*>(cm[0].second);
   }
@@ -1695,17 +1680,11 @@ cdftext::free_form_reference_format( int input ) {
   /*
    * Infer source code format. 
    */
-  if( indicator.inference_pending()  ) {
+  if( cdf_source_format().inference_pending()  ) {
     const char *bol = valid_sequence_area(mfile.data, mfile.eodata);
     if( bol ) {
-      indicator.column = 7;
-      if( infer_reference_format(bol, mfile.eodata) ) {
-       indicator.right_margin = 73;
-      }
+      cdf_source_format().infer( bol, infer_reference_format(bol, mfile.eodata) );
     }
-
-    dbgmsg("%s:%d: %s format detected", __func__, __LINE__,
-           indicator.description());
   }
 
   while( mfile.next_line() ) {
index 74637c9641f567da28b520c8d158c8d398da19a3..2212acc8e2b765c402e1e6cb2a518ef349fd61a1 100644 (file)
@@ -45,6 +45,7 @@
   };
 
   enum accept_func_t {
+    accept_e,
     accept_done_e,
     accept_command_line_e,
     accept_envar_e,
 %token  <string>        SECTION
 %token  <number>        STANDARD_ALPHABET "STANDARD ALPHABET"
 %token  <string>        SWITCH
-%token  <string>        UPSI
+%token  <string>        UPSI 
 %token  <number>        ZERO
 
                          /* environment names */
                        STRING_kw "STRING" STOP SUBTRACT START
                        UNSTRING WRITE WHEN
 
-                          ABS ACCESS ACOS ACTUAL ADVANCING AFTER ALL
+                       ARGUMENT_NUMBER  ARGUMENT_VALUE
+                       ENVIRONMENT_NAME ENVIRONMENT_VALUE
+
+                       ABS ACCESS ACOS ACTUAL ADVANCING AFTER ALL
                        ALLOCATE
                        ALPHABET ALPHABETIC ALPHABETIC_LOWER "ALPHABETIC-LOWER"
                        ALPHABETIC_UPPER "ALPHABETIC-UPPER"
 %type   <error_clauses> io_invalids read_eofs write_eops
 %type   <boolean>       io_invalid  read_eof  write_eop
                         global is_global anycase backward
+                        end_display
 %type   <number>        mistake globally first_last
 %type   <io_mode>   io_mode
 
            declarative_list_t* dcl_list_t;
            isym_list_t* isym_list;
     struct { radix_t radix; char *string; } numstr;
-    struct { int token; literal_t name; } prog_end;
+    struct { YYLTYPE loc; int token; literal_t name; } prog_end;
     struct { int token; special_name_t id; } special_type;
     struct { cbl_field_type_t type;
              uint32_t capacity; bool signable; } computational;
     struct refer_pair_t { cbl_refer_t *first, *second; } refer2;
     struct { refer_collection_t *inputs; refer_pair_t into; } str_body;
 
-    struct { accept_func_t func; cbl_refer_t *into, *from; } accept_func;
+    struct { accept_func_t func; cbl_refer_t *into, *from; special_name_t special;} accept_func;
     struct unstring_into_t *uns_into;
     struct unstring_tgt_list_t *uns_tgts;
     struct unstring_tgt_t *uns_tgt;
@@ -1513,7 +1518,7 @@ program_as:     %empty     { static const literal_t empty {}; $$ = empty; }
         |       AS LITERAL { $$ = $2; }
                 ;
 
-function_id:    FUNCTION '.' NAME program_as program_attrs[attr] '.'
+function_id:    FUNCTION NAME program_as program_attrs[attr] '.'
                 {
                   internal_ebcdic_lock();
                   current_division = identification_div_e;
@@ -1547,7 +1552,7 @@ function_id:    FUNCTION '.' NAME program_as program_attrs[attr] '.'
                   current.udf_add(current_program_index());
                   if( nparse_error > 0 ) YYABORT;
                 }
-        |       FUNCTION '.' NAME program_as is PROTOTYPE '.'
+        |       FUNCTION NAME program_as is PROTOTYPE '.'
                 {
                   cbl_unimplemented("FUNCTION PROTOTYPE");
                 }
@@ -1838,7 +1843,7 @@ select:         SELECT optional NAME[name] select_clauses[clauses] '.'
                   cbl_file_t *file = $clauses.file;
 
                   file->optional = $optional;
-                  file->line = yylineno;
+                  file->line = @name.first_line;
                   if( !namcpy(@clauses, file->name, $name) ) YYERROR;
 
                   if( ! ($clauses.clauses & assign_clause_e) ) {
@@ -1911,7 +1916,7 @@ select:         SELECT optional NAME[name] select_clauses[clauses] '.'
                   cbl_file_t file = protofile;
 
                   file.optional = $optional;
-                  file.line = yylineno;
+                  file.line = @name.first_line;
                   if( !namcpy(@name, file.name, $name) ) YYERROR;
 
                   if( file_add(@name, &file) == NULL ) YYERROR;
@@ -2473,7 +2478,7 @@ special_name:   dev_mnemonic
         |       CLASS NAME is domains
                 {
                   struct cbl_field_t field = { 0,
-                    FldClass, FldInvalid, 0, 0, 0, 0, nonarray, yylineno, "",
+                    FldClass, FldInvalid, 0, 0, 0, 0, nonarray, @NAME.first_line, "",
                     0, cbl_field_t::linkage_t(),
                    {}, NULL };
                   if( !namcpy(@NAME, field.name, $2) ) YYERROR;
@@ -2604,6 +2609,10 @@ device_name:     SYSIN           { $$.token = SYSIN; $$.id = SYSIN_e; }
         |       STDIN           { $$.token = STDIN; $$.id = STDIN_e; }
         |       STDOUT          { $$.token = STDOUT; $$.id = STDOUT_e; }
         |       STDERR          { $$.token = STDERR; $$.id = STDERR_e; }
+                /* These cannot be both ctx_name and here. *
+        /*      ARGUMENT_NUMBER   { $$.token=0; $$.id = ARG_NUM_e; } */
+        /*      ENVIRONMENT_NAME  { $$.token=0; $$.id = ENV_NAME_e; } */
+        /*      ENVIRONMENT_VALUE { $$.token=0; $$.id = ENV_VALUE_e; } */
                 ;
 
 alphabet_name:  STANDARD_ALPHABET  { $$ = alphabet_add(@1, ASCII_e); }
@@ -3164,7 +3173,7 @@ depending:      %empty
                     assert(e->type == SymField);
                     odo = symbol_index(e);
                   } else {
-                   e = symbol_field_forward_add(PROGRAM, 0, $NAME, yylineno);
+                   e = symbol_field_forward_add(PROGRAM, 0, $NAME, @NAME.first_line);
                     if( !e ) YYERROR;
                    symbol_field_location( symbol_index(e), @NAME );
                     odo = field_index(cbl_field_of(e));
@@ -3364,7 +3373,7 @@ level_name:     LEVEL ctx_name
                   }
                   struct cbl_field_t field = { 0,
                     FldInvalid, FldInvalid, 0, 0, 0, capacity_cast($1),
-                   nonarray, yylineno, "",
+                   nonarray, @ctx_name.first_line, "",
                     0, cbl_field_t::linkage_t(),
                    {}, NULL };
                   if( !namcpy(@ctx_name, field.name, $2) ) YYERROR;
@@ -3389,7 +3398,7 @@ level_name:     LEVEL ctx_name
                   }
                   struct cbl_field_t field = { 0,
                     FldInvalid, FldInvalid, 0, 0, 0, capacity_cast($1),
-                   nonarray, yylineno, "",
+                   nonarray, @LEVEL.first_line, "",
                     0, {}, {}, NULL };
 
                   $$ = field_add(@1, &field);
@@ -3527,7 +3536,7 @@ data_descr1:    level_name
                   }
                   struct cbl_field_t field = { 0, FldLiteralA, FldInvalid,
                                                constant_e, 0, 0, 78, nonarray,
-                                               yylineno, "", 0, {}, *$data, NULL };
+                                               @name.first_line, "", 0, {}, *$data, NULL };
                   if( !namcpy(@name, field.name, $name) ) YYERROR;
                   if( field.data.initial ) {
                     field.attr |= quoted_e;
@@ -3550,7 +3559,7 @@ data_descr1:    level_name
         |       LEVEL88 NAME /* VALUE */ NULLPTR
                 {
                   struct cbl_field_t field = { 0,
-                    FldClass, FldInvalid, 0, 0, 0, 88, nonarray, yylineno, "",
+                    FldClass, FldInvalid, 0, 0, 0, 88, nonarray, @NAME.first_line, "",
                     0, cbl_field_t::linkage_t(),
                    {}, NULL };
                   if( !namcpy(@NAME, field.name, $2) ) YYERROR;
@@ -3576,7 +3585,7 @@ data_descr1:    level_name
         |       LEVEL88 NAME VALUE domains
                 {
                   struct cbl_field_t field = { 0,
-                    FldClass, FldInvalid, 0, 0, 0, 88, nonarray, yylineno, "",
+                    FldClass, FldInvalid, 0, 0, 0, 88, nonarray, @NAME.first_line, "",
                     0, cbl_field_t::linkage_t(),
                    {}, NULL };
                   if( !namcpy(@NAME, field.name, $2) ) YYERROR;
@@ -4606,7 +4615,7 @@ justified_clause: is JUSTIFIED
 
 redefines_clause: REDEFINES NAME[orig]
                 {
-                  struct symbol_elem_t *e = field_of($orig);
+                  struct symbol_elem_t *e = symbol_field(PROGRAM, 0, $orig);
                   if( !e ) {
                     error_msg(@2, "REDEFINES target not defined");
                     YYERROR;
@@ -5068,9 +5077,8 @@ statement:      error {
 
                /*
                 * ISO defines ON EXCEPTION only for Format 3 (screen). We
-                * implement extensions defined by MF and Fujitsu (and us) to
-                * use ACCEPT to interact with the command line and the
-                * environment.
+                * implement extensions defined by MF and Fujitsu to use ACCEPT
+                * to interact with the command line and the environment.
                 *
                 * ISO ACCEPT and some others are implemented in accept_body,
                 * before the parser sees any ON EXCEPTION.  In those cases
@@ -5085,6 +5093,9 @@ accept:         accept_body end_accept {
                  switch( $accept_body.func ) {
                  case accept_done_e:
                    break;
+                 case accept_e:
+                    parser_accept(*$1.into, $1.special, nullptr, nullptr);
+                   break;
                  case accept_command_line_e:
                    if( $1.from->field == NULL ) { // take next command-line arg
                      parser_accept_command_line(*$1.into, argi, NULL, NULL);
@@ -5108,6 +5119,9 @@ accept:         accept_body end_accept {
                    error_msg(@ec, "ON EXCEPTION valid only "
                            "with ENVIRONMENT or COMMAND-LINE(n)");
                    break;
+                 case accept_e:
+                    parser_accept(*$1.into, $1.special, $ec.on_error, $ec.not_error);
+                   break;
                  case accept_command_line_e:
                    if( $1.from->field == NULL ) { // take next command-line arg
                      parser_accept_command_line(*$1.into, argi,
@@ -5139,7 +5153,7 @@ end_accept:     %empty %prec ACCEPT
 accept_body:    accept_refer
                 {
                  $$.func = accept_done_e;
-                  parser_accept(*$1, CONSOLE_e);
+                  parser_accept(*$1, CONSOLE_e, nullptr, nullptr);
                 }
         |       accept_refer FROM DATE
                 {
@@ -5198,29 +5212,15 @@ accept_body:    accept_refer
                 }
         |       accept_refer FROM acceptable
                 {
-                 cbl_field_t *argc = register_find("_ARGI");
-                 switch( $acceptable->id ) {
-                 case ARG_NUM_e:
-                   $$.func = accept_command_line_e;
-                   $$.into = $1;
-                   $$.from = new_reference(argc);
-                   break;
-                 case ARG_VALUE_e:
-                   $$.func = accept_command_line_e;
-                   $$.into = $1;
-                   $$.from = cbl_refer_t::empty();
-                   break;
-                 default:
-                   $$.func = accept_done_e;
-                   parser_accept( *$1, $acceptable->id );
-                 }
+                 $$.func = accept_e;
+                  $$.into = $1;
+                  $$.special = $acceptable->id;
                 }
         |       accept_refer FROM ENVIRONMENT envar
                 {
                  $$.func = accept_envar_e;
                  $$.into = $1;
                  $$.from = $envar;
-                  ////  parser_accept_envar( *$1, *$envar );
                 }
         |       accept_refer FROM COMMAND_LINE
                 {
@@ -5232,7 +5232,6 @@ accept_body:    accept_refer
                  $$.func = accept_command_line_e;
                  $$.into = $1;
                  $$.from = $expr;
-                  //// parser_accept_command_line(*$1, $expr->field );
                 }
         |       accept_refer FROM COMMAND_LINE_COUNT {
                  $$.func = accept_done_e;
@@ -5285,7 +5284,7 @@ accept_except:    EXCEPTION
                 {
                   $$.not_error = NULL;
                   $$.on_error = label_add(LblArith,
-                                          uniq_label("accept"), yylineno);
+                                          uniq_label("accept"), @1.first_line);
                   if( !$$.on_error ) YYERROR;
                   parser_accept_exception( $$.on_error );
 
@@ -5320,15 +5319,54 @@ acceptable:     device_name
                       error_msg(@NAME, "no such special name '%s'", $NAME);
                       YYERROR;
                    }
+                    if( ENV_NAME_e == *special_type ) { 
+                      error_msg(@NAME, "cannot ACCEPT FROM %qs", $NAME);
+                      YYERROR;
+                    }
                    // Add the name now, as a convenience. 
-                   cbl_special_name_t special = { 0, *special_type };
+                    int token = 0;
+                    switch(*special_type) {
+                    case ARG_NUM_e:    token = ARGUMENT_NUMBER; break;
+                    case ARG_VALUE_e:  token = ARGUMENT_VALUE; break;
+                    case ENV_VALUE_e:  token = ENVIRONMENT_VALUE; break;
+
+                    case ENV_NAME_e:
+                    default:
+                      error_msg(@NAME, "cannot ACCEPT FROM %qs", $NAME);
+                      YYERROR;
+                      break;
+                    }
+                   cbl_special_name_t special = { token, *special_type };
                    namcpy(@NAME, special.name, $NAME);
 
                    symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
                    $$ = cbl_special_name_of(e);
+                    cbl_special_name_t& unused(*$$);
+                    assert(unused.id);
                  }
                  assert($$);
                 }
+        |       ENVIRONMENT_VALUE {
+                   // Add the name now, as a convenience. 
+                   cbl_special_name_t special =
+                      { ENVIRONMENT_VALUE, ENV_VALUE_e, "ENVIRONMENT-VALUE" };
+                   symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
+                   $$ = cbl_special_name_of(e);
+                }
+        |       ARGUMENT_NUMBER {
+                   // Add the name now, as a convenience. 
+                   cbl_special_name_t special =
+                      { ARGUMENT_NUMBER, ARG_NUM_e, "ARGUMENT-NUMBER" };
+                   symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
+                   $$ = cbl_special_name_of(e);
+                }
+        |       ARGUMENT_VALUE {
+                   // Add the name now, as a convenience. 
+                   cbl_special_name_t special =
+                      { ARGUMENT_VALUE, ARG_VALUE_e, "ARGUMENT-VALUE" };
+                   symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
+                   $$ = cbl_special_name_of(e);
+                }
                 ;
 
 add:            add_impl end_add { ast_add($1); }
@@ -5558,46 +5596,18 @@ compute_expr:   '=' {
                 }
                 ;
 
-display:        disp_body end_display
+display:        disp_body end_display[advance]
                 {
-                 std::vector <cbl_refer_t> args($1.vargs->args.size());
-                 std::copy( $1.vargs->args.begin(), $1.vargs->args.end(), args.begin() );
-                 if( $1.special && $1.special->id == ARG_NUM_e ) {
-                   if( $1.vargs->args.size() != 1 ) {
-                     error_msg(@1, "ARGUMENT-NUMBER can be set to only one value");
-                   }
-                  const  cbl_refer_t& src( $1.vargs->args.front() );
-                   cbl_field_t *dst = register_find("_ARGI");
-                   parser_move( dst, src );
-                 } else {
-                   parser_display($1.special,
-                                  args.empty()? NULL : args.data(), args.size(),
-                                  DISPLAY_ADVANCE);
-                 }
-                 current.declaratives_evaluate();
-                }
-        |       disp_body NO ADVANCING end_display
-                {
-                  std::vector <cbl_refer_t> args($1.vargs->args.size());
-                 std::copy( $1.vargs->args.begin(), $1.vargs->args.end(), args.begin() );
-
-                 if( $1.special && $1.special->id == ARG_NUM_e ) {
-                   if( $1.vargs->args.size() != 1 ) {
-                     error_msg(@1, "ARGUMENT-NUMBER can be set to only one value");
-                   }
-                  const cbl_refer_t& src( $1.vargs->args.front() );
-                   cbl_field_t *dst = register_find("_ARGI");
-                   parser_move( dst, src );
-                 } else {
-                   parser_display($1.special,
-                                  args.empty()? NULL : args.data(), args.size(),
-                                  DISPLAY_NO_ADVANCE);
-                 }
+                 std::vector <cbl_refer_t> args($1.vargs->args.begin(),
+                                                 $1.vargs->args.end());
+                  parser_display($1.special, args, $advance);
                  current.declaratives_evaluate();
                 }
                 ;
-end_display:    %empty
-        |       END_DISPLAY
+end_display:    %empty                         { $$ = DISPLAY_ADVANCE; }
+        |                    END_DISPLAY       { $$ = DISPLAY_ADVANCE; }
+        |       NO ADVANCING                   { $$ = DISPLAY_NO_ADVANCE; }
+        |       NO ADVANCING END_DISPLAY       { $$ = DISPLAY_NO_ADVANCE; }
                 ;
 disp_body:      disp_vargs[vargs]
                 {
@@ -5628,14 +5638,48 @@ disp_upon:      device_name {
                       error_msg(@NAME, "no such special name '%s'", $NAME);
                       YYERROR;
                    }
-                   // Add the name now, as a convenience. 
-                   cbl_special_name_t special = { 0, *special_type };
+                   // Add the name now, as a convenience.
+                    // These may come through as a NAME, depending on how scanned. 
+                    int token = 0;
+                    switch(*special_type) {
+                    case ARG_NUM_e:    token = ARGUMENT_NUMBER; break;
+                    case ENV_NAME_e:   token = ENVIRONMENT_NAME; break;
+                    case ENV_VALUE_e:  token = ENVIRONMENT_VALUE; break;
+
+                    case ARG_VALUE_e:
+                    default:
+                      error_msg(@NAME, "cannot DISPLAY UPON %qs", $NAME);
+                      YYERROR;
+                      break;
+                    }
+                   cbl_special_name_t special = { token, *special_type };
                    namcpy(@NAME, special.name, $NAME);
 
                     e = symbol_special_add(PROGRAM, &special);
                  }
                  $$ = cbl_special_name_of(e);
                 }
+        |       ARGUMENT_NUMBER {
+                   // Add the name now, as a convenience. 
+                   cbl_special_name_t special =
+                      { ARGUMENT_NUMBER, ARG_NUM_e, "ARGUMENT-NUMBER" };
+                   symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
+                   $$ = cbl_special_name_of(e);
+                }
+        |       ENVIRONMENT_NAME {
+                   // Add the name now, as a convenience. 
+                   cbl_special_name_t special =
+                      { ENVIRONMENT_NAME, ENV_NAME_e, "ENVIRONMENT-NAME" };
+                   symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
+                   $$ = cbl_special_name_of(e);
+                }
+        |       ENVIRONMENT_VALUE {
+                   // Add the name now, as a convenience. 
+                   cbl_special_name_t special =
+                      { ENVIRONMENT_VALUE, ENV_VALUE_e, "ENVIRONMENT-VALUE" };
+                   symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
+                   $$ = cbl_special_name_of(e);
+                }
                 ;
 
 divide:         divide_impl end_divide { ast_divide($1); }
@@ -5733,14 +5777,14 @@ end_program:    end_program1[end] '.'
                     gcc_unreachable();
                   }
                   if( !matches ) {
-                    error_msg(@end, "END %s %s does not match "
+                    error_msg($end.loc, "END %s %s does not match "
                                     "%<IDENTIFICATION DIVISION %s%>",
                               token_name, name, prog->name);
                     YYERROR;
                   }
 
                   if( 0 != strcasecmp(prog->name, name) ) {
-                    error_msg(@end, "END PROGRAM '%s' does not match PROGRAM-ID '%s'",
+                    error_msg($end.loc, "END PROGRAM '%s' does not match PROGRAM-ID '%s'",
                               name, prog->name);
                     YYERROR;
                   }
@@ -5773,20 +5817,24 @@ end_program:    end_program1[end] '.'
                 ;
 end_program1:   END_PROGRAM  namestr[name]
                 {
+                  $$.loc = @name;
                   $$.token = END_PROGRAM;
                   $$.name = $name;
                 }
         |       END_FUNCTION namestr[name]
                 {
+                  $$.loc = @name;
                   $$.token = END_FUNCTION;
                   $$.name = $name;
                 }
        |       END_PROGRAM  '.' // error
                 {
+                  $$.loc = @1;
                   $$.token = END_PROGRAM;
                 }
         |       END_FUNCTION '.' // error
                 {
+                  $$.loc = @1;
                   $$.token = END_FUNCTION;
                 }
                 ;
@@ -6622,7 +6670,7 @@ name:           qname
                       auto name = names.front();
                       names.pop_front();
                       auto e = symbol_field_forward_add(PROGRAM, parent,
-                                                        name, yylineno);
+                                                        name, @1.first_line);
                       if( !e ) YYERROR;
                      symbol_field_location( symbol_index(e), @qname );
                       parent = symbol_index(e);
@@ -6652,6 +6700,10 @@ ctx_name:       NAME
 
 context_word:   APPLY                   { static char s[] ="APPLY";
                                          $$ = s; } // screen description entry
+        |       ARGUMENT_NUMBER         { static char s[] ="ARGUMENT-NUMBER";
+                                         $$ = s; } // Display Upon / Accept From
+        |       ARGUMENT_VALUE         { static char s[] ="ARGUMENT-VALUE";
+                                         $$ = s; } // Accept From
         |       ARITHMETIC             { static char s[] ="ARITHMETIC";
                                          $$ = s; } // OPTIONS paragraph
         |       ATTRIBUTE              { static char s[] ="ATTRIBUTE";
@@ -6688,6 +6740,10 @@ context_word:   APPLY                   { static char s[] ="APPLY";
                                          $$ = s; } // ERASE clause in a screen description entry
         |       ENTRY_CONVENTION       { static char s[] ="ENTRY-CONVENTION";
                                          $$ = s; } // OPTIONS paragraph
+       |       ENVIRONMENT_NAME         { static char s[] ="ENVIRONMENT-NAME";
+                                         $$ = s; } // Display Upon
+        |       ENVIRONMENT_VALUE         { static char s[] ="ENVIRONMENT-VALUE";
+                                         $$ = s; } // Display Upon / Accept From
         |       ERASE                  { static char s[] ="ERASE";
                                          $$ = s; } // screen description entry
         |       EXPANDS                { static char s[] ="EXPANDS";
@@ -7036,9 +7092,9 @@ arith_err:      SIZE_ERROR
                     *ptgt = $1 == NOT?
                       current.compute_not_error() : current.compute_on_error();
                   } else {
-                    *ptgt = label_add(LblArith, uniq_label("arith"), yylineno);
+                    *ptgt = label_add(LblArith, uniq_label("arith"), @1.first_line);
                   }
-                 (*ptgt)->lain = yylineno;
+                 (*ptgt)->lain = @1.first_line;
                   parser_arith_error( *ptgt );
                 }
                 ;
@@ -8754,12 +8810,12 @@ search_1_body:  name[table] search_varying[varying]
 
                   cbl_name_t label_name;
                  auto len = snprintf(label_name, sizeof(label_name),
-                                    "linear_search_%d", yylineno);
+                                    "linear_search_%d", @1.first_line);
                  if( ! (0 < len && len < int(sizeof(label_name))) ) {
                    gcc_unreachable();
                  }
                   cbl_label_t *name = label_add( LblSearch,
-                                                 label_name, yylineno );
+                                                 label_name, @1.first_line );
                  auto varying($varying);
                   if( index == varying ) varying = NULL;
                   parser_lsearch_start( name, $table, index, varying );
@@ -8812,9 +8868,9 @@ search_binary:  SEARCH ALL search_2_body search_2_cases
 search_2_body:  name[table]
                 {
                   statement_begin(@$, SEARCH);
-                  char *label_name = xasprintf("binary_search_%d", yylineno);
+                  char *label_name = xasprintf("binary_search_%d", @1.first_line);
                   cbl_label_t *name = label_add( LblSearch,
-                                                 label_name, yylineno );
+                                                 label_name, @1.first_line );
                   parser_bsearch_start( name, $table );
                   search_alloc(name);
                 }
@@ -9759,7 +9815,7 @@ call_except:    EXCEPTION
                 {
                   $$.not_error = NULL;
                   $$.on_error = label_add(LblArith,
-                                          uniq_label("call"), yylineno);
+                                          uniq_label("call"), @1.first_line);
                   if( !$$.on_error ) YYERROR;
                   parser_call_exception( $$.on_error );
 
@@ -9772,7 +9828,7 @@ call_except:    EXCEPTION
                 {
                   $$.not_error = NULL;
                   $$.on_error = label_add(LblArith,
-                                          uniq_label("call"), yylineno);
+                                          uniq_label("call"), @1.first_line);
                   if( !$$.on_error ) YYERROR;
                   parser_call_exception( $$.on_error );
 
@@ -9828,7 +9884,7 @@ go_to:          GOTO labels[args]
                   }
 
                  for( auto& label : $args->elems ) {
-                   label->used = yylineno;
+                   label->used = @2.first_line;
                  }
                   cbl_label_t *arg = $args->elems.front();
                   parser_goto( cbl_refer_t(), 1, &arg );
@@ -9840,7 +9896,7 @@ go_to:          GOTO labels[args]
                   std::vector <cbl_label_t *> args($args->elems.size());
                  std::copy($args->elems.begin(), $args->elems.end(), args.begin());
                  for( auto& label : $args->elems ) {
-                   label->used = yylineno;
+                   label->used = @2.first_line;
                  }
                   parser_goto( *$value, args.size(), args.data() );
                 }
@@ -9860,7 +9916,7 @@ resume:         RESUME NEXT STATEMENT
                 {
                   statement_begin(@1, RESUME);
                   parser_clear_exception();
-                 $tgt->used = yylineno;
+                 $tgt->used = @1.first_line;
                   parser_goto( cbl_refer_t(), 1, &$tgt );
                 }
                 ;
@@ -10035,7 +10091,7 @@ on_overflow:    OVERFLOW_kw
                 {
                   $$.not_error = NULL;
                   $$.on_error = label_add(LblString,
-                                          uniq_label("string"), yylineno);
+                                          uniq_label("string"), @1.first_line);
                   if( !$$.on_error ) YYERROR;
                   parser_string_overflow( $$.on_error );
 
@@ -11464,6 +11520,8 @@ keyword_str( int token ) {
   return tokens.name_of(token);
 }
 
+bool iso_cobol_word( const std::string& name, bool include_context );
+
 /*
  * Return the token for the Cobol name, unless it is a function name.  The
  * lexer uses keyword_tok to determine if what appears to be a NAME is in fact
@@ -11474,15 +11532,14 @@ keyword_str( int token ) {
  */
 
 // tokens.h is generated as needed from parse.h with tokens.h.gen
-tokenset_t::tokenset_t() {
+current_tokens_t::tokenset_t::tokenset_t() {
 #include "token_names.h"
 }
 
-bool iso_cobol_word( const std::string& name, bool include_context );
 
 // Look up the lowercase form of a keyword, excluding some CDF names.
 int
-tokenset_t::find( const cbl_name_t name, bool include_intrinsics ) {
+current_tokens_t::tokenset_t::find( const cbl_name_t name, bool include_intrinsics ) {
   static const cbl_name_t non_names[] = { // including CDF NAMES, and "SWITCH"
     "CHECKING", "LIST", "LOCATION", "MAP", "SWITCH",
   }, * const eonames = non_names + COUNT_OF(non_names);
index 105afe9db34262d2230b325d5681ccbec12aa202..3543a00513723ce54044bb859b628fc3e5586f49 100644 (file)
@@ -935,161 +935,7 @@ teed_up_names() {
   return name_queue_t::namelist_of( name_queue.peek() );
 }
 
-class tokenset_t {
-  // token_names is initialized from a generated header file. 
-  std::vector<const char *>token_names;  // position indicates token value
-  std::map <std::string, int> tokens;    // aliases
-  std::set<std::string> cobol_words;  // Anything in COBOL-WORDS may appear only once. 
- public:
-  static std::string
-  lowercase( const cbl_name_t name ) {
-    cbl_name_t lname;
-    std::transform(name, name + strlen(name) + 1, lname, ftolower);
-    return lname;
-  }
-  static std::string
-  uppercase( const cbl_name_t name ) {
-    cbl_name_t uname;
-    std::transform(name, name + strlen(name) + 1, uname, ftoupper);
-    return uname;
-  }
-
- public:
-  tokenset_t();
-  int find( const cbl_name_t name, bool include_intrinsics );
-
-  bool equate( const YYLTYPE& loc, int token,
-              const cbl_name_t name, const cbl_name_t verb = "EQUATE") {
-    auto lname( lowercase(name) );
-    auto cw = cobol_words.insert(lname);
-    if( ! cw.second ) {
-      error_msg(loc, "COBOL-WORDS %s: %s may appear but once", verb, name);
-      return false;
-    }
-    auto p = tokens.find(lowercase(name));
-    bool fOK = p == tokens.end();
-    if( fOK ) { // name not already in use
-      tokens[lname] = token;
-      dbgmsg("%s:%d: %d has alias %s", __func__, __LINE__, token, name);
-    } else {
-      error_msg(loc, "%s: %s already defined as a token", verb, name);
-    }
-    return fOK;
-  }
-  bool undefine( const YYLTYPE& loc,
-                const cbl_name_t name, const cbl_name_t verb = "UNDEFINE" ) {
-    auto lname( lowercase(name) );
-    auto cw = cobol_words.insert(lname);
-    if( ! cw.second ) {
-      error_msg(loc, "COBOL-WORDS %s: %s may appear but once", verb, name);
-      return false;
-    }
-
-    // Do not erase generic, multi-type tokens COMPUTATIONAL and BINARY_INTEGER.
-    if( binary_integer_usage_of(name) ) {
-      dbgmsg("%s:%d: generic %s remains valid as a token", __func__, __LINE__, name);
-      return true;
-    }
-
-    auto p = tokens.find(lname);
-    bool fOK = p != tokens.end();
-    if( fOK ) { // name in use
-      tokens.erase(p);
-    } else {
-      error_msg(loc, "%s: %s not defined as a token", verb, name);
-    }
-    dbgmsg("%s:%d: %s removed as a valid token name", __func__, __LINE__, name);
-    return fOK;
-  }
-  
-  bool substitute( const YYLTYPE& loc,
-                  const cbl_name_t extant, int token, const cbl_name_t name ) {
-    return
-      equate( loc, token, name, "SUBSTITUTE" )
-      &&
-      undefine( loc, extant, "SUBSTITUTE" );
-  }
-  bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
-    auto lname( lowercase(name) );
-    auto cw = cobol_words.insert(lname);
-    if( ! cw.second ) {
-      error_msg(loc, "COBOL-WORDS RESERVE: %s may appear but once", name);
-      return false;
-    }
-    tokens[lname] = -42;
-    return true;
-  }
-  int redefined_as( const cbl_name_t name ) {
-    auto lname( lowercase(name) );
-    if( cobol_words.find(lname) != cobol_words.end() ) {
-      auto p = tokens.find(lname);
-      if( p != tokens.end() ) {
-        return p->second;
-      }
-    }
-    return 0;
-  }
-  const char * name_of( int tok ) const {
-    tok -= (255 + 3);
-    gcc_assert(0 <= tok && size_t(tok) < token_names.size());
-    return tok < 0? "???" : token_names[tok];
-  }
-};
-
-class current_tokens_t {
-  tokenset_t tokens;
- public:
-  current_tokens_t() {}
-  int find( const cbl_name_t name, bool include_intrinsics ) {
-    return tokens.find(name, include_intrinsics);
-  }
-  bool equate( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
-    int token; 
-    if( 0 == (token = binary_integer_usage_of(keyword)) ) {
-      if( 0 == (token = keyword_tok(keyword)) ) {
-       error_msg(loc, "EQUATE %s: not a valid token", keyword);
-       return false;
-      }
-    }
-    auto name = keyword_alias_add(tokens.uppercase(keyword),
-                                 tokens.uppercase(alias));
-    if( name != keyword ) {
-      error_msg(loc, "EQUATE: %s is already an alias for %s", alias, name.c_str());
-      return false;
-    } 
-    return tokens.equate(loc, token, alias);
-  }
-  bool undefine( const YYLTYPE& loc, cbl_name_t keyword ) {
-    return tokens.undefine(loc, keyword);
-  }
-  bool substitute( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
-    int token; 
-    if( 0 == (token = binary_integer_usage_of(keyword)) ) {
-      if( 0 == (token = keyword_tok(keyword)) ) {
-       error_msg(loc, "SUBSTITUTE %s: not a valid token", keyword);
-       return false;
-      }
-    }
-    auto name = keyword_alias_add(tokens.uppercase(keyword),
-                                 tokens.uppercase(alias));
-    if( name != keyword ) {
-      error_msg(loc, "SUBSTITUTE: %s is already an alias for %s", alias, name.c_str());
-      return false;
-    } 
-
-    dbgmsg("%s:%d: %s (%d) will have alias %s", __func__, __LINE__, keyword, token, alias);
-    return tokens.substitute(loc, keyword, token, alias);
-  }
-  bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
-    return tokens.reserve(loc, name);
-  }
-  int redefined_as( const cbl_name_t name ) {
-    return tokens.redefined_as(name);
-  }
-  const char * name_of( int tok ) const {
-    return tokens.name_of(tok);
-  }
-} tokens;
+current_tokens_t tokens;
 
 int
 redefined_token( const cbl_name_t name ) {
@@ -2909,17 +2755,6 @@ group_attr( const cbl_field_t * field ) {
   return p->attr;
 }
 
-static struct symbol_elem_t *
-field_of( const char F[], int L, const char name[] ) {
-  struct symbol_elem_t *e = symbol_field(PROGRAM, 0, name);
-  if( !e ) {
-    cbl_internal_error("%s:%d: no symbol '%s' found", F, L, name);
-  }
-  assert( procedure_div_e != current_division  );
-  return e;
-}
-#define field_of( F ) field_of(__func__, __LINE__, (F))
-
 static struct cbl_field_t *
 field_add( const YYLTYPE& loc, cbl_field_t *field ) {
   switch(current_data_section) {
index 2fc4aea8baea7d699fc2c0361922116fb5505353..3c12edaceb1c67068ef09eaab8e0f442b7cd0068 100644 (file)
@@ -83,6 +83,8 @@ NONWORD   [^[:alnum:]$_-]+
 
 SPC  [[:space:]]+
 OSPC [[:space:]]*
+BLANK  [[:blank:]]+
+OBLANK [[:blank:]]*
 EOL  \r?\n
 BLANK_EOL   [[:blank:]]*{EOL}
 BLANK_OEOL  [[:blank:]]*{EOL}?
@@ -160,7 +162,7 @@ COMMA    [,;][[:blank:]]*
 ISNT    (IS{SPC})?NOT
 
 
-COMMENTARY DATE-COMPILED|DATE-WRITTEN|INSTALLATION|SECURITY
+COMMENTARY AUTHOR|DATE-COMPILED|DATE-WRITTEN|INSTALLATION|SECURITY
 
 SORT_MERGE    SORT(-MERGE)?
 
@@ -182,7 +184,7 @@ LINE_DIRECTIVE ^[#]line{SPC}[[:alnum:]]+{SPC}[""''].+\n
 
 %x procedure_div ident_state addr_of function classify
 %x program_id_state comment_entries
-%x author_state date_state field_level field_state dot_state
+%x date_state field_level field_state dot_state
 %x numeric_state name_state
 %x quoted1 quoted2 quoteq
 %x picture picture_count integer_count
@@ -238,30 +240,23 @@ WORKING-STORAGE{SPC}SECTION {
                 yy_push_state(field_state);
                 return WORKING_STORAGE_SECT; }
 LOCAL-STORAGE{SPC}SECTION {
-                yy_push_state(field_state);
-                return LOCAL_STORAGE_SECT; }
-WORKING-STORAGE {
-                return WORKING_STORAGE; }
-LOCAL-STORAGE {
-                return LOCAL_STORAGE; }
-SCREEN {
-                return SCREEN; }
+                  yy_push_state(field_state);
+                  return LOCAL_STORAGE_SECT; }
+WORKING-STORAGE        { return WORKING_STORAGE; }
+LOCAL-STORAGE  { return LOCAL_STORAGE; }
+SCREEN                 { return SCREEN; }
 
 LINKAGE{SPC}SECTION {
                 yy_push_state(field_state);
                 return LINKAGE_SECT; }
 
-FUNCTION-ID            { yy_push_state(ident_state);
-                         yy_push_state(program_id_state);
-                         yy_push_state(name_state); return FUNCTION; }
-
-PROGRAM-ID             { yy_push_state(ident_state);
-                         yy_push_state(program_id_state);
-                         yy_push_state(name_state); return PROGRAM_ID; }
+FUNCTION-ID{OSPC}{DOTSEP}?     { yy_push_state(ident_state);
+                                 yy_push_state(program_id_state);
+                                 yy_push_state(name_state); return FUNCTION; }
 
-PROGRAM-ID/{DOTEOL}    { yy_push_state(ident_state);
-                         yy_push_state(name_state);
-                         yy_push_state(dot_state); return PROGRAM_ID; }
+PROGRAM-ID{OSPC}{DOTSEP}?      { yy_push_state(ident_state);
+                                 yy_push_state(program_id_state);
+                                 yy_push_state(name_state); return PROGRAM_ID; }
 
 PROCEDURE{SPC}DIVISION { yy_push_state(procedure_div);
                                   return PROCEDURE_DIV; }
@@ -272,30 +267,18 @@ PROCEDURE{SPC}DIVISION    { yy_push_state(procedure_div);
 }
 
 <ident_state>{
+  {BLANK_OEOL}
   ID(ENTIFICATION)?{SPC}DIVISION       { myless(0); yy_pop_state(); }
+  (ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION {
+                                         myless(0); yy_pop_state(); }
+  OPTIONS                              { myless(0); yy_pop_state(); }
+
   AS{SPC}[""]  { yy_push_state(quoted2); return AS; }
   AS{SPC}['']  { yy_push_state(quoted1); return AS; }
   IS           { pop_return IS; }
 
-  OPTIONS              { yy_pop_state(); myless(0); }
-  [[:blank:]]*(ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION/[[:space:].] {
-                                  yy_pop_state(); myless(0); }
-  [[:blank:]]*AUTHOR[[:blank:].]+{EOL}? {
-                                 // Might not have an EOL, but stop on one.
-                                  yy_push_state(author_state); }
-
-  {DOTEOL}
-
   {COMMENTARY} { BEGIN(comment_entries); }
 }
-<author_state>{
-    [[:blank:]]+
-    ^{BLANK_EOL}
-    [^\r\n]+                   { yy_pop_state();
-                                  yylval.string = xstrdup(yytext);
-                               }
-}
-
 
 <INITIAL>{
   COBOL                { return COBOL; }
@@ -307,6 +290,15 @@ PROCEDURE{SPC}DIVISION     { yy_push_state(procedure_div);
                             yy_push_state(field_state);
                             yy_set_bol(1);
                             myless(0); }
+
+  END{SPC}PROGRAM        { yy_push_state(name_state);
+                                  return program_level() > 1?
+                                         END_SUBPROGRAM : END_PROGRAM; }
+
+  END{SPC}FUNCTION        { yy_push_state(name_state);
+                                  return program_level() > 1?
+                                         END_SUBPROGRAM /*invalid*/ :
+                                         END_FUNCTION; }
 }
 
 <INITIAL,procedure_div,cdf_state>{
@@ -444,6 +436,11 @@ STDOUT             { return STDOUT; }
 STDERR         { return STDERR; }
 SYSERR         { return STDERR; }
 
+ARGUMENT-NUMBER        { return ARGUMENT_NUMBER; }
+ARGUMENT-VALUE         { return ARGUMENT_VALUE; }
+ENVIRONMENT-NAME       { return ENVIRONMENT_NAME; }
+ENVIRONMENT-VALUE      { return ENVIRONMENT_VALUE; }
+
 CANCEL         { return CANCEL; }
 COMMIT         { return COMMIT; }
 COMMON         { return COMMON; }
@@ -541,7 +538,7 @@ SECTION{SPC}[+-]?{INTEGERZ}/{OSPC}{DOTSEP}  {
                                  auto eotext = yytext + yyleng;
                                  auto p = std::find_if(yytext, eotext, fisspace);
                                  p = std::find_if(p, eotext, nonspace);
-                                 yylval.string = p;
+                                 yylval.string = xstrdup(p);
                                  return SECTION;
                                }
 
@@ -1384,45 +1381,36 @@ USE({SPC}FOR)?          { return USE; }
 }
 
 <program_id_state>{
-  ^[[:blank:]]+
-  ^{BLANK_EOL}
+  {BLANK_OEOL}
   (IS)?[[:space:]]
+  AS/{SPC}     { myless(0); yy_pop_state(); } /* => ident_state */
 
-  COMMON/[.]|{SPC}[[:alnum:].]         { return COMMON; }
-  INITIAL/[.]|{SPC}[[:alnum:].]        { return INITIAL_kw; }
-  RECURSIVE                    { return RECURSIVE; }
-  PROGRAM/[.]|{SPC}[[:alnum:].] { return PROGRAM_kw; }
-
-  INITIAL      { pop_return INITIAL_kw; }
-  COMMON       { pop_return COMMON; }
-  PROGRAM      { pop_return PROGRAM; }
+  INITIAL      { return INITIAL_kw; }
+  COMMON       { return COMMON; }
+  RECURSIVE    { return RECURSIVE; }
+  PROGRAM      { return PROGRAM_kw; }
 
-  AS/{SPC}     { myless(0); yy_pop_state(); } /* => ident_state */
-  [[:blank:]]*{DOTSEP}[[:blank:].]+{EOL} { pop_return '.'; }
-  {DOTEOL}                              { pop_return '.'; }
+  {DOTSEP}     { pop_return '.'; }
 }
 
-<name_state>{
-  ^[[:blank:]]+
-  ^{BLANK_EOL}
-  {NAME}               |
-  {NAME}/{OSPC}[.]     { yy_pop_state();
-                         yylval.string = xstrdup(yytext); return NAME; }
+<name_state>{           /* Either pop from here, or let the quoted state pop */
+  {BLANK_OEOL}
 
+  {NAME}               { yy_pop_state();
+                         yylval.string = xstrdup(yytext);
+                         return NAME; 
+                       }
   Z?['']                { yylval.literal.set_prefix(yytext, yyleng-1);
-                         yy_push_state(quoted1); }
+                         BEGIN(quoted1); }
   Z?[""]                { yylval.literal.set_prefix(yytext, yyleng-1);
-                         yy_push_state(quoted2); }
-
-  [.]/[[:blank:]]+.     { return *yytext; }
+                         BEGIN(quoted2); }
 
-  [[:blank:]]*{DOTSEP}[[:blank:].]+{EOL} {
-                         yy_pop_state(); myless(0); }
-  {DOTEOL}                     { yy_pop_state(); myless(0); }
+  .                    { myless(0); yy_pop_state();
+                         /* Should not happen for valid inputs. */ }
 }
 <dot_state>{
   [[:blank:]]*[.][[:blank:].]+{EOL}    { pop_return '.'; }
-  [[:blank:]]*[.]                      { pop_return '.'; }
+  [[:blank:]]*[.]+                     { pop_return '.'; }
 }
 
 <date_state>{
@@ -1645,9 +1633,9 @@ B-SHIFT-RC
 
   FUNCTION                     { yy_push_state(function); return FUNCTION; }
 
-  SECTION{OSPC}[.]{SPC}/USE[[:space:]] { yylval.string = NULL; return SECTION; }
+  SECTION{OSPC}[.]+{SPC}/USE[[:space:]]        { yylval.string = NULL; return SECTION; }
 
-  [.]({SPC}(EJECT|SKIP[123]))*{SPC}EXIT{OSPC}/{DOTSEP} {
+  [.]+({SPC}(EJECT|SKIP[123]))*{SPC}EXIT{OSPC}/{DOTSEP} {
                    // EXIT format-1 is a "continue" statement
                  }
   {NAME}/{OSPC}{DOTSEP} {
@@ -2073,41 +2061,41 @@ BASIS           { yy_push_state(basis); return BASIS; }
                    if( include_debug() ) myless(7);
                  }
                }
-  ^[ ]*>>{OSPC}IF              { yy_push_state(cdf_state); return CDF_IF; }
-  ^[ ]*>>{OSPC}ELSE            { return CDF_ELSE; }
-  ^[ ]*>>{OSPC}END-IF          { return CDF_END_IF; }
+  ^[ ]*>>{OBLANK}IF            { yy_push_state(cdf_state); return CDF_IF; }
+  ^[ ]*>>{OBLANK}ELSE          { return CDF_ELSE; }
+  ^[ ]*>>{OBLANK}END-IF                { return CDF_END_IF; }
 
-  ^[ ]*[$]{OSPC}IF             { if( ! dialect_mf() )  {
+  ^[ ]*[$]{OBLANK}IF           { if( ! dialect_mf() )  {
                                    dialect_error(yylloc,  yytext, "mf");
                                  }
                                  yy_push_state(cdf_state); return CDF_IF; }
-  ^[ ]*[$]{OSPC}ELSE           { if( ! dialect_mf() )  {
+  ^[ ]*[$]{OBLANK}ELSE         { if( ! dialect_mf() )  {
                                    dialect_error(yylloc,  yytext, "mf");
                                  }
                                  return CDF_ELSE; }
-  ^[ ]*[$]{OSPC}END            { if( ! dialect_mf() ) {
+  ^[ ]*[$]{OBLANK}END          { if( ! dialect_mf() ) {
                                    dialect_error(yylloc,  yytext, "mf");
                                  }
                                  return CDF_END_IF; }
 
-  ^[ ]*[$]{OSPC}SET({SPC}CONSTANT)? {
+  ^[ ]*[$]{OBLANK}SET({SPC}CONSTANT)? {
                                  if( ! dialect_mf() ) dialect_error(yylloc, yytext, "mf");
                                  yy_push_state(cdf_state); return CDF_DEFINE; }
 
-  ^[ ]*>>{OSPC}EVALUATE                { return CDF_EVALUATE; }
-  ^[ ]*>>{OSPC}WHEN            { return CDF_WHEN; }
-  ^[ ]*>>{OSPC}END-EVALUATE    { return CDF_END_EVALUATE; }
+  ^[ ]*>>{OBLANK}EVALUATE              { return CDF_EVALUATE; }
+  ^[ ]*>>{OBLANK}WHEN          { return CDF_WHEN; }
+  ^[ ]*>>{OBLANK}END-EVALUATE  { return CDF_END_EVALUATE; }
 
-  ^[ ]*>>{OSPC}CALL-CONVENTION{SPC}C           { return CALL_VERBATIM; }
-  ^[ ]*>>{OSPC}CALL-CONVENTION{SPC}COBOL       { return CALL_COBOL; }
-  ^[ ]*>>{OSPC}CALL-CONVENTION{SPC}VERBATIM    { return CALL_VERBATIM; }
+  ^[ ]*>>{OBLANK}CALL-CONVENTION{BLANK}C               { return CALL_VERBATIM; }
+  ^[ ]*>>{OBLANK}CALL-CONVENTION{BLANK}COBOL   { return CALL_COBOL; }
+  ^[ ]*>>{OBLANK}CALL-CONVENTION{BLANK}VERBATIM        { return CALL_VERBATIM; }
 
-  ^[ ]*>>{OSPC}DEFINE  { yy_push_state(cdf_state); return CDF_DEFINE; }
-  ^[ ]*>>{OSPC}DISPLAY         { return CDF_DISPLAY; }
-  ^[ ]*>>{OSPC}TURN    { yy_push_state(exception); return TURN; }
-  ^[ ]*>>{OSPC}COBOL-WORDS     { yy_push_state(cobol_words); return COBOL_WORDS; }
+  ^[ ]*>>{OBLANK}DEFINE        { yy_push_state(cdf_state); return CDF_DEFINE; }
+  ^[ ]*>>{OBLANK}DISPLAY       { return CDF_DISPLAY; }
+  ^[ ]*>>{OBLANK}TURN  { yy_push_state(exception); return TURN; }
+  ^[ ]*>>{OBLANK}COBOL-WORDS   { yy_push_state(cobol_words); return COBOL_WORDS; }
 
-  ^[ ]*>>{OSPC}{NAME}  {
+  ^[ ]*>>{OBLANK}{NAME}        {
                          error_msg(yylloc, "unknown CDF token: %s", yytext);
                        }
 
@@ -2165,7 +2153,7 @@ BASIS             { yy_push_state(basis); return BASIS; }
 
 <*>OR                          { return OR; }
 <*>AND                         { return AND; }
-<*>{DOTSEP}[[:blank:].]+$      { return '.'; }
+<*>{DOTSEP}                    { return '.'; }
 <*>[().=*/+&-]                 { return *yytext; }
 <*>[[:blank:]]+
 <*>\r?\n
@@ -2369,7 +2357,7 @@ BASIS             { yy_push_state(basis); return BASIS; }
   POINTER      { return POINTER; }
   POSITIVE     { return POSITIVE; }
   PROCEDURE    { return PROCEDURE; }
-  PROGRAM      { return PROGRAM; }
+  PROGRAM      { return PROGRAM_kw; }
   PROGRAM-ID   { return PROGRAM_ID; }
   PROPERTY     { return PROPERTY; }
   PROTOTYPE    { return PROTOTYPE; }
@@ -2411,7 +2399,7 @@ BASIS             { yy_push_state(basis); return BASIS; }
   SCREEN       { return SCREEN; }
   SD           { return SD; }
   SEARCH       { return SEARCH; }
-  SECTION      { return SECTION; }
+  SECTION      { yylval.string = NULL; return SECTION; }
   SELECT       { return SELECT; }
   SENTENCE     { return SENTENCE; }
   SEPARATE     { return SEPARATE; }
index ea304ba0d735e9509dff003a93bf31edd7476558..696073913972b23366cadfe3017cd0767f994c80 100644 (file)
@@ -356,6 +356,10 @@ static void level_found() {
   if( scanner_normal() ) parsing.need_level(false);
 }
 
+/*
+ * Trim the scanned location by the amount about to re-scanned. 
+ * Must be a macro because it expands yyless. 
+ */
 #define myless(N)                              \
   do {                                         \
     auto n(N);                                 \
index a273da9a1cec987a6d8cdc1610a84842086786ea..fd70ea96d73b782c72b9b6efad2474d25ca18f3d 100644 (file)
@@ -34,7 +34,6 @@ start_condition_str( int sc ) {
   switch(sc) {
   case INITIAL: state = "INITIAL"; break;
   case addr_of: state = "addr_of"; break;
-  case author_state: state = "author_state"; break;
   case basis: state = "basis"; break;
   case bool_state: state = "bool_state"; break;
   case cdf_state: state = "cdf_state"; break;
index 089c9c1e352fef4f5f553f1cad366db0768425ba..4b347298a240613d8457220bdbdd844d6b44a0a6 100644 (file)
@@ -1768,8 +1768,8 @@ symbols_update( size_t first, bool parsed_ok ) {
         if( e == symbols_end() ) {
           // no field redefines the file's default record
           auto file = cbl_file_of(symbol_at(field->parent));
-          ERROR_FIELD(field, "line %d: %s lacks a file description",
-                      file->line, file->name);
+          ERROR_FIELD(field, "%s lacks a file description",
+                      file->name);
           return 0;
         }
       }
@@ -2180,14 +2180,22 @@ symbol_table_init(void) {
   }
 
   static symbol_elem_t environs[] = {
+    { symbol_elem_t{ 0, cbl_special_name_t{0, CONSOLE_e, "CONSOLE", 0, "/dev/stdout"}} }, // stdout in DISPLAY; stdin in ACCEPT
+
+    { symbol_elem_t{ 0, cbl_special_name_t{0, STDIN_e, "STDIN", 0, "/dev/stdin"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, SYSIN_e, "SYSIN", 0, "/dev/stdin"}} },
-    { symbol_elem_t{ 0, cbl_special_name_t{0, SYSIPT_e, "SYSIPT", 0, "/dev/stdout"}} },
+    { symbol_elem_t{ 0, cbl_special_name_t{0, SYSIPT_e, "SYSIPT", 0, "/dev/stdin"}} },
+
+    { symbol_elem_t{ 0, cbl_special_name_t{0, STDOUT_e, "STDOUT", 0, "/dev/stdout"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, SYSOUT_e, "SYSOUT", 0, "/dev/stdout"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, SYSLIST_e, "SYSLIST", 0, "/dev/stdout"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, SYSLST_e, "SYSLST", 0, "/dev/stdout"}} },
+
     { symbol_elem_t{ 0, cbl_special_name_t{0, SYSPUNCH_e, "SYSPUNCH", 0, "/dev/stderr"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, SYSPCH_e, "SYSPCH", 0, "/dev/stderr"}} },
-    { symbol_elem_t{ 0, cbl_special_name_t{0, CONSOLE_e, "CONSOLE", 0, "/dev/stdout"}} },
+    { symbol_elem_t{ 0, cbl_special_name_t{0, STDERR_e, "STDERR", 0, "/dev/stderr"}} },
+    { symbol_elem_t{ 0, cbl_special_name_t{0, SYSERR_e, "SYSERR", 0, "/dev/stderr"}} },
+
     { symbol_elem_t{ 0, cbl_special_name_t{0, C01_e, "C01", 0, "/dev/null"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, C02_e, "C02", 0, "/dev/null"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, C03_e, "C03", 0, "/dev/null"}} },
@@ -2207,10 +2215,6 @@ symbol_table_init(void) {
     { symbol_elem_t{ 0, cbl_special_name_t{0, S04_e, "S04", 0, "/dev/null"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, S05_e, "S05", 0, "/dev/null"}} },
     { symbol_elem_t{ 0, cbl_special_name_t{0, AFP_5A_e, "AFP-5A", 0, "/dev/null"}} },
-    { symbol_elem_t{ 0, cbl_special_name_t{0, STDIN_e, "STDIN", 0, "/dev/stdin"}} },
-    { symbol_elem_t{ 0, cbl_special_name_t{0, STDOUT_e, "STDOUT", 0, "/dev/stdout"}} },
-    { symbol_elem_t{ 0, cbl_special_name_t{0, STDERR_e, "STDERR", 0, "/dev/stderr"}} },
-    { symbol_elem_t{ 0, cbl_special_name_t{0, SYSERR_e, "SYSERR", 0, "/dev/stderr"}} },
   };
 
   struct symbol_elem_t *p = table.elems + table.nelem;
@@ -4345,6 +4349,26 @@ cbl_occurs_t::subscript_ok( const cbl_field_t *subscript ) const {
   return bounds.lower <= (size_t)sub && (size_t)sub <= bounds.upper;
 }
 
+const cbl_field_t * 
+symbol_unresolved_file_key( const cbl_file_t * file,
+                            const cbl_name_t key_field_name ) {
+  const symbol_elem_t *file_sym = symbol_elem_of(file);
+  size_t program = file_sym->program;
+  for( const symbol_elem_t *e = file_sym - 1; e->program == program; e-- ) {
+    if( e->type == SymFile ) break;
+    if( e->type == SymField ) {
+      auto f = cbl_field_of(e);
+      if( f->type == FldLiteralA ) break;
+      if( f->type == FldForward ) {
+        if( 0 == strcmp(key_field_name, f->name) ) {
+          return f;
+        }
+      }
+    }
+  }
+  return nullptr;
+}
+
 cbl_file_key_t::
 cbl_file_key_t( cbl_name_t name,
                 const std::list<cbl_field_t *>& fields,
@@ -4486,7 +4510,7 @@ cbl_file_key_t::deforward( size_t ifile ) {
                     if( ifield == fwd ) {
                       ERROR_FIELD(field, "line %d: %s of %s "
                                "is not defined",
-                               file->line, field->name, file->name);
+                               field->line, field->name, file->name);
                       return ifield;
                     }
 
@@ -4515,9 +4539,13 @@ cbl_file_key_t::deforward( size_t ifile ) {
                     // looked-up field must have same file as parent
                     if( ! (parent != NULL &&
                            symbol_index(symbol_elem_of(parent)) == ifile) ) {
-                      ERROR_FIELD(field, "line %d: %s of %s "
-                               "is not defined in file description",
-                               file->line, field->name, file->name);
+                      const cbl_field_t *undefined =
+                        symbol_unresolved_file_key(file, field->name);
+                      int lineno = undefined? undefined->line : file->line;
+                      ERROR_FIELD(undefined? undefined : field,
+                                  "line %d: %s of %s "
+                                  "is not defined in file description",
+                                  lineno, field->name, file->name);
                     }
                     return ifield;
                   } );
index 0b72b5cfc6c3a782a1748de81117e200680470d8..f96f1ec15fcc784c5b67222f9240b44e2ea9d6d4 100644 (file)
@@ -1894,6 +1894,10 @@ const cbl_label_t * symbol_program_local( const char called[] );
 
 bool redefine_field( cbl_field_t *field );
 
+const cbl_field_t * 
+symbol_unresolved_file_key( const cbl_file_t * file,
+                            const cbl_name_t key_field_name );
+
 static inline struct cbl_section_t *
 cbl_section_of( struct symbol_elem_t *e ) {
   assert(e && e->type == SymDataSection);
@@ -2387,6 +2391,165 @@ enum cbl_call_convention_t {
   cbl_call_cobol_e = 'N', // native
 };
 
+int keyword_tok( const char * text, bool include_intrinsics = false );
+int redefined_token( const cbl_name_t name );
+
+class current_tokens_t {
+  class tokenset_t {
+    // token_names is initialized from a generated header file. 
+    std::vector<const char *>token_names;  // position indicates token value
+    std::map <std::string, int> tokens;    // aliases
+    std::set<std::string> cobol_words;  // Anything in COBOL-WORDS may appear only once. 
+  public:
+    static std::string
+    lowercase( const cbl_name_t name ) {
+      cbl_name_t lname;
+      std::transform(name, name + strlen(name) + 1, lname, ftolower);
+      return lname;
+    }
+    static std::string
+    uppercase( const cbl_name_t name ) {
+      cbl_name_t uname;
+      std::transform(name, name + strlen(name) + 1, uname, ftoupper);
+      return uname;
+    }
+
+  public:
+    tokenset_t();
+    int find( const cbl_name_t name, bool include_intrinsics );
+
+    bool equate( const YYLTYPE& loc, int token,
+                 const cbl_name_t name, const cbl_name_t verb = "EQUATE") {
+      auto lname( lowercase(name) );
+      auto cw = cobol_words.insert(lname);
+      if( ! cw.second ) {
+        error_msg(loc, "COBOL-WORDS %s: %s may appear but once", verb, name);
+        return false;
+      }
+      auto p = tokens.find(lowercase(name));
+      bool fOK = p == tokens.end();
+      if( fOK ) { // name not already in use
+        tokens[lname] = token;
+        dbgmsg("%s:%d: %d has alias %s", __func__, __LINE__, token, name);
+      } else {
+        error_msg(loc, "%s: %s already defined as a token", verb, name);
+      }
+      return fOK;
+    }
+    bool undefine( const YYLTYPE& loc,
+                   const cbl_name_t name, const cbl_name_t verb = "UNDEFINE" ) {
+      auto lname( lowercase(name) );
+      auto cw = cobol_words.insert(lname);
+      if( ! cw.second ) {
+        error_msg(loc, "COBOL-WORDS %s: %s may appear but once", verb, name);
+        return false;
+      }
+
+      // Do not erase generic, multi-type tokens COMPUTATIONAL and BINARY_INTEGER.
+      if( binary_integer_usage_of(name) ) {
+        dbgmsg("%s:%d: generic %s remains valid as a token", __func__, __LINE__, name);
+        return true;
+      }
+
+      auto p = tokens.find(lname);
+      bool fOK = p != tokens.end();
+      if( fOK ) { // name in use
+        tokens.erase(p);
+      } else {
+        error_msg(loc, "%s: %s not defined as a token", verb, name);
+      }
+      dbgmsg("%s:%d: %s removed as a valid token name", __func__, __LINE__, name);
+      return fOK;
+    }
+  
+    bool substitute( const YYLTYPE& loc,
+                     const cbl_name_t extant, int token, const cbl_name_t name ) {
+      return
+        equate( loc, token, name, "SUBSTITUTE" )
+        &&
+        undefine( loc, extant, "SUBSTITUTE" );
+    }
+    bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
+      auto lname( lowercase(name) );
+      auto cw = cobol_words.insert(lname);
+      if( ! cw.second ) {
+        error_msg(loc, "COBOL-WORDS RESERVE: %s may appear but once", name);
+        return false;
+      }
+      tokens[lname] = -42;
+      return true;
+    }
+    int redefined_as( const cbl_name_t name ) {
+      auto lname( lowercase(name) );
+      if( cobol_words.find(lname) != cobol_words.end() ) {
+        auto p = tokens.find(lname);
+        if( p != tokens.end() ) {
+          return p->second;
+        }
+      }
+      return 0;
+    }
+    const char * name_of( int tok ) const {
+      tok -= (255 + 3);
+      gcc_assert(0 <= tok && size_t(tok) < token_names.size());
+      return tok < 0? "???" : token_names[tok];
+    }
+  };
+
+  tokenset_t tokens;
+ public:
+  current_tokens_t() {}
+  int find( const cbl_name_t name, bool include_intrinsics ) {
+    return tokens.find(name, include_intrinsics);
+  }
+  bool equate( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
+    int token; 
+    if( 0 == (token = binary_integer_usage_of(keyword)) ) {
+      if( 0 == (token = keyword_tok(keyword)) ) {
+       error_msg(loc, "EQUATE %s: not a valid token", keyword);
+       return false;
+      }
+    }
+    auto name = keyword_alias_add(tokens.uppercase(keyword),
+                                 tokens.uppercase(alias));
+    if( name != keyword ) {
+      error_msg(loc, "EQUATE: %s is already an alias for %s", alias, name.c_str());
+      return false;
+    } 
+    return tokens.equate(loc, token, alias);
+  }
+  bool undefine( const YYLTYPE& loc, cbl_name_t keyword ) {
+    return tokens.undefine(loc, keyword);
+  }
+  bool substitute( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
+    int token; 
+    if( 0 == (token = binary_integer_usage_of(keyword)) ) {
+      if( 0 == (token = keyword_tok(keyword)) ) {
+       error_msg(loc, "SUBSTITUTE %s: not a valid token", keyword);
+       return false;
+      }
+    }
+    auto name = keyword_alias_add(tokens.uppercase(keyword),
+                                 tokens.uppercase(alias));
+    if( name != keyword ) {
+      error_msg(loc, "SUBSTITUTE: %s is already an alias for %s", alias, name.c_str());
+      return false;
+    } 
+
+    dbgmsg("%s:%d: %s (%d) will have alias %s", __func__, __LINE__, keyword, token, alias);
+    return tokens.substitute(loc, keyword, token, alias);
+  }
+  bool reserve( const YYLTYPE& loc, const cbl_name_t name ) {
+    return tokens.reserve(loc, name);
+  }
+  int redefined_as( const cbl_name_t name ) {
+    return tokens.redefined_as(name);
+  }
+  const char * name_of( int tok ) const {
+    return tokens.name_of(tok);
+  }
+};
+
 cbl_call_convention_t current_call_convention();
 
 cbl_call_convention_t
@@ -2433,9 +2596,6 @@ public:
   int line_number() const { return line; }
 };
 
-int keyword_tok( const char * text, bool include_intrinsics = false );
-int redefined_token( const cbl_name_t name );
-
 void procedure_definition_add( size_t program, const cbl_label_t *procedure );
 void procedure_reference_add( const char *sect, const char *para,
                               int line, size_t context );
index 39df2a0390e62b9d642822d697984e973e6481f0..c04bb0fbcdcbffaa65e80f95af8fd79cc758e2d4 100644 (file)
@@ -504,7 +504,7 @@ symbol_match( size_t program, const std::list<const char *>& names ) {
     }
     auto inserted = output.insert(*p);
     if( ! inserted.second ) {
-      yyerror("%s is not a unique reference", key.name);
+      error_msg_direct("%s is not a unique reference", key.name);
     }
   }
   return output;
index 4b24fc67769cd0a9de32466a60f51cfe8d6db072..d35b7060dd96bf50dcd183cbb45ec0252b30cb49 100644 (file)
@@ -1,5 +1,5 @@
 // generated by ./token_names.h.gen ../../build/gcc/cobol/parse.h
-// Thu May  8 18:53:33 EDT 2025
+// Fri Jul  4 12:35:01 EDT 2025
 tokens = {
        { "identification", IDENTIFICATION_DIV }, // 258
        { "environment", ENVIRONMENT_DIV }, // 259
@@ -182,513 +182,517 @@ tokens = {
        { "unstring", UNSTRING }, // 433
        { "write", WRITE }, // 434
        { "when", WHEN }, // 435
-       { "abs", ABS }, // 436
-       { "access", ACCESS }, // 437
-       { "acos", ACOS }, // 438
-       { "actual", ACTUAL }, // 439
-       { "advancing", ADVANCING }, // 440
-       { "after", AFTER }, // 441
-       { "all", ALL }, // 442
-       { "allocate", ALLOCATE }, // 443
-       { "alphabet", ALPHABET }, // 444
-       { "alphabetic", ALPHABETIC }, // 445
-       { "alphabetic-lower", ALPHABETIC_LOWER }, // 446
-       { "alphabetic-upper", ALPHABETIC_UPPER }, // 447
-       { "alphanumeric", ALPHANUMERIC }, // 448
-       { "alphanumeric-edited", ALPHANUMERIC_EDITED }, // 449
-       { "also", ALSO }, // 450
-       { "alternate", ALTERNATE }, // 451
-       { "annuity", ANNUITY }, // 452
-       { "anum", ANUM }, // 453
-       { "any", ANY }, // 454
-       { "anycase", ANYCASE }, // 455
-       { "apply", APPLY }, // 456
-       { "are", ARE }, // 457
-       { "area", AREA }, // 458
-       { "areas", AREAS }, // 459
-       { "as", AS }, // 460
-       { "ascending", ASCENDING }, // 461
-       { "activating", ACTIVATING }, // 462
-       { "asin", ASIN }, // 463
-       { "assign", ASSIGN }, // 464
-       { "at", AT }, // 465
-       { "atan", ATAN }, // 466
-       { "based", BASED }, // 467
-       { "baseconvert", BASECONVERT }, // 468
-       { "before", BEFORE }, // 469
-       { "binary", BINARY }, // 470
-       { "bit", BIT }, // 471
-       { "bit-of", BIT_OF }, // 472
-       { "bit-to-char", BIT_TO_CHAR }, // 473
-       { "blank", BLANK }, // 474
-       { "block", BLOCK_kw }, // 475
-       { "boolean-of-integer", BOOLEAN_OF_INTEGER }, // 476
-       { "bottom", BOTTOM }, // 477
-       { "by", BY }, // 478
-       { "byte", BYTE }, // 479
-       { "byte-length", BYTE_LENGTH }, // 480
-       { "cf", CF }, // 481
-       { "ch", CH }, // 482
-       { "changed", CHANGED }, // 483
-       { "char", CHAR }, // 484
-       { "char-national", CHAR_NATIONAL }, // 485
-       { "character", CHARACTER }, // 486
-       { "characters", CHARACTERS }, // 487
-       { "checking", CHECKING }, // 488
-       { "class", CLASS }, // 489
-       { "cobol", COBOL }, // 490
-       { "code", CODE }, // 491
-       { "code-set", CODESET }, // 492
-       { "collating", COLLATING }, // 493
-       { "column", COLUMN }, // 494
-       { "combined-datetime", COMBINED_DATETIME }, // 495
-       { "comma", COMMA }, // 496
-       { "command-line", COMMAND_LINE }, // 497
-       { "command-line-count", COMMAND_LINE_COUNT }, // 498
-       { "commit", COMMIT }, // 499
-       { "common", COMMON }, // 500
-       { "concat", CONCAT }, // 501
-       { "condition", CONDITION }, // 502
-       { "configuration", CONFIGURATION_SECT }, // 503
-       { "contains", CONTAINS }, // 504
-       { "content", CONTENT }, // 505
-       { "control", CONTROL }, // 506
-       { "controls", CONTROLS }, // 507
-       { "convert", CONVERT }, // 508
-       { "converting", CONVERTING }, // 509
-       { "corresponding", CORRESPONDING }, // 510
-       { "cos", COS }, // 511
-       { "count", COUNT }, // 512
-       { "currency", CURRENCY }, // 513
-       { "current", CURRENT }, // 514
-       { "current-date", CURRENT_DATE }, // 515
-       { "data", DATA }, // 516
-       { "date", DATE }, // 517
-       { "date-compiled", DATE_COMPILED }, // 518
-       { "date-of-integer", DATE_OF_INTEGER }, // 519
-       { "date-to-yyyymmdd", DATE_TO_YYYYMMDD }, // 520
-       { "date-written", DATE_WRITTEN }, // 521
-       { "day", DAY }, // 522
-       { "day-of-integer", DAY_OF_INTEGER }, // 523
-       { "day-of-week", DAY_OF_WEEK }, // 524
-       { "day-to-yyyyddd", DAY_TO_YYYYDDD }, // 525
-       { "dbcs", DBCS }, // 526
-       { "de", DE }, // 527
-       { "debugging", DEBUGGING }, // 528
-       { "decimal-point", DECIMAL_POINT }, // 529
-       { "declaratives", DECLARATIVES }, // 530
-       { "default", DEFAULT }, // 531
-       { "delimited", DELIMITED }, // 532
-       { "delimiter", DELIMITER }, // 533
-       { "depending", DEPENDING }, // 534
-       { "descending", DESCENDING }, // 535
-       { "detail", DETAIL }, // 536
-       { "direct", DIRECT }, // 537
-       { "direct-access", DIRECT_ACCESS }, // 538
-       { "down", DOWN }, // 539
-       { "duplicates", DUPLICATES }, // 540
-       { "dynamic", DYNAMIC }, // 541
-       { "e", E }, // 542
-       { "ebcdic", EBCDIC }, // 543
-       { "ec", EC }, // 544
-       { "egcs", EGCS }, // 545
-       { "entry", ENTRY }, // 546
-       { "environment", ENVIRONMENT }, // 547
-       { "equal", EQUAL }, // 548
-       { "every", EVERY }, // 549
-       { "examine", EXAMINE }, // 550
-       { "exhibit", EXHIBIT }, // 551
-       { "exp", EXP }, // 552
-       { "exp10", EXP10 }, // 553
-       { "extend", EXTEND }, // 554
-       { "external", EXTERNAL }, // 555
-       { "exception-file", EXCEPTION_FILE }, // 556
-       { "exception-file-n", EXCEPTION_FILE_N }, // 557
-       { "exception-location", EXCEPTION_LOCATION }, // 558
-       { "exception-location-n", EXCEPTION_LOCATION_N }, // 559
-       { "exception-statement", EXCEPTION_STATEMENT }, // 560
-       { "exception-status", EXCEPTION_STATUS }, // 561
-       { "factorial", FACTORIAL }, // 562
-       { "false", FALSE_kw }, // 563
-       { "fd", FD }, // 564
-       { "file-control", FILE_CONTROL }, // 565
-       { "file", FILE_KW }, // 566
-       { "file-limit", FILE_LIMIT }, // 567
-       { "final", FINAL }, // 568
-       { "finally", FINALLY }, // 569
-       { "find-string", FIND_STRING }, // 570
-       { "first", FIRST }, // 571
-       { "fixed", FIXED }, // 572
-       { "footing", FOOTING }, // 573
-       { "for", FOR }, // 574
-       { "formatted-current-date", FORMATTED_CURRENT_DATE }, // 575
-       { "formatted-date", FORMATTED_DATE }, // 576
-       { "formatted-datetime", FORMATTED_DATETIME }, // 577
-       { "formatted-time", FORMATTED_TIME }, // 578
-       { "form-overflow", FORM_OVERFLOW }, // 579
-       { "free", FREE }, // 580
-       { "fraction-part", FRACTION_PART }, // 581
-       { "from", FROM }, // 582
-       { "function", FUNCTION }, // 583
-       { "generate", GENERATE }, // 584
-       { "giving", GIVING }, // 585
-       { "global", GLOBAL }, // 586
-       { "go", GO }, // 587
-       { "group", GROUP }, // 588
-       { "heading", HEADING }, // 589
-       { "hex", HEX }, // 590
-       { "hex-of", HEX_OF }, // 591
-       { "hex-to-char", HEX_TO_CHAR }, // 592
-       { "high-values", HIGH_VALUES }, // 593
-       { "highest-algebraic", HIGHEST_ALGEBRAIC }, // 594
-       { "hold", HOLD }, // 595
-       { "ibm-360", IBM_360 }, // 596
-       { "in", IN }, // 597
-       { "include", INCLUDE }, // 598
-       { "index", INDEX }, // 599
-       { "indexed", INDEXED }, // 600
-       { "indicate", INDICATE }, // 601
-       { "initial", INITIAL_kw }, // 602
-       { "initiate", INITIATE }, // 603
-       { "input", INPUT }, // 604
-       { "installation", INSTALLATION }, // 605
-       { "interface", INTERFACE }, // 606
-       { "integer", INTEGER }, // 607
-       { "integer-of-boolean", INTEGER_OF_BOOLEAN }, // 608
-       { "integer-of-date", INTEGER_OF_DATE }, // 609
-       { "integer-of-day", INTEGER_OF_DAY }, // 610
-       { "integer-of-formatted-date", INTEGER_OF_FORMATTED_DATE }, // 611
-       { "integer-part", INTEGER_PART }, // 612
-       { "into", INTO }, // 613
-       { "intrinsic", INTRINSIC }, // 614
-       { "invoke", INVOKE }, // 615
-       { "i-o", IO }, // 616
-       { "i-o-control", IO_CONTROL }, // 617
-       { "is", IS }, // 618
-       { "isnt", ISNT }, // 619
-       { "kanji", KANJI }, // 620
-       { "key", KEY }, // 621
-       { "label", LABEL }, // 622
-       { "last", LAST }, // 623
-       { "leading", LEADING }, // 624
-       { "left", LEFT }, // 625
-       { "length", LENGTH }, // 626
-       { "length-of", LENGTH_OF }, // 627
-       { "limit", LIMIT }, // 628
-       { "limits", LIMITS }, // 629
-       { "line", LINE }, // 630
-       { "lines", LINES }, // 631
-       { "line-counter", LINE_COUNTER }, // 632
-       { "linage", LINAGE }, // 633
-       { "linkage", LINKAGE }, // 634
-       { "locale", LOCALE }, // 635
-       { "locale-compare", LOCALE_COMPARE }, // 636
-       { "locale-date", LOCALE_DATE }, // 637
-       { "locale-time", LOCALE_TIME }, // 638
-       { "locale-time-from-seconds", LOCALE_TIME_FROM_SECONDS }, // 639
-       { "local-storage", LOCAL_STORAGE }, // 640
-       { "location", LOCATION }, // 641
-       { "lock", LOCK }, // 642
-       { "lock-on", LOCK_ON }, // 643
-       { "log", LOG }, // 644
-       { "log10", LOG10 }, // 645
-       { "lower-case", LOWER_CASE }, // 646
-       { "low-values", LOW_VALUES }, // 647
-       { "lowest-algebraic", LOWEST_ALGEBRAIC }, // 648
-       { "lparen", LPAREN }, // 649
-       { "manual", MANUAL }, // 650
-       { "maxx", MAXX }, // 651
-       { "mean", MEAN }, // 652
-       { "median", MEDIAN }, // 653
-       { "midrange", MIDRANGE }, // 654
-       { "minn", MINN }, // 655
-       { "multiple", MULTIPLE }, // 656
-       { "mod", MOD }, // 657
-       { "mode", MODE }, // 658
-       { "module-name", MODULE_NAME }, // 659
-       { "named", NAMED }, // 660
-       { "nat", NAT }, // 661
-       { "national", NATIONAL }, // 662
-       { "national-edited", NATIONAL_EDITED }, // 663
-       { "national-of", NATIONAL_OF }, // 664
-       { "native", NATIVE }, // 665
-       { "nested", NESTED }, // 666
-       { "next", NEXT }, // 667
-       { "no", NO }, // 668
-       { "note", NOTE }, // 669
-       { "nulls", NULLS }, // 670
-       { "null", NULLS }, // 670
-       { "nullptr", NULLPTR }, // 671
-       { "numeric", NUMERIC }, // 672
-       { "numeric-edited", NUMERIC_EDITED }, // 673
-       { "numval", NUMVAL }, // 674
-       { "numval-c", NUMVAL_C }, // 675
-       { "numval-f", NUMVAL_F }, // 676
-       { "occurs", OCCURS }, // 677
-       { "of", OF }, // 678
-       { "off", OFF }, // 679
-       { "omitted", OMITTED }, // 680
-       { "on", ON }, // 681
-       { "only", ONLY }, // 682
-       { "optional", OPTIONAL }, // 683
-       { "options", OPTIONS }, // 684
-       { "ord", ORD }, // 685
-       { "order", ORDER }, // 686
-       { "ord-max", ORD_MAX }, // 687
-       { "ord-min", ORD_MIN }, // 688
-       { "organization", ORGANIZATION }, // 689
-       { "other", OTHER }, // 690
-       { "otherwise", OTHERWISE }, // 691
-       { "output", OUTPUT }, // 692
-       { "packed-decimal", PACKED_DECIMAL }, // 693
-       { "padding", PADDING }, // 694
-       { "page", PAGE }, // 695
-       { "page-counter", PAGE_COUNTER }, // 696
-       { "pf", PF }, // 697
-       { "ph", PH }, // 698
-       { "pi", PI }, // 699
-       { "pic", PIC }, // 700
-       { "picture", PICTURE }, // 701
-       { "plus", PLUS }, // 702
-       { "present-value", PRESENT_VALUE }, // 703
-       { "print-switch", PRINT_SWITCH }, // 704
-       { "procedure", PROCEDURE }, // 705
-       { "procedures", PROCEDURES }, // 706
-       { "proceed", PROCEED }, // 707
-       { "process", PROCESS }, // 708
-       { "program-id", PROGRAM_ID }, // 709
-       { "program", PROGRAM_kw }, // 710
-       { "property", PROPERTY }, // 711
-       { "prototype", PROTOTYPE }, // 712
-       { "pseudotext", PSEUDOTEXT }, // 713
-       { "quotes", QUOTES }, // 714
-       { "quote", QUOTES }, // 714
-       { "random", RANDOM }, // 715
-       { "random-seed", RANDOM_SEED }, // 716
-       { "range", RANGE }, // 717
-       { "raise", RAISE }, // 718
-       { "raising", RAISING }, // 719
-       { "rd", RD }, // 720
-       { "record", RECORD }, // 721
-       { "recording", RECORDING }, // 722
-       { "records", RECORDS }, // 723
-       { "recursive", RECURSIVE }, // 724
-       { "redefines", REDEFINES }, // 725
-       { "reel", REEL }, // 726
-       { "reference", REFERENCE }, // 727
-       { "relative", RELATIVE }, // 728
-       { "rem", REM }, // 729
-       { "remainder", REMAINDER }, // 730
-       { "remarks", REMARKS }, // 731
-       { "removal", REMOVAL }, // 732
-       { "renames", RENAMES }, // 733
-       { "replace", REPLACE }, // 734
-       { "replacing", REPLACING }, // 735
-       { "report", REPORT }, // 736
-       { "reporting", REPORTING }, // 737
-       { "reports", REPORTS }, // 738
-       { "repository", REPOSITORY }, // 739
-       { "rerun", RERUN }, // 740
-       { "reserve", RESERVE }, // 741
-       { "restricted", RESTRICTED }, // 742
-       { "resume", RESUME }, // 743
-       { "reverse", REVERSE }, // 744
-       { "reversed", REVERSED }, // 745
-       { "rewind", REWIND }, // 746
-       { "rf", RF }, // 747
-       { "rh", RH }, // 748
-       { "right", RIGHT }, // 749
-       { "rounded", ROUNDED }, // 750
-       { "run", RUN }, // 751
-       { "same", SAME }, // 752
-       { "screen", SCREEN }, // 753
-       { "sd", SD }, // 754
-       { "seconds-from-formatted-time", SECONDS_FROM_FORMATTED_TIME }, // 755
-       { "seconds-past-midnight", SECONDS_PAST_MIDNIGHT }, // 756
-       { "security", SECURITY }, // 757
-       { "separate", SEPARATE }, // 758
-       { "sequence", SEQUENCE }, // 759
-       { "sequential", SEQUENTIAL }, // 760
-       { "sharing", SHARING }, // 761
-       { "simple-exit", SIMPLE_EXIT }, // 762
-       { "sign", SIGN }, // 763
-       { "sin", SIN }, // 764
-       { "size", SIZE }, // 765
-       { "smallest-algebraic", SMALLEST_ALGEBRAIC }, // 766
-       { "source", SOURCE }, // 767
-       { "source-computer", SOURCE_COMPUTER }, // 768
-       { "special-names", SPECIAL_NAMES }, // 769
-       { "sqrt", SQRT }, // 770
-       { "stack", STACK }, // 771
-       { "standard", STANDARD }, // 772
-       { "standard-1", STANDARD_1 }, // 773
-       { "standard-deviation", STANDARD_DEVIATION }, // 774
-       { "standard-compare", STANDARD_COMPARE }, // 775
-       { "status", STATUS }, // 776
-       { "strong", STRONG }, // 777
-       { "substitute", SUBSTITUTE }, // 778
-       { "sum", SUM }, // 779
-       { "symbol", SYMBOL }, // 780
-       { "symbolic", SYMBOLIC }, // 781
-       { "synchronized", SYNCHRONIZED }, // 782
-       { "tally", TALLY }, // 783
-       { "tallying", TALLYING }, // 784
-       { "tan", TAN }, // 785
-       { "terminate", TERMINATE }, // 786
-       { "test", TEST }, // 787
-       { "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 788
-       { "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 789
-       { "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 790
-       { "test-numval", TEST_NUMVAL }, // 791
-       { "test-numval-c", TEST_NUMVAL_C }, // 792
-       { "test-numval-f", TEST_NUMVAL_F }, // 793
-       { "than", THAN }, // 794
-       { "time", TIME }, // 795
-       { "times", TIMES }, // 796
-       { "to", TO }, // 797
-       { "top", TOP }, // 798
-       { "top-level", TOP_LEVEL }, // 799
-       { "tracks", TRACKS }, // 800
-       { "track-area", TRACK_AREA }, // 801
-       { "trailing", TRAILING }, // 802
-       { "transform", TRANSFORM }, // 803
-       { "trim", TRIM }, // 804
-       { "true", TRUE_kw }, // 805
-       { "try", TRY }, // 806
-       { "turn", TURN }, // 807
-       { "type", TYPE }, // 808
-       { "typedef", TYPEDEF }, // 809
-       { "ulength", ULENGTH }, // 810
-       { "unbounded", UNBOUNDED }, // 811
-       { "unit", UNIT }, // 812
-       { "units", UNITS }, // 813
-       { "unit-record", UNIT_RECORD }, // 814
-       { "until", UNTIL }, // 815
-       { "up", UP }, // 816
-       { "upon", UPON }, // 817
-       { "upos", UPOS }, // 818
-       { "upper-case", UPPER_CASE }, // 819
-       { "usage", USAGE }, // 820
-       { "using", USING }, // 821
-       { "usubstr", USUBSTR }, // 822
-       { "usupplementary", USUPPLEMENTARY }, // 823
-       { "utility", UTILITY }, // 824
-       { "uuid4", UUID4 }, // 825
-       { "uvalid", UVALID }, // 826
-       { "uwidth", UWIDTH }, // 827
-       { "value", VALUE }, // 828
-       { "variance", VARIANCE }, // 829
-       { "varying", VARYING }, // 830
-       { "volatile", VOLATILE }, // 831
-       { "when-compiled", WHEN_COMPILED }, // 832
-       { "with", WITH }, // 833
-       { "working-storage", WORKING_STORAGE }, // 834
-       { "xml", XML }, // 835
-       { "xmlgenerate", XMLGENERATE }, // 836
-       { "xmlparse", XMLPARSE }, // 837
-       { "year-to-yyyy", YEAR_TO_YYYY }, // 838
-       { "yyyyddd", YYYYDDD }, // 839
-       { "yyyymmdd", YYYYMMDD }, // 840
-       { "arithmetic", ARITHMETIC }, // 841
-       { "attribute", ATTRIBUTE }, // 842
-       { "auto", AUTO }, // 843
-       { "automatic", AUTOMATIC }, // 844
-       { "away-from-zero", AWAY_FROM_ZERO }, // 845
-       { "background-color", BACKGROUND_COLOR }, // 846
-       { "bell", BELL }, // 847
-       { "binary-encoding", BINARY_ENCODING }, // 848
-       { "blink", BLINK }, // 849
-       { "capacity", CAPACITY }, // 850
-       { "center", CENTER }, // 851
-       { "classification", CLASSIFICATION }, // 852
-       { "cycle", CYCLE }, // 853
-       { "decimal-encoding", DECIMAL_ENCODING }, // 854
-       { "entry-convention", ENTRY_CONVENTION }, // 855
-       { "eol", EOL }, // 856
-       { "eos", EOS }, // 857
-       { "erase", ERASE }, // 858
-       { "expands", EXPANDS }, // 859
-       { "float-binary", FLOAT_BINARY }, // 860
-       { "float-decimal", FLOAT_DECIMAL }, // 861
-       { "foreground-color", FOREGROUND_COLOR }, // 862
-       { "forever", FOREVER }, // 863
-       { "full", FULL }, // 864
-       { "highlight", HIGHLIGHT }, // 865
-       { "high-order-left", HIGH_ORDER_LEFT }, // 866
-       { "high-order-right", HIGH_ORDER_RIGHT }, // 867
-       { "ignoring", IGNORING }, // 868
-       { "implements", IMPLEMENTS }, // 869
-       { "initialized", INITIALIZED }, // 870
-       { "intermediate", INTERMEDIATE }, // 871
-       { "lc-all", LC_ALL_kw }, // 872
-       { "lc-collate", LC_COLLATE_kw }, // 873
-       { "lc-ctype", LC_CTYPE_kw }, // 874
-       { "lc-messages", LC_MESSAGES_kw }, // 875
-       { "lc-monetary", LC_MONETARY_kw }, // 876
-       { "lc-numeric", LC_NUMERIC_kw }, // 877
-       { "lc-time", LC_TIME_kw }, // 878
-       { "lowlight", LOWLIGHT }, // 879
-       { "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 880
-       { "nearest-even", NEAREST_EVEN }, // 881
-       { "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 882
-       { "none", NONE }, // 883
-       { "normal", NORMAL }, // 884
-       { "numbers", NUMBERS }, // 885
-       { "prefixed", PREFIXED }, // 886
-       { "previous", PREVIOUS }, // 887
-       { "prohibited", PROHIBITED }, // 888
-       { "relation", RELATION }, // 889
-       { "required", REQUIRED }, // 890
-       { "reverse-video", REVERSE_VIDEO }, // 891
-       { "rounding", ROUNDING }, // 892
-       { "seconds", SECONDS }, // 893
-       { "secure", SECURE }, // 894
-       { "short", SHORT }, // 895
-       { "signed", SIGNED_kw }, // 896
-       { "standard-binary", STANDARD_BINARY }, // 897
-       { "standard-decimal", STANDARD_DECIMAL }, // 898
-       { "statement", STATEMENT }, // 899
-       { "step", STEP }, // 900
-       { "structure", STRUCTURE }, // 901
-       { "toward-greater", TOWARD_GREATER }, // 902
-       { "toward-lesser", TOWARD_LESSER }, // 903
-       { "truncation", TRUNCATION }, // 904
-       { "ucs-4", UCS_4 }, // 905
-       { "underline", UNDERLINE }, // 906
-       { "unsigned", UNSIGNED_kw }, // 907
-       { "utf-16", UTF_16 }, // 908
-       { "utf-8", UTF_8 }, // 909
-       { "address", ADDRESS }, // 910
-       { "end-accept", END_ACCEPT }, // 911
-       { "end-add", END_ADD }, // 912
-       { "end-call", END_CALL }, // 913
-       { "end-compute", END_COMPUTE }, // 914
-       { "end-delete", END_DELETE }, // 915
-       { "end-display", END_DISPLAY }, // 916
-       { "end-divide", END_DIVIDE }, // 917
-       { "end-evaluate", END_EVALUATE }, // 918
-       { "end-multiply", END_MULTIPLY }, // 919
-       { "end-perform", END_PERFORM }, // 920
-       { "end-read", END_READ }, // 921
-       { "end-return", END_RETURN }, // 922
-       { "end-rewrite", END_REWRITE }, // 923
-       { "end-search", END_SEARCH }, // 924
-       { "end-start", END_START }, // 925
-       { "end-string", END_STRING }, // 926
-       { "end-subtract", END_SUBTRACT }, // 927
-       { "end-unstring", END_UNSTRING }, // 928
-       { "end-write", END_WRITE }, // 929
-       { "end-if", END_IF }, // 930
-       { "thru", THRU }, // 931
-       { "through", THRU }, // 931
-       { "or", OR }, // 932
-       { "and", AND }, // 933
-       { "not", NOT }, // 934
-       { "ne", NE }, // 935
-       { "le", LE }, // 936
-       { "ge", GE }, // 937
-       { "pow", POW }, // 938
-       { "neg", NEG }, // 939
+       { "argument-number", ARGUMENT_NUMBER }, // 436
+       { "argument-value", ARGUMENT_VALUE }, // 437
+       { "environment-name", ENVIRONMENT_NAME }, // 438
+       { "environment-value", ENVIRONMENT_VALUE }, // 439
+       { "abs", ABS }, // 440
+       { "access", ACCESS }, // 441
+       { "acos", ACOS }, // 442
+       { "actual", ACTUAL }, // 443
+       { "advancing", ADVANCING }, // 444
+       { "after", AFTER }, // 445
+       { "all", ALL }, // 446
+       { "allocate", ALLOCATE }, // 447
+       { "alphabet", ALPHABET }, // 448
+       { "alphabetic", ALPHABETIC }, // 449
+       { "alphabetic-lower", ALPHABETIC_LOWER }, // 450
+       { "alphabetic-upper", ALPHABETIC_UPPER }, // 451
+       { "alphanumeric", ALPHANUMERIC }, // 452
+       { "alphanumeric-edited", ALPHANUMERIC_EDITED }, // 453
+       { "also", ALSO }, // 454
+       { "alternate", ALTERNATE }, // 455
+       { "annuity", ANNUITY }, // 456
+       { "anum", ANUM }, // 457
+       { "any", ANY }, // 458
+       { "anycase", ANYCASE }, // 459
+       { "apply", APPLY }, // 460
+       { "are", ARE }, // 461
+       { "area", AREA }, // 462
+       { "areas", AREAS }, // 463
+       { "as", AS }, // 464
+       { "ascending", ASCENDING }, // 465
+       { "activating", ACTIVATING }, // 466
+       { "asin", ASIN }, // 467
+       { "assign", ASSIGN }, // 468
+       { "at", AT }, // 469
+       { "atan", ATAN }, // 470
+       { "based", BASED }, // 471
+       { "baseconvert", BASECONVERT }, // 472
+       { "before", BEFORE }, // 473
+       { "binary", BINARY }, // 474
+       { "bit", BIT }, // 475
+       { "bit-of", BIT_OF }, // 476
+       { "bit-to-char", BIT_TO_CHAR }, // 477
+       { "blank", BLANK }, // 478
+       { "block", BLOCK_kw }, // 479
+       { "boolean-of-integer", BOOLEAN_OF_INTEGER }, // 480
+       { "bottom", BOTTOM }, // 481
+       { "by", BY }, // 482
+       { "byte", BYTE }, // 483
+       { "byte-length", BYTE_LENGTH }, // 484
+       { "cf", CF }, // 485
+       { "ch", CH }, // 486
+       { "changed", CHANGED }, // 487
+       { "char", CHAR }, // 488
+       { "char-national", CHAR_NATIONAL }, // 489
+       { "character", CHARACTER }, // 490
+       { "characters", CHARACTERS }, // 491
+       { "checking", CHECKING }, // 492
+       { "class", CLASS }, // 493
+       { "cobol", COBOL }, // 494
+       { "code", CODE }, // 495
+       { "code-set", CODESET }, // 496
+       { "collating", COLLATING }, // 497
+       { "column", COLUMN }, // 498
+       { "combined-datetime", COMBINED_DATETIME }, // 499
+       { "comma", COMMA }, // 500
+       { "command-line", COMMAND_LINE }, // 501
+       { "command-line-count", COMMAND_LINE_COUNT }, // 502
+       { "commit", COMMIT }, // 503
+       { "common", COMMON }, // 504
+       { "concat", CONCAT }, // 505
+       { "condition", CONDITION }, // 506
+       { "configuration", CONFIGURATION_SECT }, // 507
+       { "contains", CONTAINS }, // 508
+       { "content", CONTENT }, // 509
+       { "control", CONTROL }, // 510
+       { "controls", CONTROLS }, // 511
+       { "convert", CONVERT }, // 512
+       { "converting", CONVERTING }, // 513
+       { "corresponding", CORRESPONDING }, // 514
+       { "cos", COS }, // 515
+       { "count", COUNT }, // 516
+       { "currency", CURRENCY }, // 517
+       { "current", CURRENT }, // 518
+       { "current-date", CURRENT_DATE }, // 519
+       { "data", DATA }, // 520
+       { "date", DATE }, // 521
+       { "date-compiled", DATE_COMPILED }, // 522
+       { "date-of-integer", DATE_OF_INTEGER }, // 523
+       { "date-to-yyyymmdd", DATE_TO_YYYYMMDD }, // 524
+       { "date-written", DATE_WRITTEN }, // 525
+       { "day", DAY }, // 526
+       { "day-of-integer", DAY_OF_INTEGER }, // 527
+       { "day-of-week", DAY_OF_WEEK }, // 528
+       { "day-to-yyyyddd", DAY_TO_YYYYDDD }, // 529
+       { "dbcs", DBCS }, // 530
+       { "de", DE }, // 531
+       { "debugging", DEBUGGING }, // 532
+       { "decimal-point", DECIMAL_POINT }, // 533
+       { "declaratives", DECLARATIVES }, // 534
+       { "default", DEFAULT }, // 535
+       { "delimited", DELIMITED }, // 536
+       { "delimiter", DELIMITER }, // 537
+       { "depending", DEPENDING }, // 538
+       { "descending", DESCENDING }, // 539
+       { "detail", DETAIL }, // 540
+       { "direct", DIRECT }, // 541
+       { "direct-access", DIRECT_ACCESS }, // 542
+       { "down", DOWN }, // 543
+       { "duplicates", DUPLICATES }, // 544
+       { "dynamic", DYNAMIC }, // 545
+       { "e", E }, // 546
+       { "ebcdic", EBCDIC }, // 547
+       { "ec", EC }, // 548
+       { "egcs", EGCS }, // 549
+       { "entry", ENTRY }, // 550
+       { "environment", ENVIRONMENT }, // 551
+       { "equal", EQUAL }, // 552
+       { "every", EVERY }, // 553
+       { "examine", EXAMINE }, // 554
+       { "exhibit", EXHIBIT }, // 555
+       { "exp", EXP }, // 556
+       { "exp10", EXP10 }, // 557
+       { "extend", EXTEND }, // 558
+       { "external", EXTERNAL }, // 559
+       { "exception-file", EXCEPTION_FILE }, // 560
+       { "exception-file-n", EXCEPTION_FILE_N }, // 561
+       { "exception-location", EXCEPTION_LOCATION }, // 562
+       { "exception-location-n", EXCEPTION_LOCATION_N }, // 563
+       { "exception-statement", EXCEPTION_STATEMENT }, // 564
+       { "exception-status", EXCEPTION_STATUS }, // 565
+       { "factorial", FACTORIAL }, // 566
+       { "false", FALSE_kw }, // 567
+       { "fd", FD }, // 568
+       { "file-control", FILE_CONTROL }, // 569
+       { "file", FILE_KW }, // 570
+       { "file-limit", FILE_LIMIT }, // 571
+       { "final", FINAL }, // 572
+       { "finally", FINALLY }, // 573
+       { "find-string", FIND_STRING }, // 574
+       { "first", FIRST }, // 575
+       { "fixed", FIXED }, // 576
+       { "footing", FOOTING }, // 577
+       { "for", FOR }, // 578
+       { "formatted-current-date", FORMATTED_CURRENT_DATE }, // 579
+       { "formatted-date", FORMATTED_DATE }, // 580
+       { "formatted-datetime", FORMATTED_DATETIME }, // 581
+       { "formatted-time", FORMATTED_TIME }, // 582
+       { "form-overflow", FORM_OVERFLOW }, // 583
+       { "free", FREE }, // 584
+       { "fraction-part", FRACTION_PART }, // 585
+       { "from", FROM }, // 586
+       { "function", FUNCTION }, // 587
+       { "generate", GENERATE }, // 588
+       { "giving", GIVING }, // 589
+       { "global", GLOBAL }, // 590
+       { "go", GO }, // 591
+       { "group", GROUP }, // 592
+       { "heading", HEADING }, // 593
+       { "hex", HEX }, // 594
+       { "hex-of", HEX_OF }, // 595
+       { "hex-to-char", HEX_TO_CHAR }, // 596
+       { "high-values", HIGH_VALUES }, // 597
+       { "highest-algebraic", HIGHEST_ALGEBRAIC }, // 598
+       { "hold", HOLD }, // 599
+       { "ibm-360", IBM_360 }, // 600
+       { "in", IN }, // 601
+       { "include", INCLUDE }, // 602
+       { "index", INDEX }, // 603
+       { "indexed", INDEXED }, // 604
+       { "indicate", INDICATE }, // 605
+       { "initial", INITIAL_kw }, // 606
+       { "initiate", INITIATE }, // 607
+       { "input", INPUT }, // 608
+       { "installation", INSTALLATION }, // 609
+       { "interface", INTERFACE }, // 610
+       { "integer", INTEGER }, // 611
+       { "integer-of-boolean", INTEGER_OF_BOOLEAN }, // 612
+       { "integer-of-date", INTEGER_OF_DATE }, // 613
+       { "integer-of-day", INTEGER_OF_DAY }, // 614
+       { "integer-of-formatted-date", INTEGER_OF_FORMATTED_DATE }, // 615
+       { "integer-part", INTEGER_PART }, // 616
+       { "into", INTO }, // 617
+       { "intrinsic", INTRINSIC }, // 618
+       { "invoke", INVOKE }, // 619
+       { "i-o", IO }, // 620
+       { "i-o-control", IO_CONTROL }, // 621
+       { "is", IS }, // 622
+       { "isnt", ISNT }, // 623
+       { "kanji", KANJI }, // 624
+       { "key", KEY }, // 625
+       { "label", LABEL }, // 626
+       { "last", LAST }, // 627
+       { "leading", LEADING }, // 628
+       { "left", LEFT }, // 629
+       { "length", LENGTH }, // 630
+       { "length-of", LENGTH_OF }, // 631
+       { "limit", LIMIT }, // 632
+       { "limits", LIMITS }, // 633
+       { "line", LINE }, // 634
+       { "lines", LINES }, // 635
+       { "line-counter", LINE_COUNTER }, // 636
+       { "linage", LINAGE }, // 637
+       { "linkage", LINKAGE }, // 638
+       { "locale", LOCALE }, // 639
+       { "locale-compare", LOCALE_COMPARE }, // 640
+       { "locale-date", LOCALE_DATE }, // 641
+       { "locale-time", LOCALE_TIME }, // 642
+       { "locale-time-from-seconds", LOCALE_TIME_FROM_SECONDS }, // 643
+       { "local-storage", LOCAL_STORAGE }, // 644
+       { "location", LOCATION }, // 645
+       { "lock", LOCK }, // 646
+       { "lock-on", LOCK_ON }, // 647
+       { "log", LOG }, // 648
+       { "log10", LOG10 }, // 649
+       { "lower-case", LOWER_CASE }, // 650
+       { "low-values", LOW_VALUES }, // 651
+       { "lowest-algebraic", LOWEST_ALGEBRAIC }, // 652
+       { "lparen", LPAREN }, // 653
+       { "manual", MANUAL }, // 654
+       { "maxx", MAXX }, // 655
+       { "mean", MEAN }, // 656
+       { "median", MEDIAN }, // 657
+       { "midrange", MIDRANGE }, // 658
+       { "minn", MINN }, // 659
+       { "multiple", MULTIPLE }, // 660
+       { "mod", MOD }, // 661
+       { "mode", MODE }, // 662
+       { "module-name", MODULE_NAME }, // 663
+       { "named", NAMED }, // 664
+       { "nat", NAT }, // 665
+       { "national", NATIONAL }, // 666
+       { "national-edited", NATIONAL_EDITED }, // 667
+       { "national-of", NATIONAL_OF }, // 668
+       { "native", NATIVE }, // 669
+       { "nested", NESTED }, // 670
+       { "next", NEXT }, // 671
+       { "no", NO }, // 672
+       { "note", NOTE }, // 673
+       { "nulls", NULLS }, // 674
+       { "null", NULLS }, // 674
+       { "nullptr", NULLPTR }, // 675
+       { "numeric", NUMERIC }, // 676
+       { "numeric-edited", NUMERIC_EDITED }, // 677
+       { "numval", NUMVAL }, // 678
+       { "numval-c", NUMVAL_C }, // 679
+       { "numval-f", NUMVAL_F }, // 680
+       { "occurs", OCCURS }, // 681
+       { "of", OF }, // 682
+       { "off", OFF }, // 683
+       { "omitted", OMITTED }, // 684
+       { "on", ON }, // 685
+       { "only", ONLY }, // 686
+       { "optional", OPTIONAL }, // 687
+       { "options", OPTIONS }, // 688
+       { "ord", ORD }, // 689
+       { "order", ORDER }, // 690
+       { "ord-max", ORD_MAX }, // 691
+       { "ord-min", ORD_MIN }, // 692
+       { "organization", ORGANIZATION }, // 693
+       { "other", OTHER }, // 694
+       { "otherwise", OTHERWISE }, // 695
+       { "output", OUTPUT }, // 696
+       { "packed-decimal", PACKED_DECIMAL }, // 697
+       { "padding", PADDING }, // 698
+       { "page", PAGE }, // 699
+       { "page-counter", PAGE_COUNTER }, // 700
+       { "pf", PF }, // 701
+       { "ph", PH }, // 702
+       { "pi", PI }, // 703
+       { "pic", PIC }, // 704
+       { "picture", PICTURE }, // 705
+       { "plus", PLUS }, // 706
+       { "present-value", PRESENT_VALUE }, // 707
+       { "print-switch", PRINT_SWITCH }, // 708
+       { "procedure", PROCEDURE }, // 709
+       { "procedures", PROCEDURES }, // 710
+       { "proceed", PROCEED }, // 711
+       { "process", PROCESS }, // 712
+       { "program-id", PROGRAM_ID }, // 713
+       { "program", PROGRAM_kw }, // 714
+       { "property", PROPERTY }, // 715
+       { "prototype", PROTOTYPE }, // 716
+       { "pseudotext", PSEUDOTEXT }, // 717
+       { "quotes", QUOTES }, // 718
+       { "quote", QUOTES }, // 718
+       { "random", RANDOM }, // 719
+       { "random-seed", RANDOM_SEED }, // 720
+       { "range", RANGE }, // 721
+       { "raise", RAISE }, // 722
+       { "raising", RAISING }, // 723
+       { "rd", RD }, // 724
+       { "record", RECORD }, // 725
+       { "recording", RECORDING }, // 726
+       { "records", RECORDS }, // 727
+       { "recursive", RECURSIVE }, // 728
+       { "redefines", REDEFINES }, // 729
+       { "reel", REEL }, // 730
+       { "reference", REFERENCE }, // 731
+       { "relative", RELATIVE }, // 732
+       { "rem", REM }, // 733
+       { "remainder", REMAINDER }, // 734
+       { "remarks", REMARKS }, // 735
+       { "removal", REMOVAL }, // 736
+       { "renames", RENAMES }, // 737
+       { "replace", REPLACE }, // 738
+       { "replacing", REPLACING }, // 739
+       { "report", REPORT }, // 740
+       { "reporting", REPORTING }, // 741
+       { "reports", REPORTS }, // 742
+       { "repository", REPOSITORY }, // 743
+       { "rerun", RERUN }, // 744
+       { "reserve", RESERVE }, // 745
+       { "restricted", RESTRICTED }, // 746
+       { "resume", RESUME }, // 747
+       { "reverse", REVERSE }, // 748
+       { "reversed", REVERSED }, // 749
+       { "rewind", REWIND }, // 750
+       { "rf", RF }, // 751
+       { "rh", RH }, // 752
+       { "right", RIGHT }, // 753
+       { "rounded", ROUNDED }, // 754
+       { "run", RUN }, // 755
+       { "same", SAME }, // 756
+       { "screen", SCREEN }, // 757
+       { "sd", SD }, // 758
+       { "seconds-from-formatted-time", SECONDS_FROM_FORMATTED_TIME }, // 759
+       { "seconds-past-midnight", SECONDS_PAST_MIDNIGHT }, // 760
+       { "security", SECURITY }, // 761
+       { "separate", SEPARATE }, // 762
+       { "sequence", SEQUENCE }, // 763
+       { "sequential", SEQUENTIAL }, // 764
+       { "sharing", SHARING }, // 765
+       { "simple-exit", SIMPLE_EXIT }, // 766
+       { "sign", SIGN }, // 767
+       { "sin", SIN }, // 768
+       { "size", SIZE }, // 769
+       { "smallest-algebraic", SMALLEST_ALGEBRAIC }, // 770
+       { "source", SOURCE }, // 771
+       { "source-computer", SOURCE_COMPUTER }, // 772
+       { "special-names", SPECIAL_NAMES }, // 773
+       { "sqrt", SQRT }, // 774
+       { "stack", STACK }, // 775
+       { "standard", STANDARD }, // 776
+       { "standard-1", STANDARD_1 }, // 777
+       { "standard-deviation", STANDARD_DEVIATION }, // 778
+       { "standard-compare", STANDARD_COMPARE }, // 779
+       { "status", STATUS }, // 780
+       { "strong", STRONG }, // 781
+       { "substitute", SUBSTITUTE }, // 782
+       { "sum", SUM }, // 783
+       { "symbol", SYMBOL }, // 784
+       { "symbolic", SYMBOLIC }, // 785
+       { "synchronized", SYNCHRONIZED }, // 786
+       { "tally", TALLY }, // 787
+       { "tallying", TALLYING }, // 788
+       { "tan", TAN }, // 789
+       { "terminate", TERMINATE }, // 790
+       { "test", TEST }, // 791
+       { "test-date-yyyymmdd", TEST_DATE_YYYYMMDD }, // 792
+       { "test-day-yyyyddd", TEST_DAY_YYYYDDD }, // 793
+       { "test-formatted-datetime", TEST_FORMATTED_DATETIME }, // 794
+       { "test-numval", TEST_NUMVAL }, // 795
+       { "test-numval-c", TEST_NUMVAL_C }, // 796
+       { "test-numval-f", TEST_NUMVAL_F }, // 797
+       { "than", THAN }, // 798
+       { "time", TIME }, // 799
+       { "times", TIMES }, // 800
+       { "to", TO }, // 801
+       { "top", TOP }, // 802
+       { "top-level", TOP_LEVEL }, // 803
+       { "tracks", TRACKS }, // 804
+       { "track-area", TRACK_AREA }, // 805
+       { "trailing", TRAILING }, // 806
+       { "transform", TRANSFORM }, // 807
+       { "trim", TRIM }, // 808
+       { "true", TRUE_kw }, // 809
+       { "try", TRY }, // 810
+       { "turn", TURN }, // 811
+       { "type", TYPE }, // 812
+       { "typedef", TYPEDEF }, // 813
+       { "ulength", ULENGTH }, // 814
+       { "unbounded", UNBOUNDED }, // 815
+       { "unit", UNIT }, // 816
+       { "units", UNITS }, // 817
+       { "unit-record", UNIT_RECORD }, // 818
+       { "until", UNTIL }, // 819
+       { "up", UP }, // 820
+       { "upon", UPON }, // 821
+       { "upos", UPOS }, // 822
+       { "upper-case", UPPER_CASE }, // 823
+       { "usage", USAGE }, // 824
+       { "using", USING }, // 825
+       { "usubstr", USUBSTR }, // 826
+       { "usupplementary", USUPPLEMENTARY }, // 827
+       { "utility", UTILITY }, // 828
+       { "uuid4", UUID4 }, // 829
+       { "uvalid", UVALID }, // 830
+       { "uwidth", UWIDTH }, // 831
+       { "value", VALUE }, // 832
+       { "variance", VARIANCE }, // 833
+       { "varying", VARYING }, // 834
+       { "volatile", VOLATILE }, // 835
+       { "when-compiled", WHEN_COMPILED }, // 836
+       { "with", WITH }, // 837
+       { "working-storage", WORKING_STORAGE }, // 838
+       { "xml", XML }, // 839
+       { "xmlgenerate", XMLGENERATE }, // 840
+       { "xmlparse", XMLPARSE }, // 841
+       { "year-to-yyyy", YEAR_TO_YYYY }, // 842
+       { "yyyyddd", YYYYDDD }, // 843
+       { "yyyymmdd", YYYYMMDD }, // 844
+       { "arithmetic", ARITHMETIC }, // 845
+       { "attribute", ATTRIBUTE }, // 846
+       { "auto", AUTO }, // 847
+       { "automatic", AUTOMATIC }, // 848
+       { "away-from-zero", AWAY_FROM_ZERO }, // 849
+       { "background-color", BACKGROUND_COLOR }, // 850
+       { "bell", BELL }, // 851
+       { "binary-encoding", BINARY_ENCODING }, // 852
+       { "blink", BLINK }, // 853
+       { "capacity", CAPACITY }, // 854
+       { "center", CENTER }, // 855
+       { "classification", CLASSIFICATION }, // 856
+       { "cycle", CYCLE }, // 857
+       { "decimal-encoding", DECIMAL_ENCODING }, // 858
+       { "entry-convention", ENTRY_CONVENTION }, // 859
+       { "eol", EOL }, // 860
+       { "eos", EOS }, // 861
+       { "erase", ERASE }, // 862
+       { "expands", EXPANDS }, // 863
+       { "float-binary", FLOAT_BINARY }, // 864
+       { "float-decimal", FLOAT_DECIMAL }, // 865
+       { "foreground-color", FOREGROUND_COLOR }, // 866
+       { "forever", FOREVER }, // 867
+       { "full", FULL }, // 868
+       { "highlight", HIGHLIGHT }, // 869
+       { "high-order-left", HIGH_ORDER_LEFT }, // 870
+       { "high-order-right", HIGH_ORDER_RIGHT }, // 871
+       { "ignoring", IGNORING }, // 872
+       { "implements", IMPLEMENTS }, // 873
+       { "initialized", INITIALIZED }, // 874
+       { "intermediate", INTERMEDIATE }, // 875
+       { "lc-all", LC_ALL_kw }, // 876
+       { "lc-collate", LC_COLLATE_kw }, // 877
+       { "lc-ctype", LC_CTYPE_kw }, // 878
+       { "lc-messages", LC_MESSAGES_kw }, // 879
+       { "lc-monetary", LC_MONETARY_kw }, // 880
+       { "lc-numeric", LC_NUMERIC_kw }, // 881
+       { "lc-time", LC_TIME_kw }, // 882
+       { "lowlight", LOWLIGHT }, // 883
+       { "nearest-away-from-zero", NEAREST_AWAY_FROM_ZERO }, // 884
+       { "nearest-even", NEAREST_EVEN }, // 885
+       { "nearest-toward-zero", NEAREST_TOWARD_ZERO }, // 886
+       { "none", NONE }, // 887
+       { "normal", NORMAL }, // 888
+       { "numbers", NUMBERS }, // 889
+       { "prefixed", PREFIXED }, // 890
+       { "previous", PREVIOUS }, // 891
+       { "prohibited", PROHIBITED }, // 892
+       { "relation", RELATION }, // 893
+       { "required", REQUIRED }, // 894
+       { "reverse-video", REVERSE_VIDEO }, // 895
+       { "rounding", ROUNDING }, // 896
+       { "seconds", SECONDS }, // 897
+       { "secure", SECURE }, // 898
+       { "short", SHORT }, // 899
+       { "signed", SIGNED_kw }, // 900
+       { "standard-binary", STANDARD_BINARY }, // 901
+       { "standard-decimal", STANDARD_DECIMAL }, // 902
+       { "statement", STATEMENT }, // 903
+       { "step", STEP }, // 904
+       { "structure", STRUCTURE }, // 905
+       { "toward-greater", TOWARD_GREATER }, // 906
+       { "toward-lesser", TOWARD_LESSER }, // 907
+       { "truncation", TRUNCATION }, // 908
+       { "ucs-4", UCS_4 }, // 909
+       { "underline", UNDERLINE }, // 910
+       { "unsigned", UNSIGNED_kw }, // 911
+       { "utf-16", UTF_16 }, // 912
+       { "utf-8", UTF_8 }, // 913
+       { "address", ADDRESS }, // 914
+       { "end-accept", END_ACCEPT }, // 915
+       { "end-add", END_ADD }, // 916
+       { "end-call", END_CALL }, // 917
+       { "end-compute", END_COMPUTE }, // 918
+       { "end-delete", END_DELETE }, // 919
+       { "end-display", END_DISPLAY }, // 920
+       { "end-divide", END_DIVIDE }, // 921
+       { "end-evaluate", END_EVALUATE }, // 922
+       { "end-multiply", END_MULTIPLY }, // 923
+       { "end-perform", END_PERFORM }, // 924
+       { "end-read", END_READ }, // 925
+       { "end-return", END_RETURN }, // 926
+       { "end-rewrite", END_REWRITE }, // 927
+       { "end-search", END_SEARCH }, // 928
+       { "end-start", END_START }, // 929
+       { "end-string", END_STRING }, // 930
+       { "end-subtract", END_SUBTRACT }, // 931
+       { "end-unstring", END_UNSTRING }, // 932
+       { "end-write", END_WRITE }, // 933
+       { "end-if", END_IF }, // 934
+       { "thru", THRU }, // 935
+       { "through", THRU }, // 935
+       { "or", OR }, // 936
+       { "and", AND }, // 937
+       { "not", NOT }, // 938
+       { "ne", NE }, // 939
+       { "le", LE }, // 940
+       { "ge", GE }, // 941
+       { "pow", POW }, // 942
+       { "neg", NEG }, // 943
 };
 
 // cppcheck-suppress useInitializationList
@@ -871,508 +875,512 @@ token_names = {
        "UNSTRING", // 175 (433)
        "WRITE", // 176 (434)
        "WHEN", // 177 (435)
-       "ABS", // 178 (436)
-       "ACCESS", // 179 (437)
-       "ACOS", // 180 (438)
-       "ACTUAL", // 181 (439)
-       "ADVANCING", // 182 (440)
-       "AFTER", // 183 (441)
-       "ALL", // 184 (442)
-       "ALLOCATE", // 185 (443)
-       "ALPHABET", // 186 (444)
-       "ALPHABETIC", // 187 (445)
-       "ALPHABETIC-LOWER", // 188 (446)
-       "ALPHABETIC-UPPER", // 189 (447)
-       "ALPHANUMERIC", // 190 (448)
-       "ALPHANUMERIC-EDITED", // 191 (449)
-       "ALSO", // 192 (450)
-       "ALTERNATE", // 193 (451)
-       "ANNUITY", // 194 (452)
-       "ANUM", // 195 (453)
-       "ANY", // 196 (454)
-       "ANYCASE", // 197 (455)
-       "APPLY", // 198 (456)
-       "ARE", // 199 (457)
-       "AREA", // 200 (458)
-       "AREAS", // 201 (459)
-       "AS", // 202 (460)
-       "ASCENDING", // 203 (461)
-       "ACTIVATING", // 204 (462)
-       "ASIN", // 205 (463)
-       "ASSIGN", // 206 (464)
-       "AT", // 207 (465)
-       "ATAN", // 208 (466)
-       "BASED", // 209 (467)
-       "BASECONVERT", // 210 (468)
-       "BEFORE", // 211 (469)
-       "BINARY", // 212 (470)
-       "BIT", // 213 (471)
-       "BIT-OF", // 214 (472)
-       "BIT-TO-CHAR", // 215 (473)
-       "BLANK", // 216 (474)
-       "BLOCK", // 217 (475)
-       "BOOLEAN-OF-INTEGER", // 218 (476)
-       "BOTTOM", // 219 (477)
-       "BY", // 220 (478)
-       "BYTE", // 221 (479)
-       "BYTE-LENGTH", // 222 (480)
-       "CF", // 223 (481)
-       "CH", // 224 (482)
-       "CHANGED", // 225 (483)
-       "CHAR", // 226 (484)
-       "CHAR-NATIONAL", // 227 (485)
-       "CHARACTER", // 228 (486)
-       "CHARACTERS", // 229 (487)
-       "CHECKING", // 230 (488)
-       "CLASS", // 231 (489)
-       "COBOL", // 232 (490)
-       "CODE", // 233 (491)
-       "CODE-SET", // 234 (492)
-       "COLLATING", // 235 (493)
-       "COLUMN", // 236 (494)
-       "COMBINED-DATETIME", // 237 (495)
-       "COMMA", // 238 (496)
-       "COMMAND-LINE", // 239 (497)
-       "COMMAND-LINE-COUNT", // 240 (498)
-       "COMMIT", // 241 (499)
-       "COMMON", // 242 (500)
-       "CONCAT", // 243 (501)
-       "CONDITION", // 244 (502)
-       "CONFIGURATION", // 245 (503)
-       "CONTAINS", // 246 (504)
-       "CONTENT", // 247 (505)
-       "CONTROL", // 248 (506)
-       "CONTROLS", // 249 (507)
-       "CONVERT", // 250 (508)
-       "CONVERTING", // 251 (509)
-       "CORRESPONDING", // 252 (510)
-       "COS", // 253 (511)
-       "COUNT", // 254 (512)
-       "CURRENCY", // 255 (513)
-       "CURRENT", // 256 (514)
-       "CURRENT-DATE", // 257 (515)
-       "DATA", // 258 (516)
-       "DATE", // 259 (517)
-       "DATE-COMPILED", // 260 (518)
-       "DATE-OF-INTEGER", // 261 (519)
-       "DATE-TO-YYYYMMDD", // 262 (520)
-       "DATE-WRITTEN", // 263 (521)
-       "DAY", // 264 (522)
-       "DAY-OF-INTEGER", // 265 (523)
-       "DAY-OF-WEEK", // 266 (524)
-       "DAY-TO-YYYYDDD", // 267 (525)
-       "DBCS", // 268 (526)
-       "DE", // 269 (527)
-       "DEBUGGING", // 270 (528)
-       "DECIMAL-POINT", // 271 (529)
-       "DECLARATIVES", // 272 (530)
-       "DEFAULT", // 273 (531)
-       "DELIMITED", // 274 (532)
-       "DELIMITER", // 275 (533)
-       "DEPENDING", // 276 (534)
-       "DESCENDING", // 277 (535)
-       "DETAIL", // 278 (536)
-       "DIRECT", // 279 (537)
-       "DIRECT-ACCESS", // 280 (538)
-       "DOWN", // 281 (539)
-       "DUPLICATES", // 282 (540)
-       "DYNAMIC", // 283 (541)
-       "E", // 284 (542)
-       "EBCDIC", // 285 (543)
-       "EC", // 286 (544)
-       "EGCS", // 287 (545)
-       "ENTRY", // 288 (546)
-       "ENVIRONMENT", // 289 (547)
-       "EQUAL", // 290 (548)
-       "EVERY", // 291 (549)
-       "EXAMINE", // 292 (550)
-       "EXHIBIT", // 293 (551)
-       "EXP", // 294 (552)
-       "EXP10", // 295 (553)
-       "EXTEND", // 296 (554)
-       "EXTERNAL", // 297 (555)
-       "EXCEPTION-FILE", // 298 (556)
-       "EXCEPTION-FILE-N", // 299 (557)
-       "EXCEPTION-LOCATION", // 300 (558)
-       "EXCEPTION-LOCATION-N", // 301 (559)
-       "EXCEPTION-STATEMENT", // 302 (560)
-       "EXCEPTION-STATUS", // 303 (561)
-       "FACTORIAL", // 304 (562)
-       "FALSE", // 305 (563)
-       "FD", // 306 (564)
-       "FILE-CONTROL", // 307 (565)
-       "FILE", // 308 (566)
-       "FILE-LIMIT", // 309 (567)
-       "FINAL", // 310 (568)
-       "FINALLY", // 311 (569)
-       "FIND-STRING", // 312 (570)
-       "FIRST", // 313 (571)
-       "FIXED", // 314 (572)
-       "FOOTING", // 315 (573)
-       "FOR", // 316 (574)
-       "FORMATTED-CURRENT-DATE", // 317 (575)
-       "FORMATTED-DATE", // 318 (576)
-       "FORMATTED-DATETIME", // 319 (577)
-       "FORMATTED-TIME", // 320 (578)
-       "FORM-OVERFLOW", // 321 (579)
-       "FREE", // 322 (580)
-       "FRACTION-PART", // 323 (581)
-       "FROM", // 324 (582)
-       "FUNCTION", // 325 (583)
-       "GENERATE", // 326 (584)
-       "GIVING", // 327 (585)
-       "GLOBAL", // 328 (586)
-       "GO", // 329 (587)
-       "GROUP", // 330 (588)
-       "HEADING", // 331 (589)
-       "HEX", // 332 (590)
-       "HEX-OF", // 333 (591)
-       "HEX-TO-CHAR", // 334 (592)
-       "HIGH-VALUES", // 335 (593)
-       "HIGHEST-ALGEBRAIC", // 336 (594)
-       "HOLD", // 337 (595)
-       "IBM-360", // 338 (596)
-       "IN", // 339 (597)
-       "INCLUDE", // 340 (598)
-       "INDEX", // 341 (599)
-       "INDEXED", // 342 (600)
-       "INDICATE", // 343 (601)
-       "INITIAL", // 344 (602)
-       "INITIATE", // 345 (603)
-       "INPUT", // 346 (604)
-       "INSTALLATION", // 347 (605)
-       "INTERFACE", // 348 (606)
-       "INTEGER", // 349 (607)
-       "INTEGER-OF-BOOLEAN", // 350 (608)
-       "INTEGER-OF-DATE", // 351 (609)
-       "INTEGER-OF-DAY", // 352 (610)
-       "INTEGER-OF-FORMATTED-DATE", // 353 (611)
-       "INTEGER-PART", // 354 (612)
-       "INTO", // 355 (613)
-       "INTRINSIC", // 356 (614)
-       "INVOKE", // 357 (615)
-       "I-O", // 358 (616)
-       "I-O-CONTROL", // 359 (617)
-       "IS", // 360 (618)
-       "ISNT", // 361 (619)
-       "KANJI", // 362 (620)
-       "KEY", // 363 (621)
-       "LABEL", // 364 (622)
-       "LAST", // 365 (623)
-       "LEADING", // 366 (624)
-       "LEFT", // 367 (625)
-       "LENGTH", // 368 (626)
-       "LENGTH-OF", // 369 (627)
-       "LIMIT", // 370 (628)
-       "LIMITS", // 371 (629)
-       "LINE", // 372 (630)
-       "LINES", // 373 (631)
-       "LINE-COUNTER", // 374 (632)
-       "LINAGE", // 375 (633)
-       "LINKAGE", // 376 (634)
-       "LOCALE", // 377 (635)
-       "LOCALE-COMPARE", // 378 (636)
-       "LOCALE-DATE", // 379 (637)
-       "LOCALE-TIME", // 380 (638)
-       "LOCALE-TIME-FROM-SECONDS", // 381 (639)
-       "LOCAL-STORAGE", // 382 (640)
-       "LOCATION", // 383 (641)
-       "LOCK", // 384 (642)
-       "LOCK-ON", // 385 (643)
-       "LOG", // 386 (644)
-       "LOG10", // 387 (645)
-       "LOWER-CASE", // 388 (646)
-       "LOW-VALUES", // 389 (647)
-       "LOWEST-ALGEBRAIC", // 390 (648)
-       "LPAREN", // 391 (649)
-       "MANUAL", // 392 (650)
-       "MAXX", // 393 (651)
-       "MEAN", // 394 (652)
-       "MEDIAN", // 395 (653)
-       "MIDRANGE", // 396 (654)
-       "MINN", // 397 (655)
-       "MULTIPLE", // 398 (656)
-       "MOD", // 399 (657)
-       "MODE", // 400 (658)
-       "MODULE-NAME", // 401 (659)
-       "NAMED", // 402 (660)
-       "NAT", // 403 (661)
-       "NATIONAL", // 404 (662)
-       "NATIONAL-EDITED", // 405 (663)
-       "NATIONAL-OF", // 406 (664)
-       "NATIVE", // 407 (665)
-       "NESTED", // 408 (666)
-       "NEXT", // 409 (667)
-       "NO", // 410 (668)
-       "NOTE", // 411 (669)
-       "NULLS", // 412 (670)
-       "NULLPTR", // 413 (671)
-       "NUMERIC", // 414 (672)
-       "NUMERIC-EDITED", // 415 (673)
-       "NUMVAL", // 416 (674)
-       "NUMVAL-C", // 417 (675)
-       "NUMVAL-F", // 418 (676)
-       "OCCURS", // 419 (677)
-       "OF", // 420 (678)
-       "OFF", // 421 (679)
-       "OMITTED", // 422 (680)
-       "ON", // 423 (681)
-       "ONLY", // 424 (682)
-       "OPTIONAL", // 425 (683)
-       "OPTIONS", // 426 (684)
-       "ORD", // 427 (685)
-       "ORDER", // 428 (686)
-       "ORD-MAX", // 429 (687)
-       "ORD-MIN", // 430 (688)
-       "ORGANIZATION", // 431 (689)
-       "OTHER", // 432 (690)
-       "OTHERWISE", // 433 (691)
-       "OUTPUT", // 434 (692)
-       "PACKED-DECIMAL", // 435 (693)
-       "PADDING", // 436 (694)
-       "PAGE", // 437 (695)
-       "PAGE-COUNTER", // 438 (696)
-       "PF", // 439 (697)
-       "PH", // 440 (698)
-       "PI", // 441 (699)
-       "PIC", // 442 (700)
-       "PICTURE", // 443 (701)
-       "PLUS", // 444 (702)
-       "PRESENT-VALUE", // 445 (703)
-       "PRINT-SWITCH", // 446 (704)
-       "PROCEDURE", // 447 (705)
-       "PROCEDURES", // 448 (706)
-       "PROCEED", // 449 (707)
-       "PROCESS", // 450 (708)
-       "PROGRAM-ID", // 451 (709)
-       "PROGRAM", // 452 (710)
-       "PROPERTY", // 453 (711)
-       "PROTOTYPE", // 454 (712)
-       "PSEUDOTEXT", // 455 (713)
-       "QUOTES", // 456 (714)
-       "RANDOM", // 457 (715)
-       "RANDOM-SEED", // 458 (716)
-       "RANGE", // 459 (717)
-       "RAISE", // 460 (718)
-       "RAISING", // 461 (719)
-       "RD", // 462 (720)
-       "RECORD", // 463 (721)
-       "RECORDING", // 464 (722)
-       "RECORDS", // 465 (723)
-       "RECURSIVE", // 466 (724)
-       "REDEFINES", // 467 (725)
-       "REEL", // 468 (726)
-       "REFERENCE", // 469 (727)
-       "RELATIVE", // 470 (728)
-       "REM", // 471 (729)
-       "REMAINDER", // 472 (730)
-       "REMARKS", // 473 (731)
-       "REMOVAL", // 474 (732)
-       "RENAMES", // 475 (733)
-       "REPLACE", // 476 (734)
-       "REPLACING", // 477 (735)
-       "REPORT", // 478 (736)
-       "REPORTING", // 479 (737)
-       "REPORTS", // 480 (738)
-       "REPOSITORY", // 481 (739)
-       "RERUN", // 482 (740)
-       "RESERVE", // 483 (741)
-       "RESTRICTED", // 484 (742)
-       "RESUME", // 485 (743)
-       "REVERSE", // 486 (744)
-       "REVERSED", // 487 (745)
-       "REWIND", // 488 (746)
-       "RF", // 489 (747)
-       "RH", // 490 (748)
-       "RIGHT", // 491 (749)
-       "ROUNDED", // 492 (750)
-       "RUN", // 493 (751)
-       "SAME", // 494 (752)
-       "SCREEN", // 495 (753)
-       "SD", // 496 (754)
-       "SECONDS-FROM-FORMATTED-TIME", // 497 (755)
-       "SECONDS-PAST-MIDNIGHT", // 498 (756)
-       "SECURITY", // 499 (757)
-       "SEPARATE", // 500 (758)
-       "SEQUENCE", // 501 (759)
-       "SEQUENTIAL", // 502 (760)
-       "SHARING", // 503 (761)
-       "SIMPLE-EXIT", // 504 (762)
-       "SIGN", // 505 (763)
-       "SIN", // 506 (764)
-       "SIZE", // 507 (765)
-       "SMALLEST-ALGEBRAIC", // 508 (766)
-       "SOURCE", // 509 (767)
-       "SOURCE-COMPUTER", // 510 (768)
-       "SPECIAL-NAMES", // 511 (769)
-       "SQRT", // 512 (770)
-       "STACK", // 513 (771)
-       "STANDARD", // 514 (772)
-       "STANDARD-1", // 515 (773)
-       "STANDARD-DEVIATION", // 516 (774)
-       "STANDARD-COMPARE", // 517 (775)
-       "STATUS", // 518 (776)
-       "STRONG", // 519 (777)
-       "SUBSTITUTE", // 520 (778)
-       "SUM", // 521 (779)
-       "SYMBOL", // 522 (780)
-       "SYMBOLIC", // 523 (781)
-       "SYNCHRONIZED", // 524 (782)
-       "TALLY", // 525 (783)
-       "TALLYING", // 526 (784)
-       "TAN", // 527 (785)
-       "TERMINATE", // 528 (786)
-       "TEST", // 529 (787)
-       "TEST-DATE-YYYYMMDD", // 530 (788)
-       "TEST-DAY-YYYYDDD", // 531 (789)
-       "TEST-FORMATTED-DATETIME", // 532 (790)
-       "TEST-NUMVAL", // 533 (791)
-       "TEST-NUMVAL-C", // 534 (792)
-       "TEST-NUMVAL-F", // 535 (793)
-       "THAN", // 536 (794)
-       "TIME", // 537 (795)
-       "TIMES", // 538 (796)
-       "TO", // 539 (797)
-       "TOP", // 540 (798)
-       "TOP-LEVEL", // 541 (799)
-       "TRACKS", // 542 (800)
-       "TRACK-AREA", // 543 (801)
-       "TRAILING", // 544 (802)
-       "TRANSFORM", // 545 (803)
-       "TRIM", // 546 (804)
-       "TRUE", // 547 (805)
-       "TRY", // 548 (806)
-       "TURN", // 549 (807)
-       "TYPE", // 550 (808)
-       "TYPEDEF", // 551 (809)
-       "ULENGTH", // 552 (810)
-       "UNBOUNDED", // 553 (811)
-       "UNIT", // 554 (812)
-       "UNITS", // 555 (813)
-       "UNIT-RECORD", // 556 (814)
-       "UNTIL", // 557 (815)
-       "UP", // 558 (816)
-       "UPON", // 559 (817)
-       "UPOS", // 560 (818)
-       "UPPER-CASE", // 561 (819)
-       "USAGE", // 562 (820)
-       "USING", // 563 (821)
-       "USUBSTR", // 564 (822)
-       "USUPPLEMENTARY", // 565 (823)
-       "UTILITY", // 566 (824)
-       "UUID4", // 567 (825)
-       "UVALID", // 568 (826)
-       "UWIDTH", // 569 (827)
-       "VALUE", // 570 (828)
-       "VARIANCE", // 571 (829)
-       "VARYING", // 572 (830)
-       "VOLATILE", // 573 (831)
-       "WHEN-COMPILED", // 574 (832)
-       "WITH", // 575 (833)
-       "WORKING-STORAGE", // 576 (834)
-       "XML", // 577 (835)
-       "XMLGENERATE", // 578 (836)
-       "XMLPARSE", // 579 (837)
-       "YEAR-TO-YYYY", // 580 (838)
-       "YYYYDDD", // 581 (839)
-       "YYYYMMDD", // 582 (840)
-       "ARITHMETIC", // 583 (841)
-       "ATTRIBUTE", // 584 (842)
-       "AUTO", // 585 (843)
-       "AUTOMATIC", // 586 (844)
-       "AWAY-FROM-ZERO", // 587 (845)
-       "BACKGROUND-COLOR", // 588 (846)
-       "BELL", // 589 (847)
-       "BINARY-ENCODING", // 590 (848)
-       "BLINK", // 591 (849)
-       "CAPACITY", // 592 (850)
-       "CENTER", // 593 (851)
-       "CLASSIFICATION", // 594 (852)
-       "CYCLE", // 595 (853)
-       "DECIMAL-ENCODING", // 596 (854)
-       "ENTRY-CONVENTION", // 597 (855)
-       "EOL", // 598 (856)
-       "EOS", // 599 (857)
-       "ERASE", // 600 (858)
-       "EXPANDS", // 601 (859)
-       "FLOAT-BINARY", // 602 (860)
-       "FLOAT-DECIMAL", // 603 (861)
-       "FOREGROUND-COLOR", // 604 (862)
-       "FOREVER", // 605 (863)
-       "FULL", // 606 (864)
-       "HIGHLIGHT", // 607 (865)
-       "HIGH-ORDER-LEFT", // 608 (866)
-       "HIGH-ORDER-RIGHT", // 609 (867)
-       "IGNORING", // 610 (868)
-       "IMPLEMENTS", // 611 (869)
-       "INITIALIZED", // 612 (870)
-       "INTERMEDIATE", // 613 (871)
-       "LC-ALL", // 614 (872)
-       "LC-COLLATE", // 615 (873)
-       "LC-CTYPE", // 616 (874)
-       "LC-MESSAGES", // 617 (875)
-       "LC-MONETARY", // 618 (876)
-       "LC-NUMERIC", // 619 (877)
-       "LC-TIME", // 620 (878)
-       "LOWLIGHT", // 621 (879)
-       "NEAREST-AWAY-FROM-ZERO", // 622 (880)
-       "NEAREST-EVEN", // 623 (881)
-       "NEAREST-TOWARD-ZERO", // 624 (882)
-       "NONE", // 625 (883)
-       "NORMAL", // 626 (884)
-       "NUMBERS", // 627 (885)
-       "PREFIXED", // 628 (886)
-       "PREVIOUS", // 629 (887)
-       "PROHIBITED", // 630 (888)
-       "RELATION", // 631 (889)
-       "REQUIRED", // 632 (890)
-       "REVERSE-VIDEO", // 633 (891)
-       "ROUNDING", // 634 (892)
-       "SECONDS", // 635 (893)
-       "SECURE", // 636 (894)
-       "SHORT", // 637 (895)
-       "SIGNED", // 638 (896)
-       "STANDARD-BINARY", // 639 (897)
-       "STANDARD-DECIMAL", // 640 (898)
-       "STATEMENT", // 641 (899)
-       "STEP", // 642 (900)
-       "STRUCTURE", // 643 (901)
-       "TOWARD-GREATER", // 644 (902)
-       "TOWARD-LESSER", // 645 (903)
-       "TRUNCATION", // 646 (904)
-       "UCS-4", // 647 (905)
-       "UNDERLINE", // 648 (906)
-       "UNSIGNED", // 649 (907)
-       "UTF-16", // 650 (908)
-       "UTF-8", // 651 (909)
-       "ADDRESS", // 652 (910)
-       "END-ACCEPT", // 653 (911)
-       "END-ADD", // 654 (912)
-       "END-CALL", // 655 (913)
-       "END-COMPUTE", // 656 (914)
-       "END-DELETE", // 657 (915)
-       "END-DISPLAY", // 658 (916)
-       "END-DIVIDE", // 659 (917)
-       "END-EVALUATE", // 660 (918)
-       "END-MULTIPLY", // 661 (919)
-       "END-PERFORM", // 662 (920)
-       "END-READ", // 663 (921)
-       "END-RETURN", // 664 (922)
-       "END-REWRITE", // 665 (923)
-       "END-SEARCH", // 666 (924)
-       "END-START", // 667 (925)
-       "END-STRING", // 668 (926)
-       "END-SUBTRACT", // 669 (927)
-       "END-UNSTRING", // 670 (928)
-       "END-WRITE", // 671 (929)
-       "END-IF", // 672 (930)
-       "THRU", // 673 (931)
-       "OR", // 674 (932)
-       "AND", // 675 (933)
-       "NOT", // 676 (934)
-       "NE", // 677 (935)
-       "LE", // 678 (936)
-       "GE", // 679 (937)
-       "POW", // 680 (938)
-       "NEG", // 681 (939)
+       "ARGUMENT-NUMBER", // 178 (436)
+       "ARGUMENT-VALUE", // 179 (437)
+       "ENVIRONMENT-NAME", // 180 (438)
+       "ENVIRONMENT-VALUE", // 181 (439)
+       "ABS", // 182 (440)
+       "ACCESS", // 183 (441)
+       "ACOS", // 184 (442)
+       "ACTUAL", // 185 (443)
+       "ADVANCING", // 186 (444)
+       "AFTER", // 187 (445)
+       "ALL", // 188 (446)
+       "ALLOCATE", // 189 (447)
+       "ALPHABET", // 190 (448)
+       "ALPHABETIC", // 191 (449)
+       "ALPHABETIC-LOWER", // 192 (450)
+       "ALPHABETIC-UPPER", // 193 (451)
+       "ALPHANUMERIC", // 194 (452)
+       "ALPHANUMERIC-EDITED", // 195 (453)
+       "ALSO", // 196 (454)
+       "ALTERNATE", // 197 (455)
+       "ANNUITY", // 198 (456)
+       "ANUM", // 199 (457)
+       "ANY", // 200 (458)
+       "ANYCASE", // 201 (459)
+       "APPLY", // 202 (460)
+       "ARE", // 203 (461)
+       "AREA", // 204 (462)
+       "AREAS", // 205 (463)
+       "AS", // 206 (464)
+       "ASCENDING", // 207 (465)
+       "ACTIVATING", // 208 (466)
+       "ASIN", // 209 (467)
+       "ASSIGN", // 210 (468)
+       "AT", // 211 (469)
+       "ATAN", // 212 (470)
+       "BASED", // 213 (471)
+       "BASECONVERT", // 214 (472)
+       "BEFORE", // 215 (473)
+       "BINARY", // 216 (474)
+       "BIT", // 217 (475)
+       "BIT-OF", // 218 (476)
+       "BIT-TO-CHAR", // 219 (477)
+       "BLANK", // 220 (478)
+       "BLOCK", // 221 (479)
+       "BOOLEAN-OF-INTEGER", // 222 (480)
+       "BOTTOM", // 223 (481)
+       "BY", // 224 (482)
+       "BYTE", // 225 (483)
+       "BYTE-LENGTH", // 226 (484)
+       "CF", // 227 (485)
+       "CH", // 228 (486)
+       "CHANGED", // 229 (487)
+       "CHAR", // 230 (488)
+       "CHAR-NATIONAL", // 231 (489)
+       "CHARACTER", // 232 (490)
+       "CHARACTERS", // 233 (491)
+       "CHECKING", // 234 (492)
+       "CLASS", // 235 (493)
+       "COBOL", // 236 (494)
+       "CODE", // 237 (495)
+       "CODE-SET", // 238 (496)
+       "COLLATING", // 239 (497)
+       "COLUMN", // 240 (498)
+       "COMBINED-DATETIME", // 241 (499)
+       "COMMA", // 242 (500)
+       "COMMAND-LINE", // 243 (501)
+       "COMMAND-LINE-COUNT", // 244 (502)
+       "COMMIT", // 245 (503)
+       "COMMON", // 246 (504)
+       "CONCAT", // 247 (505)
+       "CONDITION", // 248 (506)
+       "CONFIGURATION", // 249 (507)
+       "CONTAINS", // 250 (508)
+       "CONTENT", // 251 (509)
+       "CONTROL", // 252 (510)
+       "CONTROLS", // 253 (511)
+       "CONVERT", // 254 (512)
+       "CONVERTING", // 255 (513)
+       "CORRESPONDING", // 256 (514)
+       "COS", // 257 (515)
+       "COUNT", // 258 (516)
+       "CURRENCY", // 259 (517)
+       "CURRENT", // 260 (518)
+       "CURRENT-DATE", // 261 (519)
+       "DATA", // 262 (520)
+       "DATE", // 263 (521)
+       "DATE-COMPILED", // 264 (522)
+       "DATE-OF-INTEGER", // 265 (523)
+       "DATE-TO-YYYYMMDD", // 266 (524)
+       "DATE-WRITTEN", // 267 (525)
+       "DAY", // 268 (526)
+       "DAY-OF-INTEGER", // 269 (527)
+       "DAY-OF-WEEK", // 270 (528)
+       "DAY-TO-YYYYDDD", // 271 (529)
+       "DBCS", // 272 (530)
+       "DE", // 273 (531)
+       "DEBUGGING", // 274 (532)
+       "DECIMAL-POINT", // 275 (533)
+       "DECLARATIVES", // 276 (534)
+       "DEFAULT", // 277 (535)
+       "DELIMITED", // 278 (536)
+       "DELIMITER", // 279 (537)
+       "DEPENDING", // 280 (538)
+       "DESCENDING", // 281 (539)
+       "DETAIL", // 282 (540)
+       "DIRECT", // 283 (541)
+       "DIRECT-ACCESS", // 284 (542)
+       "DOWN", // 285 (543)
+       "DUPLICATES", // 286 (544)
+       "DYNAMIC", // 287 (545)
+       "E", // 288 (546)
+       "EBCDIC", // 289 (547)
+       "EC", // 290 (548)
+       "EGCS", // 291 (549)
+       "ENTRY", // 292 (550)
+       "ENVIRONMENT", // 293 (551)
+       "EQUAL", // 294 (552)
+       "EVERY", // 295 (553)
+       "EXAMINE", // 296 (554)
+       "EXHIBIT", // 297 (555)
+       "EXP", // 298 (556)
+       "EXP10", // 299 (557)
+       "EXTEND", // 300 (558)
+       "EXTERNAL", // 301 (559)
+       "EXCEPTION-FILE", // 302 (560)
+       "EXCEPTION-FILE-N", // 303 (561)
+       "EXCEPTION-LOCATION", // 304 (562)
+       "EXCEPTION-LOCATION-N", // 305 (563)
+       "EXCEPTION-STATEMENT", // 306 (564)
+       "EXCEPTION-STATUS", // 307 (565)
+       "FACTORIAL", // 308 (566)
+       "FALSE", // 309 (567)
+       "FD", // 310 (568)
+       "FILE-CONTROL", // 311 (569)
+       "FILE", // 312 (570)
+       "FILE-LIMIT", // 313 (571)
+       "FINAL", // 314 (572)
+       "FINALLY", // 315 (573)
+       "FIND-STRING", // 316 (574)
+       "FIRST", // 317 (575)
+       "FIXED", // 318 (576)
+       "FOOTING", // 319 (577)
+       "FOR", // 320 (578)
+       "FORMATTED-CURRENT-DATE", // 321 (579)
+       "FORMATTED-DATE", // 322 (580)
+       "FORMATTED-DATETIME", // 323 (581)
+       "FORMATTED-TIME", // 324 (582)
+       "FORM-OVERFLOW", // 325 (583)
+       "FREE", // 326 (584)
+       "FRACTION-PART", // 327 (585)
+       "FROM", // 328 (586)
+       "FUNCTION", // 329 (587)
+       "GENERATE", // 330 (588)
+       "GIVING", // 331 (589)
+       "GLOBAL", // 332 (590)
+       "GO", // 333 (591)
+       "GROUP", // 334 (592)
+       "HEADING", // 335 (593)
+       "HEX", // 336 (594)
+       "HEX-OF", // 337 (595)
+       "HEX-TO-CHAR", // 338 (596)
+       "HIGH-VALUES", // 339 (597)
+       "HIGHEST-ALGEBRAIC", // 340 (598)
+       "HOLD", // 341 (599)
+       "IBM-360", // 342 (600)
+       "IN", // 343 (601)
+       "INCLUDE", // 344 (602)
+       "INDEX", // 345 (603)
+       "INDEXED", // 346 (604)
+       "INDICATE", // 347 (605)
+       "INITIAL", // 348 (606)
+       "INITIATE", // 349 (607)
+       "INPUT", // 350 (608)
+       "INSTALLATION", // 351 (609)
+       "INTERFACE", // 352 (610)
+       "INTEGER", // 353 (611)
+       "INTEGER-OF-BOOLEAN", // 354 (612)
+       "INTEGER-OF-DATE", // 355 (613)
+       "INTEGER-OF-DAY", // 356 (614)
+       "INTEGER-OF-FORMATTED-DATE", // 357 (615)
+       "INTEGER-PART", // 358 (616)
+       "INTO", // 359 (617)
+       "INTRINSIC", // 360 (618)
+       "INVOKE", // 361 (619)
+       "I-O", // 362 (620)
+       "I-O-CONTROL", // 363 (621)
+       "IS", // 364 (622)
+       "ISNT", // 365 (623)
+       "KANJI", // 366 (624)
+       "KEY", // 367 (625)
+       "LABEL", // 368 (626)
+       "LAST", // 369 (627)
+       "LEADING", // 370 (628)
+       "LEFT", // 371 (629)
+       "LENGTH", // 372 (630)
+       "LENGTH-OF", // 373 (631)
+       "LIMIT", // 374 (632)
+       "LIMITS", // 375 (633)
+       "LINE", // 376 (634)
+       "LINES", // 377 (635)
+       "LINE-COUNTER", // 378 (636)
+       "LINAGE", // 379 (637)
+       "LINKAGE", // 380 (638)
+       "LOCALE", // 381 (639)
+       "LOCALE-COMPARE", // 382 (640)
+       "LOCALE-DATE", // 383 (641)
+       "LOCALE-TIME", // 384 (642)
+       "LOCALE-TIME-FROM-SECONDS", // 385 (643)
+       "LOCAL-STORAGE", // 386 (644)
+       "LOCATION", // 387 (645)
+       "LOCK", // 388 (646)
+       "LOCK-ON", // 389 (647)
+       "LOG", // 390 (648)
+       "LOG10", // 391 (649)
+       "LOWER-CASE", // 392 (650)
+       "LOW-VALUES", // 393 (651)
+       "LOWEST-ALGEBRAIC", // 394 (652)
+       "LPAREN", // 395 (653)
+       "MANUAL", // 396 (654)
+       "MAXX", // 397 (655)
+       "MEAN", // 398 (656)
+       "MEDIAN", // 399 (657)
+       "MIDRANGE", // 400 (658)
+       "MINN", // 401 (659)
+       "MULTIPLE", // 402 (660)
+       "MOD", // 403 (661)
+       "MODE", // 404 (662)
+       "MODULE-NAME", // 405 (663)
+       "NAMED", // 406 (664)
+       "NAT", // 407 (665)
+       "NATIONAL", // 408 (666)
+       "NATIONAL-EDITED", // 409 (667)
+       "NATIONAL-OF", // 410 (668)
+       "NATIVE", // 411 (669)
+       "NESTED", // 412 (670)
+       "NEXT", // 413 (671)
+       "NO", // 414 (672)
+       "NOTE", // 415 (673)
+       "NULLS", // 416 (674)
+       "NULLPTR", // 417 (675)
+       "NUMERIC", // 418 (676)
+       "NUMERIC-EDITED", // 419 (677)
+       "NUMVAL", // 420 (678)
+       "NUMVAL-C", // 421 (679)
+       "NUMVAL-F", // 422 (680)
+       "OCCURS", // 423 (681)
+       "OF", // 424 (682)
+       "OFF", // 425 (683)
+       "OMITTED", // 426 (684)
+       "ON", // 427 (685)
+       "ONLY", // 428 (686)
+       "OPTIONAL", // 429 (687)
+       "OPTIONS", // 430 (688)
+       "ORD", // 431 (689)
+       "ORDER", // 432 (690)
+       "ORD-MAX", // 433 (691)
+       "ORD-MIN", // 434 (692)
+       "ORGANIZATION", // 435 (693)
+       "OTHER", // 436 (694)
+       "OTHERWISE", // 437 (695)
+       "OUTPUT", // 438 (696)
+       "PACKED-DECIMAL", // 439 (697)
+       "PADDING", // 440 (698)
+       "PAGE", // 441 (699)
+       "PAGE-COUNTER", // 442 (700)
+       "PF", // 443 (701)
+       "PH", // 444 (702)
+       "PI", // 445 (703)
+       "PIC", // 446 (704)
+       "PICTURE", // 447 (705)
+       "PLUS", // 448 (706)
+       "PRESENT-VALUE", // 449 (707)
+       "PRINT-SWITCH", // 450 (708)
+       "PROCEDURE", // 451 (709)
+       "PROCEDURES", // 452 (710)
+       "PROCEED", // 453 (711)
+       "PROCESS", // 454 (712)
+       "PROGRAM-ID", // 455 (713)
+       "PROGRAM", // 456 (714)
+       "PROPERTY", // 457 (715)
+       "PROTOTYPE", // 458 (716)
+       "PSEUDOTEXT", // 459 (717)
+       "QUOTES", // 460 (718)
+       "RANDOM", // 461 (719)
+       "RANDOM-SEED", // 462 (720)
+       "RANGE", // 463 (721)
+       "RAISE", // 464 (722)
+       "RAISING", // 465 (723)
+       "RD", // 466 (724)
+       "RECORD", // 467 (725)
+       "RECORDING", // 468 (726)
+       "RECORDS", // 469 (727)
+       "RECURSIVE", // 470 (728)
+       "REDEFINES", // 471 (729)
+       "REEL", // 472 (730)
+       "REFERENCE", // 473 (731)
+       "RELATIVE", // 474 (732)
+       "REM", // 475 (733)
+       "REMAINDER", // 476 (734)
+       "REMARKS", // 477 (735)
+       "REMOVAL", // 478 (736)
+       "RENAMES", // 479 (737)
+       "REPLACE", // 480 (738)
+       "REPLACING", // 481 (739)
+       "REPORT", // 482 (740)
+       "REPORTING", // 483 (741)
+       "REPORTS", // 484 (742)
+       "REPOSITORY", // 485 (743)
+       "RERUN", // 486 (744)
+       "RESERVE", // 487 (745)
+       "RESTRICTED", // 488 (746)
+       "RESUME", // 489 (747)
+       "REVERSE", // 490 (748)
+       "REVERSED", // 491 (749)
+       "REWIND", // 492 (750)
+       "RF", // 493 (751)
+       "RH", // 494 (752)
+       "RIGHT", // 495 (753)
+       "ROUNDED", // 496 (754)
+       "RUN", // 497 (755)
+       "SAME", // 498 (756)
+       "SCREEN", // 499 (757)
+       "SD", // 500 (758)
+       "SECONDS-FROM-FORMATTED-TIME", // 501 (759)
+       "SECONDS-PAST-MIDNIGHT", // 502 (760)
+       "SECURITY", // 503 (761)
+       "SEPARATE", // 504 (762)
+       "SEQUENCE", // 505 (763)
+       "SEQUENTIAL", // 506 (764)
+       "SHARING", // 507 (765)
+       "SIMPLE-EXIT", // 508 (766)
+       "SIGN", // 509 (767)
+       "SIN", // 510 (768)
+       "SIZE", // 511 (769)
+       "SMALLEST-ALGEBRAIC", // 512 (770)
+       "SOURCE", // 513 (771)
+       "SOURCE-COMPUTER", // 514 (772)
+       "SPECIAL-NAMES", // 515 (773)
+       "SQRT", // 516 (774)
+       "STACK", // 517 (775)
+       "STANDARD", // 518 (776)
+       "STANDARD-1", // 519 (777)
+       "STANDARD-DEVIATION", // 520 (778)
+       "STANDARD-COMPARE", // 521 (779)
+       "STATUS", // 522 (780)
+       "STRONG", // 523 (781)
+       "SUBSTITUTE", // 524 (782)
+       "SUM", // 525 (783)
+       "SYMBOL", // 526 (784)
+       "SYMBOLIC", // 527 (785)
+       "SYNCHRONIZED", // 528 (786)
+       "TALLY", // 529 (787)
+       "TALLYING", // 530 (788)
+       "TAN", // 531 (789)
+       "TERMINATE", // 532 (790)
+       "TEST", // 533 (791)
+       "TEST-DATE-YYYYMMDD", // 534 (792)
+       "TEST-DAY-YYYYDDD", // 535 (793)
+       "TEST-FORMATTED-DATETIME", // 536 (794)
+       "TEST-NUMVAL", // 537 (795)
+       "TEST-NUMVAL-C", // 538 (796)
+       "TEST-NUMVAL-F", // 539 (797)
+       "THAN", // 540 (798)
+       "TIME", // 541 (799)
+       "TIMES", // 542 (800)
+       "TO", // 543 (801)
+       "TOP", // 544 (802)
+       "TOP-LEVEL", // 545 (803)
+       "TRACKS", // 546 (804)
+       "TRACK-AREA", // 547 (805)
+       "TRAILING", // 548 (806)
+       "TRANSFORM", // 549 (807)
+       "TRIM", // 550 (808)
+       "TRUE", // 551 (809)
+       "TRY", // 552 (810)
+       "TURN", // 553 (811)
+       "TYPE", // 554 (812)
+       "TYPEDEF", // 555 (813)
+       "ULENGTH", // 556 (814)
+       "UNBOUNDED", // 557 (815)
+       "UNIT", // 558 (816)
+       "UNITS", // 559 (817)
+       "UNIT-RECORD", // 560 (818)
+       "UNTIL", // 561 (819)
+       "UP", // 562 (820)
+       "UPON", // 563 (821)
+       "UPOS", // 564 (822)
+       "UPPER-CASE", // 565 (823)
+       "USAGE", // 566 (824)
+       "USING", // 567 (825)
+       "USUBSTR", // 568 (826)
+       "USUPPLEMENTARY", // 569 (827)
+       "UTILITY", // 570 (828)
+       "UUID4", // 571 (829)
+       "UVALID", // 572 (830)
+       "UWIDTH", // 573 (831)
+       "VALUE", // 574 (832)
+       "VARIANCE", // 575 (833)
+       "VARYING", // 576 (834)
+       "VOLATILE", // 577 (835)
+       "WHEN-COMPILED", // 578 (836)
+       "WITH", // 579 (837)
+       "WORKING-STORAGE", // 580 (838)
+       "XML", // 581 (839)
+       "XMLGENERATE", // 582 (840)
+       "XMLPARSE", // 583 (841)
+       "YEAR-TO-YYYY", // 584 (842)
+       "YYYYDDD", // 585 (843)
+       "YYYYMMDD", // 586 (844)
+       "ARITHMETIC", // 587 (845)
+       "ATTRIBUTE", // 588 (846)
+       "AUTO", // 589 (847)
+       "AUTOMATIC", // 590 (848)
+       "AWAY-FROM-ZERO", // 591 (849)
+       "BACKGROUND-COLOR", // 592 (850)
+       "BELL", // 593 (851)
+       "BINARY-ENCODING", // 594 (852)
+       "BLINK", // 595 (853)
+       "CAPACITY", // 596 (854)
+       "CENTER", // 597 (855)
+       "CLASSIFICATION", // 598 (856)
+       "CYCLE", // 599 (857)
+       "DECIMAL-ENCODING", // 600 (858)
+       "ENTRY-CONVENTION", // 601 (859)
+       "EOL", // 602 (860)
+       "EOS", // 603 (861)
+       "ERASE", // 604 (862)
+       "EXPANDS", // 605 (863)
+       "FLOAT-BINARY", // 606 (864)
+       "FLOAT-DECIMAL", // 607 (865)
+       "FOREGROUND-COLOR", // 608 (866)
+       "FOREVER", // 609 (867)
+       "FULL", // 610 (868)
+       "HIGHLIGHT", // 611 (869)
+       "HIGH-ORDER-LEFT", // 612 (870)
+       "HIGH-ORDER-RIGHT", // 613 (871)
+       "IGNORING", // 614 (872)
+       "IMPLEMENTS", // 615 (873)
+       "INITIALIZED", // 616 (874)
+       "INTERMEDIATE", // 617 (875)
+       "LC-ALL", // 618 (876)
+       "LC-COLLATE", // 619 (877)
+       "LC-CTYPE", // 620 (878)
+       "LC-MESSAGES", // 621 (879)
+       "LC-MONETARY", // 622 (880)
+       "LC-NUMERIC", // 623 (881)
+       "LC-TIME", // 624 (882)
+       "LOWLIGHT", // 625 (883)
+       "NEAREST-AWAY-FROM-ZERO", // 626 (884)
+       "NEAREST-EVEN", // 627 (885)
+       "NEAREST-TOWARD-ZERO", // 628 (886)
+       "NONE", // 629 (887)
+       "NORMAL", // 630 (888)
+       "NUMBERS", // 631 (889)
+       "PREFIXED", // 632 (890)
+       "PREVIOUS", // 633 (891)
+       "PROHIBITED", // 634 (892)
+       "RELATION", // 635 (893)
+       "REQUIRED", // 636 (894)
+       "REVERSE-VIDEO", // 637 (895)
+       "ROUNDING", // 638 (896)
+       "SECONDS", // 639 (897)
+       "SECURE", // 640 (898)
+       "SHORT", // 641 (899)
+       "SIGNED", // 642 (900)
+       "STANDARD-BINARY", // 643 (901)
+       "STANDARD-DECIMAL", // 644 (902)
+       "STATEMENT", // 645 (903)
+       "STEP", // 646 (904)
+       "STRUCTURE", // 647 (905)
+       "TOWARD-GREATER", // 648 (906)
+       "TOWARD-LESSER", // 649 (907)
+       "TRUNCATION", // 650 (908)
+       "UCS-4", // 651 (909)
+       "UNDERLINE", // 652 (910)
+       "UNSIGNED", // 653 (911)
+       "UTF-16", // 654 (912)
+       "UTF-8", // 655 (913)
+       "ADDRESS", // 656 (914)
+       "END-ACCEPT", // 657 (915)
+       "END-ADD", // 658 (916)
+       "END-CALL", // 659 (917)
+       "END-COMPUTE", // 660 (918)
+       "END-DELETE", // 661 (919)
+       "END-DISPLAY", // 662 (920)
+       "END-DIVIDE", // 663 (921)
+       "END-EVALUATE", // 664 (922)
+       "END-MULTIPLY", // 665 (923)
+       "END-PERFORM", // 666 (924)
+       "END-READ", // 667 (925)
+       "END-RETURN", // 668 (926)
+       "END-REWRITE", // 669 (927)
+       "END-SEARCH", // 670 (928)
+       "END-START", // 671 (929)
+       "END-STRING", // 672 (930)
+       "END-SUBTRACT", // 673 (931)
+       "END-UNSTRING", // 674 (932)
+       "END-WRITE", // 675 (933)
+       "END-IF", // 676 (934)
+       "THRU", // 677 (935)
+       "OR", // 678 (936)
+       "AND", // 679 (937)
+       "NOT", // 680 (938)
+       "NE", // 681 (939)
+       "LE", // 682 (940)
+       "GE", // 683 (941)
+       "POW", // 684 (942)
+       "NEG", // 685 (943)
 };
index 23f605db4ed910e2699ecb6dd49700cd0d0a92d3..0076fc4194ac888d0f1aef4cd27bd439b7e82e00 100644 (file)
  * header files.
  */
 
-#include "cobol-system.h"
-#include "coretypes.h"
-#include "tree.h"
+#include <cobol-system.h>
+#include <coretypes.h>
+#include <tree.h>
 #undef yy_flex_debug
 
 #include <langinfo.h>
 
-#include "coretypes.h"
-#include "version.h"
-#include "demangle.h"
-#include "intl.h"
-#include "backtrace.h"
-#include "diagnostic.h"
-#include "diagnostic-color.h"
-#include "diagnostic-url.h"
-#include "diagnostic-metadata.h"
-#include "diagnostic-path.h"
-#include "edit-context.h"
-#include "selftest.h"
-#include "selftest-diagnostic.h"
-#include "opts.h"
+#include <coretypes.h>
+#include <version.h>
+#include <demangle.h>
+#include <intl.h>
+#include <backtrace.h>
+#include <diagnostic.h>
+#include <diagnostic-color.h>
+#include <diagnostic-url.h>
+#include <diagnostic-metadata.h>
+#include <diagnostic-path.h>
+#include <edit-context.h>
+#include <selftest.h>
+#include <selftest-diagnostic.h>
+#include <opts.h>
+
 #include "util.h"
+
 #include "cbldiag.h"
+#include "cdfval.h"
 #include "lexio.h"
 
 #include "../../libgcobol/ec.h"
@@ -111,6 +114,81 @@ gb4( size_t input ) {
   return input;
 }
   
+/*
+ * Most CDF Directives -- those that have state -- can be pushed and popped.
+ * This class maintains stacks of them, with each stack having a "default
+ * value" that may be updated, without push/pop, via a CDF directive or
+ * command-line option.  A push to a stack pushes the default value onto it; a
+ * pop copies the top of the stack to the default value.
+ *
+ * >>PUSH ALL calls the class's push() method. 
+ * >>POP ALL calls the class's pop() method. 
+ */
+class cdf_directives_t
+{
+  typedef std::map<std::string, cdfval_t> cdf_values_t;
+
+  template <typename T>
+  class cdf_stack_t : private std::stack<T> {
+    T default_value;
+   public:
+    void value( const T& value ) {
+      T& output( std::stack<T>::empty()? default_value : std::stack<T>::top() );
+      output = value;
+    }
+    T& value() {
+      return std::stack<T>::empty()? default_value : std::stack<T>::top();
+    }
+    void push() {
+      std::stack<T>::push(value());
+    }
+    void pop() {
+      if( std::stack<T>::empty() ) {
+        error_msg(YYLTYPE(), "CDF stack empty");
+        return;
+      }
+      default_value = std::stack<T>::top();
+      std::stack<T>::pop();
+    }
+  };
+
+ public:
+  cdf_stack_t<cbl_call_convention_t> call_convention;
+  cdf_stack_t<current_tokens_t> cobol_words;
+  cdf_stack_t<cdf_values_t> dictionary;   // DEFINE
+  cdf_stack_t<source_format_t> source_format;
+  cdf_stack_t<cbl_enabled_exceptions_t> enabled_exceptions;
+
+  cdf_directives_t() {
+    call_convention.value() = cbl_call_cobol_e;
+  }
+  void push() {
+    call_convention.push();
+    cobol_words.push();
+    dictionary.push();
+    source_format.push();
+    enabled_exceptions.push();
+  }
+  void pop() {
+    call_convention.pop();
+    cobol_words.pop();
+    dictionary.pop();
+    source_format.pop();
+    enabled_exceptions.pop();
+  }
+};
+static cdf_directives_t cdf_directives;
+
+void
+cobol_set_indicator_column( int column ) {
+  cdf_directives.source_format.value().indicator_column_set(column);
+}
+source_format_t& cdf_source_format() {
+  return cdf_directives.source_format.value();
+}
+
+
 const char *
 symbol_type_str( enum symbol_type_t type )
 {
@@ -1927,7 +2005,8 @@ location_t location_from_lineno() { return token_location; }
 template <typename LOC>
 static void
 gcc_location_set_impl( const LOC& loc ) {
-  token_location = linemap_line_start( line_table, loc.last_line, 80 );
+  // Set the position to the first line & column in the location. 
+  token_location = linemap_line_start( line_table, loc.first_line, 80 );
   token_location = linemap_position_for_column( line_table, loc.first_column);
   location_dump(__func__, __LINE__, "parser", loc);
 }
@@ -1972,6 +2051,11 @@ verify_format( const char gmsgid[] ) {
 static const diagnostic_option_id option_zero;
 size_t parse_error_inc();
 
+void gcc_location_dump() {
+    linemap_dump_location( line_table, token_location, stderr );
+}
+
+
 void ydferror( const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2);
 
 void
@@ -2008,10 +2092,7 @@ class temp_loc_t {
     gcc_location_set(loc);
   }
   explicit temp_loc_t( const YDFLTYPE& loc) : orig(token_location) {
-    YYLTYPE lloc = {
-      loc.first_line, loc.first_column,
-      loc.last_line,  loc.last_column };
-    gcc_location_set(lloc);
+    gcc_location_set(loc);
   }
   ~temp_loc_t() {
     if( orig != token_location ) {
@@ -2057,6 +2138,17 @@ void error_msg( const YDFLTYPE& loc, const char gmsgid[], ... ) {
   ERROR_MSG_BODY
 }
 
+void error_msg_direct( const char gmsgid[], ... ) {
+  verify_format(gmsgid);
+  parse_error_inc();
+  auto_diagnostic_group d;
+  va_list ap;
+  va_start (ap, gmsgid);
+  auto ret = emit_diagnostic_valist( DK_ERROR, token_location,
+                                     option_zero, gmsgid, &ap );
+  va_end (ap);
+}
+
 void
 yyerror( const char gmsgid[], ... ) {
   temp_loc_t looker;
index 165915a264a88d091e03ad301435eb1099ff94a4..28818093662e5640501945da8e2f52008662aa67 100644 (file)
@@ -59,5 +59,55 @@ as_voidp( P p ) {
   return static_cast<const void *>(p);
 }
 
+/*
+ * The default source format, whether free or fixed, is determined
+ * heuristically by examining the PROGRAM-ID line, if it exists, in the first
+ * input file. If that file does not have such a line, the default is free
+ * format.  Else the format is set to fixed if anything appears on that line
+ * that would prohibit parsing it as free format,
+ */
+class source_format_t {
+  bool first_file, explicitly;
+  int left, right;
+public:
+  source_format_t()
+    : first_file(true), explicitly(false), left(0), right(0)
+  {}
+  void indicator_column_set( int column ) {
+    explicitly = true;
+    if( column == 0 ) right = 0;
+    if( column < 0 ) {
+      column = -column;
+      right = 73;
+    }
+    left = column;
+  }
+  
+  bool inference_pending() {
+    bool tf = first_file && !explicitly;
+    first_file = false;
+    return tf;
+  }
+
+  void infer( const char *bol, bool want_reference_format );
+  
+  inline bool is_fixed() const { return left == 7; }
+  inline bool is_reffmt() const { return is_fixed() && right == 73; }
+  inline bool is_free() const { return ! is_fixed(); }
+  
+  const char * description() const {
+    if( is_reffmt() ) return "REFERENCE";
+    if( is_fixed() ) return "FIXED";
+    if( is_free() ) return "FREE";
+    gcc_unreachable();
+  }    
+
+  inline int left_margin() {
+    return left == 0? left : left - 1;
+  }
+  inline int right_margin() {
+    return right == 0? right : right - 1;
+  }
+}; 
 
 #endif
index 81b5b7af812134cafde17487809f8023b6b8431a..c3d78d465b77a60d654a2a809bb993b1ed81bce6 100644 (file)
@@ -10132,55 +10132,73 @@ __gg__classify( classify_t type,
   return retval;
   }
 
-extern "C"
+static
 int
-__gg__accept_envar( cblc_field_t *tgt,
-                    size_t        tgt_offset,
-                    size_t        tgt_length,
-                    cblc_field_t *name,
-                    size_t        name_offset,
-                    size_t        name_length)
+accept_envar( cblc_field_t *tgt,
+              size_t        tgt_offset,
+              size_t        tgt_length,
+              const char   *psz_name)
   {
-  int retval;
-  tgt_length  = tgt_length  ? tgt_length  : tgt->capacity;
-  name_length = name_length ? name_length : name->capacity;
-
-  // Pick up the environment variable name, which is in teh internal codeset
-  static char   *env        = NULL;
-  static size_t  env_length = 0;
-  if( env_length < name_length+1 )
+  int retval = 1; // 1 means we couldn't find it
+  if( psz_name )
     {
-    env_length = name_length+1;
-    env = static_cast<char *>(realloc(env, env_length));
-    }
-  memcpy(env, name->data + name_offset, name_length);
-  env[name_length] = '\0';
+    tgt_length = tgt_length  ? tgt_length  : tgt->capacity;
 
-  // Get rid of leading and trailing internal_space characters:
-  char *trimmed_env = brute_force_trim(env);
+    // Pick up the environment variable name, which is in the internal codeset
+    char *env = strdup(psz_name);
+    massert(env);
 
-  // Convert the name to the console codeset:
-  __gg__internal_to_console_in_place(trimmed_env, strlen(trimmed_env));
+    // Get rid of leading and trailing internal_space characters:
+    char *trimmed_env = brute_force_trim(env);
 
-  // Pick up the environment variable, and convert it to the internal codeset
-  const char *p = getenv(trimmed_env);
-  if(p)
-    {
-    char *pp = strdup(p);
-    console_to_internal(pp, strlen(pp));
-    retval = 0; // Okay
-    move_string(tgt, tgt_offset, tgt_length, pp);
-    free(pp);
+    // Convert the name to the console codeset:
+    __gg__internal_to_console_in_place(trimmed_env, strlen(trimmed_env));
+
+    // Pick up the environment variable, and convert it to the internal codeset
+    const char *p = getenv(trimmed_env);
+    if(p)
+      {
+      char *pp = strdup(p);
+      massert(pp);
+      console_to_internal(pp, strlen(pp));
+      retval = 0; // Okay
+      move_string(tgt, tgt_offset, tgt_length, pp);
+      free(pp);
+      }
+    free(env);
     }
-  else
+
+  if( retval == 1 )
     {
-    retval = 1; // Could't find it
+    // Could't find it
     exception_raise(ec_argument_imp_environment_e);
     }
 
   return retval;
   }
 
+extern "C"
+int
+__gg__accept_envar( cblc_field_t *tgt,
+                    size_t        tgt_offset,
+                    size_t        tgt_length,
+              const cblc_field_t *name,
+                    size_t        name_offset,
+                    size_t        name_length)
+  {
+  //  We need the name to be nul-terminated:
+  char *p = static_cast<char *>(malloc(name_length + 1));
+  massert(p);
+  memcpy(p, name->data+name_offset, name_length);
+  p[name_length] = '\0';
+  int retval = accept_envar(tgt,
+                            tgt_offset,
+                            tgt_length,
+                            p);
+  free(p);
+  return retval;
+  }
+
 extern "C"
 bool
 __gg__set_envar(cblc_field_t    *name,
@@ -11247,35 +11265,42 @@ match_declarative( bool enabled,
   return matches;
 }
 
-/*
- * The default exception handler is called if:
- *   1.  The EC is enabled and was not handled by a Declarative, or
- *   2.  The EC is EC-I-O and was not handled by a Format-1 Declarative, or
- *   3.  The EC is EC-I-O, associated with a file, and is not OPEN or CLOSE.
- */
-static void
-default_exception_handler( ec_type_t ec )
+static
+void open_syslog(int option, int facility)
 {
+  static bool first_time = true;
+  if( first_time ) {
 #if HAVE_DECL_PROGRAM_INVOCATION_SHORT_NAME
   /* Declared in errno.h, when available.  */
-  static const char * const ident = program_invocation_short_name;
+    static const char * const ident = program_invocation_short_name;
 #elif defined (HAVE_GETPROGNAME)
   /* Declared in stdlib.h.  */
-  static const char * const ident = getprogname();
+    static const char * const ident = getprogname();
 #else
   /* Avoid a NULL entry.  */
-  static const char * const ident = "unnamed_COBOL_program";
+    static const char * const ident = "unnamed_COBOL_program";
 #endif
-  static bool first_time = true;
-  static const int priority = LOG_INFO, option = LOG_PERROR, facility = LOG_USER;
-  ec_disposition_t disposition = ec_category_fatal_e;
-
-  if( first_time ) {
     // TODO: Program to set option in library via command-line and/or environment.
     //       Library listens to program, not to the environment.
     openlog(ident, option, facility);
     first_time = false;
   }
+}
+
+/*
+ * The default exception handler is called if:
+ *   1.  The EC is enabled and was not handled by a Declarative, or
+ *   2.  The EC is EC-I-O and was not handled by a Format-1 Declarative, or
+ *   3.  The EC is EC-I-O, associated with a file, and is not OPEN or CLOSE.
+ */
+static void
+default_exception_handler( ec_type_t ec )
+{
+  static const int priority = LOG_INFO, option = LOG_PERROR, facility = LOG_USER;
+  open_syslog(option, facility);
+
+  ec_disposition_t disposition = ec_category_fatal_e;
+
 
   if( ec != ec_none_e ) {
     auto pec = std::find_if( __gg__exception_table, __gg__exception_table_end,
@@ -13148,6 +13173,7 @@ operator<<( std::vector<cbl_declarative_t>& dcls,
   return decode( dcls, encoded );
 }
 
+// The first element of each array is the number of elements that follow
 // The first element of each array is the number of elements that follow
 extern "C"
 void
@@ -13207,6 +13233,7 @@ __gg__set_env_name( const cblc_field_t *var,
                     size_t              offset,
                     size_t              length )
   {
+  // implements DISPLAY UPON ENVIRONMENT-NAME
   free(sv_envname);
   sv_envname = static_cast<char *>(malloc(length+1));
   massert(sv_envname);
@@ -13214,12 +13241,41 @@ __gg__set_env_name( const cblc_field_t *var,
   sv_envname[length] = '\0';
   }
 
+
+extern "C"
+void
+__gg__get_env_name( cblc_field_t *dest,
+                    size_t dest_offset,
+                    size_t dest_length)
+  {
+  // Implements ACCEPT FROM ENVIRONMENT-NAME
+  // It returns the value previously established by __gg__set_env_name.
+  if( sv_envname )
+    {
+    sv_envname = strdup("");
+    }
+  move_string(dest, dest_offset, dest_length, sv_envname);
+  }
+
+extern "C"
+int
+__gg__get_env_value(cblc_field_t *dest,
+                    size_t dest_offset,
+                    size_t dest_length)
+  {
+  return accept_envar(dest,
+                      dest_offset,
+                      dest_length,
+                      sv_envname);
+  }
+
 extern "C"
 void
 __gg__set_env_value(const cblc_field_t *value,
                     size_t              offset,
                     size_t              length )
   {
+  // implements DISPLAY UPON ENVIRONMENT-VALUE
   size_t name_length  = strlen(sv_envname);
   size_t value_length = length;
 
@@ -13258,6 +13314,11 @@ __gg__set_env_value(const cblc_field_t *value,
   setenv(trimmed_env, trimmed_val, 1);
   }
 
+extern "C"
+void
+__gg__fprintf_stderr(const char *format_string, ...)
+  __attribute__ ((__format__ (__printf__, 1, 2)));
+
 extern "C"
 void
 __gg__fprintf_stderr(const char *format_string, ...)
@@ -13270,3 +13331,81 @@ __gg__fprintf_stderr(const char *format_string, ...)
   va_end(ap);
   }
 
+
+static int sv_argument_number = 0;
+
+extern "C"
+void
+__gg__set_arg_num( const cblc_field_t *index,
+                   size_t              index_offset,
+                   size_t              index_size )
+  {
+  // Implements DISPLAY UPON ARGUMENT-NUMBER.
+  int rdigits;
+  __int128 N = get_binary_value_local(&rdigits,
+                                      index,
+                                      index->data + index_offset,
+                                      index_size);
+  // If he gives us fractional digits, just truncate
+  N /= __gg__power_of_ten(rdigits);
+
+  // N is 1-based, per normal COBOL.  We have to decrement it here:
+  N -= 1;
+  sv_argument_number = static_cast<int>(N);
+  }
+
+extern "C"
+int
+__gg__accept_arg_value( cblc_field_t *dest,
+                        size_t dest_offset,
+                        size_t dest_length)
+  {
+  // Implements ACCEPT FROM ARGUMENT-VALUE
+  int retcode;
+  command_line_plan_b();
+  if( sv_argument_number >= stashed_argc || sv_argument_number < 0 )
+    {
+    exception_raise(ec_argument_imp_command_e);
+    retcode = 1;  // Error
+    }
+  else
+    {
+    char *retval = strdup(stashed_argv[sv_argument_number]);
+    console_to_internal(retval, strlen(retval));
+    move_string(dest, dest_offset, dest_length, retval);
+    free(retval);
+    retcode = 0;  // Okay
+
+    // The Fujitsu spec says bump this value by one.
+    sv_argument_number += 1;
+    }
+  return retcode;
+  }
+
+extern "C"
+int
+__gg__get_file_descriptor(const char *device)
+  {
+  int retval = open(device, O_WRONLY);
+  
+  if( retval == -1 )
+    {
+    char *msg;
+    int ec = asprintf(&msg,
+                      "Trying to open %s.  Got error %s",
+                      device,
+                      strerror(errno));
+    if( ec != -1 )
+      {
+      static const int priority = LOG_INFO,
+                         option = LOG_PERROR,
+                       facility = LOG_USER;
+      open_syslog(option, facility);
+      syslog(priority, "%s", msg);
+      }
+    
+    // Open a new handle to /dev/stdout, since our caller will be closing it
+    retval = open("/dev/stdout", O_WRONLY);
+    }
+  return retval;
+  }