?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Process Commands' ??
MODULE clm$f_process_commands;

{
{ PURPOSE:
{   This module contains the routines that interpret an individual command or control statement.
{   This entails parsing the command image, using the command list to search for the appropriate processor,
{   and passing control to that processor in the appropriate fashion (call, load and call, execute, or
{   PROCedure call.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$variable_reference
*copyc cle$ecc_command_processing
*copyc cle$ecc_control_statement
*copyc cle$ecc_miscellaneous
*copyc clt$command_line
*copyc clt$command_line_index
*copyc clt$command_line_size
*copyc clt$f_block
*copyc clt$file
*copyc clt$interpreter_modes
*copyc clt$lexical_unit_kinds
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*copyc clp$append_status_parse_state
*copyc clp$delete_current_format_token
*copyc clp$f_check_name_for_control
*copyc clp$f_complete_file_or_var_scan
*copyc clp$f_find_current_block
*copyc clp$f_evaluate_expression
*copyc clp$f_pop_block_stack
*copyc clp$f_push_block_stack
*copyc clp$f_scan_expression
*copyc clp$f_scan_parameter_list
*copyc clp$f_scan_token
*copyc clp$f_set_command_header_type
*copyc clp$initialize_parse_state
*copyc clp$insert_format_marker
*copyc clp$isolate_text_via_separator
*copyc clp$recognize_format_tokens
*copyc clp$set_format_type
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper

  CONST
    commands_to_translate_count = 3;

  VAR
    commands_to_translate: [STATIC, READ, oss$job_paged_literal] array [1 .. commands_to_translate_count] of
          ost$name := ['CREATE_VARIABLE', 'CREATE_VARIABLES', 'CREV'];

  VAR
    clv$translate: [XREF] boolean;


  VAR
    clv$substitution_mark: [XREF, READ]  string (1) ;

  CONST
    clc$case_selection_name = '= case_selection =',
    clc$case_selection_name_size = 18;

?? TITLE := 'clp$f_process_command', EJECT ??

  PROCEDURE [XDCL] clp$f_process_command
    (    interpreter_mode: clt$interpreter_modes;
         command: ^clt$command_line;
     VAR status: ost$status);

    VAR
      index: 1 .. commands_to_translate_count,
      label: ost$name,
      escaped_command: boolean,
      name_index: clt$command_line_index,
      name_size: clt$command_line_size,
      file: clt$file,
      file_given: boolean,
      command_name: clt$name,
      separator: clt$lexical_unit_kind,
      empty_command: boolean,
      control_statement_descriptor: ^clt$f_control_statement_desc,
      parameter_list: ^clt$parameter_list,
      parameter_list_container: ^clt$parameter_list,
      parse: clt$parse_state,
      space_after_label: boolean,
      found_leading_spaces: boolean,
      value: clt$value,
      right_value_kind: [STATIC, READ] clt$value_kind_specifier := [NIL, clc$any_value],
      parameter_list_contents: ^string ( * );

    ?VAR
      clc$translate: boolean := TRUE?;

    status.normal := TRUE;
    IF STRLENGTH (command^) = 0 THEN
      RETURN;
    IFEND; {write to output ????? ||||

    clp$recognize_format_tokens (FALSE);

    PUSH parameter_list_container: [[REP #SIZE (clt$command_line_size) + #SIZE (command^) OF cell]];
    clp$parse_command (command, parameter_list_container, escaped_command, label, name_index, name_size, file,
          file_given, command_name, separator, parameter_list, parameter_list_contents, empty_command,
          space_after_label, found_leading_spaces, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$recognize_format_tokens (TRUE);

    reparse_command (command, escaped_command, label, name_index, name_size, file, file_given, command_name,
          separator, parameter_list, parameter_list_contents, empty_command, space_after_label,
          found_leading_spaces, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF empty_command THEN
      RETURN;
    IFEND;

  /process_command/
    BEGIN
      IF separator = clc$lex_equal THEN
        IF interpreter_mode = clc$interpret_mode THEN

          IF escaped_command OR (label <> osc$null_name) THEN
            osp$set_status_abnormal ('CL', cle$assignment_cant_be_labelled, '', status);
            EXIT /process_command/;
          IFEND;

          IF command_name.value (1, command_name.size) = clc$case_selection_name THEN
            clp$f_set_command_header_type (clc$case_selection);
          ELSE
            clp$f_set_command_header_type (clc$assignment);
          IFEND;
          clp$initialize_parse_state (^parameter_list_contents^, NIL, parse);
          clp$f_scan_token (clc$slu_any, parse);
          clp$f_evaluate_expression (right_value_kind, FALSE, FALSE, parse, value, status);
          IF (parse.unit.kind <> clc$lex_end_of_line) AND (parse.unit.kind <> clc$lex_comma) AND
                (NOT parse.previous_unit_is_space) AND (NOT parse.unit_is_space) THEN
            osp$set_status_abnormal ('CL', cle$expecting_end_of_expression, '', status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          IFEND;
        IFEND;

      ELSEIF file_given THEN

        IF label <> osc$null_name THEN
          osp$set_status_abnormal ('CL', cle$commands_cant_be_labelled, '', status);
          EXIT /process_command/;
        IFEND;

        clp$f_set_command_header_type (clc$file_command);
        clp$f_scan_parameter_list (parameter_list^, status);

      ELSE
        clp$f_check_name_for_control (command_name, control_statement_descriptor);
        IF control_statement_descriptor <> NIL THEN

          CASE control_statement_descriptor^.kind OF
          = clc$control_statement =

            IF (label <> '') AND (NOT control_statement_descriptor^.label_allowed) THEN
              osp$set_status_abnormal ('CL', cle$statement_cant_be_labelled, command_name.value, status);
              EXIT /process_command/;
            IFEND;
            IF escaped_command THEN
              osp$set_status_abnormal ('CL', cle$unexpected_escape, command_name.value, status);
              EXIT /process_command/;
            IFEND;
            IF separator = clc$lex_comma THEN
              osp$set_status_abnormal ('CL', cle$unexpected_comma_after, command_name.value, status);
              EXIT /process_command/;
            IFEND;

            control_statement_descriptor^.statement^ (label, parameter_list_contents^, status);

          = clc$control_command =

            IF label <> osc$null_name THEN
              osp$set_status_abnormal ('CL', cle$commands_cant_be_labelled, '', status);
              EXIT /process_command/;
            IFEND;

            control_statement_descriptor^.command^ (parameter_list^, status);
          CASEND;

        ELSE

          IF label <> osc$null_name THEN
            osp$set_status_abnormal ('CL', cle$commands_cant_be_labelled, '', status);
            EXIT /process_command/;
          IFEND;

          IF clv$translate THEN

          /search_to_translate/
            FOR index := 1 TO commands_to_translate_count DO
              IF command_name.value = commands_to_translate [index] THEN
                clp$f_set_command_header_type (clc$to_be_translated_command);
                EXIT /search_to_translate/;
              IFEND;
            FOREND /search_to_translate/;
          IFEND;

          clp$f_scan_parameter_list (parameter_list^, status);
        IFEND;
      IFEND;
    END /process_command/;

  PROCEND clp$f_process_command;
?? TITLE := 'clp$parse_command', EJECT ??
*copyc clh$parse_command

  PROCEDURE clp$parse_command
    (    command: ^string ( * );
         parameter_list_container: ^clt$parameter_list;
     VAR escaped: boolean;
     VAR label: ost$name;
     VAR name_index: clt$command_line_index;
     VAR name_size: clt$command_line_size;
     VAR file: clt$file;
     VAR file_given: boolean;
     VAR name: clt$name;
     VAR separator: clt$lexical_unit_kind;
     VAR parameter_list: ^clt$parameter_list;
     VAR parameter_list_contents: ^string ( * );
     VAR empty_command: boolean;
     VAR space_after_label: boolean;
     VAR found_leading_spaces: boolean;
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      leading_name: clt$name,
      command_index: clt$command_line_index,
      parse_for_separator: clt$parse_state,
      parameter_list_area: ^clt$parameter_list,
      parameter_list_size: ^clt$command_line_size;


    status.normal := TRUE;
    command_index := 1;
    file_given := FALSE;
    found_leading_spaces := FALSE;
    escaped := FALSE;
    clp$initialize_parse_state (command, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    found_leading_spaces := parse.previous_unit_is_space;

    IF (clv$substitution_mark <> ' ') AND (parse.text^ (parse.unit_index, parse.unit.size) =
          clv$substitution_mark) THEN
      empty_command := TRUE;
      name_index := parse.unit_index;
      RETURN;
    IFEND;

    CASE parse.unit.kind OF
    = clc$lex_query =
      clp$f_scan_token (clc$slu_non_space, parse);
      escaped := parse.unit.kind = clc$lex_divide;
      IF escaped THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
    = clc$lex_divide =
      escaped := TRUE;
      clp$f_scan_token (clc$slu_non_space, parse);
    = clc$lex_end_of_line =
      empty_command := TRUE;
      name_index := parse.unit_index;
      RETURN;
    ELSE
      escaped := FALSE;
    CASEND;
    empty_command := FALSE;

    label := osc$null_name;
    name_index := parse.unit_index;
    IF parse.unit.kind = clc$lex_name THEN
      clp$f_scan_token (clc$slu_any, parse);
      IF parse.unit.kind = clc$lex_colon THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.previous_non_space_unit_index,
              parse.previous_non_space_unit.size), label);
        clp$f_set_command_header_type (clc$labeled_command);
        clp$f_scan_token (clc$slu_non_space, parse);
        space_after_label := parse.previous_unit_is_space;
        name_index := parse.unit_index;
      IFEND;
    IFEND;
    clp$isolate_text_via_separator (clc$ibt_stop_on_relational, command^, name_index, command_index);
    name_size := command_index - name_index;


    parse.index := command_index;
    clp$f_scan_token (clc$slu_non_space, parse);
    parse_for_separator := parse;
    IF parse.previous_unit_is_space AND (NOT (parse.unit.kind IN $clt$lexical_unit_kinds
          [clc$lex_equal, clc$lex_comma, clc$lex_end_of_line])) THEN
      separator := clc$lex_space;
    ELSE
      separator := parse.unit.kind;
      clp$f_scan_token (clc$slu_non_space, parse);
    IFEND;

    parameter_list := NIL;
    parameter_list_contents := ^command^ (command_index, STRLENGTH (command^) - command_index + 1);
    IF parameter_list_container <> NIL THEN
      parameter_list_area := parameter_list_container;
      RESET parameter_list_area;
      NEXT parameter_list_size IN parameter_list_area;
      IF parameter_list_size <> NIL THEN
        parameter_list_size^ := STRLENGTH (command^) - parse.unit_index + 1;
        NEXT parameter_list_contents: [parameter_list_size^] IN parameter_list_area;
      IFEND;
      IF parameter_list_contents = NIL THEN
        osp$set_status_abnormal ('CL', cle$table_overflow, 'Parameter_List_Area in clp$parse_command',
              status);
        RETURN;
      IFEND;
      parameter_list_contents^ := command^ (parse.unit_index, parameter_list_size^);
      RESET parameter_list_area;
      NEXT parameter_list: [[REP #SIZE (parameter_list_size^) + #SIZE (parameter_list_contents^) OF cell]] IN
            parameter_list_area;
    IFEND;

    CASE separator OF
    = clc$lex_equal =
      name.value := 'assignment';
      name.size := 10;
    = clc$lex_space, clc$lex_comma, clc$lex_end_of_line =

      clp$initialize_parse_state (^command^ (name_index, name_size), NIL, parse);
      clp$f_scan_token (clc$slu_non_space, parse);
      CASE parse.unit.kind OF
      = clc$lex_colon, clc$lex_dot =
        leading_name.value := osc$null_name;
        leading_name.size := 1;
      = clc$lex_name =
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), leading_name.value);
        leading_name.size := parse.unit.size;
        clp$f_scan_token (clc$slu_any, parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          file_given := FALSE;
          name := leading_name;
          RETURN;
        IFEND;
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_command, command^ (name_index, name_size), status);
        RETURN;
      CASEND;

      file_given := TRUE;

    ELSE
      osp$set_status_abnormal ('CL', cle$unexpected_after_command, '', status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse_for_separator, status);
    CASEND;

  PROCEND clp$parse_command;
?? TITLE := 'reparse_command', EJECT ??

  PROCEDURE reparse_command
    (    command: ^string ( * );
         escaped: boolean;
         label: ost$name;
         name_index: clt$command_line_index;
         name_size: clt$command_line_size;
     VAR file: clt$file;
     VAR file_given: boolean;
     VAR name: clt$name;
     VAR separator: clt$lexical_unit_kind;
     VAR parameter_list: ^clt$parameter_list;
     VAR parameter_list_contents: ^string ( * );
     VAR empty_command: boolean;
         space_after_label: boolean;
         found_leading_spaces: boolean;
     VAR status: ost$status);

{ PURPOSE:
{    The purpose of this procedure is to pass on to the SCL formatter
{    the information concerning the command which was gathered by
{    CLP$PARSE_COMMAND.  It would be awkward for that procedure to
{    generate formmatter information via clp$add_format_token, etc.
{    due to the frequent need to "look-ahead".

    VAR
      case_block: ^clt$f_block,
      parse: clt$parse_state,
      file_parse: clt$parse_state,
      leading_name: clt$name,
      left_value_kind: [STATIC, READ] clt$value_kind_specifier :=
            [NIL, clc$variable_reference, clc$array_allowed, clc$any_value],
      variable: clt$value,
      command_index: clt$command_line_index,
      parameter_list_area: ^clt$parameter_list,
      parameter_list_size: ^ost$string_size;

    status.normal := TRUE;
    clp$initialize_parse_state (command, NIL, parse);

    IF empty_command THEN
      IF (clv$substitution_mark <>' ') AND (parse.text^ (name_index, 1) =
            clv$substitution_mark) THEN
        REPEAT
          clp$f_scan_token (clc$slu_non_space, parse);
        UNTIL parse.unit.kind = clc$lex_end_of_line;
        RETURN;
      ELSE
        clp$f_scan_token (clc$slu_non_space, parse); {To record any leading comments
        RETURN;
      IFEND;
    IFEND;

{ Read (and, via clp$f_scan_token, record) all tokens up to the command name.

    IF name_index > 1 THEN
      REPEAT
        clp$f_scan_token (clc$slu_any, parse);
      UNTIL parse.index = name_index;
    IFEND;

    clp$isolate_text_via_separator (clc$ibt_stop_on_relational, command^, name_index, command_index);
    parse.index := command_index;
    IF file_given THEN
      clp$insert_format_marker (clc$file_or_var_begin, 0);
      clp$initialize_parse_state (^command^ (name_index, name_size), NIL, file_parse);
      clp$f_scan_token (clc$slu_any, file_parse);
      CASE file_parse.unit.kind OF
      = clc$lex_colon, clc$lex_dot =
        leading_name.value := osc$null_name;
        leading_name.size := 1;
      = clc$lex_name =
        #TRANSLATE (osv$lower_to_upper, file_parse.text^ (file_parse.unit_index, file_parse.unit.size),
              leading_name.value);
        leading_name.size := file_parse.unit.size;
        clp$f_scan_token (clc$slu_any, file_parse);
      ELSE
      CASEND;

      clp$f_complete_file_or_var_scan (file_parse, status);
      IF status.normal THEN
        IF file_parse.unit.kind <> clc$lex_end_of_line THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_command, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, file_parse, status);
        IFEND;
      IFEND;
      clp$insert_format_marker (clc$file_or_var_end, 0);

    ELSEIF separator = clc$lex_equal THEN

      IF name_size = 0 THEN
        clp$f_find_current_block (case_block);
        IF case_block^.kind <> clc$case_block THEN
{actually, not the right error, but so far, better than nothing
          osp$set_status_abnormal ('CL', cle$case_sel_cant_be_labelled, '', status);
          RETURN;
        IFEND;
        name.value := clc$case_selection_name;
        name.size := clc$case_selection_name_size;
      ELSE
        clp$f_scan_expression (command^ (name_index, name_size), left_value_kind, variable, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    ELSE
      parse.index := name_index;
      clp$f_scan_token (clc$slu_non_space, parse);
    IFEND;
    IF separator <> clc$lex_space THEN
      IF separator = clc$lex_equal THEN

{ Read and record any spaces before "=".

        clp$f_scan_token (clc$slu_any, parse);
        IF parse.unit_is_space THEN
          clp$f_scan_token (clc$slu_non_space, parse);
        IFEND;

{ Read and record any spaces after "=".

        clp$f_scan_token (clc$slu_any, parse);
        IF NOT parse.unit_is_space THEN
          clp$delete_current_format_token;
        IFEND;
      ELSE
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
    ELSE
      clp$f_scan_token (clc$slu_non_space, parse);
      IF parse.previous_unit_is_space THEN
        clp$delete_current_format_token;
      IFEND;
    IFEND;

  PROCEND reparse_command;

MODEND clm$f_process_commands;
