?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Get Line' ??
MODULE clm$accept;

{
{ PURPOSE:
{   This module contains the processor for the get_line command.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$lfn_program_actions
*copyc clc$standard_file_names
*copyc clt$parameter_list
*copyc cle$bad_type_specification
*copyc clt$command_line
*copyc clt$command_line_size
*copyc clt$when_conditions
*copyc cyd$run_time_error_condition
*copyc ife$error_codes
*copyc ost$caller_identifier
*copyc ost$status
?? POP ??
*copyc amv$nil_file_identifier
*copyc clp$change_variable
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_parameters
*copyc clp$find_current_block
*copyc clp$get_line_from_command_file
*copyc clp$get_type_information
*copyc clp$get_variable
*copyc clp$get_work_area
*copyc clp$make_array_value
*copyc clp$make_clt$integer_value
*copyc clp$make_list_value
*copyc clp$make_sized_string_value
*copyc clp$pop_input
*copyc clp$push_input
*copyc clp$put_job_output
*copyc clv$nil_block_handle
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal
*copyc pmp$continue_to_cause

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

  PROCEDURE [XDCL] clp$_get_line
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (osm$getl) get_line, get_lines, accept_line, accept_lines, accl, getl (
{   variable, v: (VAR) any of
{       string
{       list 0..clc$max_list_size of string
{       array of string
{     anyend = $required
{   input, i: file = $required
{   prompt, p: string = $optional
{   line_count, lc: (VAR) integer = $optional
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 9] of clt$pdt_parameter_name,
        parameters: array [1 .. 5] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
          qualifier: clt$union_type_qualifier,
          type_size_1: clt$type_specification_size,
          element_type_spec_1: record
            header: clt$type_specification_header,
            qualifier: clt$string_type_qualifier,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$list_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
              qualifier: clt$string_type_qualifier,
            recend,
          recend,
          type_size_3: clt$type_specification_size,
          element_type_spec_3: record
            header: clt$type_specification_header,
            qualifier: clt$array_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
              qualifier: clt$string_type_qualifier,
            recend,
          recend,
        recend,
        type2: record
          header: clt$type_specification_header,
        recend,
        type3: record
          header: clt$type_specification_header,
          qualifier: clt$string_type_qualifier,
        recend,
        type4: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        type5: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [87, 12, 9, 14, 15, 33, 835], clc$command, 9, 5, 2, 0, 0, 2, 5, 'OSM$GETL'],
            [['I                              ', clc$abbreviation_entry, 2],
            ['INPUT                          ', clc$nominal_entry, 2],
            ['LC                             ', clc$abbreviation_entry, 4],
            ['LINE_COUNT                     ', clc$nominal_entry, 4],
            ['P                              ', clc$abbreviation_entry, 3],
            ['PROMPT                         ', clc$nominal_entry, 3],
            ['STATUS                         ', clc$nominal_entry, 5],
            ['V                              ', clc$abbreviation_entry, 1],
            ['VARIABLE                       ', clc$nominal_entry, 1]], [
{ PARAMETER 1
      [9, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_reference, clc$immediate_evaluation,
            clc$standard_parameter_checking, 88, clc$required_parameter, 0, 0],
{ PARAMETER 2
      [2, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 3, clc$required_parameter, 0, 0],
{ PARAMETER 3
      [6, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_value, clc$immediate_evaluation,
            clc$standard_parameter_checking, 8, clc$optional_parameter, 0, 0],
{ PARAMETER 4
      [4, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods
            [clc$specify_by_name, clc$specify_positionally], clc$pass_by_reference, clc$immediate_evaluation,
            clc$standard_parameter_checking, 20, clc$optional_parameter, 0, 0],
{ PARAMETER 5
      [7, clc$normal_usage_entry, clc$non_secure_parameter, $clt$parameter_spec_methods [clc$specify_by_name],
            clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
            clc$optional_parameter, 0, 0]],
{ PARAMETER 1
      [[1, 0, clc$union_type], [[clc$array_type, clc$list_type, clc$string_type], FALSE, 3], 8,
            [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]], 24,
            [[1, 0, clc$list_type], [8, 0, clc$max_list_size, FALSE],
            [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]]], 32,
            [[1, 0, clc$array_type], [8, FALSE], [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]]]],
{ PARAMETER 2
      [[1, 0, clc$file_type]],
{ PARAMETER 3
      [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 4
      [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]],
{ PARAMETER 5
      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$variable = 1,
      p$input = 2,
      p$prompt = 3,
      p$line_count = 4,
      p$status = 5;

    VAR
      pvt: array [1 .. 5] of clt$parameter_value;


    CONST
      default_prompt_header = ' ENTER ',
      default_prompt_header_size = 7;

    VAR
      access_mode: clt$data_access_mode,
      class: clt$variable_class,
      default_prompt_size: ost$string_size,
      element_index: clt$array_bound,
      element_index_string: ost$string,
      evaluation_method: clt$expression_eval_method,
      input_block: ^clt$block,
      input_block_handle: clt$block_handle,
      input_executable: boolean,
      input_file_id: amt$file_identifier,
      input_file_name: amt$local_file_name,
      line_count: clt$data_value,
      line_value: ^clt$data_value,
      list_value: ^clt$data_value,
      local_status: ost$status,
      max_string_size: clt$string_size,
      min_string_size: clt$string_size,
      prompt_string: ost$string,
      retry_read: boolean,
      terminate_read: boolean,
      type_information: clt$type_information,
      type_specification: ^clt$type_specification,
      upper_bound: clt$array_bound,
      using_default_prompt: boolean,
      work_area: ^^clt$work_area;

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

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


      clean_up;

    PROCEND abort_handler;
?? TITLE := 'clean_up', EJECT ??

    PROCEDURE [INLINE] clean_up;

      VAR
        ignore_status: ost$status;


      clp$pop_input (TRUE, input_block_handle, input_file_id, input_executable, NIL, ignore_status);

    PROCEND clean_up;
?? OLDTITLE, EJECT ??

?? TITLE := 'read_line', EJECT ??
{
{ The READ_LINE procedure contains a pause_break condition handler so that
{ after a pause break occurs, the prompt for input can be re-issued.
{ Normally this would happen automatically as part of an interactive read
{ operation; but since the prompt issued can be longer than that handled
{ by interactive input, it must be "manually" issued.
{

    PROCEDURE read_line;

      VAR
        data_line_size: clt$string_size,
        data_line: ^clt$command_line,
        null_prompt: ^clt$prompt_string,
        result_string_size: clt$string_size;

?? NEWTITLE := 'interactive_pause_handler', EJECT ??

      PROCEDURE interactive_pause_handler
        (    condition: pmt$condition;
             ignore_condition_information: ^pmt$condition_information;
             ignore_save_area: ^ost$stack_frame_save_area;
         VAR handler_status: ost$status);


        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
        IF handler_status.normal AND (condition.selector = ifc$interactive_condition) AND
              (condition.interactive_condition = ifc$pause_break) THEN
          retry_read := TRUE;
          EXIT read_line;
        IFEND;

      PROCEND interactive_pause_handler;
?? OLDTITLE, EJECT ??

      IF (input_block^.input.kind = clc$file_input) AND input_block^.input.interactive_device THEN
        osp$establish_condition_handler (^interactive_pause_handler, FALSE);
        clp$put_job_output (prompt_string.value (1, prompt_string.size), status);
        IF NOT status.normal THEN
          clean_up;
          EXIT clp$_get_line;
        IFEND;
      IFEND;

      PUSH null_prompt: [0];
      clp$get_line_from_command_file (null_prompt^, data_line, status);
      IF NOT status.normal THEN
        clean_up;
        EXIT clp$_get_line;
      IFEND;
      IF data_line <> NIL THEN
        IF STRLENGTH (data_line^) > max_string_size THEN
          data_line_size := max_string_size;
        ELSE
          data_line_size := STRLENGTH (data_line^);
        IFEND;
        IF data_line_size < min_string_size THEN
          result_string_size := min_string_size;
        ELSE
          result_string_size := data_line_size;
        IFEND;
        CASE line_value^.kind OF
        = clc$array =
          IF line_value^.array_value^ [element_index] = NIL THEN
            clp$make_sized_string_value (result_string_size, work_area^, line_value^.
                  array_value^ [element_index]);
          ELSE
            NEXT line_value^.array_value^ [element_index]^.string_value: [result_string_size] IN work_area^;
          IFEND;
          line_value^.array_value^ [element_index]^.string_value^ := data_line^ (1, data_line_size);
        = clc$list =
          IF line_value^.element_value <> NIL THEN {not first time through loop}
            clp$make_list_value (work_area^, list_value^.link);
            list_value := list_value^.link;
          IFEND;
          clp$make_sized_string_value (result_string_size, work_area^, list_value^.element_value);
          list_value^.element_value^.string_value^ := data_line^ (1, data_line_size);
        ELSE { clc$string_type }
          NEXT line_value^.string_value: [result_string_size] IN work_area^;
          line_value^.string_value^ := data_line^ (1, data_line_size);
          line_count.integer_value.value := line_count.integer_value.value + 1;
          terminate_read := TRUE;
        CASEND;
      ELSE
        terminate_read := TRUE;
      IFEND;

    PROCEND read_line;
?? OLDTITLE, EJECT ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_work_area (#RING (^work_area), work_area, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_variable (pvt [p$variable].variable^, work_area^, class, access_mode, evaluation_method,
          type_specification, line_value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_type_information (type_specification, work_area^, type_information, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    input_block := NIL;
    input_block_handle := clv$nil_block_handle;
    input_file_id := amv$nil_file_identifier;
    #SPOIL (input_block_handle, input_file_id);

    osp$establish_block_exit_hndlr (^abort_handler);

  /get_line/
    BEGIN
      clp$push_input (pvt [p$input].value^.file_value^, osc$null_name, '', FALSE, TRUE, input_block_handle,
            input_file_id, input_executable, status);
      IF NOT status.normal THEN
        EXIT /get_line/;
      IFEND;
      clp$find_current_block (input_block);

      using_default_prompt := FALSE;

      IF (input_block^.input.kind = clc$file_input) AND input_block^.input.interactive_device THEN

        IF pvt [p$prompt].specified THEN
          IF STRLENGTH (pvt [p$prompt].value^.string_value^) >= osc$max_string_size THEN
            prompt_string.size := osc$max_string_size;
          ELSE
            prompt_string.size := 1 + STRLENGTH (pvt [p$prompt].value^.string_value^);
          IFEND;
          prompt_string.value (1) := ' ';
          prompt_string.value (2, prompt_string.size - 1) := pvt [p$prompt].
                value^.string_value^ (1, prompt_string.size - 1);
        ELSE
          using_default_prompt := TRUE;
          prompt_string.value := default_prompt_header;
          IF STRLENGTH (pvt [p$variable].variable^) <= (osc$max_string_size - 1 - default_prompt_header_size)
                THEN
            default_prompt_size := default_prompt_header_size + STRLENGTH (pvt [p$variable].variable^) + 1;
          ELSE
            default_prompt_size := osc$max_string_size;
          IFEND;
          prompt_string.size := default_prompt_size;
          prompt_string.value (default_prompt_header_size + 1, * ) := pvt [p$variable].variable^;
          prompt_string.value (prompt_string.size) := ' ';
        IFEND;

      ELSE
        prompt_string.size := 0;
      IFEND;

      IF line_value <> NIL THEN
        CASE line_value^.kind OF
        = clc$array =
          IF type_information.kind = clc$array_type THEN
            max_string_size := type_information.array_element_type_information^.max_string_size;
            min_string_size := type_information.array_element_type_information^.min_string_size;
          ELSE
            max_string_size := clc$max_string_size;
            min_string_size := 0;
          IFEND;
          element_index := LOWERBOUND (line_value^.array_value^);
          upper_bound := UPPERBOUND (line_value^.array_value^);
        = clc$list =
          line_value^.element_value := NIL;
          line_value^.link := NIL;
          list_value := line_value;
          IF type_information.kind = clc$list_type THEN
            max_string_size := type_information.list_element_type_information^.max_string_size;
            min_string_size := type_information.list_element_type_information^.min_string_size;
            upper_bound := type_information.max_list_size;
          ELSE
            max_string_size := clc$max_string_size;
            min_string_size := 0;
            upper_bound := clc$max_list_size;
          IFEND;
          element_index := 1;
        = clc$string =
          IF type_information.kind = clc$string_type THEN
            max_string_size := type_information.max_string_size;
            min_string_size := type_information.min_string_size;
          ELSE
            max_string_size := clc$max_string_size;
            min_string_size := 0;
          IFEND;
        ELSE
          line_value^.kind := clc$string;
          NEXT line_value^.string_value: [0] IN work_area^;
          max_string_size := clc$max_string_size;
          min_string_size := 0;
        CASEND;
      ELSE
        CASE type_information.kind OF
        = clc$array_type =
          clp$make_array_value (type_information.bounds.lower, type_information.bounds.upper, work_area^,
                line_value);
          FOR element_index := type_information.bounds.lower TO type_information.bounds.upper DO
            clp$make_sized_string_value (0, work_area^, line_value^.array_value^ [element_index]);
          FOREND;
          max_string_size := type_information.array_element_type_information^.max_string_size;
          min_string_size := type_information.array_element_type_information^.min_string_size;
          element_index := type_information.bounds.lower;
          upper_bound := type_information.bounds.upper;
        = clc$list_type =
          clp$make_list_value (work_area^, line_value);
          list_value := line_value;
          max_string_size := type_information.list_element_type_information^.max_string_size;
          min_string_size := type_information.list_element_type_information^.min_string_size;
          element_index := 1;
          upper_bound := type_information.max_list_size;
        = clc$string_type =
          clp$make_sized_string_value (0, work_area^, line_value);
          max_string_size := type_information.max_string_size;
          min_string_size := type_information.min_string_size;
        ELSE
          clp$make_sized_string_value (0, work_area^, line_value);
          max_string_size := clc$max_string_size;
          min_string_size := 0;
        CASEND;
      IFEND;

      line_count.kind := clc$integer;
      line_count.integer_value.value := 0;
      line_count.integer_value.radix := 10;
      line_count.integer_value.radix_specified := FALSE;

    /input_loop/
      WHILE TRUE DO
        terminate_read := FALSE;
        retry_read := FALSE;

        IF using_default_prompt AND ((line_value^.kind = clc$array) OR (line_value^.kind = clc$list)) THEN
          clp$convert_integer_to_string (element_index, 10, FALSE, element_index_string, local_status);
          IF (default_prompt_size + element_index_string.size + 2) <= osc$max_string_size THEN
            prompt_string.size := default_prompt_size + element_index_string.size + 2;
            prompt_string.value (default_prompt_size) := '(';
            prompt_string.value (default_prompt_size + 1, element_index_string.size) :=
                  element_index_string.value (1, element_index_string.size);
            prompt_string.value (prompt_string.size - 1, 2) := ') ';
          ELSE
            prompt_string.size := default_prompt_size;
            prompt_string.value (default_prompt_size) := ' ';
          IFEND;
        IFEND;

        read_line;
        IF terminate_read THEN
          EXIT /input_loop/;
        IFEND;
        IF NOT retry_read THEN
          line_count.integer_value.value := line_count.integer_value.value + 1;
          element_index := element_index + 1;
          IF element_index > upper_bound THEN
            EXIT /input_loop/;
          IFEND;
        IFEND;
      WHILEND /input_loop/;
    END /get_line/;

    clp$pop_input (TRUE, input_block_handle, input_file_id, input_executable, NIL, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

    osp$disestablish_cond_handler;

    IF status.normal THEN
      clp$change_variable (pvt [p$variable].variable^, line_value, status);
      IF status.normal AND pvt [p$line_count].specified THEN
        clp$change_variable (pvt [p$line_count].variable^, ^line_count, status);
      IFEND;
    IFEND;

  PROCEND clp$_get_line;

MODEND clm$accept;
