?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Input Stack Manager' ??
MODULE clm$input_stack_manager;

{
{ PURPOSE:
{   This module contains procedures that manage the SCL input stack.
{
{ DESIGN:
{   The input stack consists of a subset of the information in the block stack.
{   Block stack frames of type command/function proc, input or when comprise
{   the input stack.  Each input stack frame is created, used and deleted by a
{   single task and can therefore contain the file_identifier needed to access
{   a file subsequent to opening it.
{
{ NOTE:
{   This module used to contain the procedure that created input stack frames
{   (clp$push_inpout_stack).  This routine has been split up into specialized
{   procedures, one for each of the flavors of input blocks.  These specialized
{   procedures can be found in module clm$block_stack_manager where they are to
{   use common inline routines for creating blocks.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$file_byte_address
*copyc amt$local_file_name
*IF NOT $true(osv$unix)
*copyc clc$change_secure_logging_name
*IFEND
*copyc clc$compiling_for_test_harness
*copyc clc$lexical_units_size_pad
*IF NOT $true(osv$unix)
*copyc clc$system_logging_active_name
*IFEND
*copyc cle$ecc_command_processing
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_utilities
*copyc clt$collect_statement_area
*copyc clt$command_line
*copyc clt$command_line_size
*copyc clt$command_name
*copyc clt$input_line_kind
*copyc clt$lexical_units
*IF NOT $true(osv$unix)
*copyc jmt$job_mode
*copyc ofe$error_codes
*copyc osc$volume_unavailable_cond
*copyc osd$virtual_address
*copyc ose$heap_full_exceptions
*copyc oss$job_paged_literal
*copyc oss$task_shared
*copyc ost$caller_identifier
*IFEND
*copyc ost$status
?? POP ??
*copyc amp$get_next
*copyc amp$get_partial
*IF NOT $true(osv$unix)
*copyc amp$seek_direct
*IFEND
*copyc amv$nil_file_identifier
*IF NOT $true(osv$unix)
*copyc avp$system_operator
*IFEND
*copyc clp$append_expandable_string
*copyc clp$delete_expandable_string
*copyc clp$find_current_block
*copyc clp$find_input_block
*copyc clp$get_interpreter_mode
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*copyc clp$open_command_file
*copyc clp$pop_block_stack
*copyc clp$store_expandable_string
*copyc clp$update_parse_state
*IF NOT $true(osv$unix)
*copyc clv$system_logging_activated
*IFEND
*copyc fsp$close_file
*copyc i#current_sequence_position
*IF NOT $true(osv$unix)
*copyc jmp$log_edited_login_command
*copyc jmv$executing_within_system_job
*copyc ofp$display_status_message
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$establish_condition_handler
*copyc osp$get_condition_status
*ELSE
*copyc osp$append_status_file
*IFEND
*copyc osp$increment_locked_variable
*copyc osp$set_status_abnormal
*IF NOT $true(osv$unix)
*copyc osp$set_status_from_condition
*copyc osp$verify_system_privilege
*IFEND
*copyc osv$task_shared_heap
*IF NOT $true(osv$unix)
*copyc pmp$abort
*copyc pmp$continue_to_cause
*copyc pmp$log_ascii
*copyc syp$store_system_constant
*IFEND

*IF NOT $true(osv$unix)
?? TITLE := 'clp$open_executable_cmnd_file', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$open_executable_cmnd_file
    (    file_reference: fst$file_reference;
         job_mode: jmt$job_mode;
         access_level: amc$record .. amc$segment;
         file_access_modes: clt$command_file_access_modes;
         attribute_validation: ^fst$file_cycle_attributes;
     VAR file_id: amt$file_identifier;
     VAR sequence: ^SEQ ( * );
     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 ??

    status.normal := TRUE;
    file_id := amv$nil_file_identifier;
    #SPOIL (file_id);
    osp$establish_block_exit_hndlr (^abort_handler);
    clp$open_command_file (file_reference, job_mode, access_level, file_access_modes, attribute_validation,
          {allowed_device_classes} -$fst$device_classes [], file_id, sequence, status);
    osp$disestablish_cond_handler;

  PROCEND clp$open_executable_cmnd_file;
?? TITLE := 'clp$close_executable_cmnd_file', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$close_executable_cmnd_file
    (    file_id: amt$file_identifier;
     VAR status: ost$status);


    fsp$close_file (file_id, status);

  PROCEND clp$close_executable_cmnd_file;
?? TITLE := 'clp$set_prompting_input', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_prompting_input;

    VAR
      block: ^clt$block,
      status: ^ost$status;


    clp$find_input_block (FALSE, block);
    IF block = NIL THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_prompting_input', status^);
      pmp$abort (status^);
    IFEND;

    block^.input.prompting_input := TRUE;

  PROCEND clp$set_prompting_input;
*IFEND
?? TITLE := 'clp$pop_input_stack', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$pop_input_stack
    (VAR block: ^clt$block;
     VAR status: ost$status);

    VAR
      current_block: ^clt$block;

    status.normal := TRUE;
    clp$find_current_block (current_block);

  /pop_non_input_blocks/
    WHILE TRUE DO
      CASE current_block^.kind OF
*IF NOT $true(osv$unix)
      = clc$command_proc_block, clc$function_proc_block, clc$input_block, clc$when_block =
*ELSE
      = clc$input_block =
*IFEND
        EXIT /pop_non_input_blocks/;
      = clc$task_block =
        osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$pop_input_stack', status);
*IF NOT $true(osv$unix)
        pmp$abort (status);
*ELSE
        RETURN;
*IFEND
      ELSE
        clp$pop_block_stack (current_block);
      CASEND;
    WHILEND /pop_non_input_blocks/;

    clp$pop_block_stack (current_block);
    block := current_block;

  PROCEND clp$pop_input_stack;
?? TITLE := 'clp$push_command_line', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_command_line
    (    line: ^clt$command_line;
         lexical_units: ^clt$lexical_units;
     VAR input_block: ^clt$block);

    VAR
      block: ^clt$block,
      pushed_line: ^clt$pushed_line;


    clp$find_input_block (FALSE, block);
    input_block := block;

    IF block = NIL THEN
      RETURN;
    IFEND;

    ALLOCATE pushed_line IN osv$task_shared_heap^;

    pushed_line^.previous := block^.input.pushed_line;
    pushed_line^.line := block^.input.line;
    pushed_line^.parse := block^.line_parse;
    block^.input.pushed_line := pushed_line;

    block^.input.line.area := NIL;
    block^.input.line.text := NIL;
    block^.input.line.lexical_units := NIL;
    clp$store_expandable_string (line, lexical_units, block^.input.line);

    clp$initialize_parse_state (block^.input.line.text, block^.input.line.lexical_units, block^.line_parse);

  PROCEND clp$push_command_line;
?? TITLE := 'clp$pop_command_line', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$pop_command_line;

    VAR
      block: ^clt$block,
      pushed_line: ^clt$pushed_line,
      status: ^ost$status;


    clp$find_input_block (FALSE, block);
    IF (block = NIL) OR (block^.input.pushed_line = NIL) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$pop_command_line', status^);
*IF NOT $true(osv$unix)
      pmp$abort (status^);
*ELSE
      RETURN;
*IFEND
    IFEND;

    clp$delete_expandable_string (block^.input.line);

    pushed_line := block^.input.pushed_line;
    block^.input.pushed_line := pushed_line^.previous;
    block^.input.line := pushed_line^.line;
    block^.line_parse := pushed_line^.parse;

    FREE pushed_line IN osv$task_shared_heap^;

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

  PROCEDURE [INLINE] get_next_segment_line_v0
    (VAR data {input, output} : ^clt$input_data;
     VAR line_text: ^clt$command_line);

    VAR
      line_size: ^clt$command_line_size;


    NEXT line_size IN data;
    IF line_size = NIL THEN
      line_text := NIL;
    ELSE
      NEXT line_text: [line_size^] IN data;
    IFEND;

  PROCEND get_next_segment_line_v0;
?? TITLE := 'clp$get_segment_line_v0', EJECT ??
{
{ PURPOSE:
{   This procedure handles SCL input requests directed toward an "old format"
{   SCL procedure on an object library.
{
{ NOTE:
{   This procedure assumes that the lines it reads have no trailing spaces.
{
{ NOTE:
{   This procedure is #GATEd to allow construction of a pointer to it that
{   allows the procedure to be called from above the ring of execution of
{   this module.
{

  PROCEDURE [XDCL, #GATE] clp$get_segment_line_v0
    (    ignore_line_kind: clt$input_line_kind;
         ignore_prompt_string: clt$prompt_string;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      data: ^clt$input_data,
      line_text: ^clt$command_line;

?? 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);

      CASE condition.selector OF
      = mmc$segment_access_condition =
        IF condition.segment_access_condition.identifier = mmc$sac_io_read_error THEN
          osp$get_condition_status (condition_information, status);
          EXIT clp$get_segment_line_v0;
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = osc$volume_unavailable_cond THEN
          osp$get_condition_status (condition_information, status);
          EXIT clp$get_segment_line_v0;
        IFEND;
      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    clp$find_input_block (TRUE, block);
    IF (block = NIL) OR (block^.input.kind = clc$line_input) OR (block^.input.data = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_segment_line_v0', status);
      RETURN;
    IFEND;

    IF block^.input.state = clc$end_of_input THEN
      RETURN;
    IFEND;

    osp$establish_condition_handler (^abort_handler, FALSE);

    data := block^.input.data;
    get_next_segment_line_v0 (data, line_text);
    IF line_text = NIL THEN
      block^.input.state := clc$end_of_input;
      RETURN;
    IFEND;

    clp$store_expandable_string (line_text, NIL, block^.input.data_line);

    block^.input.record_number := block^.input.record_number + 1;
    block^.input.line_address_is_for_previous := FALSE;
    block^.input.line_address := i#current_sequence_position (data);
    block^.input.state := clc$continue_input;
    block^.input.data := data;

  PROCEND clp$get_segment_line_v0;
?? TITLE := 'clp$get_segment_cmnd_line_v0', EJECT ??
{
{ PURPOSE:
{   This procedure handles SCL command line input requests directed toward
{   an "old format" SCL procedure on an object library.
{
{ NOTE:
{   This procedure assumes that the lines it reads have no trailing spaces.
{
{ NOTE:
{   This procedure is #GATEd to allow construction of a pointer to it that
{   allows the procedure to be called from above the ring of execution of
{   this module.
{

  PROCEDURE [XDCL, #GATE] clp$get_segment_cmnd_line_v0
    (VAR parse: clt$parse_state;
     VAR end_of_input: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      continuation_line: ^clt$command_line,
      continuation_line_size: clt$command_line_size,
      data: ^clt$input_data,
      lexical_units: ^clt$lexical_units,
      lexical_work_area: ^clt$work_area,
      line: ^clt$command_line,
      line_continued: boolean,
      line_size: clt$command_line_size,
      line_text: ^clt$command_line;

?? 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);

      CASE condition.selector OF
      = mmc$segment_access_condition =
        IF condition.segment_access_condition.identifier = mmc$sac_io_read_error THEN
          osp$set_status_from_condition ('CL', condition, save_area, status, handler_status);
          EXIT clp$get_segment_cmnd_line_v0;
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = osc$volume_unavailable_cond THEN
          osp$get_condition_status (condition_information, status);
          EXIT clp$get_segment_cmnd_line_v0;
        IFEND;
      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

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

    clp$find_input_block (TRUE, block);
    IF (block = NIL) OR (block^.input.kind = clc$line_input) OR (block^.input.data = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_segment_cmnd_line_v0', status);
      RETURN;
    IFEND;

    IF block^.input.state = clc$end_of_input THEN
      RETURN;
    IFEND;

    osp$establish_condition_handler (^abort_handler, FALSE);

    data := block^.input.data;
    get_next_segment_line_v0 (data, line);

    IF line = NIL THEN
      block^.input.state := clc$end_of_input;
      RETURN;
    IFEND;

    line_size := STRLENGTH (line^);

    IF (line_size < 2) OR (line^ (line_size - 1, 2) <> '..') THEN
      line_text := line;

    ELSE
      clp$store_expandable_string (line, NIL, block^.input.line);

      line_size := line_size - 2;
      WHILE (line_size > 0) AND (line^ (line_size) = '.') DO
        line_size := line_size - 1;
      WHILEND;

      REPEAT
        get_next_segment_line_v0 (data, continuation_line);
        IF continuation_line = NIL THEN
          osp$set_status_abnormal ('CL', cle$expecting_continuation_line, '', status);
          RETURN;
        IFEND;
        continuation_line_size := STRLENGTH (continuation_line^);
        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;
        clp$append_expandable_string (line_size, ^continuation_line^ (1, continuation_line_size),
              block^.input.line);
        line := block^.input.line.text;
        line_size := line_size + continuation_line_size;
      UNTIL NOT line_continued;

      line_text := line;
      line := NIL;
    IFEND;

    PUSH lexical_work_area: [[REP line_size + clc$lexical_units_size_pad OF clt$lexical_unit]];
    RESET lexical_work_area;
    clp$identify_lexical_units (line_text, lexical_work_area, lexical_units, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$store_expandable_string (line, lexical_units, block^.input.line);

    block^.input.record_number := block^.input.record_number + 1;
    block^.line_identifier.byte_address := block^.input.line_address;
    block^.line_identifier.record_number := block^.input.record_number;
    clp$initialize_parse_state (block^.input.line.text, block^.input.line.lexical_units, block^.line_parse);
    block^.input.line_address_is_for_previous := FALSE;
    block^.input.line_address := i#current_sequence_position (data);
    block^.input.state := clc$continue_input;
    block^.input.data := data;

    parse := block^.line_parse;
    end_of_input := FALSE;

  PROCEND clp$get_segment_cmnd_line_v0;
?? TITLE := 'get_next_segment_line', EJECT ??

  PROCEDURE [INLINE] get_next_segment_line
    (    line_kind: clt$input_line_kind;
     VAR data {input, output} : ^clt$input_data;
     VAR lexical_units_array: ^clt$lexical_units;
     VAR line_text: ^clt$command_line);

    VAR
      data_positioner: ^array [1 .. * ] of cell,
      line_header: ^clt$input_data_line_header;


    NEXT line_header IN data;
    lexical_units_array := NIL;
    IF line_header = NIL THEN
      line_text := NIL;
    ELSE
      NEXT line_text: [line_header^.line_size] IN data;
      IF line_header^.number_of_lexical_units > 0 THEN
        NEXT lexical_units_array: [1 .. line_header^.number_of_lexical_units] IN data;
      IFEND;
      IF line_header^.size_of_component_lines_data > 0 THEN
        IF line_kind = clc$command_line THEN
          NEXT data_positioner: [1 .. line_header^.size_of_component_lines_data] IN data;
        ELSE
          NEXT line_header IN data;
          IF line_header = NIL THEN
            line_text := NIL;
          ELSE
            NEXT line_text: [line_header^.line_size] IN data;
            IF line_header^.number_of_lexical_units > 0 THEN
              NEXT lexical_units_array: [1 .. line_header^.number_of_lexical_units] IN data;
            IFEND;
          IFEND;
          lexical_units_array := NIL;
        IFEND;
      IFEND;
    IFEND;

  PROCEND get_next_segment_line;
?? TITLE := 'clp$get_segment_line', EJECT ??
{
{ PURPOSE:
{   This procedure handles SCL input requests directed toward an object
{   library or "internal file".
{
{ NOTE:
{   This procedure assumes that the lines it reads have no trailing spaces.
{
{ NOTE:
{   This procedure is #GATEd to allow construction of a pointer to it that
{   allows the procedure to be called from above the ring of execution of
{   this module.
{

  PROCEDURE [XDCL, #GATE] clp$get_segment_line
    (    ignore_line_kind: clt$input_line_kind;
         ignore_prompt_string: clt$prompt_string;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      data: ^clt$input_data,
      ignore_lexical_units_array: ^clt$lexical_units,
      line_text: ^clt$command_line;

?? 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);

      CASE condition.selector OF
      = mmc$segment_access_condition =
        IF condition.segment_access_condition.identifier = mmc$sac_io_read_error THEN
          osp$set_status_from_condition ('CL', condition, save_area, status, handler_status);
          EXIT clp$get_segment_line;
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = osc$volume_unavailable_cond THEN
          osp$get_condition_status (condition_information, status);
          EXIT clp$get_segment_line;
        IFEND;
      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    clp$find_input_block (TRUE, block);
    IF (block = NIL) OR (block^.input.kind = clc$line_input) OR (block^.input.data = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_segment_line', status);
      RETURN;
    IFEND;

    IF block^.input.state = clc$end_of_input THEN
      RETURN;
    IFEND;

    osp$establish_condition_handler (^abort_handler, FALSE);

    data := block^.input.data;
    get_next_segment_line (clc$data_line, data, ignore_lexical_units_array, line_text);

    IF line_text = NIL THEN
      block^.input.state := clc$end_of_input;
      RETURN;
    IFEND;

    clp$store_expandable_string (line_text, NIL, block^.input.data_line);

    block^.input.record_number := block^.input.record_number + 1;
    block^.input.line_address_is_for_previous := FALSE;
    block^.input.line_address := i#current_sequence_position (data);
    block^.input.state := clc$continue_input;
    block^.input.data := data;

  PROCEND clp$get_segment_line;
?? TITLE := 'clp$get_segment_cmnd_line', EJECT ??
{
{ PURPOSE:
{   This procedure handles SCL input requests directed toward an object
{   library or "internal file".
{
{ NOTE:
{   This procedure assumes that the lines it reads have no trailing spaces.
{
{ NOTE:
{   This procedure is #GATEd to allow construction of a pointer to it that
{   allows the procedure to be called from above the ring of execution of
{   this module.
{

  PROCEDURE [XDCL, #GATE] clp$get_segment_cmnd_line
    (VAR parse: clt$parse_state;
     VAR end_of_input: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      continuation_line: ^clt$command_line,
      continuation_line_size: clt$command_line_size,
      data: ^clt$input_data,
      data_positioner: ^array [1 .. * ] of cell,
      expandable_string: ^clt$expandable_string,
      lexical_units: ^clt$lexical_units,
      lexical_work_area: ^clt$work_area,
      line: ^clt$command_line,
      line_address_increment: ost$segment_length,
      line_continued: boolean,
      line_header: ^clt$input_data_line_header,
      line_size: clt$command_line_size,
      line_text: ^clt$command_line;

?? 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);


      CASE condition.selector OF
      = mmc$segment_access_condition =
        IF condition.segment_access_condition.identifier = mmc$sac_io_read_error THEN
          osp$set_status_from_condition ('CL', condition, save_area, status, handler_status);
          EXIT clp$get_segment_cmnd_line;
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = osc$volume_unavailable_cond THEN
          osp$get_condition_status (condition_information, status);
          EXIT clp$get_segment_cmnd_line;
        IFEND;
      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

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

    clp$find_input_block (TRUE, block);
    IF (block = NIL) OR (block^.input.kind = clc$line_input) OR (block^.input.data = NIL) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_segment_cmnd_line', status);
      RETURN;
    IFEND;

    IF block^.input.state = clc$end_of_input THEN
      RETURN;
    IFEND;

    osp$establish_condition_handler (^abort_handler, FALSE);

    data := block^.input.data;
    get_next_segment_line (clc$command_line, data, lexical_units, line);

    IF line = NIL THEN
      block^.input.state := clc$end_of_input;
      RETURN;
    IFEND;

    line_size := STRLENGTH (line^);

    IF ( line_size < 2) OR (line^ ( line_size - 1, 2) <> '..') THEN
      line_text := line;

    ELSE
      clp$store_expandable_string (line, NIL, block^.input.line);

      line_size :=  line_size - 2;
      WHILE (line_size > 0) AND (line^ (line_size) = '.') DO
        line_size := line_size - 1;
      WHILEND;

      REPEAT
        get_next_segment_line (clc$command_continuation_line, data, lexical_units, continuation_line);
        IF continuation_line = NIL THEN
          osp$set_status_abnormal ('CL', cle$expecting_continuation_line, '', status);
          RETURN;
        IFEND;
        continuation_line_size := STRLENGTH (continuation_line^);
        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;
        clp$append_expandable_string (line_size, ^continuation_line^ (1, continuation_line_size),
              block^.input.line);
        line := block^.input.line.text;
        line_size := line_size + continuation_line_size;
      UNTIL NOT line_continued;

      line_text := line;
      line := NIL;
      lexical_units := NIL;
    IFEND;

    IF lexical_units = NIL THEN
      PUSH lexical_work_area: [[REP line_size + clc$lexical_units_size_pad OF clt$lexical_unit]];
      RESET lexical_work_area;
      clp$identify_lexical_units (line_text, lexical_work_area, lexical_units, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    clp$store_expandable_string (line, lexical_units, block^.input.line);

    block^.input.record_number := block^.input.record_number + 1;
    block^.line_identifier.byte_address := block^.input.line_address;
    block^.line_identifier.record_number := block^.input.record_number;
    clp$initialize_parse_state (block^.input.line.text, block^.input.line.lexical_units, block^.line_parse);
    block^.input.line_address_is_for_previous := FALSE;
    block^.input.line_address := i#current_sequence_position (data);
    block^.input.state := clc$continue_input;
    block^.input.data := data;

    parse := block^.line_parse;
    end_of_input := FALSE;

  PROCEND clp$get_segment_cmnd_line;
*IFEND
?? TITLE := 'clp$get_standard_line', EJECT ??
{
{ PURPOSE:
{   This procedure handles SCL input requests directed toward a "standard"
{   record access file.  A "standard" record access file is a mass storage
{   file for which the file_access_procedure (FAP), statement_identifier and
{   line_number attributes are undefined.
{
{ NOTE:
{   This procedure is #GATEd to allow construction of a pointer to it that
{   allows the procedure to be called from above the ring of execution of
{   this module.
{

  PROCEDURE [XDCL, #GATE] clp$get_standard_line
    (    line_kind: clt$input_line_kind;
         ignore_prompt_string: clt$prompt_string;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      expandable_string: ^clt$expandable_string,
      file_position: amt$file_position,
      first_part_of_line: ^array [1 .. clc$nominal_command_line_size] of cell,
      ignore_data: cell,
      ignore_byte_address: amt$file_byte_address,
      ignore_status: ost$status,
      lexical_units: ^clt$lexical_units,
      lexical_units_array: ^clt$lexical_units,
      lexical_work_area: ^clt$work_area,
      line: ^clt$command_line,
      line_address: amt$file_byte_address,
      line_area: ^SEQ ( * ),
      line_text: ^clt$command_line,
*IF NOT $true(osv$unix)
      next_line_area: ^cell,
*ELSE
      next_line_area: ^string(*),
*IFEND
      nominal_line: ^array [1 .. clc$nominal_command_line_size] of cell,
      record_length: amt$max_record_length,
*IF NOT $true(osv$unix)
      transfer_count: amt$transfer_count;
*ELSE
      total_count: amt$transfer_count,
      temp_line_area: ^string(*),
      transfer_count: amt$transfer_count;
*IFEND


*IF NOT $true(osv$unix)
?? 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);

      CASE condition.selector OF
      = mmc$segment_access_condition =
        IF condition.segment_access_condition.identifier = mmc$sac_io_read_error THEN
          osp$set_status_from_condition ('CL', condition, save_area, status, handler_status);
          EXIT clp$get_standard_line;
        IFEND;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = osc$volume_unavailable_cond THEN
          osp$get_condition_status (condition_information, status);
          EXIT clp$get_standard_line;
        IFEND;
      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??
*IFEND

    status.normal := TRUE;
    line := NIL;
    lexical_units := NIL;

    clp$find_input_block (TRUE, block);
    IF (block = NIL) OR (block^.input.kind <> clc$file_input) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_standard_line', status);
      RETURN;
    IFEND;

    IF block^.input.state = clc$end_of_input THEN
      RETURN;
    IFEND;

*IF NOT $true(osv$unix)
    osp$establish_condition_handler (^abort_handler, FALSE);

    IF block^.input.state = clc$update_input THEN
      amp$seek_direct (block^.input.file_id, block^.input.line_address, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF block^.input.line_address_is_for_previous THEN
        amp$get_next (block^.input.file_id, ^ignore_data, 1, transfer_count, ignore_byte_address,
              file_position, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;
*IFEND

*IF NOT $true(osv$unix)
    PUSH line_area: [[REP clc$nominal_command_line_size OF char]];
*ELSE
    PUSH temp_line_area: [clc$nominal_command_line_size];
*IFEND
    line_address := 0;

*IF NOT $true(osv$unix)
    amp$get_next (block^.input.file_id, line_area, clc$nominal_command_line_size, transfer_count,
*ELSE
    amp$get_next (block^.input.file_id, temp_line_area, clc$nominal_command_line_size, transfer_count,
*IFEND
          line_address, file_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

*IF $true(osv$unix)
    line_area := #SEQ(temp_line_area^);
*IFEND

    IF status.normal AND (file_position < amc$eor) AND (block^.input.line_layout.physical_line_size >
          #SIZE (line_area^)) THEN
      RESET line_area;
      NEXT nominal_line IN line_area;
      PUSH line_area: [[REP block^.input.line_layout.physical_line_size OF char]];
      RESET line_area;
      NEXT first_part_of_line IN line_area;
      first_part_of_line^ := nominal_line^;
*IF NOT $true(osv$unix)
      NEXT next_line_area IN line_area;
*ELSE
      NEXT next_line_area: [block^.input.line_layout.physical_line_size -
            clc$nominal_command_line_size] IN line_area;
*IFEND
*IF $true(osv$unix)
      total_count := transfer_count;
*IFEND
      record_length := clc$nominal_command_line_size;

      amp$get_partial (block^.input.file_id, next_line_area,
            block^.input.line_layout.physical_line_size - clc$nominal_command_line_size, record_length,
            transfer_count, ignore_byte_address, file_position, amc$no_skip, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
*IF NOT $true(osv$unix)
      transfer_count := record_length;
*ELSE
      transfer_count := total_count + transfer_count;
*IFEND
    IFEND;

    IF file_position < amc$eor THEN
*IF NOT $true(osv$unix)
      osp$set_status_abnormal ('CL', cle$line_too_long, block^.input.local_file_name, status);
*ELSE
      osp$set_status_abnormal ('CL', cle$line_too_long, '', status);
      osp$append_status_file (osc$status_parameter_delimiter,block^.input.local_file_name, status);
*IFEND
      RETURN;
    IFEND;

    IF line_kind = clc$command_line THEN
      expandable_string := ^block^.input.line;
    ELSE
      expandable_string := ^block^.input.data_line;
    IFEND;

    IF file_position > amc$eor THEN
      block^.input.state := clc$end_of_input;
      RETURN;
    IFEND;

    RESET line_area;
    NEXT line_text: [transfer_count] IN line_area;
    WHILE (transfer_count > 0) AND (line_text^ (transfer_count) = ' ') DO
      transfer_count := transfer_count - 1;
    WHILEND;
    line_text := ^line_text^ (1, transfer_count);

    IF (line_kind <> clc$command_line) OR ((transfer_count >= 2) AND (line_text^ (transfer_count - 1, 2) =
          '..')) THEN
      lexical_units_array := NIL;
    ELSE
      PUSH lexical_work_area: [[REP transfer_count + clc$lexical_units_size_pad OF clt$lexical_unit]];
      RESET lexical_work_area;
      clp$identify_lexical_units (line_text, lexical_work_area, lexical_units_array, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;
    clp$store_expandable_string (line_text, lexical_units_array, expandable_string^);

    block^.input.record_number := block^.input.record_number + 1;
    IF line_kind = clc$command_line THEN
      block^.line_identifier.byte_address := line_address;
      block^.line_identifier.record_number := block^.input.record_number;
      clp$initialize_parse_state (expandable_string^.text, expandable_string^.lexical_units,
            block^.line_parse);
    IFEND;
    block^.input.line_address_is_for_previous := TRUE;
    block^.input.line_address := line_address;
    block^.input.state := clc$continue_input;

  PROCEND clp$get_standard_line;
?? TITLE := 'clp$get_standard_cmnd_line', EJECT ??
{
{ PURPOSE:
{   This procedure handles SCL input requests directed toward a "standard"
{   record access file.  A "standard" record access file is a mass storage
{   file for which the file_access_procedure (FAP), statement_identifier and
{   line_number attributes are undefined.
{
{ NOTE:
{   This procedure is #GATEd to allow construction of a pointer to it that
{   allows the procedure to be called from above the ring of execution of
{   this module.
{

  PROCEDURE [XDCL, #GATE] clp$get_standard_cmnd_line
    (VAR parse: clt$parse_state;
     VAR end_of_input: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      continuation_line: ^clt$command_line,
      continuation_line_size: integer,
      lexical_units: ^clt$lexical_units,
      lexical_work_area: ^clt$work_area,
      line: ^clt$command_line,
      line_continued: boolean,
      line_size: integer;


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

    clp$find_input_block (TRUE, block);
    IF (block = NIL) OR (block^.input.kind <> clc$file_input) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_standard_cmnd_line', status);
      RETURN;
    IFEND;

    IF block^.input.state = clc$end_of_input THEN
      RETURN;
    IFEND;

    clp$get_standard_line (clc$command_line, '', status);
    IF (NOT status.normal) OR (block^.input.state = clc$end_of_input) THEN
      RETURN;
    IFEND;
    line := block^.input.line.text;

*IF $true(osv$unix)
    IF (STRLENGTH (line^) < 1) OR (line^ (STRLENGTH (line^), 1) <> '\') THEN
*ELSE
    IF (STRLENGTH (line^) < 2) OR (line^ (STRLENGTH (line^) - 1, 2) <> '..') THEN
*IFEND
      parse := block^.line_parse;
      end_of_input := FALSE;
      RETURN;
    IFEND;

*IF $true(osv$unix)
    line_size := STRLENGTH (line^) - 1;
    WHILE (line_size > 0) AND (line^ (line_size) = '\') DO
*ELSE
    line_size := STRLENGTH (line^) - 2;
    WHILE (line_size > 0) AND (line^ (line_size) = '.') DO
*IFEND
      line_size := line_size - 1;
    WHILEND;

    REPEAT
      clp$get_standard_line (clc$command_continuation_line, '', status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      continuation_line := block^.input.data_line.text;
      IF (continuation_line = NIL) OR (block^.input.state = clc$end_of_input) THEN
        osp$set_status_abnormal ('CL', cle$expecting_continuation_line, '', status);
        RETURN;
      IFEND;
      continuation_line_size := STRLENGTH (continuation_line^);
*IF $true(osv$unix)
      line_continued := (continuation_line_size >= 1) AND (continuation_line^
            (continuation_line_size, 1) = '\');
      IF line_continued THEN
        continuation_line_size := continuation_line_size - 1;
        WHILE (continuation_line_size > 0) AND (continuation_line^ (continuation_line_size) = '\') DO
*ELSE
      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
*IFEND
          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;
      clp$append_expandable_string (line_size, ^block^.input.data_line.text^ (1, continuation_line_size),
            block^.input.line);
      line := block^.input.line.text;
      line_size := line_size + continuation_line_size;
    UNTIL NOT line_continued;

    PUSH lexical_work_area: [[REP line_size + clc$lexical_units_size_pad OF clt$lexical_unit]];
    RESET lexical_work_area;
    clp$identify_lexical_units (line, lexical_work_area, lexical_units, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$store_expandable_string (NIL, lexical_units, block^.input.line);
    clp$initialize_parse_state (block^.input.line.text, block^.input.line.lexical_units, block^.line_parse);

    parse := block^.line_parse;
    end_of_input := FALSE;

  PROCEND clp$get_standard_cmnd_line;
?? TITLE := 'clp$append_continuation_line', EJECT ??
{
{ PURPOSE:
{   This procedure is used by clp$get_non_standard_cmnd_line to append a
{   continuation line (contained in the data_line field of an input block) to
{   the end of the corresponding command line.
{

  PROCEDURE [XDCL, #GATE] clp$append_continuation_line
    (    command_line_size: clt$command_line_size;
         continuation_line_size: clt$command_line_size;
     VAR command_line: ^clt$command_line);

    VAR
      block: ^clt$block,
      status: ^ost$status;


    clp$find_input_block (TRUE, block);
    IF (block = NIL) OR (block^.input.kind = clc$line_input) OR (block^.input.line.text = NIL) OR
          (command_line_size > STRLENGTH (block^.input.line.text^)) OR (block^.input.data_line.text = NIL) OR
          (continuation_line_size > STRLENGTH (block^.input.data_line.text^)) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$append_continuation_line', status^);
*IF NOT $true(osv$unix)
      pmp$abort (status^);
*ELSE
      RETURN;
*IFEND
    IFEND;

    clp$append_expandable_string (command_line_size, ^block^.input.data_line.
          text^ (1, continuation_line_size), block^.input.line);

    command_line := block^.input.line.text;

  PROCEND clp$append_continuation_line;
?? TITLE := 'clp$set_input_line', EJECT ??
{
{ PURPOSE:
{   This procedure is used by clp$get_non_standard_line to save the line it
{   read, along with any associated information, in the current input block.
{
{ NOTE:
{   If line_text is NIL, end of input is assumed.
{

  PROCEDURE [XDCL, #GATE] clp$set_input_line
    (    line_kind: clt$input_line_kind;
         line_text: ^clt$command_line;
         line_identifier: clt$line_identifier;
         record_number: amt$file_byte_address;
         line_address: amt$file_byte_address);

    VAR
      block: ^clt$block,
      expandable_string: ^clt$expandable_string,
      lexical_units_array: ^clt$lexical_units,
      lexical_work_area: ^clt$work_area,
      status: ost$status;


    clp$find_input_block (TRUE, block);
    IF (block = NIL) OR (block^.input.kind <> clc$file_input) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_input_line', status);
*IF NOT $true(osv$unix)
      pmp$abort (status);
*ELSE
      RETURN;
*IFEND
    IFEND;

    block^.input.record_number := record_number;
    block^.input.line_address_is_for_previous := TRUE;
    block^.input.line_address := line_address;

    IF line_kind = clc$command_line THEN
      expandable_string := ^block^.input.line;
    ELSE
      expandable_string := ^block^.input.data_line;
    IFEND;

    IF line_text = NIL THEN
      block^.input.state := clc$end_of_input;
      RETURN;
    IFEND;

    IF (line_kind <> clc$command_line) OR ((STRLENGTH (line_text^) >= 2) AND
          (line_text^ (STRLENGTH (line_text^) - 1, 2) = '..')) THEN
      lexical_units_array := NIL;
    ELSE
      PUSH lexical_work_area: [[REP STRLENGTH (line_text^) + clc$lexical_units_size_pad OF clt$lexical_unit]];
      RESET lexical_work_area;
      clp$identify_lexical_units (line_text, lexical_work_area, lexical_units_array, status);
      IF NOT status.normal THEN
*IF NOT $true(osv$unix)
        pmp$abort (status);
*ELSE
        RETURN;
*IFEND
      IFEND;
    IFEND;

    clp$store_expandable_string (line_text, lexical_units_array, expandable_string^);

    IF line_kind = clc$command_line THEN
      block^.line_identifier := line_identifier;
      IF lexical_units_array <> NIL THEN
        clp$initialize_parse_state (expandable_string^.text, expandable_string^.lexical_units,
              block^.line_parse);
      IFEND;
    IFEND;

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

  PROCEDURE [XDCL, #GATE] clp$init_input_parse_state
    (    lexical_units: ^clt$lexical_units;
     VAR parse: clt$parse_state);

    VAR
      block: ^clt$block,
      status: ^ost$status;


    clp$find_input_block (FALSE, block);
    IF (block = NIL) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$init_input_parse_state', status^);
      pmp$abort (status^);
    IFEND;

    clp$store_expandable_string (NIL, lexical_units, block^.input.line);

    clp$initialize_parse_state (block^.input.line.text, block^.input.line.lexical_units, block^.line_parse);

    parse := block^.line_parse;

  PROCEND clp$init_input_parse_state;
?? TITLE := 'clp$set_input_line_position', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_input_line_position
    (    line_identifier: clt$line_identifier);

    VAR
      block: ^clt$block,
      data_positioner: ^array [1 .. * ] of cell,
      status: ^ost$status;


    clp$find_input_block (TRUE, block);
    IF block = NIL THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_input_line_position', status^);
      pmp$abort (status^);
    IFEND;

    block^.input.line_address_is_for_previous := FALSE;
    block^.input.line_address := line_identifier.byte_address;

    IF block^.input.data <> NIL THEN
      RESET block^.input.data;
      IF block^.input.line_address > 0 THEN
        NEXT data_positioner: [1 .. block^.input.line_address] IN block^.input.data;
      IFEND;
    IFEND;

    block^.line_identifier := line_identifier;
    IF line_identifier.record_number > 0 THEN
      block^.input.record_number := line_identifier.record_number - 1;
    ELSE
      block^.input.record_number := 0;
    IFEND;

    block^.input.state := clc$continue_input;

  PROCEND clp$set_input_line_position;
?? TITLE := 'clp$reset_input_state', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$reset_input_state;

    VAR
      block: ^clt$block,
      status: ^ost$status;

    clp$find_input_block (TRUE, block);
    IF block = NIL THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$reset_input_state', status^);
      pmp$abort (status^);
    IFEND;

    block^.input.state := clc$continue_input;

  PROCEND clp$reset_input_state;
*IFEND
?? TITLE := 'clp$set_input_line_parse', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_input_line_parse
    (    line_parse: clt$parse_state);

    VAR
      block: ^clt$block,
      status: ^ost$status;


    clp$find_input_block (FALSE, block);
    IF block = NIL THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_input_line_parse', status^);
*IF NOT $true(osv$unix)
      pmp$abort (status^);
*ELSE
      RETURN;
*IFEND
    IFEND;

    clp$update_parse_state (line_parse, block^.line_parse);

  PROCEND clp$set_input_line_parse;
?? TITLE := 'clp$set_input_line_finished', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_input_line_finished;

    VAR
      block: ^clt$block,
      status: ^ost$status;


    clp$find_input_block (FALSE, block);
    IF (block = NIL) OR (block^.line_parse.text = NIL) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_input_line_finished', status^);
*IF NOT $true(osv$unix)
      pmp$abort (status^);
*ELSE
      RETURN;
*IFEND
    IFEND;

    block^.line_parse.index := block^.line_parse.index_limit;
    block^.line_parse.units_array_index := UPPERBOUND (block^.line_parse.units_array^);
    block^.line_parse.unit.kind := clc$lex_end_of_line;
    block^.line_parse.unit.size := 0;
    block^.line_parse.unit_index := block^.line_parse.index_limit;

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

  PROCEDURE [XDCL, #GATE] clp$reset_input_position
    (    line_identifier: clt$line_identifier;
         line_parse: clt$parse_state);

    VAR
      block: ^clt$block,
      status: ^ost$status;


    clp$find_input_block (FALSE, block);
    IF block = NIL THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$reset_input_position', status^);
      pmp$abort (status^);
    IFEND;

    IF (block^.input.kind = clc$line_input) OR (block^.line_identifier.byte_address =
          line_identifier.byte_address) THEN
      clp$update_parse_state (line_parse, block^.line_parse);
      RETURN;
    IFEND;

    block^.input.state := clc$reset_input;
    block^.input.reset_line_identifier := line_identifier;
    block^.input.reset_line_parse := line_parse;

  PROCEND clp$reset_input_position;
*IFEND
?? TITLE := 'clp$set_current_prompt_string', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_current_prompt_string
    (    prompt_string: ift$prompt_string);

    VAR
      status: ^ost$status,
      block: ^clt$block;


    clp$find_input_block (FALSE, block);
    IF (block = NIL) OR (NOT ((block^.input.kind <> clc$line_input) AND (0 <= prompt_string.size) AND
          (prompt_string.size <= UPPERVALUE (prompt_string.size)))) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_current_prompt_string', status^);
*IF NOT $true(osv$unix)
      pmp$abort (status^);
*ELSE
      RETURN;
*IFEND
    IFEND;
    block^.input.current_prompt_string := prompt_string;

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

  PROCEDURE [XDCL, #GATE] clp$set_prev_cmnd_name_and_stat
    (    command: ^clt$command_line;
         command_name: clt$command_name;
         command_status: ost$status);

    VAR
      block: ^clt$block;

{ This request is meaningless if called from an asynchronous task.  If this
{ happens and we don't find the input block, ignore the request.

    clp$find_input_block (FALSE, block);
    IF block <> NIL THEN
      clp$store_expandable_string (command, NIL, block^.previous_command);
      block^.previous_command_name := command_name;
      block^.previous_command_status := command_status;
    IFEND;

  PROCEND clp$set_prev_cmnd_name_and_stat;
*IFEND
?? TITLE := 'clp$ignore_rest_of_file', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$ignore_rest_of_file
    (    utility_name: clt$utility_name;
     VAR status: ost$status);

    VAR
      target_block: ^clt$block,
      block: ^clt$block;


    status.normal := TRUE;
    clp$find_current_block (block);
    target_block := block;

  /find_target_block/
    WHILE target_block <> NIL DO
      CASE target_block^.kind OF
      = clc$task_block =
        IF NOT target_block^.synchronous_with_parent THEN
          target_block := NIL;
          EXIT /find_target_block/;
        IFEND;
      = clc$input_block =
        IF target_block^.label = utility_name THEN
          EXIT /find_target_block/;
        IFEND;
      ELSE
        ;
      CASEND;
      target_block := target_block^.previous_block;
    WHILEND /find_target_block/;

    IF target_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unknown_utility, utility_name, status);
      RETURN;
    IFEND;

    REPEAT
      block^.interpreter_mode := clc$skip_mode;
      block^.being_exited := TRUE;
      IF (block^.kind = clc$input_block) AND (block^.associated_utility <> NIL) THEN
        block^.associated_utility^.termination_command_found := TRUE;
      IFEND;
      block := block^.previous_block;
    UNTIL block = target_block^.previous_block;

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

  VAR
    clv$command_logging_activated: [XDCL, oss$task_shared] boolean := FALSE;

?? SKIP := 3 ??

  PROCEDURE [XDCL, #GATE] clp$log_command_line
    (    line: string ( * );
     VAR status: ost$status);

    VAR
      display_size: 0 .. ofc$max_display_message,
      interpreter_mode: clt$interpreter_modes,
      ascii_logset: pmt$ascii_logset,
      msg_origin: pmt$log_msg_origin;


    status.normal := TRUE;
    IF NOT (clv$command_logging_activated OR jmv$executing_within_system_job) THEN
      RETURN;
    IFEND;

    ?IF NOT clc$compiling_for_test_harness THEN
      IF clv$system_logging_activated OR jmv$executing_within_system_job THEN
        ascii_logset := $pmt$ascii_logset [pmc$job_log, pmc$system_log];
      ELSE
        ascii_logset := $pmt$ascii_logset [pmc$job_log];
      IFEND;
    ?ELSE
      ascii_logset := $pmt$ascii_logset [pmc$job_log];
    ?IFEND;

    clp$get_interpreter_mode (interpreter_mode);
    IF interpreter_mode = clc$interpret_mode THEN
      msg_origin := pmc$msg_origin_command;
    ELSE
      msg_origin := pmc$msg_origin_command_skip;
    IFEND;

    pmp$log_ascii (line, ascii_logset, msg_origin, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (interpreter_mode = clc$interpret_mode) AND (STRLENGTH (line) > 0) THEN
      IF STRLENGTH (line) <= ofc$max_display_message THEN
        display_size := STRLENGTH (line);
      ELSE
        display_size := ofc$max_display_message;
      IFEND;
      ofp$display_status_message (line (1, display_size), status);
    IFEND;

  PROCEND clp$log_command_line;
?? TITLE := 'clp$log_edited_login_command', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$log_edited_login_command
    (VAR status: ost$status);

    VAR
      block: ^clt$block;

    ?IF NOT clc$compiling_for_test_harness THEN
      osp$verify_system_privilege;
    ?IFEND;
    status.normal := TRUE;

    clv$command_logging_activated := TRUE;

    clp$find_current_block (block);
    IF (block^.kind = clc$command_block) AND (block^.command_kind = clc$login_command) THEN
      block^.command_logging_completed := TRUE;
      block^.command_echoing_completed := TRUE;
    IFEND;

    jmp$log_edited_login_command (status);
  PROCEND clp$log_edited_login_command;
?? TITLE := 'clp$set_system_logging_active', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_system_logging_active
    (    activate: boolean;
     VAR status: ost$status);

    status.normal := TRUE;

    IF NOT avp$system_operator () THEN
      osp$set_status_abnormal ('OF', ofe$sou_not_active,'system_operator',status);
      RETURN;
    IFEND;

    syp$store_system_constant (clc$system_logging_active_name, $INTEGER (activate), status);

  PROCEND clp$set_system_logging_active;
?? TITLE := 'clp$set_secure_logging_active', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_secure_logging_active
    (    activate: boolean;
     VAR status: ost$status);


    status.normal := TRUE;
    IF jmv$executing_within_system_job THEN
      syp$store_system_constant (clc$change_secure_logging_name, $INTEGER (activate), status);
    ELSE
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'CHANGE_SECURE_LOGGING', status);
    IFEND;

  PROCEND clp$set_secure_logging_active;
?? TITLE := 'clp$suppress_command_logging', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$suppress_command_logging;

{ This procedure is no longer useful.  It will be removed when all references
{ to it are eliminated.

  PROCEND clp$suppress_command_logging;
*IFEND
?? TITLE := 'clp$change_prompt_string', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$change_prompt_string
    (    new_prompt_string: string ( * );
     VAR old_prompt_string: string (ifc$max_prompt_string_size));

    VAR
      block: ^clt$block,
      ignore_task: boolean,
      status: ^ost$status;


    clp$find_input_block (FALSE, block);
    IF block = NIL THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$change_prompt_string', status^);
*IF NOT $true(osv$unix)
      pmp$abort (status^);
*ELSE
      RETURN;
*IFEND
    IFEND;

    old_prompt_string := block^.input.base_prompt_string.value (2, * );
    clp$set_prompt_string (block, new_prompt_string);

  PROCEND clp$change_prompt_string;
?? TITLE := 'clp$set_prompt_string', EJECT ??

  PROCEDURE [XDCL] clp$set_prompt_string
    (    block: ^clt$block;
         prompt_string: string ( * ));

    VAR
      prompt_string_size: integer;


    IF block^.input.interactive_device THEN
      prompt_string_size := STRLENGTH (prompt_string);
      WHILE (prompt_string_size > 0) AND (prompt_string (prompt_string_size) = ' ') DO
        prompt_string_size := prompt_string_size - 1;
      WHILEND;
      IF prompt_string_size > (ifc$max_prompt_string_size - 3 - 1) THEN
        block^.input.base_prompt_string.size := ifc$max_prompt_string_size - 3;
      ELSE
        block^.input.base_prompt_string.size := prompt_string_size + 1;
      IFEND;
      block^.input.base_prompt_string.value (1) := ' ';
      block^.input.base_prompt_string.value (2, * ) := prompt_string;
    ELSE
      block^.input.base_prompt_string.size := 0;
      block^.input.base_prompt_string.value := '';
    IFEND;

  PROCEND clp$set_prompt_string;

MODEND clm$input_stack_manager;
