1 /* BEGIN PROCEDURE ..... scanner ..... 05/18/76 J Falksen
  2    UPDATED 08/04/76 D. Ward
  3    UPDATED 12/15/78, 01/05/78 P. Prange
  4    Modified: 28 March 85 - BW  Allow comments to contain the ::= symbol.
  5 */
  6 
  7 /* format: style4,indattr,idind30 */
  8 scanner: proc;
  9 dcl  T                             char (symbol_characters_length - T_pos + 1) defined (symbol_characters) position (T_pos);
 10 dcl  (addr, byte, length, rank)    builtin;
 11 dcl  k                             fixed bin (21);
 12 dcl  lalr_error_table_$bad_nonterminal_symbol fixed bin (35) external static;
 13 dcl  lalr_error_table_$bad_rule_name fixed bin (35) external static;
 14 dcl  lalr_error_table_$no_end_comment_delimiter fixed bin (35) external static;
 15 dcl  last_operator_index           fixed bin internal static options (constant) init (9);
 16 dcl  m                             fixed bin (21);
 17 
 18 /* :|<!='(/?\040\014\011\013\012 */
 19 dcl  operators_and_white_space     char (14) internal static options (constant) init (":|<!='(/? ^L ^K
 20 ");
 21                                                             /* '\040\014\011\013\012 */
 22 dcl  white_space                   char (5) internal static options (constant) init (" ^L ^K
 23 ");
 24 dcl  operators_white_space_or_dollar char (15) internal static options (constant) init (":|<!='(/?$ ^L        ^K
 25 ");
 26 dcl  white_space_or_escape         char (6) internal static options (constant) init ("' ^L          ^K
 27 ");
 28 
 29 /*
 30    Symbol used in
 31    lalr_parse_grammar_.lalr   return    Type of LALR symbol
 32    ========================   ======    ==================
 33 
 34    EOI                        0         End of Information
 35 
 36    ::=                        1         ::=
 37 
 38    |                          2         | (or symbol)
 39 
 40    <non-terminal symbol>      3         BNF variable         i.e., <   xxx   >
 41 
 42    <rule semantics>           4         LALR semantics       i.e., ! .. pl1 code ...  <varb> ::=
 43    ^O                                                        or ! => action <varb> ::=
 44 
 45    <production semantics>     5         LALR semantics       i.e., => action
 46 
 47    <terminal symbol>          6         terminal symbol      i.e.,  abc  x'60b => "x b"
 48 
 49 */
 50 MORE:
 51           if next_char_pos > next_newline_pos then
 52                if next_line ()
 53                then do;
 54                     stk.symbol (lookahead_put) = 0;         /* End Of Input. */
 55                     return;
 56                end;
 57           j = index (operators_and_white_space, substr (input, next_char_pos, 1));
 58           if j > last_operator_index
 59           then do;
 60                                                             /* White space. */
 61                                                             /* Count white space. */
 62                j = verify (substr (input, next_char_pos, next_newline_pos - next_char_pos), white_space) - 1;
 63                if j < 0 then
 64                     next_char_pos = next_newline_pos + 1;   /* All white space, use rest of line. */
 65                else next_char_pos = next_char_pos + j;      /* Otherwise, skip over white space. */
 66                goto MORE;
 67           end;
 68           stk.symbol (lookahead_put) = j;
 69           stk.symptr (lookahead_put) = addr (substr (input, next_char_pos, 1));
 70           stk.symlen (lookahead_put),
 71                stk.token_position (lookahead_put), stk.token_length (lookahead_put),
 72                stk.tag (lookahead_put) = 0;
 73           symbol_line_id.file = file_number;                /* Current input file number. */
 74           symbol_line_id.line = line_number;                /* Current input line number. */
 75           unspec (stk.line_id (lookahead_put)) = unspec (symbol_line_id);
 76           first_char_pos = next_char_pos;
 77           next_char_pos = next_char_pos + 1;
 78           go to LS (j);
 79 
 80 LS (1):                                                     /* Colon for possible "::=". */
 81           if substr (input, next_char_pos, 2) ^= ":=" then
 82                goto terminal;                               /* ":" is a terminal here. */
 83           next_char_pos = next_char_pos + 2;
 84           stk.symlen (lookahead_put) = 3;
 85           if production_name_last_applied
 86           then do;
 87                rule_fmt, rule_str, rule_num = rule_num + 1;
 88                print_last_line = 1;                         /* Start list of output. */
 89                                                             /* Format for print line. */
 90                if prod_sw then
 91                     l = productions_list_size;              /* Set up to print the production number. */
 92                else l = 1;                                  /* Set up to print the alternative number. */
 93                                                             /* Count white space. */
 94                j = verify (substr (input, next_char_pos, next_newline_pos - next_char_pos), white_space) - 1;
 95                if j < 0
 96                then do;
 97                     eoif = next_line ();                    /* All white space, use rest of line. */
 98                     stk.file (lookahead_put) = file_number;
 99                     stk.line (lookahead_put) = line_number;
100                end;
101                else next_char_pos = next_char_pos + j;      /* Otherwise, skip over white space. */
102                alternative_fmt = l;                         /* Print alternative/production number. */
103           end;
104           return;
105 
106 LS (2):                                                     /* Another production, named the same as the last production. */
107           stk.symlen (lookahead_put) = 1;
108           if prod_sw then
109                l = productions_list_size;                   /* Set up to print the production number. */
110           else l = Alt + 1;                                 /* Set up to print the alternative number. */
111                                                             /* Count white space. */
112           j = verify (substr (input, next_char_pos, next_newline_pos - next_char_pos), white_space) - 1;
113           if j < 0
114           then do;                                          /* All white space, use rest of line. */
115                eoif = next_line ();
116                stk.file (lookahead_put) = file_number;
117                stk.line (lookahead_put) = line_number;
118           end;
119           else next_char_pos = next_char_pos + j;           /* Otherwise, skip over white space. */
120           if string (alternative_fmt) = "" then
121                alternative_fmt = l;                         /* Print alternative/production number on this line. */
122           return;
123 
124 LS (3):                                                     /* Variable */
125           l = 0;
126           do while (next_char_pos <= length (input));
127                                                             /* Look for the ending ">". */
128                j = index (substr (input, next_char_pos, next_newline_pos - next_char_pos), ">");
129                if j = 0
130                then do;                                     /* ">" not in the current line. */
131                                                             /* Get another line. */
132                     if next_line ()
133                     then do;
134                          call PR (lalr_error_table_$bad_nonterminal_symbol);
135                                                             /* ">" not found at all. */
136                          l, stk.symbol (lookahead_put) = 0;
137                          return;
138                     end;
139                end;
140                else do;
141                     t = next_char_pos + j - 1;              /* Calculate position of the ending ">". */
142                     if substr (input, t - 1, 1) ^= "'"
143                     then do;                                /* Make sure its not escaped. */
144                          next_char_pos = first_char_pos;    /* Back up to the beginning. */
145                          do while (next_char_pos <= t);     /* Process the variable. */
146                               if substr (input, next_char_pos, 1) = "'" /* Test for an escape. */
147 
148                               then do;
149                                    l = l + 1;
150                                    substr (T, l, 1) = escape_value ();
151                               end;
152                               else do;                      /* Process non-escaped stuff. */
153                                                             /* Count white space. */
154                                    j = verify (substr (input, next_char_pos, t - next_char_pos + 1), white_space) - 1;
155                                    if j > 0
156                                    then do;                 /* Process white space. */
157                                         next_char_pos = next_char_pos + j;
158                                         if l > 1 & next_char_pos < t then
159                                              l = l + 1;
160                                         substr (T, l, 1) = " ";
161                                    end;
162                                    else do;                 /* Process black stuff. */
163                                         j = search (substr (input, next_char_pos, t - next_char_pos + 1),
164                                              white_space_or_escape) - 1;
165                                         if j < 0 then
166                                              j = t - next_char_pos + 1;
167                                                             /* Pick up the black stuff. */
168                                         substr (T, l + 1, j) = substr (input, next_char_pos, j);
169                                         l = l + j;
170                                         next_char_pos = next_char_pos + j;
171                                    end;
172                               end;
173                          end;
174                          stk.symlen (lookahead_put) = next_char_pos - first_char_pos;
175                          stk.token_position (lookahead_put) = T_pos;
176                          stk.token_length (lookahead_put) = l;
177                          T_pos = T_pos + l;
178                          return;
179                     end;
180                     next_char_pos = t + 1;                  /* Reset next_char_pos to find the next ">". */
181                end;
182           end;
183 
184 
185 LS (4):                                                     /* Rule semantics */
186           bang_sw = true;
187           stk.symlen (lookahead_put) = 1;
188           stk.token_position (lookahead_put) = 0;
189           if separate_semantics_sw
190           then do;
191                if prod_sw then
192                     return;
193                if ^next_token () then
194                     return;
195                if substr (input, next_char_pos, 2) ^= "=>" then
196                     return;
197                next_char_pos = next_char_pos + 2;
198                go to store_action_name;
199           end;
200           if sem_sw
201           then do;
202                                                             /* Copy the rule (through the "!") to the semantics segment. */
203                call put_semantics_file;
204                if pl1_sem | c_sem
205                then do;
206                     substr (sem, sem_seg_length + 1, 3) = " */";
207                     sem_seg_length = sem_seg_length + 3;
208                end;
209                else do;
210                     if substr (input, next_char_pos, 1) = newline then
211                          got = got + 1;
212                     substr (sem, sem_seg_length + 1, 1) = newline;
213                     sem_seg_length = sem_seg_length + 1;
214                end;
215           end;
216           if ^lgsc_sw then
217                print_last_line = 2;                         /* Indicate rule printing to end, "!" has been reached. */
218           first_char_pos, last_char_pos = next_char_pos;    /* Location of char after !. */
219           if substr (input, last_char_pos, 1) ^= newline then
220                last_char_pos = last_char_pos - 1;
221           semantic_sw = true;
222           significant_semantic = false;
223           eoif = false;                                     /* Set the flag to search for the next rule. */
224 look_for_next_rule:
225           do while (^eoif);
226                if next_char_pos > next_newline_pos then
227 get_next_line:
228                     eoif = next_line ();                    /* Current line is exhausted, get another. */
229                else do;                                     /* When the current line is not exhausted: */
230                                                             /* Count characters before next "::". */
231                     j = index (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1), "::") - 1;
232                     if j < 0 then
233                          j = next_newline_pos - next_char_pos + 1; /* If none, make like one was appended to the line. */
234                                                             /* Count characters before next question mark. */
235                     k = index (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1), "?") - 1;
236                     if k < 0 then
237                          k = next_newline_pos - next_char_pos + 1; /* If none, make like one was appended to the line. */
238 
239 /* Count characters before next "/*". */
240                     m = index (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1), "/*") - 1;
241                     if m >= 0 then do;
242                          if m < j then
243                               if m < k
244                               then do;                      /* The "/*" was first, skip over the comment. */
245                                    next_char_pos = next_char_pos + m + 2; /* Start by skipping over the "/*". */
246                                                             /* Look for ending delimiter. */
247                                    m = index (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1),
248                                         "*/");
249                                    do while (m = 0);        /* Until the delimiter is found, */
250                                         eoif = next_line ();/* get the next line. */
251                                         if ^eoif then
252                                                             /* If there was a next line, look for ending delimiter. */
253                                              m = index (substr (input, next_char_pos,
254                                                   next_newline_pos - next_char_pos + 1), "*/");
255                                         else do;            /* Otherwise, print error message. */
256                                              call lalr_print_ (static_data_ptr, "Un", "n",
257                                                   lalr_error_table_$ends_in_pl1_comment);
258                                              m = -1;
259                                         end;
260                                    end;
261                                                             /* Position just beyond the ending delimiter. */
262                                    next_char_pos = next_char_pos + m + 1;
263                                    go to look_for_next_rule;
264                               end;
265                     end;
266 
267                     else do;
268                                                             /* Count characters before next "(*". */
269                          m = index (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1), "(*") - 1;
270                          if m >= 0 then
271                               if m < j then
272                                    if m < k
273                                    then do;                 /* The "(*" was first, skip over the comment. */
274                                         next_char_pos = next_char_pos + m + 2; /* Start by skipping over the "(*". */
275                                                             /* Look for ending delimiter. */
276                                         m = index (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1),
277                                              "*)");
278                                         do while (m = 0);   /* Until the delimiter is found, */
279                                              eoif = next_line (); /* get the next line. */
280                                              if ^eoif then
281                                                             /* If there was a next line, look for ending delimiter. */
282                                                   m = index (substr (input, next_char_pos,
283                                                        next_newline_pos - next_char_pos + 1), "*)");
284                                              else do;       /* Otherwise, print error message. */
285                                                   call lalr_print_ (static_data_ptr, "Un", "n",
286                                                        lalr_error_table_$ends_in_pl1_comment);
287                                                   m = -1;
288                                              end;
289                                         end;
290                                                             /* Position just beyond the ending delimiter. */
291                                         next_char_pos = next_char_pos + m + 1;
292                                         go to look_for_next_rule;
293                                    end;
294                     end;
295 
296                     if ada_sil_sem
297                     then do;
298                                                             /* Count characters before next "--". */
299                          m = index (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1), "--") - 1;
300                          if m >= 0 then
301                               if m < j then
302                                    if m < k
303                                    then do;                 /* The "--" was first, */
304                                         next_char_pos = next_newline_pos + 1; /* Skip the rest of the line. */
305                                         go to get_next_line;
306                                    end;
307                     end;
308                     else if asm_sem
309                     then do;
310                                                             /* Find first character following the line number. */
311                          m = verify (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1), "0123456789");
312                          if m ^= 0 then
313                               if substr (input, next_char_pos + m - 1, 1) = "*"
314                               then do;                      /* This is a comment line, */
315                                    next_char_pos = next_newline_pos + 1; /* skip it. */
316                                    go to get_next_line;
317                               end;
318                     end;
319                     if k < j
320                     then do;
321                          next_char_pos = next_char_pos + k + 1; /* The question mark was first, position to the
322                                                                character following it and try for an include. */
323                          bit_box = include_macro ();
324                          eoif = false;
325                     end;
326                     else do;
327                          next_char_pos = next_char_pos + j;
328                          if next_char_pos < next_newline_pos
329                          then do;
330                                                             /* A "::" found, see if it makes a "::=". */
331                               if substr (input, next_char_pos - 1, 1) ^= "'" & substr (input, next_char_pos + 2, 1) = "="
332                               then do;
333                                                             /* "::=", the next rule is found. */
334                                    eoif = true;
335                                    do j = next_char_pos - 1 to first_char_pos by -1 while (substr (input, j, 1) ^= "<");
336                                                             /* Search backward for left of the variable. */
337                                    end;
338                                    if j < first_char_pos
339                                    then do;                 /* "<" is missing. We should go to next rule. */
340                                         call PR (lalr_error_table_$bad_rule_name);
341                                         next_char_pos = next_char_pos + 3; /* Reset next_char_pos to find next "::=" . */
342                                         eoif = false;       /* Reset the flag to go on. */
343                                    end;
344                                    else next_char_pos = j;  /* Set next_char_pos at beginning of next rule. */
345                               end;
346                               else do;                      /* It is not a "::=" , go on! */
347                                    next_char_pos = next_char_pos + 3; /* Reset next_char_pos to find "::=". */
348                               end;
349                          end;
350                     end;
351                end;
352           end;
353           call put_semantics_file;                          /* Copy the rest of the semantic to the semantics segment. */
354           semantic_sw = false;
355           if sem_sw
356           then do;
357                if pl1_sem | c_sem
358                then do;
359                     substr (sem, sem_seg_length + 1, 3) = "/* ";
360                     sem_seg_length = sem_seg_length + 3;
361                end;
362                else do;
363                     if substr (sem, sem_seg_length, 1) ^= newline
364                     then do;
365                          substr (sem, sem_seg_length + 1, 1) = newline;
366                          sem_seg_length = sem_seg_length + 1;
367                     end;
368                end;
369           end;
370           if significant_semantic then
371                                                             /* There are "significant" semantics. */
372                stk.token_position (lookahead_put) = 1;
373           return;
374 
375 
376 LS (5):                                                     /* Equal sign */
377           if ^separate_semantics_sw | ^prod_sw then
378                go to terminal;
379           if substr (input, next_char_pos, 1) ^= ">" then
380                go to terminal;
381           stk.symlen (lookahead_put) = 2;
382           next_char_pos = next_char_pos + 1;
383 
384 store_action_name:
385           if ^next_token () then
386                return;
387           first_char_pos = next_char_pos;
388           symbol_line_id.file = file_number;                /* Current input file number. */
389           symbol_line_id.line = line_number;                /* Current input line number. */
390           stk.token_position (lookahead_put) = name ();
391           if substr (input, next_char_pos, 1) = "$" then
392                go to read_entry_name;
393           stk.symptr (lookahead_put) = addr (substr (input, first_char_pos, 1));
394           stk.symlen (lookahead_put) = next_char_pos - first_char_pos;
395           unspec (stk.line_id (lookahead_put)) = unspec (symbol_line_id);
396           stk.token_length (lookahead_put) = stk.token_position (lookahead_put);
397           if ^next_token () then
398                return;
399           if substr (input, next_char_pos, 1) ^= ":" then
400                return;
401           if substr (input, next_char_pos + 1, 2) = ":=" then
402                return;
403           next_char_pos = next_char_pos + 1;
404           stk.tag (lookahead_put) = stk.token_position (lookahead_put);
405           stk.token_position (lookahead_put), stk.token_length (lookahead_put) = 0;
406           if ^next_token () then
407                return;
408           j = index (operators_and_white_space, substr (input, next_char_pos, 1));
409           if j ^= 0 then
410                if j ^= 6 then
411                     return;
412           if substr (input, next_char_pos, 3) = "::=" then
413                return;
414           first_char_pos = next_char_pos;
415           symbol_line_id.file = file_number;                /* Current input file number. */
416           symbol_line_id.line = line_number;                /* Current input line number. */
417           stk.token_position (lookahead_put) = name ();
418           if substr (input, next_char_pos, 1) ^= "$" then
419                stk.token_length (lookahead_put) = stk.token_position (lookahead_put);
420           else do;
421 read_entry_name:
422                next_char_pos = next_char_pos + 1;
423                stk.token_length (lookahead_put) = name ();
424           end;
425           stk.symptr (lookahead_put) = addr (substr (input, first_char_pos, 1));
426           stk.symlen (lookahead_put) = next_char_pos - first_char_pos;
427           unspec (stk.line_id (lookahead_put)) = unspec (symbol_line_id);
428           return;
429 
430 
431 
432 LS (0): terminal:
433           stk.symbol (lookahead_put) = 6;
434 LS (6):                                                     /* Apostrophe */
435           l = 0; next_char_pos = first_char_pos;
436           do while (next_char_pos <= length (input));
437                if substr (input, next_char_pos, 1) = "'"    /* Test for an escape. */
438                then do;
439                     l = l + 1;
440                     substr (T, l, 1) = escape_value ();
441                end;
442                else do;                                     /* Process non-escaped stuff. */
443                                                             /* Search for the terminating character. */
444                     j = search (substr (input, next_char_pos, next_newline_pos - next_char_pos + 1),
445                          operators_and_white_space) - 1;
446                     if j = 0 then                           /* If this character is a "(", ":", or "?" not part of */
447                          j = 1;                             /* a "(*", "::=", or "?include", pick it up. */
448                     else if j < 0 then
449                          j = next_newline_pos - next_char_pos + 1; /* If no terminating character found, use rest of line. */
450                                                             /* Pick up everything in front of terminating character. */
451                     substr (T, l + 1, j) = substr (input, next_char_pos, j);
452                     l = l + j;
453                     next_char_pos = next_char_pos + j;      /* Skip over the stuff just picked up. */
454                end;
455                                                             /* Continue based on current character. */
456                go to terminal_case (index (operators_and_white_space, substr (input, next_char_pos, 1)));
457 terminal_case (1):                                          /* Colon */
458                if substr (input, next_char_pos + 1, 2) = ":=" then
459                     go to terminal_end;
460                else go to terminal_case (0);
461 terminal_case (7):                                          /* Left parenthesis */
462 terminal_case (8):                                          /* Slash */
463                if substr (input, next_char_pos + 1, 1) = "*" then
464                     go to terminal_end;
465                else go to terminal_case (0);
466 terminal_case (9):                                          /* Question mark */
467                if substr (input, next_char_pos + 1, 7) = "include" then
468                     go to terminal_end;
469                else go to terminal_case (0);
470 terminal_case (2):                                          /* Vertical bar */
471 terminal_case (3):                                          /* Left angle bracket */
472 terminal_case (4):                                          /* Exclamation point */
473 terminal_case (10):                                         /* Space */
474 terminal_case (11):                                         /* Newpage */
475 terminal_case (12):                                         /* Horizontal Tab */
476 terminal_case (13):                                         /* Vertical tab */
477 terminal_case (14):                                         /* Newline */
478 terminal_end:
479                stk.symlen (lookahead_put) = next_char_pos - first_char_pos;
480                stk.token_position (lookahead_put) = T_pos;
481                stk.token_length (lookahead_put) = l;
482                T_pos = T_pos + l;
483                return;
484 terminal_case (5):                                          /* Equal sign */
485                if separate_semantics_sw & prod_sw then
486                     if substr (input, next_char_pos + 1, 1) = ">" then
487                          go to terminal_end;
488 terminal_case (6):                                          /* Apostrophe */
489 terminal_case (0):                                          /* None of the above */
490           end;
491 
492 
493 LS (7):                                                     /* Left parenthesis. */
494           if substr (input, next_char_pos, 1) = "*"
495           then do;                                          /* This is a begin of comment string delimiter. */
496                eoif = false;                                /* Reset End Of Input Flag. */
497                do while (^eoif);
498                                                             /* Look for the ending delimiter. */
499                     j = index (substr (input, next_char_pos, next_newline_pos - next_char_pos), "*)") - 1;
500                     if j < 0 then
501                                                             /* Ending delimiter not found in current line. */
502                          eoif = next_line ();               /* "Get" the next line. */
503                     else do;
504                          next_char_pos = next_char_pos + j + 2; /* Set next_char_pos just beyond the ending delimiter. */
505                          go to MORE;                        /* Try again. */
506                     end;
507                end;
508                call PR (lalr_error_table_$no_end_comment_delimiter);
509                stk.symbol (lookahead_put) = 0;
510                return;
511           end;
512           else go to terminal;                              /* Left parenthesis is a terminal here. */
513 
514 LS (8):                                                     /* Slash. */
515           if substr (input, next_char_pos, 1) = "*"
516           then do;                                          /* This is a begin of comment string delimiter. */
517                eoif = false;                                /* Reset End Of Input Flag. */
518                do while (^eoif);
519                                                             /* Look for the ending delimiter. */
520                     j = index (substr (input, next_char_pos, next_newline_pos - next_char_pos), "*/") - 1;
521                     if j < 0 then
522                                                             /* Ending delimiter not found in current line. */
523                          eoif = next_line ();               /* "Get" the next line. */
524                     else do;
525                          next_char_pos = next_char_pos + j + 2; /* Set next_char_pos just beyond the ending delimiter. */
526                          go to MORE;                        /* Try again. */
527                     end;
528                end;
529                call PR (lalr_error_table_$no_end_comment_delimiter);
530                stk.symbol (lookahead_put) = 0;
531                return;
532           end;
533           else go to terminal;                              /* Slash is a terminal here. */
534 
535 
536 LS (9):                                                     /* Question mark */
537           if include_macro () then
538                go to MORE;
539           else go to terminal;
540 %page;
541 name: proc returns (fixed bin);
542           names_list_size = names_list_size + 1;
543           names_list.position (names_list_size) = name_characters_length + 1;
544           do while (substr (input, next_char_pos, 1) = "'");
545 get_name:
546                name_characters_length = name_characters_length + 1;
547                substr (name_characters, name_characters_length, 1) = escape_value ();
548           end;
549           j = search (substr (input, next_char_pos, next_newline_pos - next_char_pos),
550                operators_white_space_or_dollar) - 1;
551           if j < 0 then
552                j = next_newline_pos - next_char_pos;
553           if j > 0
554           then do;
555                name_characters_length = name_characters_length + j;
556                substr (name_characters, name_characters_length - j + 1, j) = substr (input, next_char_pos, j);
557                next_char_pos = next_char_pos + j;
558                if substr (input, next_char_pos, 1) = "'" then
559                     go to get_name;
560           end;
561           names_list.length (names_list_size) = name_characters_length + 1 - names_list.position (names_list_size);
562           do k = 1 to names_list_size - 1;
563                if names_list.length (k) = j then
564                     if substr (name_characters, names_list.position (k), j) =
565                          substr (name_characters, name_characters_length - j + 1, j)
566                     then do;
567                          names_list_size = names_list_size - 1;
568                          name_characters_length = name_characters_length - j;
569                          return (k);
570                     end;
571           end;
572           return (names_list_size);
573      end name;
574 %page;
575 next_token: proc returns (bit (1));
576 dcl  eoif                          bit (1);
577           eoif = false;
578           do while (^eoif);
579                j = verify (substr (input, next_char_pos, next_newline_pos - next_char_pos), white_space) - 1;
580                if j < 0 then
581                     eoif = next_line ();
582                else do;
583                     next_char_pos = next_char_pos + j;
584                     if substr (input, next_char_pos, 1) = "?"
585                     then do;
586                          next_char_pos = next_char_pos + 1;
587                          if ^include_macro ()
588                          then do;
589                               next_char_pos = next_char_pos - 1;
590                               return (true);
591                          end;
592                     end;
593                     else if substr (input, next_char_pos, 2) = "(*"
594                     then do;
595                          do while (^eoif);
596                               j = index (substr (input, next_char_pos, next_newline_pos - next_char_pos), "*)") - 1;
597                               if j < 0 then
598                                    eoif = next_line ();
599                               else do;
600                                    next_char_pos = next_char_pos + j + 2;
601                                    go to end_comment;
602                               end;
603                          end;
604                          call PR (lalr_error_table_$no_end_comment_delimiter);
605                          stk.symbol (lookahead_put) = 0;
606                          return (false);
607                     end;
608                     else if substr (input, next_char_pos, 2) = "/*"
609                     then do;
610                          do while (^eoif);
611                               j = index (substr (input, next_char_pos, next_newline_pos - next_char_pos), "*/") - 1;
612                               if j < 0 then
613                                    eoif = next_line ();
614                               else do;
615                                    next_char_pos = next_char_pos + j + 2;
616                                    go to end_comment;
617                               end;
618                          end;
619                          call PR (lalr_error_table_$no_end_comment_delimiter);
620                          stk.symbol (lookahead_put) = 0;
621                          return (false);
622                     end;
623                     else return (true);
624                end;
625 end_comment:
626           end;
627           return (false);
628      end next_token;
629 %page;
630 escape_value: proc returns (char (1));
631 dcl  j                             fixed bin;
632           next_char_pos = next_char_pos + 1;                /* Skip over the escape character. */
633           if next_char_pos > length (input) then
634                return (" ");
635           if substr (input, next_char_pos, 1) < "0" | substr (input, next_char_pos, 1) > "7"
636           then do;
637                next_char_pos = next_char_pos + 1;           /* Advance one character to the right. */
638                return (substr (input, next_char_pos - 1, 1));
639           end;
640           j = 0;
641           do next_char_pos = next_char_pos to next_char_pos + 2
642                while (substr (input, next_char_pos, 1) >= "0" & substr (input, next_char_pos, 1) <= "7");
643                j = 8 * j + (rank (substr (input, next_char_pos, 1)) - rank ("0"));
644           end;
645           return (byte (j));
646      end escape_value;
647      end scanner;