?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Lexical Processors' ??
MODULE clm$lexical_processors;

{
{ PURPOSE:
{   This module contains routines and tables used to perform lexical
{   analysis on SCL input text.
{
{ DESIGN:
{   The design is essentially "ad hoc" in that the definition of the lexical
{   structure of SCL is imbedded in executable code as well as in the tables
{   that are used.  The detailed design of the code is oriented to making
{   extensive use of those CYBER 180 BDP instructions externalized in CYBIL
{   as intrinsics.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
*copyc clc$max_integer
*copyc clc$min_integer
*copyc clt$lexical_token
*copyc clt$lexical_unit
*copyc clt$lexical_unit_kinds
*copyc clt$lexical_units
*copyc clt$parse_state
*copyc clt$token_evaluation_options
?? PUSH (LISTEXT := ON) ??
*IF NOT $true(osv$unix)
*copyc clc$max_cobol_name_size
*ELSE
*copyc cle$not_supported
*IFEND
*copyc cle$ecc_lexical
*copyc cle$work_area_overflow
*IF NOT $true(osv$unix)
*copyc clt$integer
*IFEND
*copyc clt$name
*copyc clt$number
*IF NOT $true(osv$unix)
*copyc clt$number_kind
*copyc clt$number_kinds
*copyc clt$real
*IFEND
*copyc clt$slu_termination_option
*IF NOT $true(osv$unix)
*copyc clt$string_index
*copyc clt$string_value
*IFEND
*copyc clt$work_area
*IF NOT $true(osv$unix)
*copyc cyt$string_size
*copyc osc$processor_defined_registers
*copyc osd$conditions
*copyc oss$job_paged_literal
*IFEND
?? SKIP := 3 ??

{
{ PURPOSE:
{   The following procedure exists solely to provide a "shelter" for the
{   declarations contained in certain decks that are *COPYC'd into this
{   deck.  For example, this module defines an XDCL'd variable that is
{   referenced by an INLINE procedure.  In order to make the deck containing
{   the INLINE procedure "self-contained" it *COPYCs the deck containing the
{   XREF declaration of the variable.  Since the INLINE procedure is needed
{   in this module, both the XDCL and XREF declaration will appear in this
{   module.  The following "dummy" procedure is used to hide the XREF
{   declaration of the variable from the rest of the module.
{

  PROCEDURE [INLINE] dummy;

*copyc clp$identify_lexical_unit

*IF NOT $true(osv$unix)
*copyc clv$comment_delimiter
*copyc clv$letter_char
*copyc clv$non_cobol_name_char
*copyc clv$non_letter_or_digit
*copyc clv$non_space
*IFEND

  PROCEND dummy;
?? SKIP := 3 ??
?? POP ??
*copyc clp$initialize_parse_state
*IF NOT $true(osv$unix)
*copyc clp$recognize_cobol_name
*IFEND
*copyc clp$scan_lexical_unit
*IF NOT $true(osv$unix)
*copyc clv$hex_digits
*copyc clv$negative_infinity
*copyc clv$positive_infinity
*copyc mlp$input_floating_number
*IFEND
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper

?? TITLE := 'clv$non_graphic', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$non_graphic: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$non_graphic: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 32 of TRUE,
          { ..~} REP 95 of FALSE,
          {---} REP 129 of TRUE];

?? TITLE := 'clv$non_alphanumeric', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$non_alphanumeric: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$non_alphanumeric: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 35 of TRUE,
          { # } FALSE,
          { $ } FALSE,
          {---} REP 11 of TRUE,
          {0..9} REP 10 of FALSE,
          {---} REP 6 of TRUE,
          { @ } FALSE,
          {A..Z} REP 26 of FALSE,
          { [ } FALSE,
          { \ } FALSE,
          { ] } FALSE,
          { ^ } FALSE,
          { _ } FALSE,
          { ` } FALSE,
          {a..z} REP 26 of FALSE,
          { { } FALSE,
          { | } FALSE,
          { } FALSE,
          { ~ } FALSE,
          {---} REP 129 of TRUE];

?? TITLE := 'clv$non_letter_or_digit', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$non_letter_or_digit: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$non_letter_or_digit: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 48 of TRUE,
          {0..9} REP 10 of FALSE,
          {---} REP 7 of TRUE,
          {A..Z} REP 26 of FALSE,
          {---} REP 6 of TRUE,
          {a..z} REP 26 of FALSE,
          {---} REP 133 of TRUE];

?? TITLE := 'clv$non_space', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$non_space: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$non_space: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 9 of TRUE,
          {HT } FALSE,
          {---} REP 22 of TRUE,
          {- -} FALSE,
          {---} REP 223 of TRUE];

?? TITLE := 'clv$string_delimiter', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$string_delimiter: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$string_delimiter: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 39 of FALSE,
          { ' } TRUE,
          {---} REP 216 of FALSE];

?? TITLE := 'clv$comment_delimiter', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$comment_delimiter: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$comment_delimiter: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 34 of FALSE,
          { " } TRUE,
          {---} REP 221 of FALSE];

?? TITLE := 'clv$non_decimal_digit', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$non_decimal_digit: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$non_decimal_digit: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 48 of TRUE,
          {0..9} REP 10 of FALSE,
          {---} REP 198 of TRUE];

?? TITLE := 'clv$non_zero_digit', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$non_zero_digit: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$non_zero_digit: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 48 of TRUE,
          { 0 } FALSE,
          {---} REP 207 of TRUE];

?? TITLE := 'clv$non_dot', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$non_dot: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$non_dot: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 46 of TRUE,
          { . } FALSE,
          {---} REP 209 of TRUE];

?? TITLE := 'clv$isolate_application_value', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$isolate_application_value: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of
*ELSE
    clv$isolate_application_value: [XDCL, #GATE, READ] packed array [char] of
*IFEND
          boolean := [
          {---} REP 9 of FALSE,
          {HT } TRUE,
          {---} REP 22 of FALSE,
          {- -} TRUE,
          {---} FALSE,
          { " } TRUE,
          {---} REP 4 of FALSE,
          { ' } TRUE,
          { ( } TRUE,
          { ) } TRUE,
          {---} REP 2 of FALSE,
          { , } TRUE,
          {---} FALSE,
          { . } TRUE,
          {---} REP 12 of FALSE,
          { ; } TRUE,
          { < } TRUE,
          { = } TRUE,
          { > } TRUE,
          {---} REP 28 of FALSE,
          { [ } TRUE,
          { \ } FALSE,
          { ] } TRUE,
          { ^ } TRUE,
          { _ } FALSE,
          { ` } TRUE,
          {---} REP 29 of FALSE,
          { { } TRUE,
          { | } FALSE,
          { } TRUE,
          {---} REP 130 of FALSE];

?? TITLE := 'clv$isolate_balanced_text', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$isolate_balanced_text: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$isolate_balanced_text: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 9 of FALSE,
          {HT } TRUE,
          {---} REP 22 of FALSE,
          {- -} TRUE,
          {---} FALSE,
          { " } TRUE,
          {---} REP 4 of FALSE,
          { ' } TRUE,
          { ( } TRUE,
          { ) } TRUE,
          {---} REP 2 of FALSE,
          { , } TRUE,
          {---} FALSE,
          { . } TRUE,
          {---} REP 12 of FALSE,
          { ; } TRUE,
          { < } TRUE,
          { = } TRUE,
          { > } TRUE,
          {---} REP 193 of FALSE];

?? TITLE := 'clv$international_name_char', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$international_name_char: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean :=
*ELSE
    clv$international_name_char: [XDCL, #GATE, READ] packed array [char] of boolean :=
*IFEND
          [
          {---} REP 91 of FALSE,
          { [ } TRUE,
          { \ } TRUE,
          { ] } TRUE,
          { ^ } TRUE,
          { _ } FALSE,
          { ` } TRUE,
          {a..z} REP 26 of FALSE,
          { { } TRUE,
          { | } TRUE,
          { } TRUE,
          { ~ } TRUE,
          {---} REP 129 of FALSE];

?? TITLE := 'clv$letter_char', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$letter_char: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$letter_char: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 65 of FALSE,
          {A..Z} REP 26 of TRUE,
          {---} REP 6 of FALSE,
          {a..z} REP 26 of TRUE,
          {---} REP 133 of FALSE];

?? TITLE := 'clv$non_cobol_name_char', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$non_cobol_name_char: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$non_cobol_name_char: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 45 of TRUE,
          { - } FALSE,
          {---} REP 2 of TRUE,
          {0..9} REP 10 of FALSE,
          {---} REP 7 of TRUE,
          {A..Z} REP 26 of FALSE,
          {---} REP 6 of TRUE,
          {a..z} REP 26 of FALSE,
          {---} REP 133 of TRUE];

?? TITLE := 'clv$special_name_char', EJECT ??

  VAR
*IF NOT $true(osv$unix)
    clv$special_name_char: [XDCL, #GATE, READ, oss$job_paged_literal] packed array [char] of boolean := [
*ELSE
    clv$special_name_char: [XDCL, #GATE, READ] packed array [char] of boolean := [
*IFEND
          {---} REP 35 of FALSE,
          { # } TRUE,
          { $ } TRUE,
          {---} REP 27 of FALSE,
          { @ } TRUE,
          {---} REP 30 of FALSE,
          { _ } TRUE,
          {---} REP 160 of FALSE];


?? TITLE := 'Identify Lexical Unit(s)', EJECT ??
*IF NOT $true(osv$unix)

{
{   These requests are used to determine the kind and size of the next lexical
{ unit in a line.  The bulk of the code is duplicated in the two requests
{ (CLP$IDENTIFY_LEXICAL_UNIT and (CLP$IDENTIFY_LEXICAL_UNITS) because of the
{ frequency of their.  Even the overhead of "calling" an inline procedure is
{ too expensive.
{
{   Name and long name units are syntactically the same; they differ in their
{ allowed sizes.  A name unit may not exceed 31 characters whereas a long name
{ unit does.  Names must be delimited at both ends.  The following BNF
{ definitions illustrate the syntax of name units:
{
{    <clc$lex[_long]_name> ::= <alphabetic char> [<alphanumeric char>]...
{    <alphanumeric char> ::= <alphabetic char> | <digit>
{    <alphabetic char> ::= <letter>
{                        | <special alphabetic char>
{                        | <international letter>
{    <letter> ::= <upper case letter> | <lower case letter>
{    <upper case letter> ::= A | B | C | D | E | F | G | H | I | J | K | L | M
{                          | N | O | P | Q | R | S | T | U | V | W | X | Y | Z
{    <lower case letter> ::= a | b | c | d | e | f | g | h | i | j | k | l | m
{                          | n | o | p | q | r | s | t | u | v | w | x | y | z
{    <international letter> ::= <upper case international letter>
{                             | <lower case international letter>
{    <upper case international letter> ::= @ | '[' |  \  | ^ | ']'
{    <lower case international letter> ::= ` |  {  | '|' | ~ |  }
{    <special alphabetic char> ::= # | $ | _
{    <digit> ::= 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
{
{   The following BNF definition illustrates the syntax of an unsigned decimal
{ unit:
{
{    <clc$lex_unsigned_decimal> ::= <digit>...
{
{   The following BNF definition illustrates the syntax of an alpha number
{ unit:
{
{    <clc$lex_alpha_number> ::= <digit> [<digit>]... <letter> [<digit>]...
{
{   The following BNF definitions illustrate the syntax of string units:
{
{    <clc$lex_string> ::= ' [<string char>]... '
{    <clc$lex_unterminated_string> ::= ' [<string char>]...
{    <string char> ::= <any ascii character except '>
{
{   The following BNF definitions illustrate the syntax of comment units:
{
{    <clc$lex_comment> ::= " [<comment char>]... "
{    <clc$lex_unterminated_comment> ::= " [<comment char>]...
{    <comment char> ::= <any ascii character except ">
{
{   The following BNF definitions illustrate the representation of the
{ delimiter and operator units:
{
{    <clc$lex_semicolon> ::= ;
{    <clc$lex_colon> ::= :
{    <clc$lex_cybil_assign> ::= :=
{    <clc$lex_left_parenthesis> ::= (
{    <clc$lex_right_parenthesis> ::= )
{    <clc$lex_comma> ::= ,
{    <clc$lex_ellipsis> ::= .. [.]...
{    <clc$lex_dot> ::= .
{    <clc$lex_query> ::= ?
{    <clc$lex_greater_than> ::= >
{    <clc$lex_greater_equal> ::= >=
{    <clc$lex_less_than> ::= <
{    <clc$lex_less_equal> ::= <=
{    <clc$lex_equal> ::= =
{    <clc$lex_not_equal> ::= <>
{    <clc$lex_assign> ::= =
{    <clc$lex_concatenate> ::= //
{    <clc$lex_exponentiate> ::= **
{    <clc$lex_multiply> ::= *
{    <clc$lex_divide> ::= /
{    <clc$lex_add> ::= +
{    <clc$lex_subtract> ::= -
{
{   Contiguous spaces are treated collectively as a clc$lex_space.  The
{ horizontal tab (HT) character is treated identically to the space character.
{
{   Any character that does not begin a token previously described, is
{ returned as a clc$lex_unknown.
{

*IFEND
?? NEWTITLE := 'clp$ientify_lexical_unit', EJECT ??

{
{   This request is used to determine the kind and size of the next lexical
{ unit in a line.  On entry, INDEX indicates where to begin scanning TEXT.  On
{ exit, INDEX indicates where scanning stopped (i.e.  the next character, if
{ any, to be scanned).
{
{       CLP$IDENTIFY_LEXICAL_UNIT (TEXT, INDEX, UNIT_IS_SPACE, UNIT)
{
{ TERMINATION_OPTION: (input)  This parameter specifies whether to return with
{       the next unit identified, or to return with the next non space unit.
{
{ TEXT: (input)  This parameter specifies the text to be scanned.
{
{ INDEX: (input, output)  This parameter specifies the next character within
{       text to be scanned.
{
{ UNIT_INDEX: (output)  This parameter specified the index within text of
{       the identified lexical unit.
{
{ UNIT_IS_SPACE: (output)  This parametrer specifies whether the UNIT is
{       normally considerred to be a space (i.e.  clc$lex_space,
{       clc$lex_comment, or clc$lex_unterminated_comment).
{
{ UNIT: (output)  This parameter specifies the identified lexical unit.
{

  PROCEDURE [XDCL, #GATE] clp$identify_lexical_unit
    (    termination_option: clt$slu_termination_option;
         text: ^clt$string_value;
     VAR index {input, output} : clt$string_index;
     VAR unit_index: clt$string_index;
     VAR unit_is_space: boolean;
     VAR unit: clt$lexical_unit);

    VAR
      end_unit_index: clt$string_index,
      scan_found_char: boolean,
      scan_index: integer;


    REPEAT
      unit_index := index;

    /identify_lexical_unit/
      BEGIN
        unit_is_space := FALSE;

        IF index > STRLENGTH (text^) THEN
          unit.kind := clc$lex_end_of_line;
          unit.size := 0;

        ELSE
          CASE text^ (index) OF

          = ' ', $CHAR (9) {HT} =
            unit.kind := clc$lex_space;
            unit_is_space := TRUE;
            #SCAN (clv$non_space, text^ (index + 1, * ), scan_index, scan_found_char);
            end_unit_index := index + scan_index;

          = '"' =
            #SCAN (clv$comment_delimiter, text^ (index + 1, * ), scan_index, scan_found_char);
            IF scan_found_char THEN
              unit.kind := clc$lex_comment;
              end_unit_index := index + scan_index + 1;
            ELSE
              unit.kind := clc$lex_unterminated_comment;
              end_unit_index := index + scan_index;
            IFEND;
            unit_is_space := TRUE;

*IF $true(osv$unix)
          = '#', '$', '@', 'A' .. 'Z', '[', ']', '^', '_', '`', 'a' .. 'z', '{', '|', '}', '~' =
*ELSE
          = '#', '$', '@', 'A' .. 'Z', '[', '\', ']', '^', '_', '`', 'a' .. 'z', '{', '|', '}', '~' =
*IFEND
            #SCAN (clv$non_alphanumeric, text^ (index + 1, * ), scan_index, scan_found_char);
            end_unit_index := index + scan_index;
            IF (end_unit_index - index) > osc$max_name_size THEN
              unit.kind := clc$lex_long_name;
            ELSE
              unit.kind := clc$lex_name;
            IFEND;

          = '''' =
            #SCAN (clv$string_delimiter, text^ (index + 1, * ), scan_index, scan_found_char);
            IF scan_found_char THEN
              unit.kind := clc$lex_string;
              end_unit_index := index + scan_index + 1;
            ELSE
              unit.kind := clc$lex_unterminated_string;
              end_unit_index := index + scan_index;
            IFEND;

          = '(' =
            unit.kind := clc$lex_left_parenthesis;
            end_unit_index := index + 1;

          = ')' =
            unit.kind := clc$lex_right_parenthesis;
            end_unit_index := index + 1;

          = '*' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '*') THEN
              unit.kind := clc$lex_exponentiate;
              end_unit_index := index + 2;
            ELSE
              unit.kind := clc$lex_multiply;
              end_unit_index := index + 1;
            IFEND;

          = '+' =
            unit.kind := clc$lex_add;
            end_unit_index := index + 1;

          = ',' =
            unit.kind := clc$lex_comma;
            end_unit_index := index + 1;

          = '-' =
            unit.kind := clc$lex_subtract;
            end_unit_index := index + 1;

          = '.' =
            #SCAN (clv$non_dot, text^ (index + 1, * ), scan_index, scan_found_char);
            IF scan_index > 1 THEN
              unit.kind := clc$lex_ellipsis;
              end_unit_index := index + scan_index;
            ELSE
              unit.kind := clc$lex_dot;
              end_unit_index := index + 1;
            IFEND;

*IF $true(osv$unix)
          = '\' =
            unit.kind := clc$lex_ellipsis;
            end_unit_index := index + 1;

*IFEND
          = '/' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '/') THEN
              unit.kind := clc$lex_concatenate;
              end_unit_index := index + 2;
            ELSE
              unit.kind := clc$lex_divide;
              end_unit_index := index + 1;
            IFEND;

          = '0' .. '9' =
            #SCAN (clv$non_letter_or_digit, text^ (index + 1, * ), scan_index, scan_found_char);
            end_unit_index := index + scan_index;
            #SCAN (clv$non_decimal_digit, text^ (index, end_unit_index - index), scan_index,
                  scan_found_char);
            IF scan_found_char THEN
              unit.kind := clc$lex_alpha_number;
            ELSE
              unit.kind := clc$lex_unsigned_decimal;
            IFEND;

          = ':' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '=') THEN
              unit.kind := clc$lex_cybil_assign;
              end_unit_index := index + 2;
            ELSE
              unit.kind := clc$lex_colon;
              end_unit_index := index + 1;
            IFEND;

          = ';' =
            unit.kind := clc$lex_semicolon;
            end_unit_index := index + 1;

          = '<' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '=') THEN
              unit.kind := clc$lex_less_equal;
              end_unit_index := index + 2;
            ELSEIF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '>') THEN
              unit.kind := clc$lex_not_equal;
              end_unit_index := index + 2;
            ELSE
              unit.kind := clc$lex_less_than;
              end_unit_index := index + 1;
            IFEND;

          = '=' =
            unit.kind := clc$lex_equal;
            end_unit_index := index + 1;

          = '>' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '=') THEN
              unit.kind := clc$lex_greater_equal;
              end_unit_index := index + 2;
            ELSE
              unit.kind := clc$lex_greater_than;
              end_unit_index := index + 1;
            IFEND;

          = '?' =
            unit.kind := clc$lex_query;
            end_unit_index := index + 1;

          ELSE
            unit.kind := clc$lex_unknown;
            end_unit_index := index + 1;

          CASEND;

          unit.size := end_unit_index - index;
          index := end_unit_index;
        IFEND;
      END /identify_lexical_unit/;

    UNTIL (termination_option = clc$slu_any) OR (NOT unit_is_space);

  PROCEND clp$identify_lexical_unit;
?? TITLE := 'clp$identify_lexical_units', EJECT ??

{
{   This request constructs an array identifying all of the lexical units in a
{ line.
{
{       CLP$IDENTIFY_LEXICAL_UNITS (TEXT, WORK_AREA, UNITS, STATUS)
{
{ TEXT: (input)  This parameter specifies the text to be scanned.
{
{ WORK_AREA: (input, output)  This parameter specifies an area of storage into
{       which is constructed the array of lexical units.  The current position
{       of this sequence pointer is updated to reflect the amount of storage
{       used by the request.
{
{ UNITS: (output)  This parameter specifies the array of identified lexical
{       units.
{
{ STATUS: (output)  This parameter specifies the request status.
{

  PROCEDURE [XDCL, #GATE] clp$identify_lexical_units
    (    text: ^clt$string_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR units: ^clt$lexical_units;
     VAR status: ost$status);

    VAR
      count: clt$string_size,
      end_unit_index: clt$string_index,
      index: clt$string_index,
      scan_found_char: boolean,
      scan_index: integer,
      unit: ^clt$lexical_unit,
      work_area_ptr: ^clt$work_area;


    status.normal := TRUE;

    work_area_ptr := work_area;
    NEXT unit IN work_area_ptr;
    IF unit = NIL THEN
      osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
      RETURN;
    IFEND;

    unit^.kind := clc$lex_beginning_of_line;
    unit^.size := 0;

    count := 1;
    index := 1;

    REPEAT
      NEXT unit IN work_area_ptr;

      IF unit = NIL THEN
        osp$set_status_abnormal ('CL', cle$work_area_overflow, '', status);
        RETURN;
      IFEND;

    /identify_lexical_unit/
      BEGIN
        IF index > STRLENGTH (text^) THEN
          unit^.kind := clc$lex_end_of_line;
          unit^.size := 0;

        ELSE
          CASE text^ (index) OF

          = ' ', $CHAR (9) {HT} =
            unit^.kind := clc$lex_space;
            #SCAN (clv$non_space, text^ (index + 1, * ), scan_index, scan_found_char);
            end_unit_index := index + scan_index;

          = '"' =
            #SCAN (clv$comment_delimiter, text^ (index + 1, * ), scan_index, scan_found_char);
            IF scan_found_char THEN
              unit^.kind := clc$lex_comment;
              end_unit_index := index + scan_index + 1;
            ELSE
              unit^.kind := clc$lex_unterminated_comment;
              end_unit_index := index + scan_index;
            IFEND;

*IF $true(osv$unix)
          = '#', '$', '@', 'A' .. 'Z', '[', ']', '^', '_', '`', 'a' .. 'z', '{', '|', '}', '~' =
*ELSE
          = '#', '$', '@', 'A' .. 'Z', '[', '\', ']', '^', '_', '`', 'a' .. 'z', '{', '|', '}', '~' =
*IFEND
            #SCAN (clv$non_alphanumeric, text^ (index + 1, * ), scan_index, scan_found_char);
            end_unit_index := index + scan_index;
            IF (end_unit_index - index) > osc$max_name_size THEN
              unit^.kind := clc$lex_long_name;
            ELSE
              unit^.kind := clc$lex_name;
            IFEND;

          = '''' =
            #SCAN (clv$string_delimiter, text^ (index + 1, * ), scan_index, scan_found_char);
            IF scan_found_char THEN
              unit^.kind := clc$lex_string;
              end_unit_index := index + scan_index + 1;
            ELSE
              unit^.kind := clc$lex_unterminated_string;
              end_unit_index := index + scan_index;
            IFEND;

          = '(' =
            unit^.kind := clc$lex_left_parenthesis;
            end_unit_index := index + 1;

          = ')' =
            unit^.kind := clc$lex_right_parenthesis;
            end_unit_index := index + 1;

          = '*' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '*') THEN
              unit^.kind := clc$lex_exponentiate;
              end_unit_index := index + 2;
            ELSE
              unit^.kind := clc$lex_multiply;
              end_unit_index := index + 1;
            IFEND;

          = '+' =
            unit^.kind := clc$lex_add;
            end_unit_index := index + 1;

          = ',' =
            unit^.kind := clc$lex_comma;
            end_unit_index := index + 1;

          = '-' =
            unit^.kind := clc$lex_subtract;
            end_unit_index := index + 1;

          = '.' =
            #SCAN (clv$non_dot, text^ (index + 1, * ), scan_index, scan_found_char);
            IF scan_index > 1 THEN
              unit^.kind := clc$lex_ellipsis;
              end_unit_index := index + scan_index;
            ELSE
              unit^.kind := clc$lex_dot;
              end_unit_index := index + 1;
            IFEND;

*IF $true(osv$unix)
          = '\' =
            unit^.kind := clc$lex_ellipsis;
            end_unit_index := index + 1;

*IFEND
          = '/' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '/') THEN
              unit^.kind := clc$lex_concatenate;
              end_unit_index := index + 2;
            ELSE
              unit^.kind := clc$lex_divide;
              end_unit_index := index + 1;
            IFEND;

          = '0' .. '9' =
            #SCAN (clv$non_letter_or_digit, text^ (index + 1, * ), scan_index, scan_found_char);
            end_unit_index := index + scan_index;
            #SCAN (clv$non_decimal_digit, text^ (index, end_unit_index - index), scan_index, scan_found_char);
            IF scan_found_char THEN
              unit^.kind := clc$lex_alpha_number;
            ELSE
              unit^.kind := clc$lex_unsigned_decimal;
            IFEND;

          = ':' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '=') THEN
              unit^.kind := clc$lex_cybil_assign;
              end_unit_index := index + 2;
            ELSE
              unit^.kind := clc$lex_colon;
              end_unit_index := index + 1;
            IFEND;

          = ';' =
            unit^.kind := clc$lex_semicolon;
            end_unit_index := index + 1;

          = '<' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '=') THEN
              unit^.kind := clc$lex_less_equal;
              end_unit_index := index + 2;
            ELSEIF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '>') THEN
              unit^.kind := clc$lex_not_equal;
              end_unit_index := index + 2;
            ELSE
              unit^.kind := clc$lex_less_than;
              end_unit_index := index + 1;
            IFEND;

          = '=' =
            unit^.kind := clc$lex_equal;
            end_unit_index := index + 1;

          = '>' =
            IF (index < STRLENGTH (text^)) AND (text^ (index + 1) = '=') THEN
              unit^.kind := clc$lex_greater_equal;
              end_unit_index := index + 2;
            ELSE
              unit^.kind := clc$lex_greater_than;
              end_unit_index := index + 1;
            IFEND;

          = '?' =
            unit^.kind := clc$lex_query;
            end_unit_index := index + 1;

          ELSE
            unit^.kind := clc$lex_unknown;
            end_unit_index := index + 1;

          CASEND;

          unit^.size := end_unit_index - index;
          index := end_unit_index;
        IFEND;
      END /identify_lexical_unit/;

      count := count + 1;
    UNTIL unit^.kind = clc$lex_end_of_line;

    NEXT units: [1 .. count] IN work_area;

  PROCEND clp$identify_lexical_units;
?? OLDTITLE ??
?? TITLE := 'clp$append_status_parse_state', EJECT ??
*copy clh$append_status_parse_state

  PROCEDURE [XDCL, #GATE] clp$append_status_parse_state
    (    delimiter: char;
         parse: clt$parse_state;
     VAR status {input, output} : ost$status);


    CASE parse.unit.kind OF
    = clc$lex_beginning_of_line =
      osp$append_status_parameter (delimiter, 'beginning of line', status);
    = clc$lex_end_of_line =
      osp$append_status_parameter (delimiter, 'end of line', status);
    = clc$lex_space =
      osp$append_status_parameter (delimiter, 'space', status);
    ELSE
      osp$append_status_parameter (delimiter, parse.text^ (parse.unit_index, parse.unit.size), status);
    CASEND;

  PROCEND clp$append_status_parse_state;
?? TITLE := 'clp$append_status_string', EJECT ??
*copy clh$append_status_string

  PROCEDURE [XDCL, #GATE] clp$append_status_string
    (    delimiter: char;
         text: string ( * );
     VAR status {input, output} : ost$status);

    CONST
      space_constant = ' ';

    VAR
      space: char,
      status_text_size: ost$string_size,
      text_size: integer;


    IF status.normal THEN
      RETURN;
    IFEND;

    status_text_size := status.text.size;
    IF status_text_size >= osc$max_string_size THEN
      RETURN;
    IFEND;
    text_size := STRLENGTH (text);

{ By assigning the value space to a char the CYBIL compiler will place this value in a register.
{ In addition, code motion will move the register load out of the loop.  This should significantly,
{ improve the "stripping" of trailing characters.

    space := space_constant;
    WHILE (text_size > 0) AND (text (text_size) = space) DO
      text_size := text_size - 1;
    WHILEND;
    status_text_size := status_text_size + 1;
    status.text.value (status_text_size) := delimiter;
    IF text_size > osc$max_string_size - status_text_size THEN
      text_size := osc$max_string_size - status_text_size;
    IFEND;
    status.text.value (status_text_size + 1, text_size) := text (1, text_size);
    status.text.size := status_text_size + text_size;

  PROCEND clp$append_status_string;
?? TITLE := 'clp$evaluate_numeric_literal', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$evaluate_numeric_literal
    (    sign: -1 .. 1;
         default_radix: 2 .. 16;
     VAR parse {input, output} : clt$parse_state;
     VAR literal: clt$number;
     VAR status: ost$status);

    VAR
      bad_literal: ost$status_condition,
      check_parse: clt$parse_state,
      first_unit_is_unsigned_decimal: boolean,
      number_index: clt$string_index,
      number_of_digits: clt$string_size,
      number_size: clt$string_size;

    VAR
*IF NOT $true(osv$unix)
      conversion_status: mlt$error,
      exponent: clt$integer,
      ignore_source_length: mlt$string_length,
      ignore_status: ost$status,
*IFEND
      real_number_string: ^clt$string_value,
      scan_found_char: boolean,
      scan_index: integer;

    VAR
      digit: -15 .. 15,
      i: clt$string_index,
      radix_index: clt$string_index,
*IF NOT $true(osv$unix)
      temp_integer: integer,
      user_conditions: ost$user_conditions;
*ELSE
      temp_integer: integer;
*IFEND


    status.normal := TRUE;

    number_index := parse.unit_index;
    number_size := parse.unit.size;
    number_of_digits := number_size;

    first_unit_is_unsigned_decimal := parse.unit.kind = clc$lex_unsigned_decimal;
    clp$scan_lexical_unit (clc$slu_any, parse);

    IF first_unit_is_unsigned_decimal AND (parse.unit.kind = clc$lex_dot) THEN
*IF NOT $true(osv$unix)
      check_parse := parse;
      clp$scan_lexical_unit (clc$slu_any, check_parse);
      IF check_parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_unsigned_decimal, clc$lex_alpha_number]
            THEN

        literal.kind := clc$real_number;
        bad_literal := cle$improper_real;

      /real_ok/
        BEGIN
          parse := check_parse;
          IF parse.unit.kind = clc$lex_unsigned_decimal THEN
            number_size := parse.index - number_index;
            number_of_digits := number_of_digits + parse.unit.size;
          ELSE {clc$lex_alpha_number}
            number_size := parse.index - number_index;
            #SCAN (clv$non_decimal_digit, parse.text^ (parse.unit_index, parse.unit.size), scan_index,
                  scan_found_char);
            number_of_digits := number_of_digits + scan_index - 1;
            CASE parse.text^ (parse.unit_index + scan_index - 1) OF
            = 'E', 'e', 'D', 'd' =
              number_size := parse.index - number_index;
              IF (parse.unit.size - scan_index) > 0 THEN
                #SCAN (clv$non_decimal_digit, parse.text^ (parse.unit_index + scan_index,
                      parse.unit.size - scan_index), scan_index, scan_found_char);
                IF scan_found_char THEN
                  EXIT /real_ok/;
                ELSE
                  clp$convert_string_to_integer (parse.text^ (parse.unit_index + scan_index,
                        parse.unit.size - scan_index), exponent, ignore_status);
                  number_of_digits := exponent.value;
                IFEND;
              ELSE
                clp$scan_lexical_unit (clc$slu_any, parse);
                IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_add, clc$lex_subtract] THEN
                  number_size := parse.index - number_index;
                  clp$scan_lexical_unit (clc$slu_any, parse);
                  IF parse.unit.kind <> clc$lex_unsigned_decimal THEN
                    EXIT /real_ok/;
                  ELSE
                    clp$convert_string_to_integer (parse.text^ (parse.unit_index, parse.unit.size),
                          exponent, ignore_status);
                    number_of_digits := exponent.value;
                  IFEND;
                IFEND;
              IFEND;
            ELSE
              EXIT /real_ok/;
            CASEND;
          IFEND;

          number_size := parse.index - number_index;
          clp$scan_lexical_unit (clc$slu_any, parse);

          IF sign >= 0 THEN
            real_number_string := ^parse.text^ (number_index, number_size);
          ELSE
            PUSH real_number_string: [1 + number_size];
            real_number_string^ (1) := '-';
            real_number_string^ (2, number_size) := parse.text^ (number_index, number_size);
          IFEND;

          mlp$input_floating_number (real_number_string, STRLENGTH (real_number_string^),
                ^literal.real_number.value, mlc$double_precision, mlc$ignore_blanks, ignore_source_length,
                conversion_status);
          IF conversion_status = mle$overflow THEN
            osp$set_status_abnormal ('CL', cle$real_literal_too_large, real_number_string^, status);
            RETURN;
          ELSEIF conversion_status <> mle$no_error THEN
            EXIT /real_ok/;
          IFEND;

          IF number_of_digits <= clc$max_real_number_digits THEN
            literal.real_number.number_of_digits := number_of_digits;
          ELSE
            literal.real_number.number_of_digits := clc$max_real_number_digits;
          IFEND;

          RETURN;
        END /real_ok/;
        osp$set_status_abnormal ('CL', bad_literal, parse.text^ (number_index, number_size), status);
        RETURN;

      IFEND;
*ELSE
        osp$set_status_abnormal ('CL', cle$not_supported, 'reals', status);
        RETURN;
*IFEND
    IFEND;

    literal.kind := clc$integer_number;
    literal.integer_number.radix := default_radix;
    literal.integer_number.radix_specified := FALSE;
    bad_literal := cle$improper_integer;

  /integer_ok/
    BEGIN
      IF parse.unit.kind = clc$lex_left_parenthesis THEN
        literal.integer_number.radix_specified := TRUE;
        number_size := parse.index - number_index;
        clp$scan_lexical_unit (clc$slu_non_space, parse);
        number_size := parse.index - number_index;
        IF parse.unit.kind <> clc$lex_unsigned_decimal THEN
          bad_literal := cle$improper_radix_spec;
          EXIT /integer_ok/;
        IFEND;
        radix_index := parse.unit_index;
        temp_integer := 0;
        REPEAT
          temp_integer := (temp_integer * 10) + ($INTEGER (parse.text^ (radix_index)) - $INTEGER ('0'));
          radix_index := radix_index + 1;
        UNTIL (radix_index >= parse.index) OR (temp_integer > UPPERVALUE (literal.integer_number.radix));
        IF (temp_integer < LOWERVALUE (literal.integer_number.radix)) OR
              (temp_integer > UPPERVALUE (literal.integer_number.radix)) THEN
          bad_literal := cle$improper_radix_value;
          EXIT /integer_ok/;
        IFEND;
        literal.integer_number.radix := temp_integer;
        clp$scan_lexical_unit (clc$slu_non_space, parse);
        number_size := parse.index - number_index;
        IF parse.unit.kind <> clc$lex_right_parenthesis THEN
          bad_literal := cle$improper_radix_spec;
          EXIT /integer_ok/;
        IFEND;
        clp$scan_lexical_unit (clc$slu_any, parse);
      IFEND;

      literal.integer_number.value := 0;
      FOR i := number_index TO number_index + number_of_digits - 1 DO
        CASE parse.text^ (i) OF
        = '0' .. '9' =
          digit := $INTEGER (parse.text^ (i)) - $INTEGER ('0');
        = 'A' .. 'F' =
          digit := $INTEGER (parse.text^ (i)) - $INTEGER ('A') + 10;
        = 'a' .. 'f' =
          digit := $INTEGER (parse.text^ (i)) - $INTEGER ('a') + 10;
        ELSE
          bad_literal := cle$alpha_char_in_number;
          EXIT /integer_ok/;
        CASEND;
        IF digit >= literal.integer_number.radix THEN
          bad_literal := cle$digit_too_large;
          EXIT /integer_ok/;
        IFEND;

        IF sign = 1 THEN
          IF ((clc$max_integer - digit) DIV literal.integer_number.radix) < literal.integer_number.value THEN
            osp$set_status_abnormal ('CL', cle$integer_literal_too_large, parse.
                  text^ (number_index, number_size), status);
            RETURN;
          IFEND;
        ELSE
          IF ((clc$min_integer + digit) DIV literal.integer_number.radix) > literal.integer_number.value THEN
            osp$set_status_abnormal ('CL', cle$integer_literal_too_large, parse.
                  text^ (number_index, number_size), status);
            RETURN;
          IFEND;
          digit := -digit;
        IFEND;

        literal.integer_number.value := (literal.integer_number.value * literal.integer_number.radix) + digit;
      FOREND;
      RETURN;
    END /integer_ok/;
    osp$set_status_abnormal ('CL', bad_literal, parse.text^ (number_index, number_size), status);

  PROCEND clp$evaluate_numeric_literal;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$evaluate_token', EJECT ??
*copy clh$evaluate_token

  PROCEDURE [XDCL, #GATE] clp$evaluate_token
    (    text: clt$string_value;
         evaluation_options: clt$token_evaluation_options;
     VAR index {input, output} : clt$string_index;
     VAR spaces_preceded_token: boolean;
     VAR token: clt$lexical_token;
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      token_recognized: boolean;

?? NEWTITLE := 'recognize_cobol_name', EJECT ??

    PROCEDURE [INLINE] recognize_cobol_name;

      VAR
        cobol_name_size: ost$name_size,
        is_cobol_name: boolean,
        is_only_cobol_name: boolean;


      clp$recognize_cobol_name (parse.text^ (parse.unit_index, * ), cobol_name_size, is_only_cobol_name,
            is_cobol_name);
      token_recognized := is_cobol_name AND is_only_cobol_name;
      IF token_recognized THEN
        token.kind := clc$cobol_name_token;
        parse.unit.size := cobol_name_size;
      IFEND;

    PROCEND recognize_cobol_name;
?? TITLE := 'recognize_name', EJECT ??

    PROCEDURE recognize_name;

      VAR
        scan_found_char: boolean,
        scan_index: integer;


      #SCAN (clv$international_name_char, parse.text^ (parse.unit_index, parse.unit.size), scan_index,
            scan_found_char);
      IF scan_found_char THEN
        IF (clc$international_char_is_token IN evaluation_options) OR
              (clc$special_char_is_token IN evaluation_options) THEN
          IF scan_index = 1 THEN
            token_recognized := TRUE;
            set_international_char_token;
            RETURN;
          IFEND;
          parse.unit.size := scan_index - 1;
          IF parse.unit.size <= osc$max_name_size THEN
            parse.unit.kind := clc$lex_name;
          IFEND;
        ELSE
          token_recognized := parse.unit.kind = clc$lex_name;
          IF token_recognized THEN
            token.kind := clc$name_token;
          IFEND;
          RETURN;
        IFEND;
      IFEND;

      #SCAN (clv$special_name_char, parse.text^ (parse.unit_index, parse.unit.size), scan_index,
            scan_found_char);
      IF scan_found_char THEN
        IF clc$special_char_is_token IN evaluation_options THEN
          IF scan_index = 1 THEN
            token_recognized := TRUE;
            set_special_char_token;
            RETURN;
          IFEND;
          parse.unit.size := scan_index - 1;
          IF parse.unit.size <= osc$max_name_size THEN
            parse.unit.kind := clc$lex_name;
          IFEND;
        ELSE
          IF (scan_index = 1) AND ((parse.text^ (parse.unit_index) = '$') OR (parse.text^ (parse.unit_index) =
                '#')) AND (clc$special_cybil_name_is_token IN evaluation_options) AND
                (1 < parse.unit.size) AND (parse.unit.size <= (osc$max_name_size + 1)) AND
                clv$letter_char [parse.text^ (parse.unit_index + 1)] THEN
            token_recognized := TRUE;
            token.kind := clc$special_cybil_name_token;
            RETURN;
          IFEND;
          token_recognized := parse.unit.kind = clc$lex_name;
          IF token_recognized THEN
            IF scan_index = 1 THEN
              token.kind := clc$name_token;
            ELSE
              token.kind := clc$cybil_name_token;
            IFEND;
          IFEND;
          RETURN;
        IFEND;
      IFEND;

      IF clc$cobol_name_is_token IN evaluation_options THEN
        recognize_cobol_name;
        IF token_recognized THEN
          RETURN;
        IFEND;
      IFEND;

      token_recognized := parse.unit.kind = clc$lex_name;
      IF token_recognized THEN
        token.kind := clc$simple_name_token;
      IFEND;

    PROCEND recognize_name;
?? TITLE := 'recognize_number', EJECT ??

    PROCEDURE [INLINE] recognize_number
      (    signed: boolean);

      VAR
        number: clt$number;


      clp$evaluate_numeric_literal (sign, 10, parse, number, local_status);
      IF local_status.normal THEN
        IF number.kind = clc$integer_number THEN
          token.descriptor := 'integer';
          IF signed THEN
            token.kind := clc$signed_integer_token;
          ELSE
            token.kind := clc$unsigned_integer_token;
          IFEND;
          token.int := number.integer_number;
        ELSE
          token.descriptor := 'real number';
          IF signed THEN
            token.kind := clc$signed_real_token;
          ELSE
            token.kind := clc$unsigned_real_token;
          IFEND;
          token.rnum := number.real_number;
        IFEND;
        token.text_size := index + parse.unit_index - 1 - token.text_index;
      IFEND;

    PROCEND recognize_number;
?? TITLE := 'set_international_char_token', EJECT ??

    PROCEDURE [INLINE] set_international_char_token;


      token.descriptor := parse.text^ (parse.unit_index, 1);
      CASE parse.text^ (parse.unit_index) OF
      = '[' =
        token.kind := clc$left_bracket_token;
      = '\' =
        token.kind := clc$reverse_slant_token;
      = ']' =
        token.kind := clc$right_bracket_token;
      = '^' =
        token.kind := clc$circumflex_token;
      = '`' =
        token.kind := clc$grave_accent_token;
      = '{' =
        token.kind := clc$left_brace_token;
      = '|' =
        token.kind := clc$vertical_bar_token;
      = '}' =
        token.kind := clc$right_brace_token;
      = '~' =
        token.kind := clc$tilde_token;
      ELSE
        token.kind := clc$unknown_token;
      CASEND;
      token.str.size := 1;
      token.str.value := parse.text^ (parse.unit_index, 1);
      token.str_complete := TRUE;
      token.text_size := 1;
      index := token.text_index + 1;

    PROCEND set_international_char_token;
?? TITLE := 'set_name_token', EJECT ??

    PROCEDURE [INLINE] set_name_token;


      CASE token.kind OF
      = clc$name_token .. clc$simple_name_token =
        token.descriptor := 'name';
      = clc$cobol_name_token =
        token.descriptor := 'COBOL name';
      ELSE
        RETURN;
      CASEND;
      token.str.size := parse.unit.size;
      #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, token.str.size), token.str.value);
      token.str_complete := TRUE;
      token.text_size := parse.unit.size;
      index := token.text_index + token.text_size;

    PROCEND set_name_token;
?? TITLE := 'set_special_char_token', EJECT ??

    PROCEDURE [INLINE] set_special_char_token;


      token.descriptor := parse.text^ (parse.unit_index, 1);
      CASE parse.text^ (parse.unit_index) OF
      = '#' =
        token.kind := clc$number_sign_token;
      = '$' =
        token.kind := clc$dollar_sign_token;
      = '@' =
        token.kind := clc$commercial_at_token;
      = '_' =
        token.kind := clc$underscore_token;
      ELSE
        token.kind := clc$unknown_token;
      CASEND;
      token.str.size := 1;
      token.str.value := parse.text^ (parse.unit_index, 1);
      token.str_complete := TRUE;
      token.text_size := 1;
      index := token.text_index + 1;

    PROCEND set_special_char_token;
?? OLDTITLE, EJECT ??

    VAR
      comment_size: clt$string_size,
      control_characters: [STATIC, READ, oss$job_paged_literal] array [$CHAR (0) .. $CHAR (20(16))] of
            string (3) := ['NUL', 'SOH', 'STX', 'ETX', 'EOT', 'ENQ', 'ACK', 'BEL', 'BS', 'HT', 'LF', 'VT',
            'FF', 'CR', 'SO', 'SI', 'DLE', 'DC1', 'DC2', 'DC3', 'DC4', 'NAK', 'SYN', 'ETB', 'CAN', 'EM',
            'SUB', 'ESC', 'FS', 'GS', 'RS', 'US', 'SP'],
      first_string_unit: boolean,
      ignore_spaces: boolean,
      local_status: ost$status,
      sign: -1 .. 1,
      slu_termination_option: clt$slu_termination_option,
      string_unit_size: clt$string_size,
      token_kind_table: [STATIC, READ, oss$job_paged_literal] array [clc$lex_semicolon .. clc$lex_divide] of
            clt$lexical_token_kind := [clc$semicolon_token, clc$colon_token, clc$cybil_assign_token,
            clc$left_parenthesis_token, clc$right_parenthesis_token, clc$comma_token, clc$ellipsis_token,
            clc$dot_token, clc$query_token, clc$greater_than_token, clc$greater_equal_token,
            clc$less_than_token, clc$less_equal_token, clc$equal_token, clc$not_equal_token,
            clc$concatenate_token, clc$exponentiate_token, clc$multiply_token, clc$divide_token],
      treat_comments_as_spaces: boolean;

  /evaluate/
    BEGIN

      status.normal := TRUE;
      local_status.normal := TRUE;

      ignore_spaces := clc$ignore_spaces_before_token IN evaluation_options;
      treat_comments_as_spaces := NOT (clc$comment_is_token IN evaluation_options);
      IF ignore_spaces AND treat_comments_as_spaces THEN
        slu_termination_option := clc$slu_non_space;
      ELSE
        slu_termination_option := clc$slu_any;
      IFEND;
      clp$initialize_parse_state (^text (index, * ), NIL, parse);
      clp$scan_lexical_unit (slu_termination_option, parse);
      IF ignore_spaces AND (parse.unit.kind = clc$lex_space) THEN
        clp$scan_lexical_unit (clc$slu_any, parse);
      IFEND;
      spaces_preceded_token := parse.unit_index > 1;

      token_recognized := FALSE;
      token.text_index := index + parse.unit_index - 1;

      CASE parse.unit.kind OF

      = clc$lex_unknown =
        CASE parse.text^ (parse.unit_index) OF
        = $CHAR (0) .. $CHAR (20(16)) =
          token.descriptor := 'character';
          token.descriptor (11, 3) := control_characters [parse.text^ (parse.unit_index)];
        = $CHAR (21(16)) .. $CHAR (7e(16)) =
          token.descriptor := parse.text^ (parse.unit_index, 1);
        = $CHAR (7f(16)) =
          token.descriptor := 'character DEL';
        = $CHAR (80(16)) .. $CHAR (0ff(16)) =
          token.descriptor := 'character 0xx(16)';
          token.descriptor (12) := clv$hex_digits [$INTEGER (parse.text^ (parse.unit_index)) DIV 16];
          token.descriptor (13) := clv$hex_digits [$INTEGER (parse.text^ (parse.unit_index)) MOD 16];
        CASEND;
        token.kind := clc$unknown_token;
        token.str.size := 1;
        token.str.value := parse.text^ (parse.unit_index, 1);
        token.str_complete := TRUE;
        token.text_size := 1;
        index := token.text_index + 1;

      = clc$lex_beginning_of_line, clc$lex_end_of_line =
        token.descriptor := 'end of line';
        token.kind := clc$end_of_line_token;
        token.str.size := 0;
        token.str.value := '';
        token.str_complete := TRUE;
        token.text_size := 0;
        index := STRLENGTH (text) + 1;

      = clc$lex_space =
        token.descriptor := 'space';
        token.kind := clc$space_token;
        token.str.size := 1;
        token.str.value := ' ';
        token.str_complete := TRUE;
        IF treat_comments_as_spaces THEN
          clp$scan_lexical_unit (clc$slu_non_space, parse);
          token.text_size := index + parse.unit_index - 1 - token.text_index;
        ELSE
          token.text_size := parse.unit.size;
        IFEND;
        index := token.text_index + token.text_size;

      = clc$lex_comment, clc$lex_unterminated_comment =
        IF treat_comments_as_spaces THEN
          token.descriptor := 'space';
          token.kind := clc$space_token;
          clp$scan_lexical_unit (clc$slu_non_space, parse);
          token.text_size := index + parse.unit_index - 1 - token.text_index;
          token.str.size := 1;
          token.str.value := ' ';
          token.str_complete := TRUE;
        ELSE
          token.descriptor := 'comment';
          token.kind := clc$comment_token;
          token.text_size := parse.unit.size;
          comment_size := parse.unit.size - 1 - $INTEGER (parse.unit.kind = clc$lex_comment);
          token.str_complete := comment_size <= osc$max_string_size;
          IF token.str_complete THEN
            token.str.size := comment_size;
          ELSE
            token.str.size := osc$max_string_size;
          IFEND;
          token.str.value := parse.text^ (parse.unit_index + 1, token.str.size);
        IFEND;
        index := token.text_index + token.text_size;

      = clc$lex_semicolon .. clc$lex_divide =
        IF parse.unit.size > 1 THEN
          token.descriptor := parse.text^ (parse.unit_index, 2);
          token.str.size := 2;
          token.str.value := parse.text^ (parse.unit_index, 2);
        ELSE
          token.descriptor := parse.text^ (parse.unit_index, 1);
          token.str.size := 1;
          token.str.value := parse.text^ (parse.unit_index, 1);
        IFEND;
        token.str_complete := TRUE;
        token.kind := token_kind_table [parse.unit.kind];
        token.text_size := parse.unit.size;
        index := token.text_index + token.text_size;

      = clc$lex_add, clc$lex_subtract =
        token.descriptor := parse.text^ (parse.unit_index, 1);
        IF parse.unit.kind = clc$lex_add THEN
          sign := 1;
          token.kind := clc$add_token;
        ELSE
          sign := -1;
          token.kind := clc$subtract_token;
        IFEND;
        token.str.size := 1;
        token.str.value := token.descriptor;
        token.str_complete := TRUE;
        token.text_size := 1;
        clp$scan_lexical_unit (slu_termination_option, parse);
        IF ignore_spaces AND (parse.unit.kind = clc$lex_space) THEN
          clp$scan_lexical_unit (clc$slu_any, parse);
        IFEND;
        IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_unsigned_decimal, clc$lex_alpha_number] THEN
          recognize_number (TRUE);
          IF NOT local_status.normal THEN
            local_status.normal := TRUE;
          IFEND;
        IFEND;
        index := token.text_index + token.text_size;

      = clc$lex_name =
        IF clc$classify_name_token IN evaluation_options THEN
          recognize_name;
        ELSE
          token.kind := clc$name_token;
        IFEND;
        set_name_token;

      = clc$lex_long_name =
        IF clc$classify_name_token IN evaluation_options THEN
          recognize_name;
        ELSE
          token_recognized := FALSE;
        IFEND;
        IF token_recognized THEN
          set_name_token;
        ELSE
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                local_status);
        IFEND;

      = clc$lex_alpha_number, clc$lex_unsigned_decimal =
        IF $clt$token_evaluation_options [clc$classify_name_token,
              clc$cobol_name_is_token] <= evaluation_options THEN
          recognize_cobol_name;
        ELSE
          token_recognized := FALSE;
        IFEND;
        IF token_recognized THEN
          set_name_token;
        ELSE
          sign := 1;
          recognize_number (FALSE);
          IF local_status.normal THEN
            index := token.text_index + token.text_size;
          IFEND;
        IFEND;

      = clc$lex_string =
        token.descriptor := 'string';
        token.kind := clc$string_token;
        token.str.size := 0;
        token.str_complete := TRUE;
        first_string_unit := TRUE;
        REPEAT
          IF token.str_complete AND (NOT first_string_unit) THEN
            IF token.str.size = osc$max_string_size THEN
              token.str_complete := FALSE;
            ELSE
              token.str.size := token.str.size + 1;
              token.str.value (token.str.size) := '''';
            IFEND;
          IFEND;
          IF token.str_complete THEN
            string_unit_size := parse.unit.size - 2;
            IF (token.str.size + string_unit_size) > osc$max_string_size THEN
              token.str_complete := FALSE;
              string_unit_size := osc$max_string_size - token.str.size;
            IFEND;
            token.str.value (token.str.size + 1, string_unit_size) :=
                  parse.text^ (parse.unit_index + 1, string_unit_size);
            token.str.size := token.str.size + string_unit_size;
          IFEND;
          first_string_unit := FALSE;
          clp$scan_lexical_unit (clc$slu_any, parse);
        UNTIL parse.unit.kind <> clc$lex_string;
        IF parse.unit.kind = clc$lex_unterminated_string THEN
          osp$set_status_abnormal ('CL', cle$missing_string_delimiter, parse.text^, local_status);
        ELSE
          token.text_size := index + parse.unit_index - 1 - token.text_index;
          index := token.text_index + token.text_size;
        IFEND;

      = clc$lex_unterminated_string =
        osp$set_status_abnormal ('CL', cle$missing_string_delimiter, parse.text^, local_status);

      CASEND;
    END /evaluate/;

    IF NOT local_status.normal THEN
      status := local_status;
    IFEND;

  PROCEND clp$evaluate_token;
*IFEND
?? TITLE := 'clp$convert_string_to_integer', EJECT ??
*copy clh$convert_string_to_integer

  PROCEDURE [XDCL, #GATE] clp$convert_string_to_integer
    (    str: string ( * );
     VAR int: clt$integer;
     VAR status: ost$status);

    VAR
      literal: clt$number,
      local_status: ost$status,
      parse: clt$parse_state,
      sign: -1 .. 1;


  /convert/
    BEGIN
      status.normal := TRUE;

{Preset literal.kind to ensure that subsequent processing resets it.

      literal.kind := clc$real_number;

      clp$initialize_parse_state (^str, NIL, parse);
      clp$scan_lexical_unit (clc$slu_non_space, parse);

      sign := 1;
      CASE parse.unit.kind OF
      = clc$lex_add =
        clp$scan_lexical_unit (clc$slu_non_space, parse);
      = clc$lex_subtract =
        sign := -1;
        clp$scan_lexical_unit (clc$slu_non_space, parse);
      ELSE
        ;
      CASEND;

      IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_unsigned_decimal, clc$lex_alpha_number] THEN
        clp$evaluate_numeric_literal (sign, 10, parse, literal, local_status);
        IF NOT local_status.normal THEN
          status := local_status;
          EXIT /convert/;
        IFEND;
        IF parse.unit_is_space THEN
          clp$scan_lexical_unit (clc$slu_non_space, parse);
        IFEND;
      IFEND;

      IF (parse.unit_index < parse.index_limit) OR (literal.kind <> clc$integer_number) THEN
        osp$set_status_abnormal ('CL', cle$improper_integer, str, status);
        EXIT /convert/;
      IFEND;

      int := literal.integer_number;
    END /convert/;


  PROCEND clp$convert_string_to_integer;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$i_convert_string_to_integer', EJECT ??

{
{ This procedure is the same as the above except for the additon of the
{ DEFAULT_RADIX parameter.
{

  PROCEDURE [XDCL, #GATE] clp$i_convert_string_to_integer
    (    str: string ( * );
         default_radix: 2 .. 16;
     VAR int: clt$integer;
     VAR status: ost$status);

    VAR
      literal: clt$number,
      parse: clt$parse_state,
      sign: -1 .. 1;


    status.normal := TRUE;

{Preset literal.kind to ensure that subsequent processing resets it.

    literal.kind := clc$real_number;

    clp$initialize_parse_state (^str, NIL, parse);
    clp$scan_lexical_unit (clc$slu_non_space, parse);

    sign := 1;
    CASE parse.unit.kind OF
    = clc$lex_add =
      clp$scan_lexical_unit (clc$slu_non_space, parse);
    = clc$lex_subtract =
      sign := -1;
      clp$scan_lexical_unit (clc$slu_non_space, parse);
    ELSE
      ;
    CASEND;

    IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_unsigned_decimal, clc$lex_alpha_number] THEN
      clp$evaluate_numeric_literal (sign, default_radix, parse, literal, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF parse.unit_is_space THEN
        clp$scan_lexical_unit (clc$slu_non_space, parse);
      IFEND;
    IFEND;

    IF (parse.unit_index < parse.index_limit) OR (literal.kind <> clc$integer_number) THEN
      osp$set_status_abnormal ('CL', cle$improper_integer, str, status);
      RETURN;
    IFEND;

    int := literal.integer_number;

  PROCEND clp$i_convert_string_to_integer;
*IFEND
?? TITLE := 'clp$convert_string_to_name', EJECT ??
*copyc clh$convert_string_to_name

  PROCEDURE [XDCL, #GATE] clp$convert_string_to_name
    (    str: string ( * );
     VAR name: clt$name;
     VAR status: ost$status);

    VAR
      parse: clt$parse_state;


  /convert/
    BEGIN
      status.normal := TRUE;
      clp$initialize_parse_state (^str, NIL, parse);

    /ok/
      BEGIN
        clp$scan_lexical_unit (clc$slu_non_space, parse);
        CASE parse.unit.kind OF
        = clc$lex_name =
          name.size := parse.unit.size;
          #TRANSLATE (osv$lower_to_upper, str (parse.unit_index, parse.unit.size), name.value);
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, str, status);
          EXIT /convert/;
        ELSE
          EXIT /ok/;
        CASEND;
        clp$scan_lexical_unit (clc$slu_non_space, parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          EXIT /convert/;
        IFEND;
      END /ok/;
      osp$set_status_abnormal ('CL', cle$improper_name, str, status);
    END /convert/;

  PROCEND clp$convert_string_to_name;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$convert_string_to_real', EJECT ??
*copy clh$convert_string_to_real

  PROCEDURE [XDCL, #GATE] clp$convert_string_to_real
    (    str: string ( * );
     VAR real_number: clt$real;
     VAR status: ost$status);

    VAR
      literal: clt$number,
      local_status: ost$status,
      parse: clt$parse_state,
      name: ost$name,
      sign: -1 .. 1;


  /convert/
    BEGIN
      status.normal := TRUE;

{Preset literal.kind to ensure that subsequent processing resets it.

      literal.kind := clc$integer_number;

      clp$initialize_parse_state (^str, NIL, parse);
      clp$scan_lexical_unit (clc$slu_non_space, parse);

      sign := 1;
      CASE parse.unit.kind OF
      = clc$lex_add =
        clp$scan_lexical_unit (clc$slu_non_space, parse);
      = clc$lex_subtract =
        sign := -1;
        clp$scan_lexical_unit (clc$slu_non_space, parse);
      ELSE
        ;
      CASEND;

      CASE parse.unit.kind OF
      = clc$lex_name =
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);
        IF name = '$INFINITY' THEN
          IF sign = 1 THEN
*IF NOT $true(osv$unix)
            #UNCHECKED_CONVERSION (clv$positive_infinity^, real_number.value);
*ELSE
            real_number.value := clv$positive_infinity^;
*IFEND
          ELSE
*IF NOT $true(osv$unix)
            #UNCHECKED_CONVERSION (clv$negative_infinity^, real_number.value);
*ELSE
            real_number.value := clv$negative_infinity^;
*IFEND
          IFEND;
          real_number.number_of_digits := clc$max_real_number_digits;
          clp$scan_lexical_unit (clc$slu_non_space, parse);
          IF parse.unit_index < parse.index_limit THEN
            osp$set_status_abnormal ('CL', cle$improper_real, str, status);
          IFEND;
          EXIT /convert/;
        IFEND;
      = clc$lex_unsigned_decimal =
        clp$evaluate_numeric_literal (sign, 10, parse, literal, local_status);
        IF NOT local_status.normal THEN
          status := local_status;
          EXIT /convert/;
        IFEND;
        IF parse.unit_is_space THEN
          clp$scan_lexical_unit (clc$slu_non_space, parse);
        IFEND;
      ELSE
        ;
      CASEND;

      IF (parse.unit_index < parse.index_limit) OR (literal.kind <> clc$real_number) THEN
        osp$set_status_abnormal ('CL', cle$improper_real, str, status);
        EXIT /convert/;
      IFEND;

      real_number := literal.real_number;
    END /convert/;

  PROCEND clp$convert_string_to_real;
*IFEND

MODEND clm$lexical_processors;
