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

{
{ PURPOSE:
{   This module contains the procedures that collect commands from the current command file onto a
{   specified file.  Both external and internal versions of this facility are available.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_command_processing
*copyc cle$unexpected_call_to
*copyc clk$collect_commands
*copyc clt$command_line_index
*copyc clt$input_data_line_header
*copyc clt$lexical_unit_kinds
*copyc clt$substitution_mark
*copyc fst$file_reference
*copyc ost$name
*copyc ost$status
?? POP ??
*copyc amp$put_next
*copyc amv$nil_file_identifier
*copyc clp$find_input_block
*copyc clp$get_collect_text_cmnd_info
*copyc clp$get_command_line
*copyc clp$get_line_from_command_file
*copyc clp$get_work_area
*copyc clp$identify_lexical_units
*copyc clp$internal_evaluate_sub_param
*copyc clp$parse_command
*copyc clp$scan_any_lexical_unit
*copyc clp$scan_unnested_cmnd_lex_unit
*copyc clp$set_input_line_finished
*copyc clp$set_input_line_parse
*copyc clp$substitute_delimited_text
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper

?? TITLE := 'clp$collect_commands', EJECT ??
*copyc clh$collect_commands

  PROCEDURE [XDCL, #GATE] clp$collect_commands
    (    file: fst$file_reference;
         terminator: ost$name;
     VAR status: ost$status);

?? NEWTITLE := 'abort_handler', EJECT ??

    PROCEDURE abort_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);


      fsp$close_file (file_id, handler_status);
      handler_status.normal := TRUE;

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    VAR
      block: ^clt$block,
      collect_text_info: clt$collect_text_command_info,
      collect_text_prompt: ^clt$prompt_string,
      collect_text_pvt: ^clt$parameter_value_table,
      command_parse: clt$parse_state,
      empty_command: boolean,
      end_index: clt$command_line_index,
      end_of_input: boolean,
      file_attachment: array [1 .. 3] of fst$attachment_option,
      file_id: amt$file_identifier,
      first_line: boolean,
      form: clt$command_reference_form,
      ignore_byte_address: amt$file_byte_address,
      ignore_command_ref_parse: clt$parse_state,
      ignore_escaped: boolean,
      ignore_file: clt$file,
      ignore_label: ost$name,
      ignore_prompting_requested: boolean,
      ignore_util_command_list_entry: ^clt$command_list_entry,
      line: ^clt$command_line,
      line_size: clt$command_line_size,
      local_status: ost$status,
      name: clt$name,
      parse: clt$parse_state,
      saved_work_area: ^clt$work_area,
      separator: clt$lexical_unit_kind,
      start_index: clt$command_line_index,
      translated_terminator: ost$name,
      until_string: ^clt$command_line,
      write_line: boolean,
      work_area: ^^clt$work_area;


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

  /collect_commands/
    BEGIN
      clp$find_input_block (TRUE, block);
      IF block = NIL THEN
        osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$collect_commands', status);
        EXIT /collect_commands/;
      IFEND;

      file_id := amv$nil_file_identifier;
      #SPOIL (file_id);
      osp$establish_block_exit_hndlr (^abort_handler);

      file_attachment [1].selector := fsc$access_and_share_modes;
      file_attachment [1].access_modes.selector := fsc$specific_access_modes;
      file_attachment [1].access_modes.value := $fst$file_access_options [fsc$append, fsc$shorten];
      file_attachment [1].share_modes.selector := fsc$specific_share_modes;
      file_attachment [1].share_modes.value := $fst$file_access_options [];
      file_attachment [2].selector := fsc$access_and_share_modes;
      file_attachment [2].access_modes.selector := fsc$specific_access_modes;
      file_attachment [2].access_modes.value := $fst$file_access_options [fsc$append];
      file_attachment [2].share_modes.selector := fsc$specific_share_modes;
      file_attachment [2].share_modes.value := $fst$file_access_options [];
      file_attachment [3].selector := fsc$open_share_modes;
      file_attachment [3].open_share_modes := -$fst$file_access_options [];

      fsp$open_file (file, amc$record, ^file_attachment, NIL, NIL, NIL, NIL, file_id, local_status);
      IF NOT local_status.normal THEN
        status := local_status;
        EXIT /collect_commands/;
      IFEND;

      clp$get_work_area (#RING (^work_area), work_area, local_status);
      IF NOT local_status.normal THEN
        status := local_status;
        EXIT /collect_commands/;
      IFEND;

      #TRANSLATE (osv$lower_to_upper, terminator, translated_terminator);

      collect_text_pvt := NIL;
      until_string := NIL;

      first_line := TRUE;
      end_of_input := FALSE;
      parse := block^.line_parse;
      line := parse.text;
      start_index := parse.unit_index;
      end_index := start_index;

    /loop/
      WHILE TRUE DO
        IF parse.unit.kind = clc$lex_end_of_line THEN

          line_size := end_index - start_index;
          IF write_line AND ((line_size > 0) OR (NOT first_line)) THEN
            amp$put_next (file_id, ^line^ (start_index), line_size, ignore_byte_address, local_status);
            IF NOT local_status.normal THEN
              write_line := FALSE;
              IF status.normal THEN
                status := local_status;
              IFEND;
            IFEND;
          IFEND;

          IF until_string <> NIL THEN
            REPEAT
              saved_work_area := work_area^;
              clp$get_line_from_command_file (collect_text_prompt^, line, local_status);
              work_area^ := saved_work_area;
              IF NOT local_status.normal THEN
                IF status.normal THEN
                  status := local_status;
                IFEND;
                EXIT /loop/;
              ELSEIF line = NIL THEN
                end_of_input := TRUE;
                IF status.normal THEN
                  osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, 'end_of_input', status);
                  osp$append_status_parameter (osc$status_parameter_delimiter, until_string^, status);
                IFEND;
                EXIT /loop/;
              IFEND;
              amp$put_next (file_id, line, STRLENGTH (line^), ignore_byte_address, local_status);
              IF NOT local_status.normal THEN
                write_line := FALSE;
                IF status.normal THEN
                  status := local_status;
                IFEND;
              IFEND;
            UNTIL line^ = until_string^;
            until_string := NIL;
          IFEND;

          saved_work_area := work_area^;
          clp$get_command_line (parse, end_of_input, local_status);
          work_area^ := saved_work_area;
          IF NOT local_status.normal THEN
            IF status.normal THEN
              status := local_status;
            IFEND;
            EXIT /loop/;
          ELSEIF end_of_input THEN
            EXIT /loop/;
          ELSEIF parse.unit.kind = clc$lex_beginning_of_line THEN
            clp$scan_any_lexical_unit (parse);
          IFEND;
          first_line := FALSE;
          line := parse.text;
          start_index := 1;
          end_index := 1;
        IFEND;

        command_parse := parse;
        clp$scan_unnested_cmnd_lex_unit (parse);
        command_parse.index_limit := parse.unit_index;
        IF parse.unit.kind = clc$lex_semicolon THEN
          clp$scan_any_lexical_unit (parse);
        IFEND;

        saved_work_area := work_area^;
        clp$parse_command (command_parse, ignore_prompting_requested, ignore_escaped, ignore_label,
              ignore_command_ref_parse, ignore_file, form, name, ignore_util_command_list_entry, separator,
              empty_command, local_status);
        work_area^ := saved_work_area;

        IF local_status.normal AND (NOT empty_command) AND (form = clc$name_only_command_ref) AND
              (separator <> clc$lex_equal) THEN

          IF (name.value = translated_terminator) AND (separator IN $clt$lexical_unit_kinds
                [clc$lex_semicolon, clc$lex_end_of_line]) THEN
            line_size := end_index - start_index;
            IF write_line AND (line_size > 0) THEN
              amp$put_next (file_id, ^line^ (start_index), line_size, ignore_byte_address, local_status);
              IF NOT local_status.normal THEN
                IF status.normal THEN
                  status := local_status;
                IFEND;
              IFEND;
            IFEND;
            EXIT /loop/;

          ELSEIF (name.value = 'COLLECT_TEXT') OR (name.value = 'COLT') THEN
            IF collect_text_pvt = NIL THEN
              clp$get_collect_text_cmnd_info (collect_text_info);
              PUSH collect_text_pvt: [1 .. collect_text_info.number_of_parameters];
              PUSH collect_text_prompt: [block^.input.base_prompt_string.size];
              IF STRLENGTH (collect_text_prompt^) > 0 THEN
                collect_text_prompt^ := block^.input.base_prompt_string.value (2, * );
                collect_text_prompt^ (STRLENGTH (collect_text_prompt^)) := '?';
              IFEND;
            IFEND;
            saved_work_area := work_area^;
            clp$internal_evaluate_sub_param (command_parse, collect_text_info.pdt, work_area^,
                  collect_text_pvt, local_status);
            IF NOT collect_text_pvt^ [collect_text_info.input_parameter_number].specified THEN
{
{ An input parameter was not specified.
{
              IF collect_text_pvt^ [collect_text_info.until_parameter_number].specified THEN
                IF collect_text_pvt^ [collect_text_info.until_parameter_number].value <> NIL THEN
{
{ An until string was specified and could be evaluated.
{
                  PUSH until_string: [STRLENGTH (collect_text_pvt^ [collect_text_info.until_parameter_number].
                        value^.string_value^)];
                  until_string^ := collect_text_pvt^ [collect_text_info.until_parameter_number].value^.
                        string_value^;
                ELSE
{
{ An until string was specified but could NOT be evaluated.
{
                  status := local_status;
                  EXIT /loop/;
                IFEND;
              ELSE
{
{ An until string was not specified.  The default is assumed.
{
                until_string := collect_text_info.default_until_string;
              IFEND;
            IFEND;
            work_area^ := saved_work_area;
          IFEND;

        IFEND;
        end_index := parse.unit_index;
      WHILEND /loop/;

      IF NOT end_of_input THEN
        IF until_string <> NIL THEN
          clp$set_input_line_finished;
        ELSE
          clp$set_input_line_parse (parse);
        IFEND;
      IFEND;

      fsp$close_file (file_id, local_status);
      IF (NOT local_status.normal) AND status.normal THEN
        status := local_status;
      IFEND;
    END /collect_commands/;

    osp$disestablish_cond_handler;

  PROCEND clp$collect_commands;
?? TITLE := 'clp$collect_statement', EJECT ??
{
{ PURPOSE:
{   This procedure is used to collect commands within "structured statements" such WHEN/WHENEND.
{   Collection is terminated when an END_NAME is encounterred which balances the BEGIN_NAME that
{   is presumed to have called this procedure.
{

  PROCEDURE [XDCL] clp$collect_statement
    (    save_statement: boolean;
         begin_name: ost$name;
         end_name: ost$name;
         first_line_to_write: clt$command_line;
         substitution_mark: clt$substitution_mark;
     VAR work_area {input, output} : ^clt$work_area;
     VAR statement_area: ^clt$collect_statement_area;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      collect_statement_area: ^clt$collect_statement_area,
      collect_text_info: clt$collect_text_command_info,
      collect_text_prompt: ^clt$prompt_string,
      collect_text_pvt: ^clt$parameter_value_table,
      collect_the_statement: boolean,
      command_index: clt$command_line_index,
      command_parse: clt$parse_state,
      empty_command: boolean,
      end_index: clt$command_line_index,
      end_of_input: boolean,
      first_line: boolean,
      form: clt$command_reference_form,
      ignore_command_ref_parse: clt$parse_state,
      ignore_escaped: boolean,
      ignore_file: clt$file,
      ignore_label: ost$name,
      ignore_prompting_requested: boolean,
      ignore_util_command_list_entry: ^clt$command_list_entry,
      lexical_units: ^clt$lexical_units,
      line: ^clt$command_line,
      line_size: clt$command_line_size,
      local_status: ost$status,
      name: clt$name,
      new_line: ^clt$command_line,
      parse: clt$parse_state,
      save_lexical_units: boolean,
      saved_work_area: ^clt$work_area,
      separator: clt$lexical_unit_kind,
      start_index: clt$command_line_index,
      statement_area_size: integer,
      statement_level: integer,
      until_string: ^clt$command_line;

?? NEWTITLE := 'collect_line', EJECT ??

    PROCEDURE [INLINE] collect_line;

      VAR
        collected_lexical_units: ^clt$lexical_units,
        collected_line: ^clt$command_line,
        header: ^clt$input_data_line_header;


      NEXT header IN work_area;
      header^.line_size := line_size;
      NEXT collected_line: [line_size] IN work_area;
      collected_line^ (1, line_size) := line^ (start_index, line_size);
      statement_area_size := statement_area_size + #SIZE (header^) + #SIZE (collected_line^);

      IF NOT save_lexical_units THEN
        header^.number_of_lexical_units := 0;
      ELSE
        IF lexical_units <> NIL THEN
          NEXT collected_lexical_units: [1 .. UPPERBOUND (lexical_units^)] IN work_area;
          collected_lexical_units^ := lexical_units^;
        ELSE
          clp$identify_lexical_units (collected_line, work_area, collected_lexical_units, local_status);
          IF NOT local_status.normal THEN
            collect_the_statement := FALSE;
            IF status.normal THEN
              status := local_status;
            IFEND;
            RETURN;
          IFEND;
        IFEND;
        header^.number_of_lexical_units := UPPERBOUND (collected_lexical_units^);
        statement_area_size := statement_area_size + #SIZE (collected_lexical_units^);
      IFEND;

      header^.size_of_component_lines_data := 0;

    PROCEND collect_line;
?? TITLE := 'perform_substitution', EJECT ??

    PROCEDURE [INLINE] perform_substitution;

      VAR
        new_line_size: clt$command_line_size;


      clp$substitute_delimited_text (line^ (1, line_size), substitution_mark.value, new_line^, new_line_size,
            local_status);
      IF NOT local_status.normal THEN
        collect_the_statement := FALSE;
        IF status.normal THEN
          status := local_status;
        IFEND;
        RETURN;
      IFEND;

      IF (new_line_size <> line_size) OR (new_line^ (1, line_size) <> line^ (1, line_size)) THEN
        line := ^new_line^ (1, new_line_size);
        line_size := new_line_size;
        lexical_units := NIL;
      IFEND;

    PROCEND perform_substitution;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    clp$find_input_block (TRUE, block);
    IF block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$collect_statement', status);
      statement_area := NIL;
      RETURN;
    IFEND;

    collect_the_statement := save_statement;
    save_lexical_units := save_statement AND (begin_name <> 'JOB');

    IF collect_the_statement THEN
      collect_statement_area := work_area;
      statement_area_size := 0;
      IF STRLENGTH (first_line_to_write) > 0 THEN
        line := ^first_line_to_write;
        line_size := STRLENGTH (line^);
        lexical_units := NIL;
        collect_line;
      IFEND;
      IF substitution_mark.specified THEN
        PUSH new_line: [clc$max_command_line_size];
      IFEND;
    IFEND;

    collect_text_pvt := NIL;
    until_string := NIL;

    first_line := TRUE;
    end_of_input := FALSE;
    parse := block^.line_parse;
    line := parse.text;
    start_index := parse.unit_index;
    end_index := start_index;
    statement_level := 1;

  /loop/
    WHILE TRUE DO
      IF parse.unit.kind = clc$lex_end_of_line THEN

        line_size := end_index - start_index;
        IF collect_the_statement AND ((line_size > 0) OR (NOT first_line)) THEN
          IF (line = parse.text) AND (start_index = 1) AND (line_size = STRLENGTH (line^)) THEN
            lexical_units := parse.units_array;
          ELSE
            lexical_units := NIL;
          IFEND;
          IF substitution_mark.specified THEN
            perform_substitution;
          IFEND;
          collect_line;
        IFEND;

        IF until_string <> NIL THEN
          save_lexical_units := FALSE;
          start_index := 1;
          REPEAT
            saved_work_area := work_area;
            clp$get_line_from_command_file (collect_text_prompt^, line, local_status);
            work_area := saved_work_area;
            IF NOT local_status.normal THEN
              IF status.normal THEN
                status := local_status;
              IFEND;
              EXIT /loop/;
            ELSEIF line = NIL THEN
              end_of_input := TRUE;
              osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, 'end_of_input', status);
              osp$append_status_parameter (osc$status_parameter_delimiter, until_string^, status);
              EXIT /loop/;
            IFEND;
            start_index := 1;
            line_size := STRLENGTH (line^);
            IF substitution_mark.specified THEN
              perform_substitution;
            IFEND;
            collect_line;
          UNTIL line^ = until_string^;
          until_string := NIL;
          save_lexical_units := save_statement AND (begin_name <> 'JOB');
        IFEND;

        saved_work_area := work_area;
        clp$get_command_line (parse, end_of_input, local_status);
        work_area := saved_work_area;
        IF NOT local_status.normal THEN
          IF status.normal THEN
            status := local_status;
          IFEND;
          EXIT /loop/;
        ELSEIF end_of_input THEN
          osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, 'end_of_input', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, end_name, status);
          EXIT /loop/;
        ELSEIF parse.unit.kind = clc$lex_beginning_of_line THEN
          clp$scan_any_lexical_unit (parse);
        IFEND;
        first_line := FALSE;
        line := parse.text;
        start_index := 1;
        end_index := 1;
      IFEND;

      command_parse := parse;
      command_index := parse.unit_index;
      clp$scan_unnested_cmnd_lex_unit (parse);
      command_parse.index_limit := parse.unit_index;
      IF parse.unit.kind = clc$lex_semicolon THEN
        clp$scan_any_lexical_unit (parse);
      IFEND;
      end_index := parse.unit_index;

      saved_work_area := work_area;
      clp$parse_command (command_parse, ignore_prompting_requested, ignore_escaped, ignore_label,
            ignore_command_ref_parse, ignore_file, form, name, ignore_util_command_list_entry, separator,
            empty_command, local_status);
      work_area := saved_work_area;

      IF local_status.normal AND (NOT empty_command) AND (form = clc$name_only_command_ref) AND
            (separator <> clc$lex_equal) THEN

        IF name.value = begin_name THEN
          statement_level := statement_level + 1;

        ELSEIF name.value = end_name THEN
          statement_level := statement_level - 1;
          IF statement_level <= 0 THEN

            IF collect_the_statement AND (begin_name = 'JOB') THEN
              PUSH new_line: [command_index + 6 - 1];
              new_line^ (1, command_index - 1) := line^ (1, command_index - 1);
              new_line^ (command_index, 6) := 'LOGOUT';
              line := new_line;
              end_index := command_index + 6;
            IFEND;

            IF collect_the_statement THEN
              line_size := end_index - start_index;
              IF (line = parse.text) AND (start_index = 1) AND (line_size = STRLENGTH (line^)) THEN
                lexical_units := parse.units_array;
              ELSE
                lexical_units := NIL;
              IFEND;
              IF substitution_mark.specified THEN
                perform_substitution;
              IFEND;
              collect_line;
            IFEND;

            EXIT /loop/;
          IFEND;

        ELSEIF (name.value = 'COLLECT_TEXT') OR (name.value = 'COLT') THEN
          saved_work_area := work_area;
          IF collect_text_pvt = NIL THEN
            clp$get_collect_text_cmnd_info (collect_text_info);
            PUSH collect_text_pvt: [1 .. collect_text_info.number_of_parameters];
            PUSH collect_text_prompt: [block^.input.base_prompt_string.size];
            IF STRLENGTH (collect_text_prompt^) > 0 THEN
              collect_text_prompt^ := block^.input.base_prompt_string.value (2, * );
              collect_text_prompt^ (STRLENGTH (collect_text_prompt^)) := '?';
            IFEND;
          IFEND;
          clp$internal_evaluate_sub_param (command_parse, collect_text_info.pdt, work_area, collect_text_pvt,
                local_status);
          IF NOT collect_text_pvt^ [collect_text_info.input_parameter_number].specified THEN
{
{ An input parameter was not specified.
{
            IF collect_text_pvt^ [collect_text_info.until_parameter_number].specified THEN
              IF collect_text_pvt^ [collect_text_info.until_parameter_number].value <> NIL THEN
{
{ An until string was specified and could be evaluated.
{
                PUSH until_string: [STRLENGTH (collect_text_pvt^ [collect_text_info.until_parameter_number].
                      value^.string_value^)];
                until_string^ := collect_text_pvt^ [collect_text_info.until_parameter_number].value^.
                      string_value^;
              ELSE
 {
{ An until string was specified but could NOT be evaluated.
{
               status := local_status;
                collect_the_statement := FALSE;
                EXIT /loop/;
              IFEND;
            ELSE
{
{ An until string was not specified.  The default is assumed.
{
              until_string := collect_text_info.default_until_string;
            IFEND;
          IFEND;
          work_area := saved_work_area;
        IFEND;

      IFEND;
    WHILEND /loop/;

    IF NOT end_of_input THEN
      IF until_string <> NIL THEN
        clp$set_input_line_finished;
      ELSE
        clp$set_input_line_parse (parse);
      IFEND;
    IFEND;

    IF collect_the_statement THEN
      work_area := collect_statement_area;
      NEXT statement_area: [[REP statement_area_size OF cell]] IN work_area;
      RESET statement_area;
    ELSE
      statement_area := NIL;
    IFEND;

  PROCEND clp$collect_statement;

MODEND clm$collect_commands;
