1 /* format: style4,indattr,idind30 */
   2 lalr: lrk: proc;
   3 
   4 /*        LALR; a translator that generates a lalr(k)
   5    ^O     (Donald Knuth) parser from a BNF grammar.
   6 
   7    ^O     Dave Ward and Jim Falksen
   8    ^O     June 1976
   9 
  10    ^O     Modified by P. Prange
  11    ^O     December 1978 and December 1979
  12    Modified: 01 May 85 - B. Wong  Added "lalr_rev" entry point.
  13 */
  14 
  15 dcl  L_and_states_files            (2) fixed bin init (L_f, states_f);
  16 dcl  actions_files                 (3) fixed bin init (terminal_characters_f, terminals_list_f, variables_list_f);
  17 dcl  addr                          builtin;
  18 dcl  addrel                        builtin;
  19 dcl  all_files                     (1) fixed bin internal static options (constant) init (-1);
  20 dcl  argl                          fixed bin (21);
  21 dcl  argp                          ptr;
  22 dcl  cleanup                       condition;
  23 dcl  clock                         builtin;
  24 dcl  code                          fixed bin (35);
  25 dcl  com_err_                      entry options (variable);
  26 dcl  com_err_$suppress_name        entry options (variable);
  27 dcl  component_name                char (32);
  28 dcl  cu_$arg_count                 entry (fixed bin, fixed bin (35));
  29 dcl  cu_$arg_ptr                   entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
  30 dcl  date_time_                    entry (fixed bin (71), char (*));
  31 dcl  dbs                           (36) bit (1) unaligned internal static init ((36) (1)"0"b);
  32 dcl  divide                        builtin;
  33 dcl  entryname                     char (32);
  34 dcl  eoi_symbol                    char (eoi_symbol_length) based (eoi_symbol_pointer);
  35 dcl  eoi_symbol_length             fixed bin;
  36 dcl  eoi_symbol_pointer            ptr;
  37 dcl  error_table_$translation_aborted fixed bin (35) external static;
  38 dcl  error_terminals               (200) fixed bin;
  39 dcl  error_terminals_count         fixed bin;
  40 dcl  expand_pathname_$component    entry (char (*), char (*), char (*), char (*), fixed bin (35));
  41 dcl  failed                        bit (1);
  42 dcl  false                         bit (1) internal static options (constant) init ("0"b);
  43 dcl  float                         builtin;
  44 dcl  fp                            char (256) varying init ("");
  45 dcl  get_group_id_                 entry returns (char (32));
  46 dcl  get_line_length_$switch       entry (ptr, fixed bin (35)) returns (fixed bin (17));
  47 dcl  get_shortest_path_            entry (char (*)) returns (char (168));
  48 dcl  1 grammar_part                like input_part;
  49 dcl  hbound                        builtin;
  50 dcl  hcs_$get_process_usage        entry (ptr, fixed bin (35));
  51 dcl  i                             fixed bin;
  52 dcl  index                         builtin;
  53 dcl  initiate_file_                entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
  54 dcl  input                         char (input_length) based (input_pointer);
  55 dcl  input_length                  fixed bin (21);
  56 dcl  input_pointer                 ptr;
  57 dcl  ioa_                          entry options (variable);
  58 dcl  ioa_$nnl                      entry options (variable);
  59 dcl  ioa_$ioa_switch               entry options (variable);
  60 dcl  lalr_and_result_files         (2) fixed bin init (lalr_f, result_f);
  61 dcl  lalr_classify_symbols_        entry (ptr, ptr, char (*), (200) fixed bin, fixed bin);
  62 dcl  lalr_compress_dpda_           entry (ptr, fixed bin, (200) fixed bin, fixed bin);
  63 dcl  lalr_error_table_$arg_value_too_big fixed bin (35) external static;
  64 dcl  lalr_error_table_$bad_semantics_suffix fixed bin (35) external static;
  65 dcl  lalr_error_table_$grammar_changed fixed bin (35) external static;
  66 dcl  lalr_error_table_$l6_dpda_bad_controls fixed bin (35) external static;
  67 dcl  lalr_error_table_$missing_mark_terminal fixed bin (35) external static;
  68 dcl  lalr_error_table_$no_argument_value fixed bin (35) external static;
  69 dcl  lalr_error_table_$no_bnf      fixed bin (35) external static;
  70 dcl  lalr_error_table_$no_grammar_given fixed bin (35) external static;
  71 dcl  lalr_error_table_$not_positive_integer fixed bin (35) external static;
  72 dcl  lalr_error_table_$prelude_changed fixed bin (35) external static;
  73 dcl  lalr_error_table_$prod_count_changed fixed bin (35) external static;
  74 dcl  lalr_error_table_$unable_to_check_for_change fixed bin (35) external static;
  75 dcl  lalr_error_table_$unrecognized_option fixed bin (35) external static;
  76 dcl  lalr_error_table_$zero_hash_modulus fixed bin (35) external static;
  77 dcl  lalr_fatal                    condition;
  78 dcl  lalr_file                     (1) fixed bin init (lalr_f);
  79 dcl  lalr_io_utility_$close        entry (ptr, (*) fixed bin);
  80 dcl  lalr_io_utility_$open         entry (ptr, (*) fixed bin, bit (1));
  81 dcl  lalr_io_utility_$open_iox_extend entry (ptr, (*) fixed bin, bit (1));
  82 dcl  lalr_io_utility_$open_i       entry (ptr, (*) fixed bin, bit (1));
  83 dcl  lalr_io_utility_$zero         entry (ptr, (*) fixed bin);
  84 dcl  lalr_list_dpda_               entry (ptr);
  85 dcl  lalr_list_symbols_            entry (ptr);
  86 dcl  lalr_make_backpointers_       entry (ptr);
  87 dcl  lalr_make_dpda_               entry (ptr);
  88 dcl  lalr_make_lr0_cfsm_           entry (ptr, fixed bin);
  89 dcl  lalr_make_result_             entry (ptr, char (*) varying, char (*) varying, char (*));
  90 dcl  lalr_make_table_$lalr_entrypoint entry (ptr);
  91 dcl  lalr_make_vtr_table_          entry (ptr);
  92 dcl  lalr_optimize_                entry (ptr, fixed bin);
  93 dcl  lalr_parse_grammar_           entry (ptr, ptr);
  94 dcl  lalr_remove_inadequacies_     entry (ptr);
  95 dcl  lalrlist_file                 (1) fixed bin init (lalrlist_f);
  96 dcl  length                        builtin;
  97 dcl  1 local_data                  like static_data;
  98 dcl  marked_symbol                 char (marked_symbol_length) based (marked_symbol_pointer);
  99 dcl  marked_symbol_length          fixed bin;
 100 dcl  marked_symbol_pointer         ptr;
 101 dcl  min                           builtin;
 102 dcl  n                             fixed bin;
 103 dcl  name                          (3) char (194);
 104 dcl  new_standard_prelude          char (new_standard_prelude_length) based (new_standard_prelude_ptr);
 105 dcl  new_standard_prelude_length   fixed bin;
 106 dcl  new_standard_prelude_ptr      ptr;
 107 dcl  null                          builtin;
 108 dcl  null_string                   char (0) internal static options (constant) init ("");
 109 dcl  num_inad                      fixed bin init (0);
 110 dcl  old_productions_list_ptr      ptr;
 111 dcl  old_standard_prelude          char (old_standard_prelude_length) based (old_standard_prelude_ptr);
 112 dcl  old_standard_prelude_length   fixed bin;
 113 dcl  old_standard_prelude_ptr      ptr;
 114 dcl  options_list                  char (256) varying;
 115 dcl  origin_sw                     bit (1);
 116 dcl  parameter                     char (parameter_length) unaligned based (parameter_pointer);
 117 dcl  parameter_length              fixed bin (21);
 118 dcl  parameter_pointer             ptr;
 119 dcl  productions_files             (3) fixed bin init (productions_list_f, symbols_list_f, symbol_characters_f);
 120 %include process_usage;
 121 dcl  program_interrupt             condition;
 122 dcl  result_file                   (1) fixed bin init (result_f);
 123 dcl  reverse                       builtin;
 124 dcl  rtrim                         builtin;
 125 dcl  1 saved_statistics            internal static like statistics;
 126 dcl  sem_file                      (1) fixed bin init (sem_f);
 127 dcl  sem_suffix                    (10) char (12) internal static options (constant) init (
 128                                    ".pl1", ".incl.pl1", ".nml", ".nml.MAC", ".incl.nml", ".ada", ".incl.ada", ".c", ".incl.c", ".h");
 129 dcl  string                        builtin;
 130 dcl  substr                        builtin;
 131 dcl  1 statistics,
 132        2 abs_users                 fixed bin,
 133        2 max_abs_users             fixed bin,
 134        2 mxunits                   fixed bin,
 135        2 mxusers                   fixed bin,
 136        2 n_daemons                 fixed bin,
 137        2 n_units                   fixed bin,
 138        2 n_users                   fixed bin,
 139        2 date_time                 char (24),
 140        2 segment_name              char (66),
 141        2 sysid                     char (32),
 142        2 usage                     (0:16) like process_usage;
 143 dcl  time_iocb_ptr                 ptr;
 144 dcl  true                          bit (1) internal static options (constant) init ("1"b);
 145 dcl  unspec                        builtin;
 146 dcl  v                             fixed bin;
 147 dcl  verify                        builtin;
 148 dcl  whoptr                        ptr internal static init (null ());
 149 
 150 dcl  1 args                        (200),
 151        2 pointer                   ptr,
 152        2 length                    fixed bin (21);
 153 
 154 dcl  NL                            char (1) internal static options (constant) init ("
 155 ");
 156 %page;
 157           unspec (statistics.usage) = ""b;
 158           statistics.number_wanted (*) = 9;
 159           call hcs_$get_process_usage (addr (statistics.usage (0)), code);
 160 
 161           if whoptr = null () then
 162                call initiate_file_ (">system_control_1", "whotab", R_ACCESS, whoptr, (0), code);
 163           if whoptr ^= null ()
 164           then do;
 165                statistics.mxusers = whotab.mxusers; statistics.n_users = whotab.n_users;
 166                statistics.mxunits = whotab.mxunits; statistics.n_units = whotab.n_units;
 167                statistics.max_abs_users = whotab.max_abs_users;
 168                statistics.abs_users = whotab.abs_users;
 169                statistics.n_daemons = whotab.n_daemons;
 170                statistics.sysid = whotab.sysid;
 171           end;
 172 
 173           lalr_severity_ = 5;
 174 
 175 /*        Obtain pointers to, and lengths of, input arguments. */
 176           call cu_$arg_count (n, code);
 177           if code ^= 0
 178           then do;
 179                call com_err_ (code, command_name);
 180                return;
 181           end;
 182           if n = 0
 183           then do;
 184 bad_args:
 185                call com_err_$suppress_name (0, command_name,
 186                     "Usage: ^a path {-control_args}", command_name);
 187                return;
 188           end;
 189           do i = 1 to n;
 190                call cu_$arg_ptr (i, argp, argl, code);
 191                if code ^= 0
 192                then do;
 193                     call com_err_ (code, command_name);
 194                     go to bad_args;
 195                end;
 196                args.pointer (i) = argp;
 197                args.length (i) = argl;
 198           end;
 199 %page;
 200 /*        Initialize various variables. */
 201           input_part_ptr = addr (grammar_part);
 202           static_data_ptr = addr (local_data);
 203           call lalr_io_utility_$zero (static_data_ptr, all_files);
 204           local_data.print_data.maxlength = get_line_length_$switch (iox_$user_output, code);
 205           if code ^= 0 then
 206                local_data.print_data.maxlength = lalr_static_$default.print_data.maxlength;
 207           local_data.print_data.error_maxlength = get_line_length_$switch (iox_$error_output, code);
 208           if code ^= 0 then
 209                local_data.print_data.error_maxlength = lalr_static_$default.print_data.error_maxlength;
 210           local_data.print_data.indent = 0;
 211           local_data.print_data.list_maxlength = lalr_static_$default.print_data.list_maxlength;
 212           local_data.print_data.page_length = lalr_static_$default.print_data.page_length;
 213           local_data.print_data.error_linelength,
 214                local_data.print_data.list_linelength,
 215                local_data.print_data.linelength = 0;
 216           local_data.file_pointer (lalrlist_f) = null ();
 217           eoi_symbol_length, marked_symbol_length = 0;
 218           eoi_symbol_pointer, marked_symbol_pointer = addr (null_string);
 219           string (local_data.options) = lalr_static_$default.options;
 220           origin_sw = false;
 221           local_data.hash_modulus = lalr_static_$default.hash_modulus;
 222           local_data.multiple_lookahead.mla_max = lalr_static_$default.mla_max;
 223           local_data.multiple_lookahead.mla_min = 0;
 224           local_data.multiple_lookahead.indefinite_recursions,
 225                local_data.multiple_lookahead.infinite_lookaheads,
 226                local_data.multiple_lookahead.max_lookahead_exceeded = 0;
 227           local_data.optimization_gains.read_transitions,
 228                local_data.optimization_gains.look_transitions,
 229                local_data.optimization_gains.read_look_states,
 230                local_data.optimization_gains.lookback_transitions,
 231                local_data.optimization_gains.apply_states,
 232                local_data.optimization_gains.multiple_look_transitions,
 233                local_data.optimization_gains.multiple_look_states,
 234                local_data.optimization_gains.dpda_words,
 235                local_data.optimization_gains.unique_dpda_edges,
 236                local_data.optimization_gains.mla_min = 0;
 237           string (local_data.dbs) = string (dbs);
 238           local_data.transfer_arg_number = lalr_static_$default.transfer_arg_number;
 239           local_data.info.unique_dpda_edges = 0;
 240           options_list = "";
 241           name (*) = "";
 242           call date_time_ (clock (), statistics.date_time);
 243           local_data.date_time = statistics.date_time;
 244           local_data.user_id = rtrim (get_group_id_ ());
 245           local_data.sem.dname, local_data.sem.ename, local_data.sem.suffix = "";
 246           local_data.table.dname, local_data.table.ename, local_data.table.suffix = "";
 247 
 248           on program_interrupt begin;
 249                local_data.brief_sw = true;
 250           end;
 251 
 252 /*        Obtain grammar segment.       */
 253           call get_name (0, 1, n, args);
 254           if name (1) = ""
 255           then do;
 256                call com_err_ (lalr_error_table_$no_grammar_given, command_name);
 257                return;
 258           end;
 259           call expand_pathname_$component (name (1), local_data.lalr.dname, entryname, component_name, code);
 260           if code ^= 0
 261           then do;
 262                call com_err_ (code, command_name, "^a", name (1));
 263                return;
 264           end;
 265           local_data.lalr.dname = get_shortest_path_ (local_data.lalr.dname);
 266           local_data.lalr.suffix = "";
 267           i = length (rtrim (entryname));
 268           if component_name = ""
 269           then do;
 270                if i > 5 then
 271                     if substr (entryname, i - 4, 5) = ".lalr" then
 272                          i = i - 5;
 273                if i > 4 then
 274                     if substr (entryname, i - 3, 4) = ".lrk" then
 275                          i = i - 4;
 276                local_data.lalr.ename = substr (entryname, 1, i);
 277                local_data.lalr.cname = "";
 278                if substr (entryname, 1, i) ^= entryname then
 279                     local_data.lalr.suffix = substr (entryname, i + 1);
 280           end;
 281           else do;
 282                local_data.lalr.ename = substr (entryname, 1, i);
 283                i = length (rtrim (component_name));
 284                if i > 5 then
 285                     if substr (component_name, i - 4, 5) = ".lalr" then
 286                          i = i - 5;
 287                if i > 4 then
 288                     if substr (component_name, i - 3, 4) = ".lrk" then
 289                          i = i - 4;
 290                local_data.lalr.cname = substr (component_name, 1, i);
 291                if substr (component_name, 1, i) ^= component_name then
 292                     local_data.lalr.suffix = substr (component_name, i + 1);
 293           end;
 294 
 295 /*        Initialize segments.          */
 296           call lalr_io_utility_$open (static_data_ptr, lalr_file, failed);
 297           if failed then
 298                return;
 299           if local_data.lalr.cname = "" then
 300                statistics.segment_name, entryname = local_data.lalr.ename || local_data.lalr.suffix;
 301           else do;
 302                entryname = local_data.lalr.cname || local_data.lalr.suffix;
 303                statistics.segment_name = local_data.lalr.ename;
 304                substr (statistics.segment_name, length (local_data.lalr.ename) - 7, 2) = "::";
 305                substr (statistics.segment_name, length (local_data.lalr.ename) - 5) = entryname;
 306           end;
 307           unspec (grammar_part) = ""b;
 308           grammar_part.parse.position, grammar_part.parse.line = 1;
 309           grammar_part.parse.length, input_length = local_data.file_length (lalr_f);
 310           input_pointer = local_data.file_pointer (lalr_f);
 311           call disect;
 312 
 313 /* Process options from command line.  Reset same options specified in source. */
 314           call process_args (options_list, n, args);
 315           i = 0;
 316           if local_data.asm_sw then
 317                i = i + 1;
 318           if local_data.ada_sil_sw then
 319                i = i + 1;
 320           if local_data.c_sw then
 321                i = i + 1;
 322           if i > 1
 323           then do;
 324                call com_err_ (lalr_error_table_$l6_dpda_bad_controls, command_name);
 325                go to FINI;
 326           end;
 327           if ^origin_sw then
 328                local_data.origin_zero_sw = local_data.c_sw;
 329           if local_data.separate_semantics_sw
 330           then do;
 331                local_data.sem_sw = false;
 332                name (2) = "";
 333           end;
 334           else if local_data.sem_sw
 335           then do;
 336                if name (2) = "" then
 337                     name (2) = "=_s.incl.pl1";
 338                call expand (2, local_data.sem.dname, local_data.sem.ename, local_data.sem.suffix);
 339                if local_data.sem.suffix = ".incl" then
 340                     local_data.sem.suffix = ".incl.pl1";
 341                do i = 1 to hbound (sem_suffix, 1) while (local_data.sem.suffix ^= sem_suffix (i));
 342                end;
 343                if i > hbound (sem_suffix, 1)
 344                then do;
 345                     call com_err_ (lalr_error_table_$bad_semantics_suffix, command_name, """^a""", local_data.sem.suffix);
 346                     goto FINI;
 347                end;
 348                call lalr_io_utility_$open (static_data_ptr, sem_file, failed);
 349                if failed then
 350                     go to FINI;
 351           end;
 352           if local_data.tl_sw | local_data.vl_sw | local_data.alm_sw
 353                | local_data.gmap_sw | local_data.asm_sw | local_data.ada_sil_sw | local_data.c_sw
 354           then do;
 355                if name (3) = "" then
 356                     name (3) = "=_t.incl.pl1";
 357                call expand (3, local_data.table.dname, local_data.table.ename, local_data.table.suffix);
 358           end;
 359                                                             /* Set list_sw if list for anything specified. */
 360           local_data.list_sw =
 361                local_data.dpda_sw | local_data.sor_sw | local_data.sym_sw | local_data.term_sw | local_data.controls_sw;
 362           if local_data.nd_sw
 363           then do;
 364                call lalr_io_utility_$open_i (static_data_ptr, result_file, failed);
 365                if failed then
 366                     goto FINI;
 367                call lalr_io_utility_$open (static_data_ptr, productions_files, failed);
 368                if failed then
 369                     goto FINI;
 370                if local_data.separate_semantics_sw
 371                then do;
 372                     call lalr_io_utility_$open (static_data_ptr, actions_files, failed);
 373                     if failed then
 374                          goto FINI;
 375                end;
 376                if local_data.list_sw
 377                then do;
 378                     call lalr_io_utility_$open (static_data_ptr, L_and_states_files, failed);
 379                     if failed then
 380                          goto FINI;
 381                end;
 382           end;
 383           else do;
 384                call lalr_io_utility_$open (static_data_ptr, result_file, failed);
 385                if failed then
 386                     goto FINI;
 387                call lalr_io_utility_$open (static_data_ptr, all_files, failed);
 388                if failed then
 389                     goto FINI;
 390           end;
 391           if local_data.list_sw
 392           then do;
 393                call lalr_io_utility_$open (static_data_ptr, lalrlist_file, failed);
 394                if failed then
 395                     goto FINI;
 396           end;
 397 
 398           lalr_severity_ = 0;
 399           call ioa_$nnl ("LALR ^a^/", vers.lalr);
 400 
 401           if local_data.list_sw then
 402                call list_1;
 403 %page;
 404 /*        Set on conditions.            */
 405           on cleanup call cleaner;
 406           on lalr_fatal
 407                begin;
 408                if local_data.print_data.error_linelength > 0 then
 409                     call lalr_print_ (static_data_ptr, "n", "");
 410                call com_err_ (error_table_$translation_aborted, command_name);
 411                lalr_severity_ = 4;
 412                goto FINI;
 413           end;
 414 ^L
 415 /* Translate the grammar.               */
 416           call hcs_$get_process_usage (addr (statistics.usage (1)), code);
 417                                                             /* grammar -> productions_list unclassified_symbols_list
 418                                                                symbol_characters [semantics -> X[.suffix]] */
 419           call lalr_parse_grammar_ (static_data_ptr, input_part_ptr);
 420           if local_data.sem_sw then
 421                call lalr_io_utility_$close (static_data_ptr, sem_file);
 422           call hcs_$get_process_usage (addr (statistics.usage (2)), code);
 423           if local_data.nd_sw
 424           then do;
 425                result_ptr = local_data.file_pointer (result_f);
 426                if header_2.version < 1 | header_2.version > lalr_result_version_3 then
 427                     call lalr_print_ (static_data_ptr, "n", "n", lalr_error_table_$unable_to_check_for_change);
 428                else do;
 429                     n = min (1, header_2.version - 1);
 430                     productions_list_ptr = local_data.file_pointer (productions_list_f);
 431                     productions_list_size = local_data.file_length (productions_list_f);
 432                     if productions_list_size ^= header_2.productions then
 433                          call lalr_print_ (static_data_ptr, "Nn", "Nn", lalr_error_table_$prod_count_changed,
 434                               header_2.productions - 1, productions_list_size - 1);
 435                     else do;
 436                          old_productions_list_ptr = addrel (result_ptr, header_2.productions_list_offset + n);
 437                          if unspec (old_productions_list_ptr -> productions_list) ^= unspec (productions_list) then
 438                               call lalr_print_ (static_data_ptr, "Nn", "Nn", lalr_error_table_$grammar_changed);
 439                     end;
 440                     i = header_2.standard_prelude_offset + n;
 441                     if i <= 0
 442                     then do;
 443                          old_standard_prelude_ptr = addr (null_string); old_standard_prelude_length = 0;
 444                     end;
 445                     else do;
 446                          old_standard_prelude_ptr = addrel (result_ptr, i);
 447                          old_standard_prelude_length = header_2.standard_prelude_length;
 448                     end;
 449                     if grammar_part.prelude.position = 0
 450                     then do;
 451                          new_standard_prelude_ptr = addr (null_string); new_standard_prelude_length = 0;
 452                     end;
 453                     else do;
 454                          new_standard_prelude_ptr = addr (substr (input, grammar_part.prelude.position, 1));
 455                          new_standard_prelude_length = grammar_part.prelude.length;
 456                     end;
 457                     if old_standard_prelude ^= new_standard_prelude then
 458                          call lalr_print_ (static_data_ptr, "Nn", "Nn", lalr_error_table_$prelude_changed);
 459                end;
 460           end;
 461           else begin;
 462 dcl  standard_prelude              char (grammar_part.prelude.length) defined (input) position (grammar_part.prelude.position);
 463                                                             /* productions_list unclassified_symbols_list
 464                                                                symbol_characters -> symbols_list variables_hash_list
 465                                                                variables_list variable_characters terminals_hash_list
 466                                                                terminals_list terminal_characters symbol_attributes */
 467                call lalr_classify_symbols_
 468                     (static_data_ptr, input_part_ptr, eoi_symbol, error_terminals, error_terminals_count);
 469                call hcs_$get_process_usage (addr (statistics.usage (3)), code);
 470                                                             /* productions_list variable_list -> backpointers */
 471                call lalr_make_backpointers_ (static_data_ptr);
 472                call hcs_$get_process_usage (addr (statistics.usage (4)), code);
 473                                                             /* productions_list symbols_list symbol_attributes variables_list
 474                                                                backpointers -> set configuration symbol_attributes */
 475                call lalr_make_lr0_cfsm_ (static_data_ptr, num_inad);
 476                call hcs_$get_process_usage (addr (statistics.usage (5)), code);
 477                if num_inad > 0
 478                then do;                                     /* productions_list set configuration symbols_list ->
 479                                                                set configuration */
 480                     local_data.db_make_vtr_table = local_data.db_make_vtr_table_1;
 481                     call lalr_make_vtr_table_ (static_data_ptr);
 482                     call hcs_$get_process_usage (addr (statistics.usage (6)), code);
 483                     call lalr_remove_inadequacies_ (static_data_ptr);
 484                     call hcs_$get_process_usage (addr (statistics.usage (7)), code);
 485                end;
 486                                                             /* set configuration -> states transitions */
 487                local_data.db_make_vtr_table = local_data.db_make_vtr_table_2;
 488                call lalr_make_vtr_table_ (static_data_ptr);
 489                call hcs_$get_process_usage (addr (statistics.usage (8)), code);
 490                call lalr_make_dpda_ (static_data_ptr);
 491                call hcs_$get_process_usage (addr (statistics.usage (9)), code);
 492                                                             /* Reset marked terminal values negative (in transitions). */
 493                if marked_symbol_length > 0 then
 494                     n = mark_val ();
 495                else n = 0;
 496                if local_data.opt_sw
 497                then do;                                     /* states transitions -> states transitions */
 498                     call lalr_optimize_ (static_data_ptr, n);
 499                     call hcs_$get_process_usage (addr (statistics.usage (10)), code);
 500                end;
 501                                                             /* states transitions -> dpda || skip || default_transitions */
 502                call lalr_compress_dpda_ (static_data_ptr, n, error_terminals, error_terminals_count);
 503                call hcs_$get_process_usage (addr (statistics.usage (11)), code);
 504                                                             /* dpda skip variables_hash_list variables_list
 505                                                                variable_characters terminals_hash_list terminals_list
 506                                                                terminal_characters production_names standard_prelude
 507                                                                productions_list symbols_list -> result */
 508                call lalr_make_result_ (static_data_ptr, options_list, fp, standard_prelude);
 509                call hcs_$get_process_usage (addr (statistics.usage (12)), code);
 510                if local_data.table.ename ^= ""
 511                then do;                                     /* dpda skip standard_prelude
 512                                                                [terminals_list terminal_characters [terminals_hash_list]]
 513                                                                [production_names [variables_list variable_characters]]
 514                                                                -> outputs */
 515                     call lalr_make_table_$lalr_entrypoint (static_data_ptr);
 516                     call hcs_$get_process_usage (addr (statistics.usage (13)), code);
 517                end;
 518           end;
 519                                                             /* count, symbols, unconnected variables, terminals -> list */
 520           if local_data.count_sw | local_data.sym_sw | local_data.term_sw then
 521                call lalr_list_symbols_ (static_data_ptr);
 522           call hcs_$get_process_usage (addr (statistics.usage (14)), code);
 523           if local_data.dpda_sw
 524           then do;                                          /* dpda skip -> list */
 525                call lalr_list_dpda_ (static_data_ptr);
 526                call hcs_$get_process_usage (addr (statistics.usage (15)), code);
 527           end;
 528 FINI:
 529           if local_data.print_data.list_linelength > 0 then
 530                call lalr_print_ (static_data_ptr, "", "n");
 531           if local_data.print_data.error_linelength > 0 then
 532                call lalr_print_ (static_data_ptr, "n", "");
 533           if local_data.print_data.linelength > 0 then
 534                call lalr_print_ (static_data_ptr, "Un", "");
 535           call cleaner;
 536           if local_data.time_sw
 537           then do;
 538                time_iocb_ptr = iox_$user_output;
 539                if local_data.list_sw
 540                then do;
 541                     call lalr_io_utility_$open_iox_extend (static_data_ptr, lalrlist_file, failed);
 542                     if ^failed
 543                     then do;
 544                          time_iocb_ptr = local_data.file_pointer (lalrlist_f);
 545                          call ioa_$ioa_switch (time_iocb_ptr, "^|");
 546                     end;
 547                end;
 548                call time;
 549                if local_data.list_sw then
 550                     call lalr_io_utility_$close (static_data_ptr, lalrlist_file);
 551           end;
 552           return;
 553 
 554 cleaner: proc;
 555           call lalr_io_utility_$close (static_data_ptr, lalr_and_result_files);
 556           call lalr_io_utility_$close (static_data_ptr, all_files);
 557           if local_data.file_length (lalrlist_f) > 0 then
 558                call lalr_io_utility_$close (static_data_ptr, lalrlist_file);
 559           call hcs_$get_process_usage (addr (statistics.usage (16)), code);
 560           unspec (saved_statistics) = unspec (statistics);
 561           return;
 562      end cleaner;
 563 ^L
 564 times: entry;
 565           if saved_statistics.cpu_time (0) = 0
 566           then do;
 567                call ioa_ ("No times available.");
 568                return;
 569           end;
 570           unspec (statistics) = unspec (saved_statistics);
 571           time_iocb_ptr = iox_$user_output;
 572           call time;
 573           return;
 574 time: proc;
 575 dcl  phase_name                    (16) char (19) unaligned internal static options (constant) init (
 576                                    "setup",
 577                                    "parse_grammar",
 578                                    "classify_symbols",
 579                                    "make_back_pointers",
 580                                    "make_lr0_cfsm",
 581                                    "make_vtr_table_1",
 582                                    "remove_inadequacies",
 583                                    "make_vtr_table_2",
 584                                    "make_dpda",
 585                                    "optimize",
 586                                    "compress_dpda",
 587                                    "make_result",
 588                                    "make_table",
 589                                    "list_symbols",
 590                                    "list_dpda",
 591                                    "wrapup");
 592 dcl  1 total                       like process_usage;
 593 dcl  1 usage                       like process_usage;
 594           if statistics.cpu_time (0) = 0 then
 595                return;
 596           do i = 1 to hbound (statistics.usage, 1);
 597                if statistics.cpu_time (i) = 0 then
 598                     unspec (statistics.usage (i)) = unspec (statistics.usage (i - 1));
 599           end;
 600           total = statistics.usage (hbound (statistics.usage, 1)) - statistics.usage (0);
 601           call ioa_$ioa_switch (time_iocb_ptr, "^/Segment ^a was processed by ^a on ^a",
 602                statistics.segment_name, command_name, statistics.date_time);
 603           call ioa_$ioa_switch (time_iocb_ptr, "^/Multics ^a, load ^.1f/^.1f; ^d users, ^d interactive, ^d daemons.",
 604                statistics.sysid, divide (statistics.n_units, 10, 35, 18), divide (statistics.mxunits, 10, 35, 28),
 605                statistics.n_users, statistics.n_users - statistics.abs_users - statistics.n_daemons, statistics.n_daemons);
 606           call ioa_$ioa_switch (time_iocb_ptr, "Absentee users ^d/^d^/", statistics.max_abs_users, statistics.abs_users);
 607           call ioa_$ioa_switch (time_iocb_ptr, "^38xVCPU MEMORY^6xFAULTS^8xVTOC   VTOC
 608 PHASE^18xCPU TIME       TIME  UNITS  PAGE   SEG BOUND READS WRITES");
 609           do i = 1 to hbound (statistics.usage, 1);
 610                usage = statistics.usage (i) - statistics.usage (i - 1);
 611                call ioa_$ioa_switch (time_iocb_ptr, "^19a^7.3f ^6.2f% ^7.3f^7d^6d^6d^6d^6d^7d", phase_name (i),
 612                     float (usage.cpu_time) / 1.0e6, 1.0e2 * (float (usage.cpu_time) / float (total.cpu_time)),
 613                     float (usage.virtual_cpu_time) / 1.0e6,
 614                     usage.paging_measure, usage.page_faults, usage.segment_faults,
 615                     usage.bounds_faults, usage.vtoc_reads, usage.vtoc_writes);
 616           end;
 617           call ioa_$ioa_switch (time_iocb_ptr, "Total^14x^7.3f 100.00% ^7.3f^7d^6d^6d^6d^6d^7d",
 618                float (total.cpu_time) / 1.0e6, float (total.virtual_cpu_time) / 1.0e6,
 619                total.paging_measure, total.page_faults, total.segment_faults,
 620                total.bounds_faults, total.vtoc_reads, total.vtoc_writes);
 621           return;
 622      end time;
 623 ^L
 624 get_name: proc (i, v, nargs, args);
 625 dcl  next_arg                      char (args.length (i + 1)) based (args.pointer (i + 1));
 626 dcl  i                             fixed bin parameter;
 627 dcl  nargs                         fixed bin parameter;
 628 dcl  v                             fixed bin parameter;
 629 
 630 dcl  1 args                        (200) parameter,
 631        2 pointer                   ptr,
 632        2 length                    fixed bin (21);
 633           if i < nargs then
 634                if substr (next_arg, 1, 1) ^= "-"
 635                then do;
 636                     name (v) = next_arg;
 637                     i = i + 1;
 638                     return;
 639                end;
 640           name (v) = "";
 641           return;
 642      end get_name;
 643 ^L
 644 list_1: proc;
 645 dcl  installation_id               char (32);
 646 dcl  length                        builtin;
 647 dcl  line_length                   fixed bin (21);
 648 dcl  line_number                   fixed decimal (5);
 649 dcl  1 line_prefix                 unaligned,
 650        2 filler_1                  char (3),
 651        2 formatted_line_number     picture "zzzzz",
 652        2 filler_2                  char (12);
 653 dcl  line_prefix_string            char (20) defined (line_prefix);
 654 dcl  next_character                fixed bin (21);
 655 dcl  segment_name                  char (32);
 656 dcl  system_info_$installation_id  entry (char (*));
 657           local_data.print_data.indent = 24;
 658           if length (local_data.lalr.cname) = 0 then
 659                segment_name = local_data.lalr.ename;
 660           else segment_name = local_data.lalr.cname;
 661           call lalr_print_ (static_data_ptr, "", "Tn", "GENERATION LISTING OF SEGMENT ", segment_name);
 662           call lalr_print_ (static_data_ptr, "", "T", "Generated by: ", local_data.user_id);
 663           call lalr_print_ (static_data_ptr, "", "x", " using LALR ", vers.lalr);
 664           call lalr_print_ (static_data_ptr, "", "n", " of ", date);
 665           call system_info_$installation_id (installation_id);
 666           call lalr_print_ (static_data_ptr, "", "Tn", "Generated at: ", installation_id);
 667           call lalr_print_ (static_data_ptr, "", "Tn", "Generated on: ", local_data.date_time);
 668           call lalr_print_ (static_data_ptr, "", "Tn", "     Options: ", options_list);
 669           if length (fp) > 0 then
 670                call lalr_print_ (static_data_ptr, "", "Tn", "File options: ", fp);
 671           call lalr_print_ (static_data_ptr, "", "n");
 672           local_data.print_data.indent = 0;
 673           if local_data.controls_sw
 674           then do;
 675                next_character = 1; line_number = 0;
 676                line_prefix_string = "";
 677                do while (next_character < grammar_part.parse.position);
 678                     line_length =
 679                          index (substr (input, next_character, grammar_part.parse.position - next_character), NL) - 1;
 680                     if line_length < 0 then
 681                          line_length = grammar_part.parse.position - next_character;
 682                     formatted_line_number, line_number = line_number + 1;
 683                     begin;
 684 dcl  control_line                  char (line_length) defined (input) position (next_character);
 685                          call lalr_print_ (static_data_ptr, "", "n", line_prefix_string, control_line);
 686                     end;
 687                     next_character = next_character + line_length + 1;
 688                end;
 689           end;
 690           return;
 691      end list_1;
 692 ^L
 693 disect: proc;
 694 
 695 /*        Process the option parmeters in the lalr source segment.
 696    ^O     Note -parse must precede the grammar and is the final option.
 697 */
 698 dcl  lalr_get_symbol_              entry (ptr, ptr);
 699 dcl  T                             char (400);
 700 dcl  input                         char (x.input_length) based (x.input_pointer);
 701 dcl  length                        builtin;
 702 dcl  newline                       char (1) internal static options (constant) init ("
 703 ");
 704 dcl  nargs                         fixed bin;
 705 dcl  1 args                        (200),
 706        2 pointer                   ptr,
 707        2 length                    fixed bin (21);
 708 dcl  1 x                           aligned like get_symbol_data;
 709 %include lalr_get_symbol;
 710           get_symbol_data_ptr = addr (x);
 711           x.T_pointer = addr (T);
 712           x.input_pointer = local_data.file_pointer (lalr_f);
 713           x.input_length = local_data.file_length (lalr_f);
 714           x.next_newline_pos = 0;
 715           x.file, x.line = 0;
 716           x.next_char_pos = 1;
 717           x.print_diagnostics = false;
 718           nargs = 1;
 719           call lalr_get_symbol_ (static_data_ptr, get_symbol_data_ptr);
 720           if x.first_char_pos ^= x.column_one_pos | substr (T, 1, 1) ^= "-" then
 721                return;
 722           do while (x.first_char_pos <= length (input));
 723                if substr (T, 1, x.T_length) = "-order"
 724                then do;
 725                     fp = fp || "-order ";
 726                     grammar_part.order.position = x.next_char_pos;
 727                     grammar_part.order.line = x.line;
 728                     call find_next_control;
 729                     grammar_part.order.length = x.first_char_pos - grammar_part.order.position;
 730                end;
 731                else if substr (T, 1, x.T_length) = "-recover"
 732                then do;
 733                     fp = fp || "-recover ";
 734                     grammar_part.recover.position = x.next_char_pos;
 735                     grammar_part.recover.line = x.line;
 736                     call find_next_control;
 737                     grammar_part.recover.length = x.first_char_pos - grammar_part.recover.position;
 738                end;
 739                else if substr (T, 1, x.T_length) = "-parse"
 740                then do;
 741                     grammar_part.parse.position = x.next_char_pos;
 742                     grammar_part.parse.line = x.line;
 743                     call process_args (fp, nargs, args);
 744                     return;
 745                end;
 746                else if substr (T, 1, x.T_length) = "-prelude"
 747                then do;
 748                     fp = fp || "-prelude ";
 749                     grammar_part.prelude.position = x.next_char_pos;
 750                     if substr (input, grammar_part.prelude.position, 1) = newline then
 751                          grammar_part.prelude.position = grammar_part.prelude.position + 1;
 752                     grammar_part.prelude.line = x.line;
 753                     call find_next_control;
 754                     grammar_part.prelude.length = x.first_char_pos - grammar_part.prelude.position;
 755                end;
 756                else if substr (T, 1, x.T_length) = "-synonyms"
 757                then do;
 758                     fp = fp || "-synonyms ";
 759                     grammar_part.synonym.position = x.next_char_pos;
 760                     grammar_part.synonym.line = x.line;
 761                     call find_next_control;
 762                     grammar_part.synonym.length = x.first_char_pos - grammar_part.synonym.position;
 763                     local_data.syn_sw = true;
 764                end;
 765                else do;
 766 queue_argument:                                             /* Set next args entry. */
 767                     nargs = nargs + 1;
 768                     args.pointer (nargs) = addr (substr (input, x.first_char_pos, 1));
 769                     args.length (nargs) = x.length;
 770                     call lalr_get_symbol_ (static_data_ptr, get_symbol_data_ptr);
 771                     if x.first_char_pos <= length (input) then
 772                          if x.first_char_pos ^= x.column_one_pos | substr (T, 1, 1) ^= "-" then
 773                               go to queue_argument;
 774                end;
 775           end;
 776           call com_err_ (lalr_error_table_$no_bnf, command_name);
 777           go to FINI;
 778 find_next_control: proc;
 779                do while (true);
 780                     call lalr_get_symbol_ (static_data_ptr, get_symbol_data_ptr);
 781                     if x.first_char_pos > length (input) then
 782                          return;
 783                     if x.first_char_pos = x.column_one_pos then
 784                          if substr (T, 1, 1) = "-" then
 785                               return;
 786                end;
 787           end find_next_control;
 788      end disect;
 789 ^L
 790 expand: proc (v, dname, ename, suffix);
 791 dcl  dname                         char (168) parameter;
 792 dcl  ename                         char (32) varying parameter aligned;
 793 dcl  equal_name                    char (32);
 794 dcl  expand_pathname_              entry (char (*), char (*), char (*), fixed bin (35));
 795 dcl  get_equal_name_               entry (char (*), char (*), char (32), fixed bin (35));
 796 dcl  i                             fixed bin;
 797 dcl  suffix                        char (32) varying parameter aligned;
 798 dcl  target_name                   char (32);
 799 dcl  v                             fixed bin parameter;
 800 
 801 dcl  def_sfx                       (2:3) char (32) varying internal static options (constant) init (
 802                                    ".pl1",                  /* -sem */
 803                                    ".incl.pl1");            /* -table */
 804           call expand_pathname_ (name (v), dname, equal_name, code);
 805           if code ^= 0
 806           then do;
 807                call com_err_ (code, command_name, "^a", name (v));
 808                goto FINI;
 809           end;
 810           call get_equal_name_ (entryname, equal_name, target_name, code);
 811           if code ^= 0
 812           then do;
 813                call com_err_ (code, command_name, "^a", name (v));
 814                go to FINI;
 815           end;
 816           i = 32 - index (reverse (target_name), ".");
 817           if i = 32
 818           then do;
 819                                                             /* Supply default suffix. */
 820                ename = rtrim (target_name);
 821                suffix = def_sfx (v);
 822           end;
 823           else do;
 824                                                             /* Caller supplied suffix. */
 825                if i > 5 then
 826                     if substr (target_name, i - 4, 5) = ".incl" then
 827                          i = i - 5;
 828                ename = substr (target_name, 1, i);
 829                suffix = rtrim (substr (target_name, i + 1));
 830           end;
 831           return;
 832      end expand;
 833 ^L
 834 mark_val: proc returns (fixed bin);
 835 dcl  lalr_error_table_$marked_symbol_not_defined fixed bin (35) external static;
 836 dcl  n                             fixed bin;
 837           terminals_hash_list_ptr = local_data.file_pointer (terminals_hash_list_f);
 838           terminals_hash_list_size = local_data.file_length (terminals_hash_list_f);
 839           terminals_list_ptr = local_data.file_pointer (terminals_list_f);
 840           terminals_list_size = local_data.file_length (terminals_list_f);
 841           terminal_characters_ptr = local_data.file_pointer (terminal_characters_f);
 842           terminal_characters_length = local_data.file_length (terminal_characters_f);
 843           n = terminals_hash_list (lalr_hash_ (marked_symbol, terminals_hash_list_size));
 844           do while (n > 0);
 845                if marked_symbol_length = terminals_list.length (n) then
 846                     if marked_symbol =
 847                          substr (terminal_characters, terminals_list.position (n), marked_symbol_length) then
 848                                                             /* Encoded value of mark found. */
 849                          return (n);
 850                                                             /* Link to next entry. */
 851                n = terminals_list.link (n);
 852           end;
 853                                                             /* Marked terminal not in language. */
 854           call lalr_print_ (static_data_ptr, "n", "n", lalr_error_table_$marked_symbol_not_defined, marked_symbol);
 855           return (0);
 856 
 857 %include lalr_hash_;
 858      end mark_val;
 859 ^L
 860 process_args: proc (options_list, nargs, args);
 861                                                             /* Process the parameters (arguments). */
 862 dcl  1 args                        (200) parameter,
 863        2 pointer                   ptr,
 864        2 length                    fixed bin (21);
 865 dcl  error_table_$badopt           fixed bin (35) external static;
 866 dcl  f                             fixed bin;
 867 dcl  i                             fixed bin;
 868 dcl  l                             fixed bin;
 869 dcl  length                        builtin;
 870 dcl  m                             fixed bin;
 871 dcl  nargs                         fixed bin parameter;
 872 dcl  next_parameter                char (args (i + 1).length) based (args (i + 1).pointer);
 873 dcl  options_list                  char (256) varying parameter;
 874           do i = 2 to nargs;
 875                parameter_pointer = args.pointer (i);
 876                parameter_length = args.length (i);
 877                if substr (parameter, 1, 1) = "-"
 878                then do;
 879                                                             /*        Search the options name table. */
 880                     options_list = options_list || parameter;
 881                     options_list = options_list || " ";
 882                     f = 1;
 883                     l = hbound (keyword, 1);
 884                     do while (f <= l);
 885                          m = divide (f + l, 2, 17, 0);
 886                          if parameter < keyword.name (m) then
 887                               l = m - 1;
 888                          else if parameter > keyword.name (m) then
 889                               f = m + 1;
 890                          else do;
 891                               v = keyword.value (m);
 892                               goto option (v);
 893                          end;
 894                     end;
 895                                                             /*        parameter not a known option. */
 896                     call com_err_
 897                          (lalr_error_table_$unrecognized_option, command_name, """^a""", parameter);
 898                     goto FINI;
 899 
 900 option (1):                                                 /* -alm */
 901 option (2):                                                 /* -gmap */
 902 option (6):                                                 /* -source */
 903 option (7):                                                 /* -symbols */
 904 option (8):                                                 /* -list */
 905 option (9):                                                 /* -terminals */
 906 option (12):                                                /* -terminals_list */
 907 option (16):                                                /* -count */
 908 option (20):                                                /* -asm */
 909 option (21):                                                /* -ada_sil */
 910 option (22):                                                /* -no_dpda */
 911 option (23):                                                /* -time */
 912 option (30):                                                /* -variables_list */
 913                                                             /* Set the appropriate bit. */
 914                     substr (string (local_data.options), v, 1) = true;
 915                     goto next_arg;
 916 option (3):                                                 /* -hash N */
 917                     local_data.hash_modulus = get_no (i, "-hash", 131071);
 918                     if local_data.hash_modulus <= 0
 919                     then do;
 920                          call com_err_ (lalr_error_table_$zero_hash_modulus, command_name);
 921                          goto FINI;
 922                     end;
 923                     goto next_arg;
 924 option (4):                                                 /* -max_look_ahead N */
 925                     local_data.multiple_lookahead.mla_max = get_no (i, "-max_look_ahead", 25);
 926                     goto next_arg;
 927 option (5):                                                 /* -mark TERM */
 928                     i = i + 1;
 929                     if i > nargs
 930                     then do;
 931                          call com_err_ (lalr_error_table_$missing_mark_terminal, command_name);
 932                          goto FINI;
 933                     end;
 934                     marked_symbol_pointer = args (i).pointer;
 935                     marked_symbol_length = args (i).length;
 936                     goto next_arg;
 937 option (11):                                                /* -ssl */
 938                     local_data.dpda_sw = true;
 939 option (10):                                                /* -ss  */
 940                     local_data.sor_sw, local_data.sym_sw = true;
 941                     goto next_arg;
 942 option (13):                                                /* -terminals_hash_list */
 943                     local_data.tl_sw, local_data.thl_sw = true;
 944                     go to next_arg;
 945 option (14):                                                /* -semantics [X[.suffix]] */
 946                     local_data.sem_sw = true;
 947                     call get_name (i, 2, nargs, args);
 948                     goto next_arg;
 949 option (15):                                                /* -table [X[.suffix]] */
 950                     local_data.tl_sw, local_data.thl_sw, local_data.vl_sw, local_data.prod_names_sw, local_data.syn_sw =
 951                          true;
 952                     call get_name (i, 3, nargs, args);
 953                     goto next_arg;
 954 option (19):                                                /* -long_source */
 955                     local_data.sor_sw, local_data.lgsc_sw = true;
 956                     go to next_arg;
 957 option (17):                                                /* -optimize */
 958                     local_data.opt_sw, local_data.opt_rd_sw, local_data.opt_lk_sw, local_data.opt_ap_sw = true;
 959                     goto next_arg;
 960 option (18):                                                /* -line_length N */
 961                     local_data.print_data.list_maxlength = get_no (i, "-line_length", 256);
 962                     goto next_arg;
 963 option (24):                                                /* -controls */
 964                     local_data.sor_sw, local_data.controls_sw = true;
 965                     goto next_arg;
 966 option (25):                                                /* -production */
 967                     local_data.prod_sw = true; local_data.rule_only_sw = false;
 968                     go to next_arg;
 969 option (26):                                                /* -page_length N */
 970                     local_data.print_data.page_length = get_no (i, "-page_length", 85);
 971                     goto next_arg;
 972 option (27):                                                /* -optimize_reads */
 973                     local_data.opt_sw, local_data.opt_rd_sw = true;
 974                     goto next_arg;
 975 option (28):                                                /* -optimize_applies */
 976                     local_data.opt_sw, local_data.opt_ap_sw = true;
 977                     goto next_arg;
 978 option (29):                                                /* -production_names */
 979                     local_data.prod_names_sw, local_data.vl_sw = true;
 980                     go to next_arg;
 981 option (31):                                                /* -dpda_xref */
 982                     local_data.dx_sw, local_data.dpda_sw = true;
 983                     go to next_arg;
 984 option (32):                                                /* -optimize_looks */
 985                     local_data.opt_sw, local_data.opt_lk_sw = true;
 986                     goto next_arg;
 987 option (34):                                                /* -no_source */
 988 option (35):                                                /* -no_symbols */
 989 option (36):                                                /* -no_list */
 990 option (37):                                                /* -no_terminals */
 991 option (41):                                                /* -no_terminals_hash_list */
 992 option (44):                                                /* -no_count */
 993 option (47):                                                /* -no_long_source */
 994 option (48):                                                /* -no_asm */
 995 option (49):                                                /* -no_ada_sil */
 996 option (50):                                                /* -dpda */
 997 option (51):                                                /* -no_time */
 998 option (52):                                                /* -no_controls */
 999 option (57):                                                /* -no_production_names */
1000 option (59):                                                /* -no_dpda_xref */
1001                                                             /* Reset the appropriate bit. */
1002                     substr (string (local_data.options), v - 28, 1) = false;
1003                     go to next_arg;
1004 option (33):                                                /* -no_mark */
1005                     marked_symbol_length = 0;
1006                     go to next_arg;
1007 option (39):                                                /* -nssl */
1008                     local_data.dpda_sw = false;
1009 option (38):                                                /* -nss */
1010                     local_data.sym_sw, local_data.sor_sw = false;
1011                     go to next_arg;
1012 option (40):                                                /* -no_terminals_list */
1013                     local_data.thl_sw, local_data.tl_sw, local_data.syn_sw = false;
1014                     go to next_arg;
1015 option (55):                                                /* -no_optimize_reads */
1016                     local_data.opt_rd_sw = false;
1017                     go to next_arg;
1018 option (56):                                                /* -no_optimize_applies */
1019                     local_data.opt_ap_sw = false;
1020                     go to next_arg;
1021 option (58):                                                /* -no_variables_list */
1022                     local_data.prod_names_sw, local_data.vl_sw = false;
1023                     go to next_arg;
1024 option (60):                                                /* -no_optimize_looks */
1025                     local_data.opt_lk_sw = false;
1026                     go to next_arg;
1027 option (45):                                                /* -no_optimize */
1028                     local_data.opt_sw, local_data.opt_rd_sw, local_data.opt_ap_sw, local_data.opt_lk_sw = false;
1029                     go to next_arg;
1030 option (42):                                                /* -no_semantics */
1031                     local_data.sem_sw = false;
1032                     name (2) = "";
1033                     go to next_arg;
1034 option (43):                                                /* -no_table */
1035                     local_data.tl_sw, local_data.thl_sw, local_data.prod_names_sw, local_data.vl_sw, local_data.syn_sw =
1036                          false;
1037                     name (3) = "";
1038                     go to next_arg;
1039 option (46):                                                /* -no_alm */
1040                     local_data.alm_sw = false;
1041                     go to next_arg;
1042 option (53):                                                /* -rule */
1043                     local_data.prod_sw, local_data.rule_only_sw = false;
1044                     go to next_arg;
1045 option (54):                                                /* -no_gmap */
1046                     local_data.gmap_sw = false;
1047                     go to next_arg;
1048 option (61):                                                /* -no_semantics_header */
1049                     local_data.no_sem_hdr_sw = true;
1050                     go to next_arg;
1051 option (62):                                                /* -semantics_header */
1052                     local_data.no_sem_hdr_sw = false;
1053                     go to next_arg;
1054 option (63):                                                /* -separate_semantics */
1055                     local_data.separate_semantics_sw = true;
1056                     if i < nargs then
1057                          if substr (next_parameter, 1, 1) ^= "-" then
1058                               local_data.transfer_arg_number = get_no (i, "-separate_semantics", 255);
1059                     go to next_arg;
1060 option (64):                                                /* -embedded_semantics */
1061                     local_data.separate_semantics_sw = false;
1062                     local_data.transfer_arg_number = lalr_static_$default.transfer_arg_number;
1063                     go to next_arg;
1064 option (65):                                                /* -end_of_information */
1065                     local_data.no_eoi_sw = false;
1066                     if i < nargs then
1067                          if substr (next_parameter, 1, 1) ^= "-"
1068                          then do;
1069                               i = i + 1;
1070                               eoi_symbol_pointer = args (i).pointer;
1071                               eoi_symbol_length = args (i).length;
1072                          end;
1073                     go to next_arg;
1074 option (66):                                                /* -no_end_of_information */
1075                     local_data.no_eoi_sw = true;
1076                     go to next_arg;
1077 option (67):                                                /* -rule_only */
1078                     local_data.prod_sw = false; local_data.rule_only_sw = true;
1079                     go to next_arg;
1080 option (68):                                                /* -synonyms */
1081                     local_data.syn_sw, local_data.tl_sw = true;
1082                     go to next_arg;
1083 option (69):                                                /* -no_synonyms */
1084                     local_data.syn_sw = false;
1085                     go to next_arg;
1086 option (70):                                                /* -brief */
1087                     local_data.brief_sw = true;
1088                     go to next_arg;
1089 option (71):                                                /* -long */
1090                     local_data.brief_sw = false;
1091                     go to next_arg;
1092 option (72):                                                /* -c */
1093                     local_data.c_sw = true;
1094                     go to next_arg;
1095 option (73):                                                /* -no_c */
1096                     local_data.c_sw = false;
1097                     go to next_arg;
1098 option (74):                                                /* -origin */
1099                     origin_sw = true;
1100                     local_data.origin_zero_sw = (get_no (i, "-origin", 1) = 0);
1101                     go to next_arg;
1102 option (75):                                                /* -dps6_format */
1103                     local_data.hrs_fmt_sw = false;
1104                     go to next_arg;
1105 option (76):                                                /* -hrs_format */
1106                     local_data.hrs_fmt_sw = true;
1107                     go to next_arg;
1108                end;
1109                call com_err_ (error_table_$badopt, command_name, """^a""", parameter);
1110                goto FINI;
1111 next_arg:
1112           end;
1113           if length (options_list) > 0 then
1114                options_list = substr (options_list, 1, length (options_list) - 1);
1115           return;
1116 ^L
1117 get_no:   proc (i, w, m) returns (fixed bin);
1118                                                             /* Convert the i+1th parameter to fixed bin and return. */
1119 dcl  cv_dec_check_                 entry (char (*), fixed bin (35)) returns (fixed bin (35));
1120 dcl  i                             fixed bin parameter;
1121 dcl  m                             fixed bin parameter;
1122 dcl  v                             fixed bin;
1123 dcl  w                             char (*) parameter;
1124                i = i + 1;
1125                if i > nargs
1126                then do;
1127 bad_value:          call com_err_ (lalr_error_table_$no_argument_value, command_name, "(^a)", w);
1128                     goto FINI;
1129                end;
1130 
1131                parameter_pointer = args (i).pointer;
1132                parameter_length = args (i).length;
1133                if substr (parameter, 1, 1) = "-" then
1134                     go to bad_value;
1135                v = cv_dec_check_ (parameter, code);
1136                if code ^= 0 | v < 0
1137                then do;
1138                     call com_err_
1139                          (lalr_error_table_$not_positive_integer, command_name, "(^a ^a)", w, parameter);
1140                     go to FINI;
1141                end;
1142                if v > m
1143                then do;
1144                     call com_err_
1145                          (lalr_error_table_$arg_value_too_big, command_name, "(^a: ^d > ^d)", w, v, m);
1146                     go to FINI;
1147                end;
1148                options_list = options_list || parameter;
1149                options_list = options_list || " ";
1150                return (v);
1151           end get_no;
1152      end process_args;
1153 ^L
1154 dbn: entry;
1155           mv = true;
1156           my_name = "lalr$dbn";
1157           goto set_db;
1158 dbf: entry;
1159           mv = false;
1160           my_name = "lalr$dbf";
1161 dcl  mv                            bit (1);
1162 dcl  my_name                       char (8);
1163 dcl  sv                            char (argl) based (argp);
1164 dcl  sw_names                      (15) char (20) unaligned internal static options (constant) init (
1165                                    "parse_grammar",
1166                                    "classify_symbols",
1167                                    "make_backpointers",
1168                                    "make_lr0_cfsm",
1169                                    "remove_inadequacies",
1170                                    "make_dpda",
1171                                    "compress_dpda",
1172                                    "list_symbols",
1173                                    "io_utility",
1174                                    "make_skip_table",
1175                                    "make_table",
1176                                    "optimize",
1177                                    "make_vtr_table",
1178                                    "make_vtr_table_1",
1179                                    "make_vtr_table_2");
1180 dcl  sw_numbers                    (15) fixed bin internal static options (constant) init (
1181                                    1, 2, 3, 4, 5, 6, 7, 8, 10, 13, 14, 19, 20, 11, 12);
1182 set_db:
1183           call cu_$arg_ptr (1, argp, argl, code);
1184           if code = 0
1185           then do;
1186                if substr (sv, argl, 1) = "_" then
1187                     argl = argl - 1;
1188                if argl > 5 then
1189                     if substr (sv, 1, 5) = "lalr_"
1190                     then do;
1191                          argp = addr (substr (sv, 6, 1));
1192                          argl = argl - 5;
1193                     end;
1194                do i = 1 to hbound (sw_names, 1);
1195                     if sw_names (i) = sv
1196                     then do;
1197                          if sw_numbers (i) = 20 then
1198                               dbs (11), dbs (12) = mv;
1199                          else dbs (sw_numbers (i)) = mv;
1200                          return;
1201                     end;
1202                end;
1203           end;
1204           call com_err_ (code, my_name, "Valid args:^(^4(^1x^a^)^/^-^)", sw_names);
1205           return;
1206 ^L
1207 lalr_rev:
1208 rev: entry;
1209           call ioa_ ("lalr:^- ^a", vers.lalr);
1210           call ioa_ ("scanner:^- ^a", vers.scanner);
1211           call ioa_ ("old_lalrp: ^a", vers.old_lalrp);
1212           call ioa_ ("new_lalrp: ^a", vers.new_lalrp);
1213           call ioa_ ("date:^-^a", date);
1214           return;
1215 ^L
1216 %include lalr_opts;
1217 %include lalr_static_;
1218 %include lalr_productions_list;
1219 %include lalr_result;
1220 %include whotab;
1221 %include access_mode_values;
1222      end lalr;