?? TITLE := 'cli$input_procedures' ??
?? NEWTITLE := 'cli$Input_procedures "global" declarations', EJECT ??
{
{ PURPOSE:
{   The purpose of this "module" is to provide a procedure of the type
{   clt$internal_input_procedure.  It is expected that this "module" will be
{   *COPYed into the module of the caller.
{
{ NOTES:
{   . clp$ip_initialize must be called before clp$input_procedure is called.
{
{   . Names of global variables and procedures in this "module" follow the
{     standard naming conventions with IP_ appended to the $ (with the
{     exception of clp$input_procedure).
{

?? PUSH (LISTEXT := ON) ??
*IF NOT $true(osv$unix)
*copyc amt$file_identifier
*IFEND
*copyc clc$lexical_units_size_pad
*copyc clc$max_command_line_size
*copyc cle$ecc_line_length
*copyc clt$command_line
*copyc clt$command_line_size
*IF NOT $true(osv$unix)
*copyc fst$file_reference
*IFEND
?? POP ??
*IF NOT $true(osv$unix)
*copyc amp$fetch
*copyc amp$get_next
*copyc amp$get_partial
*copyc clp$determine_line_layout
*ELSE
*copyc amp_get_next
*IFEND
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*IF NOT $true(osv$unix)
*copyc clp$layout_data_line
*copyc osp$append_status_file
*IFEND
*copyc osp$set_status_abnormal

  VAR
    clv$ip: [STATIC] record
      capture_command_line: ^procedure (    line: ^clt$command_line;
                                            lexical_units: ^clt$lexical_units),
      capture_data_line: ^procedure (    line: ^clt$command_line),
*IF NOT $true(osv$unix)
      file_id: amt$file_identifier,
*IFEND
      file_name: ^fst$file_reference,
*IF NOT $true(osv$unix)
      file_position: ^amt$file_position,
*IFEND
      lexical_work_area: ^clt$work_area,
*IF NOT $true(osv$unix)
      line_identifier: clt$line_identifier,
      line_layout: clt$line_layout,
*IFEND
      line: ^string (clc$max_command_line_size),
    recend;

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

  PROCEDURE clp$ip_initialize
    (    input_file_name: fst$file_reference;
*IF NOT $true(osv$unix)
         input_file_id: amt$file_identifier;
         input_file_position: ^amt$file_position;
*IFEND
         capture_command_line: ^procedure
           (    line: ^clt$command_line;
                lexical_units: ^clt$lexical_units);
         capture_data_line: ^procedure (    line: ^clt$command_line);
     VAR work_area {input, output} : ^clt$work_area;
     VAR status: ost$status);

*IF NOT $true(osv$unix)
    VAR
      dummy_file_name: amt$local_file_name,
      file_attributes: array [1 .. 4] of amt$fetch_item;
*IFEND


    status.normal := TRUE;
    clv$ip.capture_command_line := capture_command_line;
    clv$ip.capture_data_line := capture_data_line;
*IF NOT $true(osv$unix)
    clv$ip.file_id := input_file_id;
*IFEND
    NEXT clv$ip.file_name: [STRLENGTH (input_file_name)] IN work_area;
    clv$ip.file_name^ := input_file_name;
*IF NOT $true(osv$unix)
    clv$ip.file_position := input_file_position;
*IFEND
    NEXT clv$ip.lexical_work_area: [[REP clc$max_command_line_size +
          clc$lexical_units_size_pad OF clt$lexical_unit]] IN work_area;
    NEXT clv$ip.line IN work_area;

*IF NOT $true(osv$unix)
    file_attributes [1].key := amc$record_type;
    file_attributes [2].key := amc$max_record_length;
    file_attributes [2].max_record_length := 256;
    file_attributes [3].key := amc$line_number;
    file_attributes [4].key := amc$statement_identifier;
    amp$fetch (clv$ip.file_id, file_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dummy_file_name := clv$ip.file_name^;
    clp$determine_line_layout (dummy_file_name,
          file_attributes [1].record_type, file_attributes [2].
          max_record_length, file_attributes [3].source <>
          amc$undefined_attribute, file_attributes [3].line_number,
          file_attributes [4].source <> amc$undefined_attribute,
          file_attributes [4].statement_identifier, clv$ip.line_layout,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clv$ip.line_identifier.record_number := 0;
*IFEND

  PROCEND clp$ip_initialize;
?? TITLE := 'clp$input_procedure', EJECT ??

  PROCEDURE clp$input_procedure
    (VAR parse: clt$parse_state;
     VAR end_of_input: boolean;
     VAR status: ost$status);

    VAR
      lexical_units: ^clt$lexical_units,
      line: ^clt$command_line,
      line_size: clt$command_line_size;


    clp$ip_get_command_line (clv$ip.line^, line_size, end_of_input, status);
    IF (NOT status.normal) OR end_of_input THEN
      RETURN;
    IFEND;

    line := ^clv$ip.line^ (1, line_size);
    RESET clv$ip.lexical_work_area;
    clp$identify_lexical_units (line, clv$ip.lexical_work_area, lexical_units,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$initialize_parse_state (line, lexical_units, parse);

    IF clv$ip.capture_command_line <> NIL THEN
      clv$ip.capture_command_line^ (line, lexical_units);
    IFEND;

  PROCEND clp$input_procedure;
?? TITLE := 'clp$ip_get_command_line', EJECT ??

  PROCEDURE clp$ip_get_command_line
    (VAR line: clt$command_line;
     VAR line_size: clt$command_line_size;
     VAR end_of_input: boolean;
     VAR status: ost$status);

    VAR
      line_continued: boolean,
      continuation_line_size: clt$command_line_size,
      continuation_line: ^clt$command_line;


    clp$ip_get_data_line (line, line_size, end_of_input, status);
    IF (NOT status.normal) OR end_of_input THEN
      RETURN;
    IFEND;

    IF (line_size >= 2) AND (line (line_size - 1, 2) = '..') THEN
      line_size := line_size - 2;
      WHILE (line_size > 0) AND (line (line_size) = '.') DO
        line_size := line_size - 1;
      WHILEND;
      PUSH continuation_line: [clc$max_command_line_size];
      REPEAT
        clp$ip_get_data_line (continuation_line^, continuation_line_size,
              end_of_input, status);
        IF NOT status.normal THEN
          RETURN;
        ELSEIF end_of_input THEN
          osp$set_status_abnormal ('CL', cle$expecting_continuation_line, '',
                status);
          RETURN;
        IFEND;
        line_continued := (continuation_line_size >= 2) AND
              (continuation_line^ (continuation_line_size - 1, 2) = '..');
        IF line_continued THEN
          continuation_line_size := continuation_line_size - 2;
          WHILE (continuation_line_size > 0) AND
                (continuation_line^ (continuation_line_size) = '.') DO
            continuation_line_size := continuation_line_size - 1;
          WHILEND;
        IFEND;
        IF (line_size + continuation_line_size) >
              clc$max_command_line_size THEN
          osp$set_status_abnormal ('CL', cle$continued_line_too_long, '',
                status);
          RETURN;
        IFEND;
        line (line_size + 1, continuation_line_size) :=
              continuation_line^ (1, continuation_line_size);
        line_size := line_size + continuation_line_size;
      UNTIL NOT line_continued;
    IFEND;

  PROCEND clp$ip_get_command_line;
?? TITLE := 'clp$ip_get_data_line', EJECT ??

  PROCEDURE clp$ip_get_data_line
    (VAR line: clt$command_line;
     VAR line_size: clt$command_line_size;
     VAR end_of_input: boolean;
     VAR status: ost$status);

    VAR
      dummy_file_name: amt$local_file_name,
      line_area: ^SEQ ( * ),
      next_line_area: ^cell,
*IF NOT $true(osv$unix)
      nominal_line: ^array [1 .. clc$nominal_command_line_size] of cell,
      first_part_of_line: ^array [1 .. clc$nominal_command_line_size] of cell,
      ignore_byte_address: amt$file_byte_address,
      transfer_count: amt$transfer_count,
      record_length: amt$max_record_length,
*ELSE
      get_line: string (256),
      get_length: integer,
      stat: integer,
*IFEND
      line_value: ^clt$command_line;


    status.normal := TRUE;
    end_of_input := TRUE;
    line_size := 0;

*IF NOT $true(osv$unix)
    PUSH line_area: [[REP clc$nominal_command_line_size OF char]];
    clv$ip.line_identifier.byte_address := 0;
    amp$get_next (clv$ip.file_id, line_area, clc$nominal_command_line_size,
          transfer_count, clv$ip.line_identifier.byte_address,
          clv$ip.file_position^, status);
    IF status.normal AND (clv$ip.file_position^ < amc$eor) AND
          (clv$ip.line_layout.physical_line_size >
          clc$nominal_command_line_size) THEN
      RESET line_area;
      NEXT nominal_line IN line_area;
      PUSH line_area: [[REP clv$ip.line_layout.physical_line_size OF char]];
      RESET line_area;
      NEXT first_part_of_line IN line_area;
      first_part_of_line := nominal_line;
      NEXT next_line_area IN line_area;
      record_length := clc$nominal_command_line_size;
      amp$get_partial (clv$ip.file_id, next_line_area,
            clv$ip.line_layout.physical_line_size -
            clc$nominal_command_line_size, record_length, transfer_count,
            ignore_byte_address, clv$ip.file_position^, amc$no_skip, status);
      transfer_count := record_length;
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    ELSEIF clv$ip.file_position^ < amc$eor THEN
      osp$set_status_abnormal ('CL', cle$line_too_long, '', status);
      osp$append_status_file (osc$status_parameter_delimiter,
            clv$ip.file_name^, status);
      RETURN;
    ELSEIF clv$ip.file_position^ > amc$eor THEN
      RETURN;
    ELSE
      dummy_file_name := clv$ip.file_name^;
      clp$layout_data_line (dummy_file_name, transfer_count,
            clv$ip.line_layout, line_area, line_value, clv$ip.line_identifier,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    end_of_input := FALSE;
    IF STRLENGTH (line_value^) > UPPERVALUE (line_size) THEN
      line_size := UPPERVALUE (line_size);
    ELSE
      line_size := STRLENGTH (line_value^);
    IFEND;
    line (1, line_size) := line_value^ (1, line_size);
*ELSE

    end_of_input := FALSE;
    amp_get_next (get_line, get_length, stat);
    status.normal := stat <> 1;
    status.condition := stat;
    line_size := get_length - 1;
    line (1, line_size) := get_line (1, line_size);
*IFEND

    IF clv$ip.capture_data_line <> NIL THEN
      clv$ip.capture_data_line^ (^line (1, line_size));
    IFEND;

  PROCEND clp$ip_get_data_line;
?? OLDTITLE ??
