?? NEWTITLE := 'NOS/VE SCL Interpreter : Control Statement Processors' ??
MODULE clm$control_statements;
?? RIGHT := 110 ??

{
{ PURPOSE:
{   This module contains the processors for the SCL control statements.  Also, it contains the procedure
{   and table used to search for a control statement or control command.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_integer
*copyc clc$min_integer
*copyc clc$standard_file_names
*copyc cle$ecc_command_processing
*copyc cle$ecc_control_statement
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_parsing
*copyc clt$command_line
*copyc clt$command_line_index
*copyc clt$command_line_size
*copyc clt$command_processor
*copyc clt$control_statement
*copyc clt$control_statement_desc
*copyc clt$control_statement_info
*copyc clt$environment_object
*copyc clt$name
*copyc clt$parameter_list
*copyc clt$utility_name
*copyc clt$when_condition
*copyc cyd$run_time_error_condition
*copyc loc$task_services_library_name
*copyc osc$unseen_mail_condition
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc ost$caller_identifier
*copyc ost$name_reference
*copyc ost$status
?? POP ??
*copyc amv$nil_file_identifier
*copyc clp$advance_for_block
*copyc clp$append_status_parse_state
*copyc clp$change_prompt_string
*copyc clp$collect_statement
*copyc clp$continue
*copyc clp$convert_ext_value_to_int
*copyc clp$convert_int_value_to_ext
*copyc clp$convert_type_desc_to_spec
*copyc clp$convert_type_spec_to_desc
*copyc clp$create_var_from_type_spec
*copyc clp$cycle_block
*copyc clp$data_value_compare
*copyc clp$derive_type_desc_from_value
*copyc clp$disestablish_cond_handler
*copyc clp$echo_command
*copyc clp$echo_trace_information
*copyc clp$establish_condition_handler
*copyc clp$evaluate_boolean_expression
*copyc clp$evaluate_data_name_expr
*copyc clp$evaluate_integer_expression
*copyc clp$evaluate_list_expression
*copyc clp$evaluate_name
*copyc clp$evaluate_name_for_write
*copyc clp$evaluate_parameters
*copyc clp$evaluate_status_expression
*copyc clp$evaluate_unqual_union_expr
*copyc clp$execute_named_task
*copyc clp$exit_block
*copyc clp$find_connected_files
*copyc clp$find_current_block
*copyc clp$find_cycle_block
*copyc clp$find_exit_block
*copyc clp$find_input_block
*copyc clp$get_command_line
*copyc clp$get_command_search_mode
*copyc clp$get_interpreter_mode
*copyc clp$get_path_description
*copyc clp$get_work_area
*copyc clp$identify_lexical_units
*copyc clp$include_file
*copyc clp$initialize_parse_state
*copyc clp$internal_evaluate_expr
*copyc clp$internal_gen_type_spec
*copyc clp$log_command_line
*copyc clp$make_deferred_value
*copyc clp$pop_block_stack
*copyc clp$pop_environment
*copyc clp$pop_input
*copyc clp$pop_input_stack
*copyc clp$process_command_file
*copyc clp$process_continued_condition
*copyc clp$process_exit_condition
*copyc clp$produce_variable_ref_expr
*copyc clp$push_block_block
*copyc clp$push_case_block
*copyc clp$push_dynamic_command_list
*copyc clp$push_environment
*copyc clp$push_for_incremental_block
*copyc clp$push_for_list_block
*copyc clp$push_if_block
*copyc clp$push_input
*copyc clp$push_input_internal_block
*copyc clp$push_loop_block
*copyc clp$push_repeat_block
*copyc clp$push_while_block
*copyc clp$reset_input_position
*copyc clp$scan_any_lexical_unit
*copyc clp$scan_argument_list
*copyc clp$scan_non_space_lexical_unit
*copyc clp$scan_unnested_cmnd_lex_unit
*copyc clp$scan_unnested_sep_lex_unit
*copyc clp$set_case_block
*copyc clp$set_exit_position
*copyc clp$set_if_block
*copyc clp$set_input_line_parse
*copyc clp$set_repeat_until
*copyc clp$set_task_statement_task
*copyc clp$skip_block
*copyc clp$trimmed_string_size
*copyc clp$update_variable
*copyc clp$validate_name
*copyc clv$nil_block_handle
*copyc clv$standard_files
*copyc clv$value_descriptors
*copyc jmp$_job
*copyc jmp$jobend_statement
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$enforce_exception_policies
*copyc osp$establish_block_exit_hndlr
*copyc osp$file_access_condition
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osv$lower_to_upper
*copyc pmp$abort
*copyc pmp$continue_to_cause
*copyc pmp$exit
*copyc pmp$get_unique_name
*copyc pmp$get_user_identification

*copyc osv$initial_exception_context

  CONST
    ignore_command_file = osc$null_name;

?? TITLE := 'Control Statements and Commands', EJECT ??

{
{ NOTE:
{   All "commands" in the following table must also appear in the table
{   clv$intrinsic_commands with "availability=hidden".  This is to allow
{   all relevant information about these commands to be accessible via
{   the display_command_information command which is geared up to interrogate
{   a clt$command_table.  This also makes determining the source of the
{   command possible via function $source, etc.
{
{ NOTE:
{   The processor for the FUNCTION statement does not appear in this table
{   in order to allow "FUNCTION" to be used as the name for a subcommand of
{   generate_command_table and UTILITY/UTILITYEND.
{   The entry for FUNCTION appears in the table clv$intrinsic_commands with
{   "availability=hidden".
{

  CONST
    number_of_control_names = 49,
    min_control_name_size = 2 {IF} ,
    max_control_name_size = 13 {PUSH_COMMANDS} ;

  VAR
    control_statements: [STATIC, READ, oss$job_paged_literal] array [1 .. number_of_control_names] of record
      name: string (max_control_name_size),
      descriptor: clt$control_statement_desc,
    recend := [
          {} ['BLOCK                          ', [TRUE, clc$control_statement, TRUE, ^clp$block_statement]],
          {} ['BLOCKEND                       ', [TRUE, clc$control_statement, FALSE,
          ^clp$blockend_statement]],
          {} ['CANCEL                         ', [FALSE, clc$control_statement, FALSE,
          ^clp$cancel_statement]],
          {} ['CASE                           ', [TRUE, clc$control_statement, TRUE, ^clp$case_statement]],
          {} ['CASEND                         ', [TRUE, clc$control_statement, FALSE, ^clp$casend_statement]],
          {} ['CAUSE                          ', [FALSE, clc$control_statement, FALSE, ^clp$cause_statement]],
          {} ['CHECK                          ', [TRUE, clc$control_statement, TRUE, ^clp$check_statement]],
          {} ['CHECKEND                       ', [TRUE, clc$control_statement, FALSE,
          ^clp$checkend_statement]],
          {} ['COLLECT_TEXT                   ', [TRUE, clc$control_command, ^clp$_collect_text]],
          {} ['COLT                           ', [TRUE, clc$control_command, ^clp$_collect_text]],
          {} ['CONTINUE                       ', [FALSE, clc$control_statement, FALSE,
          ^clp$continue_statement]],
          {} ['CYCLE                          ', [FALSE, clc$control_statement, FALSE, ^clp$cycle_statement]],
          {} ['ELSE                           ', [TRUE, clc$control_statement, FALSE, ^clp$else_statement]],
          {} ['ELSEIF                         ', [TRUE, clc$control_statement, FALSE, ^clp$elseif_statement]],
          {} ['EXIT                           ', [FALSE, clc$control_statement, FALSE, ^clp$exit_statement]],
          {} ['EXIT_PROC                      ', [FALSE, clc$control_statement, FALSE,
          ^clp$exit_proc_statement]],
          {} ['FOR                            ', [TRUE, clc$control_statement, TRUE, ^clp$for_statement]],
          {} ['FOREND                         ', [TRUE, clc$control_statement, FALSE, ^clp$forend_statement]],
          {} ['FUNCEND                        ', [TRUE, clc$control_statement, FALSE,
          ^clp$funcend_statement]],

{-- 'FUNCTION                       ', [TRUE, clc$control_statement, FALSE,
{-- ^clp$_function_statement]],

    {} ['IF                             ', [TRUE, clc$control_statement, FALSE, ^clp$if_statement]],
          {} ['IFEND                          ', [TRUE, clc$control_statement, FALSE, ^clp$ifend_statement]],
          {} ['JOB                            ', [TRUE, clc$control_command, ^jmp$_job]],
          {} ['JOBEND                         ', [TRUE, clc$control_statement, FALSE, ^jmp$jobend_statement]],
          {} ['LOCK                           ', [FALSE, clc$control_statement, FALSE, ^clp$lock_statement]],
          {} ['LOOP                           ', [TRUE, clc$control_statement, TRUE, ^clp$loop_statement]],
          {} ['LOOPEND                        ', [TRUE, clc$control_statement, FALSE,
          ^clp$loopend_statement]],
          {} ['PIPE                           ', [TRUE, clc$control_statement, FALSE, ^clp$pipe_statement]],
          {} ['PIPEND                         ', [TRUE, clc$control_statement, FALSE, ^clp$pipend_statement]],
          {} ['POP                            ', [FALSE, clc$control_statement, FALSE, ^clp$pop_statement]],
          {} ['PROC                           ', [TRUE, clc$control_statement, FALSE,
          ^clp$procedure_statement]],
          {} ['PROCEDURE                      ', [TRUE, clc$control_statement, FALSE,
          ^clp$procedure_statement]],
          {} ['PROCEND                        ', [TRUE, clc$control_statement, FALSE,
          ^clp$procend_statement]],
          {} ['PUSH                           ', [FALSE, clc$control_statement, FALSE, ^clp$push_statement]],
          {} ['PUSH_COMMANDS                  ', [FALSE, clc$control_statement, FALSE, ^clp$push_commands]],
          {} ['REPEAT                         ', [TRUE, clc$control_statement, TRUE, ^clp$repeat_statement]],
          {} ['TASK                           ', [TRUE, clc$control_command, ^clp$_task]],
          {} ['TASKEND                        ', [TRUE, clc$control_statement, FALSE,
          ^clp$taskend_statement]],
          {} ['TYPE                           ', [TRUE, clc$control_statement, FALSE, ^clp$type_statement]],
          {} ['TYPEND                         ', [TRUE, clc$control_statement, FALSE, ^clp$typend_statement]],
          {} ['UNLOCK                         ', [FALSE, clc$control_statement, FALSE,
          ^clp$unlock_statement]],
          {} ['UNTIL                          ', [TRUE, clc$control_statement, FALSE, ^clp$until_statement]],
          {} ['UTILITY                        ', [TRUE, clc$control_command, ^clp$_utility]],
          {} ['UTILITYEND                     ', [TRUE, clc$control_statement, FALSE,
          ^clp$utilityend_statement]],
          {} ['VAR                            ', [TRUE, clc$control_statement, FALSE, ^clp$var_statement]],
          {} ['VAREND                         ', [TRUE, clc$control_statement, FALSE, ^clp$varend_statement]],
          {} ['WHEN                           ', [TRUE, clc$control_statement, FALSE, ^clp$when_statement]],
          {} ['WHENEND                        ', [TRUE, clc$control_statement, FALSE,
          ^clp$whenend_statement]],
          {} ['WHILE                          ', [TRUE, clc$control_statement, TRUE, ^clp$while_statement]],
          {} ['WHILEND                        ', [TRUE, clc$control_statement, FALSE,
          ^clp$whilend_statement]]];

?? EJECT ??

  VAR
    clv$non_substitution_mark: [STATIC, XDCL, READ, oss$job_paged_literal] packed array [char] of boolean := [
          {---} REP 9 of FALSE,
          {HT } TRUE,
          {---} REP 22 of FALSE,
          {- -} TRUE,
          {---} FALSE,
          { " } TRUE,
          { # } TRUE,
          { $ } TRUE,
          {---} REP 2 of FALSE,
          { ' } TRUE,
          { ( } TRUE,
          { ) } TRUE,
          {---} REP 2 of FALSE,
          { , } TRUE,
          {---} REP 3 of FALSE,
          {0..9} REP 10 of TRUE,
          {---} FALSE,
          { ; } TRUE,
          {---} REP 4 of FALSE,
          { @ } TRUE,
          {A..Z} REP 26 of TRUE,
          { [ } TRUE,
          { \ } TRUE,
          { ] } TRUE,
          { ^ } TRUE,
          { _ } TRUE,
          { ` } TRUE,
          {a..z} REP 26 of TRUE,
          { { } TRUE,
          { | } TRUE,
          { } TRUE,
          { ~ } TRUE,
          {---} REP 129 of FALSE];

?? PUSH (LISTEXT := ON) ??

  PROCEDURE [XREF] clp$_collect_text
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] clp$_utility
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

  PROCEDURE [XREF] clp$utilityend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

?? POP ??
?? TITLE := 'clp$check_name_for_control', EJECT ??

  PROCEDURE [XDCL] clp$check_name_for_control
    (    name: clt$name;
     VAR control_statement_descriptor: ^clt$control_statement_desc);

    VAR
      current_index: 1 .. number_of_control_names,
      low_index: 1 .. number_of_control_names + 1,
      temp: integer,
      high_index: 0 .. number_of_control_names;


    IF (min_control_name_size <= name.size) AND (name.size <= max_control_name_size) THEN
      low_index := 1;
      high_index := UPPERBOUND (control_statements);
      REPEAT
        temp := low_index + high_index;
        current_index := temp DIV 2;
        IF name.value (1, max_control_name_size) = control_statements [current_index].name THEN
          control_statement_descriptor := ^control_statements [current_index].descriptor;
          RETURN; {----->
        ELSEIF name.value (1, max_control_name_size) > control_statements [current_index].name THEN
          low_index := current_index + 1;
        ELSE
          high_index := current_index - 1;
        IFEND;
      UNTIL low_index > high_index;
    IFEND;

    control_statement_descriptor := NIL;

  PROCEND clp$check_name_for_control;
?? TITLE := 'evaluate_boolean_expression', EJECT ??

  PROCEDURE evaluate_boolean_expression
    (    statement_name: ost$name_reference;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
         optional_termination_name: ost$name_reference;
     VAR result: boolean;
     VAR status: ost$status);

    VAR
      clause_name: array [1 .. 1] of ost$name,
      ignore_found_clause_name: ost$name,
      next_parse: clt$parse_state,
      result_boolean: clt$boolean;


    status.normal := TRUE;

    IF optional_termination_name <> '' THEN
      clause_name [1] := optional_termination_name;
      find_clause_name (clause_name, TRUE, parse, next_parse, ignore_found_clause_name);
    IFEND;

    clp$evaluate_boolean_expression (work_area, parse, result_boolean, status);
    IF NOT status.normal THEN
      IF status.condition = cle$unspecified_value_for_req THEN
        osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, statement_name, status);
      IFEND;
      RETURN; {----->
    IFEND;
    result := result_boolean.value;

    IF parse.unit_is_space THEN
      clp$scan_non_space_lexical_unit (parse);
    IFEND;
    IF parse.unit_index < parse.index_limit THEN
      osp$set_status_condition (cle$unexpected_after_bool_expr, status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
    IFEND;

    IF optional_termination_name <> '' THEN
      parse := next_parse;
    IFEND;

  PROCEND evaluate_boolean_expression;
?? TITLE := 'evaluate_unqual_union_expr', EJECT ??

  PROCEDURE evaluate_unqual_union_expr
    (    statement_name: ost$name_reference;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
         optional_termination_name: ost$name_reference;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

    VAR
      clause_name: array [1 .. 1] of ost$name,
      ignore_found_clause_name: ost$name,
      next_parse: clt$parse_state,
      result_value: ^clt$data_value,
      ignore_result_type_description: ^clt$type_description;

    status.normal := TRUE;
    IF optional_termination_name <> '' THEN
      clause_name [1] := optional_termination_name;
      find_clause_name (clause_name, TRUE, parse, next_parse, ignore_found_clause_name);
    IFEND;

    clp$evaluate_unqual_union_expr (work_area, parse, ignore_result_type_description, result_value, status);
    IF NOT status.normal THEN
      IF status.condition = cle$unspecified_value_for_req THEN
        osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, statement_name, status);
      IFEND;
      RETURN; {----->
    IFEND;
    result := result_value;

    IF parse.unit_is_space THEN
      clp$scan_non_space_lexical_unit (parse);
    IFEND;
    IF parse.unit_index < parse.index_limit THEN
      osp$set_status_condition (cle$unexpected_after_bool_expr, status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
    IFEND;

    IF optional_termination_name <> '' THEN
      parse := next_parse;
    IFEND;

  PROCEND evaluate_unqual_union_expr;
?? TITLE := 'evaluate_case_selection', EJECT ??

  PROCEDURE evaluate_case_selection
    (    case_selection_value: ^clt$internal_data_value;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: boolean;
     VAR status: ost$status);

    VAR
      case_value: ^clt$data_value,
      lexical_units: ^clt$lexical_units,
      result_type_description: ^clt$type_description,
      result_value: ^clt$data_value,
      selction_text_p: ^string ( * ),
      selection_parse: clt$parse_state;

?? NEWTITLE := 'evaluate_selection', EJECT ??

    PROCEDURE evaluate_selection
      (VAR parse: clt$parse_state;
       VAR case_value: ^clt$data_value;
       VAR work_area {input, output} : ^clt$work_area;
       VAR result: boolean;
       VAR status: ost$status);

      VAR
        expression_parse: clt$parse_state,
        local_result: clt$comparison_result,
        local_result_high: clt$comparison_result,
        local_result_low: clt$comparison_result;

      expression_parse := parse;
      clp$scan_unnested_sep_lex_unit (clc$ignore_ellipsis, parse);
      expression_parse.index_limit := parse.unit_index;

      IF NOT result THEN
        clp$evaluate_unqual_union_expr (work_area, expression_parse, result_type_description, result_value,
              status);
        IF NOT status.normal THEN
          IF status.condition = cle$unspecified_value_for_req THEN
            osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'CASE Selection', status);
          IFEND;
          RETURN; {----->
        IFEND;

        IF (case_value = NIL) AND (case_selection_value <> NIL) AND
              (case_selection_value^.header.value <> NIL) THEN
          clp$convert_int_value_to_ext (case_selection_value, case_selection_value^.header.value, work_area,
                case_value, status);
          IF NOT status.normal THEN
            RETURN; {----->
          IFEND;
        IFEND;

        IF (result_value <> NIL) AND (case_value <> NIL) AND (result_value^.kind = clc$range) AND
              (case_value^.kind <> clc$range) THEN
          local_result_low := clp$data_value_compare (case_value, result_value^.low_value);
          local_result_high := clp$data_value_compare (case_value, result_value^.high_value);
          result := ((local_result_low = clc$equal) OR (local_result_low = clc$left_is_greater)) AND
                ((local_result_high = clc$equal) OR (local_result_high = clc$right_is_greater));
        ELSE
          local_result := clp$data_value_compare (case_value, result_value);
          result := local_result = clc$equal;
        IFEND;
      IFEND;

    PROCEND evaluate_selection;
?? OLDTITLE ??
?? NEWTITLE := 'p$scan_trailing_equal_unit', EJECT ??

  PROCEDURE p$scan_trailing_equal_lex_unit
    (VAR parse {input, output} : clt$parse_state);

    VAR
      backup_parse: clt$parse_state,
      done: boolean,
      equal_found: boolean,
      space_relevant: boolean;

    done := FALSE;
    equal_found := FALSE;
    space_relevant := TRUE;

    WHILE (NOT done) AND (parse.unit_index < parse.index_limit) DO
      IF NOT parse.unit_is_space THEN
        parse.previous_non_space_unit := parse.unit;
        parse.previous_non_space_unit_index := parse.unit_index;
      IFEND;

      parse.previous_unit_is_space := parse.unit_is_space;
      parse.unit_index := parse.index;
      parse.units_array_index := parse.units_array_index + 1;
      parse.unit := parse.units_array^ [parse.units_array_index];
      parse.index := parse.index + parse.unit.size;

      parse.unit_is_space := FALSE;
      CASE parse.unit.kind OF
      = clc$lex_space, clc$lex_comment, clc$lex_unterminated_comment =
        parse.unit_is_space := TRUE;
        IF (NOT equal_found) AND space_relevant THEN
          backup_parse := parse;
        IFEND;

      = clc$lex_equal =
        equal_found := TRUE;
        IF NOT parse.previous_unit_is_space THEN
          backup_parse := parse;
        IFEND;

      = clc$lex_end_of_line =
        done := TRUE;

      ELSE
        equal_found := FALSE;
        space_relevant := TRUE;
      CASEND;
    WHILEND;

    IF equal_found AND (done OR (parse.unit_index >= parse.index_limit)) THEN
      parse := backup_parse;

    ELSEIF parse.unit.kind = clc$lex_beginning_of_line THEN
      parse.units_array_index := 2;
      parse.unit.kind := clc$lex_end_of_line;
    IFEND;

  PROCEND p$scan_trailing_equal_lex_unit;
?? OLDTITLE ??
?? EJECT ??
    status.normal := TRUE;
    case_value := NIL;
    result := FALSE;
    clp$scan_non_space_lexical_unit (parse);

{Remove optional trailing equal unit
    selection_parse := parse;
    p$scan_trailing_equal_lex_unit (parse);
    selction_text_p := ^parse.text^ (selection_parse.index - selection_parse.unit.size,
          parse.unit_index - selection_parse.index + selection_parse.unit.size);

    clp$identify_lexical_units (selction_text_p, work_area, lexical_units, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    clp$initialize_parse_state (selction_text_p, lexical_units, selection_parse);
    clp$scan_non_space_lexical_unit (selection_parse);

  /evaluate_selections/
    WHILE TRUE DO
      CASE selection_parse.unit.kind OF
      = clc$lex_equal =
        clp$scan_non_space_lexical_unit (selection_parse);
        EXIT /evaluate_selections/; {----->

      = clc$lex_end_of_line =
        EXIT /evaluate_selections/; {----->

      = clc$lex_comma =
        clp$scan_non_space_lexical_unit (selection_parse);

      ELSE

        evaluate_selection (selection_parse, case_value, work_area, result, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

        IF selection_parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (selection_parse);
        IFEND;
        IF selection_parse.unit.kind = clc$lex_comma THEN
          clp$scan_non_space_lexical_unit (selection_parse);
        IFEND;

      CASEND;
    WHILEND /evaluate_selections/;

    IF selection_parse.unit_is_space THEN
      clp$scan_non_space_lexical_unit (selection_parse);
    IFEND;
    IF selection_parse.unit_index < selection_parse.index_limit THEN
      osp$set_status_condition (cle$unexpected_after_bool_expr, status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, selection_parse, status);
    IFEND;

  PROCEND evaluate_case_selection;
?? TITLE := 'check_statement_terminator', EJECT ??

  PROCEDURE check_statement_terminator
    (    statement_name: ost$name_reference;
         block_kind: clt$block_kind;
     VAR parse {input, output} : clt$parse_state;
     VAR statement_block: ^clt$block;
     VAR status: ost$status);

    VAR
      terminator_name: ost$name;

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

    IF statement_block^.kind <> block_kind THEN
      CASE statement_block^.kind OF
      = clc$block_block, clc$case_block, clc$check_block, clc$command_proc_block, clc$for_block,
            clc$function_proc_block, clc$if_block, clc$loop_block, clc$repeat_block, clc$when_block,
            clc$while_block =
        osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, statement_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, statement_block^.kind_end_name, status);
      ELSE
        osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, statement_name, status);
      CASEND;
      RETURN; {----->
    IFEND;

    CASE parse.unit.kind OF
    = clc$lex_end_of_line =
      ;
    = clc$lex_semicolon =
      CASE statement_block^.kind OF
      = clc$command_proc_block, clc$function_proc_block =
        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind <> clc$lex_end_of_line THEN
          osp$set_status_condition (cle$unexpected_after_procend, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, statement_name, status);
          RETURN; {----->
        IFEND;
      ELSE
        ;
      CASEND;
    ELSE
      IF parse.unit.kind <> clc$lex_name THEN
        osp$set_status_condition (cle$expecting_label, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, statement_name, status);
        RETURN; {----->
      IFEND;

      #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), terminator_name);
      CASE statement_block^.kind OF
      = clc$command_proc_block, clc$function_proc_block =
        IF terminator_name <> statement_block^.proc_name THEN
          osp$set_status_abnormal ('CL', cle$wrong_statement_label, statement_name, status);
          RETURN; {----->
        IFEND;
      ELSE
        IF terminator_name <> statement_block^.label THEN
          osp$set_status_abnormal ('CL', cle$wrong_statement_label, statement_name, status);
          RETURN; {----->
        IFEND;
      CASEND;

      clp$scan_non_space_lexical_unit (parse);
      CASE parse.unit.kind OF
      = clc$lex_end_of_line =
        ;
      = clc$lex_semicolon =
        CASE statement_block^.kind OF
        = clc$command_proc_block, clc$function_proc_block =
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind <> clc$lex_end_of_line THEN
            osp$set_status_condition (cle$unexpected_after_end_label, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, statement_name, status);
            RETURN; {----->
          IFEND;
        ELSE
          ;
        CASEND;
      ELSE
        osp$set_status_condition (cle$unexpected_after_end_label, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, statement_name, status);
        RETURN; {----->
      CASEND;
    CASEND;

    IF NOT (statement_block^.being_exited OR statement_block^.exit_position.defined) THEN
      clp$set_exit_position;
    IFEND;

  PROCEND check_statement_terminator;
?? TITLE := 'find_clause_name', EJECT ??

  PROCEDURE find_clause_name
    (    clause_names: array [1 .. * ] of ost$name;
         clause_name_is_terminator: boolean;
     VAR parse {input, output} : clt$parse_state;
     VAR next_parse: clt$parse_state;
     VAR found_clause_name: ost$name);

    VAR
      check_parse: clt$parse_state,
      i: integer,
      name: ost$name,
      nesting_level: clt$string_size;


    found_clause_name := osc$null_name;
    next_parse := parse;
    nesting_level := 0;

    REPEAT
      CASE next_parse.unit.kind OF

      = clc$lex_left_parenthesis =
        nesting_level := nesting_level + 1;

      = clc$lex_right_parenthesis =
        IF nesting_level = 0 THEN
          RETURN; {----->
        IFEND;
        nesting_level := nesting_level - 1;

      = clc$lex_name =
        IF nesting_level = 0 THEN
          #TRANSLATE (osv$lower_to_upper, next_parse.text^ (next_parse.unit_index, next_parse.unit.size),
                name);

        /check_clause_names/
          FOR i := 1 TO UPPERBOUND (clause_names) DO
            IF name = clause_names [i] THEN
              IF clause_name_is_terminator THEN
                check_parse := next_parse;
                clp$scan_non_space_lexical_unit (check_parse);
                IF check_parse.unit_index < check_parse.index_limit THEN
                  CYCLE /check_clause_names/; {----->
                IFEND;
              IFEND;
              parse.index_limit := next_parse.unit_index;
              found_clause_name := name;
              RETURN; {----->
            IFEND;
          FOREND /check_clause_names/;
        IFEND;

      ELSE
        ;
      CASEND;

      clp$scan_non_space_lexical_unit (next_parse);
    UNTIL next_parse.unit_index >= next_parse.index_limit;

  PROCEND find_clause_name;
?? TITLE := 'process_when_clause', EJECT ??

  PROCEDURE [INLINE] process_when_clause
    (    statement_name: ost$name_reference;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR when_condition: boolean;
     VAR status: ost$status);


    status.normal := TRUE;
    IF NOT parse.previous_unit_is_space THEN
      osp$set_status_condition (cle$unexpected_after_when, status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, statement_name, status);
      RETURN; {----->
    IFEND;

    evaluate_boolean_expression (statement_name, parse, work_area, '', when_condition, status);

  PROCEND process_when_clause;
?? TITLE := 'prepare_interactive_statement', EJECT ??

  PROCEDURE prepare_interactive_statement
    (    begin_name: ost$name_reference;
         end_name: ost$name_reference;
         prompt_string: clt$prompt_string;
     VAR work_area {input, output} : ^clt$work_area;
     VAR internal_input_block: ^clt$block;
     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);


      clp$pop_input (TRUE, input_block_handle, file_id, input_executable, NIL, handler_status);
      handler_status.normal := TRUE;

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    VAR
      current_input_block: ^clt$block,
      file_id: amt$file_identifier,
      ignore_line_layout: clt$line_layout,
      input_block_handle: clt$block_handle,
      input_executable: boolean,
      local_status: ost$status,
      statement_area: ^clt$collect_statement_area,
      statement_begin_name: ost$name,
      statement_end_name: ost$name,
      substitution_mark: clt$substitution_mark;


    status.normal := TRUE;
    internal_input_block := NIL;

    clp$find_input_block (FALSE, current_input_block);
    IF current_input_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'prepare_interactive_statement', status);
      RETURN; {----->
    IFEND;
    IF (current_input_block^.input.kind <> clc$file_input) OR current_input_block^.input.file_rereadable THEN
      RETURN; {----->
    IFEND;

    input_block_handle := clv$nil_block_handle;
    file_id := amv$nil_file_identifier;
    #SPOIL (input_block_handle, file_id);

    osp$establish_block_exit_hndlr (^abort_handler);

  /collect/
    BEGIN
      clp$push_input (clc$current_command_input, osc$null_name, prompt_string, FALSE, TRUE,
            input_block_handle, file_id, input_executable, status);
      IF NOT status.normal THEN
        EXIT /collect/; {----->
      IFEND;

      statement_begin_name := begin_name;
      statement_end_name := end_name;
      substitution_mark.specified := FALSE;
      clp$collect_statement (TRUE, statement_begin_name, statement_end_name, '', substitution_mark, work_area,
            statement_area, status);

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

    osp$disestablish_cond_handler;

    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$push_input_internal_block (osc$null_name, current_input_block^.input_can_be_echoed, statement_area,
          internal_input_block);

  PROCEND prepare_interactive_statement;
?? TITLE := 'process_interactive_statement', EJECT ??

  PROCEDURE process_interactive_statement
    (    internal_input_block: ^clt$block;
     VAR status: ost$status);

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


    clp$process_command_file (internal_input_block, NIL, status);
    IF status.normal AND (NOT internal_input_block^.being_exited) THEN
      clp$find_current_block (end_internal_input_block);
      IF end_internal_input_block <> internal_input_block THEN
        osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, internal_input_block^.kind_end_name,
              status);
        osp$append_status_parameter (osc$status_parameter_delimiter, end_internal_input_block^.kind_end_name,
              status);
      IFEND;
    IFEND;
    IF status.normal THEN
      clp$pop_input_stack (end_internal_input_block, status);
    ELSE
      clp$pop_input_stack (end_internal_input_block, ignore_status);
    IFEND;

  PROCEND process_interactive_statement;
?? TITLE := 'clp$process_delayed_block', EJECT ??

  PROCEDURE [XDCL] clp$process_delayed_block
    (    utility_name: clt$utility_name;
         statement_area: ^clt$collect_statement_area;
         can_be_echoed: boolean;
     VAR status: ost$status);

    VAR
      internal_input_block: ^clt$block;


    clp$push_input_internal_block (utility_name, can_be_echoed, statement_area, internal_input_block);

    process_interactive_statement (internal_input_block, status);

  PROCEND clp$process_delayed_block;
?? TITLE := 'clp$prepare_delayed_block', EJECT ??

  PROCEDURE [XDCL] clp$prepare_delayed_block
    (    interpreter_mode: clt$interpreter_modes;
         begin_name: ost$name_reference;
         end_name: ost$name_reference;
         prompt_string: clt$prompt_string;
         first_line_to_write: clt$command_line;
         substitution_mark: clt$substitution_mark;
     VAR statement_area: ^clt$collect_statement_area;
     VAR can_be_echoed: boolean;
     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);


      clp$pop_input (TRUE, input_block_handle, file_id, input_executable, NIL, handler_status);

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    VAR
      current_input_block: ^clt$block,
      file_id: amt$file_identifier,
      input_block_handle: clt$block_handle,
      input_executable: boolean,
      local_status: ost$status,
      statement_begin_name: ost$name,
      statement_end_name: ost$name,
      work_area: ^^clt$work_area;


    status.normal := TRUE;
    statement_area := NIL;

    clp$find_input_block (FALSE, current_input_block);
    IF current_input_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$prepare_delayed_block', status);
      RETURN; {----->
    IFEND;
    can_be_echoed := current_input_block^.input_can_be_echoed;

    input_block_handle := clv$nil_block_handle;
    file_id := amv$nil_file_identifier;
    #SPOIL (input_block_handle, file_id);

    osp$establish_block_exit_hndlr (^abort_handler);

  /collect/
    BEGIN
      clp$push_input (clc$current_command_input, osc$null_name, prompt_string, FALSE, TRUE,
            input_block_handle, file_id, input_executable, status);
      IF NOT status.normal THEN
        EXIT /collect/; {----->
      IFEND;

      clp$get_work_area (#RING (^work_area), work_area, status);
      IF NOT status.normal THEN
        EXIT /collect/; {----->
      IFEND;

      statement_begin_name := begin_name;
      statement_end_name := end_name;
      clp$collect_statement ((interpreter_mode = clc$interpret_mode), statement_begin_name,
            statement_end_name, first_line_to_write, substitution_mark, work_area^, statement_area, status);

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

    osp$disestablish_cond_handler;

  PROCEND clp$prepare_delayed_block;
?? TITLE := 'process_exit_and_cycle_label', EJECT ??

  PROCEDURE process_exit_and_cycle_label
    (    statement_name: ost$name_reference;
     VAR parse {input, output} : clt$parse_state;
     VAR target_label: ost$name;
     VAR following_clause_name: ost$name;
     VAR status: ost$status);


    status.normal := TRUE;
    target_label := '';
    following_clause_name := '';

    CASE parse.unit.kind OF
    = clc$lex_end_of_line, clc$lex_semicolon =
      RETURN; {----->
    = clc$lex_long_name =
      osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
            status);
      RETURN; {----->
    = clc$lex_name =
      ;
    ELSE
      IF statement_name = 'EXIT' THEN
        osp$set_status_condition (cle$expecting_label_when_with, status);
      ELSE
        osp$set_status_condition (cle$expecting_label_or_when, status);
      IFEND;
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN; {----->
    CASEND;

    #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), following_clause_name);
    IF (following_clause_name = 'WHEN') OR ((statement_name = 'EXIT') AND
          ((following_clause_name = 'WITH') OR (following_clause_name = 'ABORT'))) THEN
      RETURN; {----->
    IFEND;

    target_label := following_clause_name;

    clp$scan_non_space_lexical_unit (parse);

    CASE parse.unit.kind OF
    = clc$lex_end_of_line, clc$lex_semicolon =
      RETURN; {----->
    = clc$lex_long_name =
      osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
            status);
      RETURN; {----->
    = clc$lex_name =
      ;
    ELSE
      IF statement_name = 'EXIT' THEN
        osp$set_status_condition (cle$expecting_with_or_when, status);
      ELSE
        osp$set_status_condition (cle$expecting_cycle_when, status);
      IFEND;
      RETURN; {----->
    CASEND;

    #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), following_clause_name);
    IF (following_clause_name = 'WHEN') OR ((statement_name = 'EXIT') AND
          ((following_clause_name = 'WITH') OR (following_clause_name = 'ABORT'))) THEN
      RETURN; {----->
    IFEND;

    IF statement_name = 'EXIT' THEN
      osp$set_status_condition (cle$expecting_with_or_when, status);
    ELSE
      osp$set_status_condition (cle$expecting_cycle_when, status);
    IFEND;

  PROCEND process_exit_and_cycle_label;
?? TITLE := 'clp$cycle_statement', EJECT ??

  PROCEDURE clp$cycle_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      clause_name: ost$name,
      current_block: ^clt$block,
      cycle_condition: boolean,
      expression_parse: clt$parse_state,
      for_list_node: ^clt$i_data_value,
      for_value: integer,
      target_block: ^clt$block,
      target_label: ost$name;


    process_exit_and_cycle_label ('CYCLE', parse, target_label, clause_name, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$find_cycle_block (target_label, current_block, target_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF clause_name = 'WHEN' THEN
      clp$scan_non_space_lexical_unit (parse);
      process_when_clause ('CYCLE', parse, work_area, cycle_condition, status);
      IF NOT (status.normal AND cycle_condition) THEN
        RETURN; {----->
      IFEND;
    IFEND;

    CASE target_block^.kind OF

    = clc$for_block =
      IF target_block^.for_control.style = clc$for_control_incremental THEN
        for_value := target_block^.for_control.value.value + target_block^.for_control.increment;
        cycle_condition := ((target_block^.for_control.increment > 0) AND
              (for_value <= target_block^.for_control.limit)) OR
              ((target_block^.for_control.increment < 0) AND (for_value >= target_block^.for_control.limit));
      ELSE {clc$for_control_list}
        for_list_node := #PTR (target_block^.for_control.list^.header.value, target_block^.for_control.list^);
        cycle_condition := for_list_node <> NIL;
      IFEND;

    = clc$loop_block =
      cycle_condition := TRUE;

    = clc$repeat_block =
      cycle_condition := target_block^.exit_position.defined;
      IF cycle_condition THEN
        expression_parse := target_block^.expression_parse;
        evaluate_boolean_expression ('UNTIL', expression_parse, work_area, '', cycle_condition, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        cycle_condition := NOT cycle_condition;
      IFEND;

    = clc$while_block =
      expression_parse := target_block^.expression_parse;
      evaluate_boolean_expression ('WHILE', expression_parse, work_area, 'DO', cycle_condition, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

    ELSE

{ Should never get here.

      cycle_condition := FALSE;
    CASEND;

    IF cycle_condition THEN
      WHILE current_block <> target_block DO
        clp$pop_block_stack (current_block);
      WHILEND;

      IF target_block^.kind = clc$for_block THEN
        IF target_block^.for_control.style = clc$for_control_incremental THEN
          advance_for_increment (target_block, work_area, status);
        ELSE {clc$for_control_list}
          advance_for_list (target_block, target_block^.for_control.list, for_list_node^.element_value,
                work_area, status);
        IFEND;
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        clp$advance_for_block (FALSE);
      IFEND;

      clp$reset_input_position (target_block^.line_identifier, target_block^.line_parse);
    ELSE
      clp$cycle_block (target_label, (target_block^.kind <> clc$repeat_block) OR
            target_block^.exit_position.defined, status);
    IFEND;

  PROCEND clp$cycle_statement;
?? TITLE := 'clp$exit_statement', EJECT ??

  PROCEDURE clp$exit_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      initial_clause_name: ost$name,
      target_label: ost$name;


    process_exit_and_cycle_label ('EXIT', parse, target_label, initial_clause_name, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    exit_statement (target_label, initial_clause_name, parse, work_area, status);

  PROCEND clp$exit_statement;
?? TITLE := 'exit_statement', EJECT ??

{
{   The EXIT statement is used for the following purposes in SCL:
{
{   - get out of a structured statement (e.g.  LOOP/LOOPEND)
{   - get out of an SCL command procedure
{   - get out of and return a result from an SCL function procedure
{   - get out of a CHECK/CHECKEND statement (not yet implemented)
{   - get out of a task (program)
{   - get out of a command utility
{
{   There are two variants to EXITing a command utility.  The first appears
{ similar to EXITing a structured statement.  For example, the following
{ sequence shows a conditional exit from the "source code utility":
{
{       SOURCE_CODE_UTILITY
{         .
{         .
{         EXIT UTILITY WHEN some_condition
{         .
{         .
{       QUIT
{
{   In this example, if some_condition is true, the statements following the
{ EXIT statement up to and including the QUIT command are skipped, and normal
{ processing resumes with the statement following QUIT.
{
{   The EXIT statement also provides the means for implementing a "utility
{ termination command" for a utility implemented at the "command level." For
{ instance, the following is an example of an SCL procedure that implements the
{ command used to "quit" a hypothetical_utility.
{
{       PROCEDURE quit, qui (
{         status)
{
{         EXIT hypothetical_utility
{
{       PROCEND quit
{
{   In this procedure the EXIT statement causes termination of the "innermost"
{ input block associated with hypothetical_utility.  The following comments
{ describe how all of this is accomplished.
{
{   The following fields of a CLT$BLOCK are used by the EXIT process:
{
{ INTERPRETER_MODE:  This field is set to CLC$SKIP_MODE for any block that is
{       in the process of "being exited".
{
{ SOURCE.UTILITY_TERMINATION_COMMAND:  When a command is encountered (within
{       module CLM$PROCESS_COMMANDS) that is a utility subcommand and has the
{       same command table "ordinal" as the utility's termination command, this
{       field is set to TRUE in the corresponding CLC$COMMAND_BLOCK or
{       CLC$COMMAND_PROC_BLOCK.  Otherwise this field is FALSE.
{
{ BEING_EXITED:  This field is set to TRUE for any block that is in the process
{       of "being exited".
{
{ EXIT_POSITION:  This field contains information describing whether the
{       location of the end of a structured statement is known, and if so where
{       it is.  This information is used to avoid the need to explicitly skip
{       over statements when we already know where to transfer control after an
{       EXIT (or CYCLE when there are no more iterations of the statement to be
{       performed).
{
{ INPUT.STATE,
{ INPUT.RESET_LINE_IDENTIFIER,
{ INPUT.RESET_LINE_INDEX:  These fields are used to "mark" an input block so
{       that the next time a "get" is done using that block, its position can
{       be "reset" to the proper place.  This is done via the
{       CLP$RESET_INPUT_POSITION request which sets the INPUT.STATE field to
{       CLC$RESET_INPUT and stores the specified values into the other two
{       fields.
{
{ INPUT.ASSOCIATED_UTILITY:  This field points to the CLC$UTILITY_BLOCK
{       associated with a CLC$INPUT_BLOCK, if any.
{
{ COMMAND_ENVIRONMENT.COMMANDS,
{ COMMAND_ENVIRONMENT.TERMINATION_COMMAND_ORDINAL:  These fields of a
{       CLC$UTILITY_BLOCK are used to determine whether a command is a
{       utility termination command.
{
{ TERMINATION_COMMAND_FOUND:  This field of a CLC$UTILITY_BLOCK is used to
{       determine whether an input block associated with the utility that is
{       "being exited" can actually be exited yet.  It is set to TRUE by the
{       CLP$EXIT_STATEMENT request for the second type of exit from a utility,
{       described above.  It is also set to TRUE via the
{       CLP$IGNORE_REST_OF_FILE request which is called by CLP$END_INCLUDE (or
{       the "obsolete" CLP$END_SCAN_COMMAND_FILE request).
{
{   The process of EXITing starts in the control statement processor for the
{ EXIT statement (CLP$EXIT_STATEMENT) or EXIT_PROC (CLP$EXIT_PROC_STATEMENT).
{ CLP$EXIT_STATEMENT calls PROCESS_EXIT_AND_CYCLE_LABEL in order to determine
{ the target of the EXIT.  CLP$EXIT_PROC_STATEMENT "hard wires" the target as
{ "PROCEDURE." Both routines then call EXIT_STATEMENT.
{
{   The first thing EXIT_STATEMENT does is to call CLP$FIND_EXIT_BLOCK in order
{ to find the CLT$BLOCK that corresponds to the target block of the EXIT.  A
{ boolean that indicates whether a utility is the target is also returned.
{ Note that if a utility is the target of the EXIT, the block considered to be
{ the target is the innermost input block associated with that utility.
{
{   The next step is to evaluate the remaining parameters of the EXIT (or
{ EXIT_PROC) statement.
{
{   If the WHEN clause was present and the value of its expression was false,
{ the EXIT is inhibited.
{
{   If the target block is a function procedure, the WITH clause is required
{ and specifies an expression for the result of the function.  If the target
{ block is the current TASK, the WITH clause is required and specifies the
{ task's termination status.  If the target block is a command procedure or
{ CHECK/CHECKEND statement, the WITH clause is optional and specifies an
{ expression for the corresponding termination status.  For any other kind of
{ block, the WITH clause is not allowed.
{
{   If the target block is the current TASK, the ABORT option determines how to
{ proceed.  If ABORT was omitted, the task is terminated by calling PMP$EXIT.
{ If ABORT was specified, the task is terminated by calling PMP$ABORT, thereby
{ allowing an "abort file" associated with the task, if any, to be processed.
{
{   For any target block other than the current TASK, CLP$EXIT_BLOCK is called
{ to instigate the exiting process.  It marks the blocks between the current
{ and target, inclusive, as being exited and in skip mode.  If a utility is the
{ EXIT target, the utility block's TERMINATION_COMMAND_FOUND field is set to
{ true.
{
{   While CLP$EXIT_BLOCK is marking the appropriate blocks, it determines the
{ existence and location of two other blocks.  These are refered to as the
{ CHILD_TASK_BLOCK and the EXIT_CONTROL_BLOCK.  The term target task is used in
{ the following discussion to refer to the task that "owns" the target block of
{ the EXIT.
{
{   If the target task is not the task issuing the EXIT, the CHILD_TASK_BLOCK
{ is the CLC$TASK_BLOCK corresponding to the direct child task of the target
{ task.  Otherwise the CHILD_TASK_BLOCK is NIL.
{
{   The EXIT_CONTROL_BLOCK designates a block that either is the target block
{ or is the closest "control block" to the target block that is marked for
{ exit.  If no such block exists in the target task, the EXIT_CONTROL_BLOCK is
{ NIL.  A "control block" is either a CLC$COMMAND_BLOCK,
{ CLC$COMMAND_PROC_BLOCK, CLC$FUNCTION_BLOCK, CLC$FUNCTION_PROC_BLOCK,
{ CLC$INPUT_BLOCK, or CLC$WHEN_BLOCK.  These blocks are "control" blocks in the
{ sense that there is an instance of execution of a procedure within the SCL
{ interpreter corresponding to each of these kinds of blocks.  These procedures
{ have condition handlers wihtin them that can perform a (CYBIL) non-local exit
{ out of the procedure for the "control block."
{
{   If the CHILD_TASK_BLOCK is not NIL (i.e.  the target task is an ancester of
{ the task issuing the EXIT) CLP$EXIT_BLOCK sends a "signal" to the target task
{ by calling CLP$SEND_EXITING_SIGNAL.  The "exiting signal" includes the
{ PMT$TASK_ID of the target task's direct child task (which may be the task
{ issuing the EXIT) and the EXIT_CONTROL_BLOCK (which may be NIL).  The handler
{ for this signal, CLP$SCL_SIGNAL_HANDLER, terminates the child task and, if
{ the EXIT_CONTROL_BLOCK is not NIL, causes the "task condition"
{ CLC$EXITING_CONDITION.
{
{   If the CHILD_TASK_BLOCK is NIL but the EXIT_CONTROL_BLOCK is not NIL,
{ CLP$EXIT_BLOCK, itself, causes the "task condition" CLC$EXITING_CONDITION.
{
{   If both CHILD_TASK_BLOCK and EXIT_CONTROL_BLOCK are NIL, CLP$EXIT_BLOCK
{ does nothing more.
{
{   The processing done directly by the processor of the EXIT statement is
{ complete at this point.  The block stack now indicates what, if any, further
{ processing is needed in order to accomplish the EXIT.
{
{   CLP$PROCESS_COMMAND_FILE makes a "is it time to exit the current input
{ block" check after it has called PROCESS_COMMAND_LINE.  PROCESS_COMMAND_LINE
{ makes the same check after it has processed each statement on a line.
{
{   It is time to exit the current input block if the block's BEING_EXITED
{ field is true and
{
{   - the input is from an interactive device, or
{   - it is not associated with a command utility, or
{   - the command utility's termination command isn't defined, or
{   - the command utility's termination command has been found.
{
{   To take care of finding a utility's termination command when the
{ interpreter mode is CLC$SKIP_MODE, CLP$PROCESS_COMMAND makes a check to see
{ if the command it is "skipping" is the termination command of the utility
{ associated with the current input block.  If so, CLP$IGNORE_REST_OF_FILE is
{ called to indicate that the termination command has been found.
{
{   The PROCESS_SUB_COMMAND routine called during command search sets the
{ "command search state" according to whether the command being processed is
{ the termination command of a utility.  This information is ultimately set in
{ the CLC$COMMAND_BLOCK or CLC$COMMAND_PROC_BLOCK "pushed" for the command by
{ the appropriate "invoke" routine.
{
{   (When a utility is created (CLP$CREATE_UTILITY_ENVIRONMENT), a definition
{ for the termination command is part of it.  This definition consists of the
{ command's index and ordinal within the command table associated with the
{ utility.  The ordinal is what is checked during command search to determine
{ whether the current command is a utility's termination command.  The index
{ is used to retrieve the name of the termination command from the table for a
{ CLP$GET_UTILITY_ATTRIBUTES call.)
{

  PROCEDURE exit_statement
    (    target_label: ost$name,
         initial_clause_name: ost$name;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR status: ost$status);

    VAR
      abort_option_allowed: boolean,
      abort_option_specified: boolean,
      clause_name: ost$name,
      clause_names: [STATIC, READ, oss$job_paged_literal] array [1 .. 3] of ost$name := ['ABORT', 'WHEN',
            'WITH'],
      error_condition: ost$status_condition_code,
      exit_condition: boolean,
      exit_status: ^ost$status,
      function_result: ^clt$internal_data_value,
      ignore_result_type_description: ^clt$type_description,
      next_parse: clt$parse_state,
      target_block: ^clt$block,
      terminating_utility: boolean,
      unexpected_condition: ost$status_condition_code,
      when_clause_specified: boolean,
      when_expression_parse: clt$parse_state,
      with_clause_allowed: boolean,
      with_clause_specified: boolean,
      with_expression_parse: clt$parse_state,
      with_expression_result: ^clt$data_value;


    clp$find_exit_block (target_label, target_block, terminating_utility, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    abort_option_allowed := target_block^.kind = clc$task_block;
    abort_option_specified := FALSE;
    clause_name := initial_clause_name;
    exit_status := NIL;
    function_result := NIL;
    when_clause_specified := FALSE;
    with_clause_allowed := target_block^.kind IN $clt$block_kinds
          [clc$check_block, clc$command_proc_block, clc$function_proc_block, clc$task_block];
    with_clause_specified := FALSE;

  /process_exit_parameters/
    WHILE NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) DO

      IF clause_name = 'ABORT' THEN
        IF NOT abort_option_allowed THEN
          osp$set_status_condition (cle$abort_option_not_allowed, status);
          RETURN; {----->
        ELSEIF abort_option_specified THEN
          osp$set_status_condition (cle$duplicate_abort_option, status);
          RETURN; {----->
        IFEND;
        abort_option_specified := TRUE;

        clp$scan_non_space_lexical_unit (parse);
        IF (parse.unit.kind <> clc$lex_name) OR (NOT parse.previous_unit_is_space) THEN
          osp$set_status_condition (cle$expecting_with_after_abort, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN; {----->
        IFEND;

        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
        IF clause_name <> 'WITH' THEN
          osp$set_status_condition (cle$expecting_with_after_abort, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN; {----->
        IFEND;
      IFEND;

      IF clause_name = 'WITH' THEN
        IF NOT with_clause_allowed THEN
          osp$set_status_condition (cle$with_clause_not_allowed, status);
          RETURN; {----->
        ELSEIF with_clause_specified THEN
          osp$set_status_condition (cle$duplicate_with_clause, status);
          RETURN; {----->
        IFEND;
        with_clause_specified := TRUE;

        clp$scan_non_space_lexical_unit (parse);
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_condition (cle$unexpected_after_with, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN; {----->
        IFEND;

        find_clause_name (clause_names, FALSE, parse, next_parse, clause_name);
        with_expression_parse := parse;
        parse := next_parse;

        unexpected_condition := cle$unexpected_after_with_value;
        error_condition := 0;

      ELSEIF clause_name = 'WHEN' THEN
        IF when_clause_specified THEN
          osp$set_status_condition (cle$duplicate_when_clause, status);
          RETURN; {----->
        IFEND;
        when_clause_specified := TRUE;

        clp$scan_non_space_lexical_unit (parse);
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_condition (cle$unexpected_after_when, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN; {----->
        IFEND;

        find_clause_name (clause_names, FALSE, parse, next_parse, clause_name);
        when_expression_parse := parse;
        parse := next_parse;

        unexpected_condition := cle$unexpected_after_when_value;
        error_condition := 0;

      ELSEIF with_clause_allowed THEN
        IF with_clause_specified THEN
          IF when_clause_specified THEN
            error_condition := unexpected_condition;
          ELSE
            error_condition := cle$expecting_exit_when;
          IFEND;
        ELSEIF when_clause_specified THEN
          error_condition := cle$expecting_with;
        ELSE
          error_condition := cle$expecting_with_or_when;
        IFEND;

      ELSEIF when_clause_specified THEN
        error_condition := cle$unexpected_after_when_value;

      ELSE
        error_condition := cle$expecting_exit_when;
      IFEND;

      IF error_condition <> 0 THEN
        osp$set_status_condition (error_condition, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN; {----->
      IFEND;

    WHILEND /process_exit_parameters/;

    IF (NOT with_clause_specified) AND (target_block^.kind IN $clt$block_kinds
          [clc$function_proc_block, clc$task_block]) THEN
      osp$set_status_condition (cle$with_clause_required, status);
      RETURN; {----->
    IFEND;

    IF when_clause_specified THEN
      process_when_clause ('EXIT', when_expression_parse, work_area, exit_condition, status);
      IF NOT (status.normal AND exit_condition) THEN
        RETURN; {----->
      IFEND;
    IFEND;

    IF with_clause_specified THEN
      IF target_block^.kind = clc$function_proc_block THEN
        clp$evaluate_unqual_union_expr (work_area, with_expression_parse, ignore_result_type_description,
              with_expression_result, status);
        IF NOT status.normal THEN
          IF status.condition = cle$unspecified_value_for_req THEN
            osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'EXIT', status);
          IFEND;
          RETURN; {----->
        IFEND;
        clp$convert_ext_value_to_int (NIL, with_expression_result, NIL, work_area, function_result, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

      ELSE
        PUSH exit_status;
        clp$evaluate_status_expression (work_area, with_expression_parse, exit_status^, status);
        IF NOT status.normal THEN
          IF status.condition = cle$unspecified_value_for_req THEN
            osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'EXIT', status);
          IFEND;
          RETURN; {----->
        IFEND;
      IFEND;

      IF with_expression_parse.unit_index < with_expression_parse.index_limit THEN
        osp$set_status_condition (cle$unexpected_after_with_value, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, with_expression_parse, status);
        RETURN; {----->
      IFEND;
    IFEND;

    IF target_block^.kind <> clc$task_block THEN
      clp$exit_block (#OFFSET (target_block), exit_status, function_result, terminating_utility, status);
    ELSEIF abort_option_specified THEN
      pmp$abort (exit_status^);
    ELSE
      pmp$exit (exit_status^);
    IFEND;

  PROCEND exit_statement;
?? TITLE := 'clp$exit_proc_statement', EJECT ??

  PROCEDURE clp$exit_proc_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      initial_clause_name: ost$name,
      target_label: ost$name;


    status.normal := TRUE;

    CASE parse.unit.kind OF
    = clc$lex_end_of_line, clc$lex_semicolon =
      initial_clause_name := '';
    = clc$lex_name =
      #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), initial_clause_name);
      IF (initial_clause_name <> 'WHEN') AND (initial_clause_name <> 'WITH') THEN
        osp$set_status_abnormal ('CL', cle$expecting_with_or_when, initial_clause_name, status);
        RETURN; {----->
      IFEND;
    = clc$lex_long_name =
      osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
            status);
      RETURN; {----->
    ELSE
      osp$set_status_condition (cle$expecting_with_or_when, status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN; {----->
    CASEND;

    target_label := 'PROC';
    exit_statement (target_label, initial_clause_name, parse, work_area, status);

  PROCEND clp$exit_proc_statement;
?? TITLE := 'clp$procedure_statement', EJECT ??

{
{ PURPOSE:
{   This procedure receives control if a PROCEDURE (PROC) statement is encounterred in the normal course of
{   processing commands.   Since PROCEDURE declarations can not be nested an error status is returned.  This
{   is done in order to produce a less misleading status than "Unknown command: PROCEDURE (PROC)".
{

  PROCEDURE clp$procedure_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);


    osp$set_status_condition (cle$unexpected_proc, status);

  PROCEND clp$procedure_statement;
?? TITLE := 'clp$procend_statement', EJECT ??

  PROCEDURE clp$procend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      proc_block: ^clt$block;


    parse.index_limit := STRLENGTH (parse.text^) + 1;
    check_statement_terminator ('PROCEND', clc$command_proc_block, parse, proc_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    clp$skip_block;

  PROCEND clp$procend_statement;
?? TITLE := 'clp$_function_statement', EJECT ??

{
{ PURPOSE:
{   This commadn receives control if a FUNCTION statement is encounterred in the normal course of processing
{   commands.   Since FUNCTION declarations can not be nested an error status is returned.  This is done in
{   order to produce a less misleading status than "Unknown command: FUNCTION".
{

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


    osp$set_status_condition (cle$unexpected_function, status);

  PROCEND clp$_function_statement;
?? TITLE := 'clp$funcend_statement', EJECT ??

  PROCEDURE clp$funcend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      proc_block: ^clt$block;


    parse.index_limit := STRLENGTH (parse.text^) + 1;
    check_statement_terminator ('FUNCEND', clc$function_proc_block, parse, proc_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    clp$skip_block;

  PROCEND clp$funcend_statement;
?? TITLE := 'clp$check_statement', EJECT ??

  PROCEDURE clp$check_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);


    osp$set_status_abnormal ('CL', cle$not_supported, 'CHECK statement', status);

  PROCEND clp$check_statement;
?? TITLE := 'clp$checkend_statement', EJECT ??

  PROCEDURE clp$checkend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      check_block: ^clt$block;


    check_statement_terminator ('CHECKEND', clc$check_block, parse, check_block, status);
    IF (NOT status.normal) AND ((status.condition = cle$unexpected_control_statemnt) OR
          (status.condition = cle$unbalanced_block_structure)) THEN
      RETURN; {----->
    IFEND;
    clp$pop_block_stack (check_block);

  PROCEND clp$checkend_statement;
?? TITLE := 'clp$block_statement', EJECT ??

  PROCEDURE clp$block_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      internal_input_block: ^clt$block,
      block_block: ^clt$block;


    status.normal := TRUE;
    IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'BLOCK', status);
      RETURN; {----->
    IFEND;

    prepare_interactive_statement ('BLOCK', 'BLOCKEND', 'block', work_area, internal_input_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$push_block_block (info.label, block_block);

    IF internal_input_block <> NIL THEN
      process_interactive_statement (internal_input_block, status);
    IFEND;

  PROCEND clp$block_statement;
?? TITLE := 'clp$blockend_statement', EJECT ??

  PROCEDURE clp$blockend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      block_block: ^clt$block;


    check_statement_terminator ('BLOCKEND', clc$block_block, parse, block_block, status);
    IF (NOT status.normal) AND ((status.condition = cle$unexpected_control_statemnt) OR
          (status.condition = cle$unbalanced_block_structure)) THEN
      RETURN; {----->
    IFEND;
    clp$pop_block_stack (block_block);

  PROCEND clp$blockend_statement;
?? TITLE := 'clp$if_statement', EJECT ??

  PROCEDURE clp$if_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      if_block: ^clt$block,
      if_condition: boolean,
      internal_input_block: ^clt$block;

    status.normal := TRUE;
    IF info.interpreter_mode <> clc$interpret_mode THEN
      if_condition := FALSE;
    ELSE
      evaluate_boolean_expression ('IF', parse, work_area, 'THEN', if_condition, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    prepare_interactive_statement ('IF', 'IFEND', 'if', work_area, internal_input_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$push_if_block (if_condition, if_block);

    IF internal_input_block <> NIL THEN
      process_interactive_statement (internal_input_block, status);
    IFEND;

  PROCEND clp$if_statement;
?? TITLE := 'interpret_if', EJECT ??

  FUNCTION [INLINE] interpret_if
    (    bool: boolean): clt$interpreter_modes;

    IF bool THEN
      interpret_if := clc$interpret_mode;
    ELSE
      interpret_if := clc$skip_mode;
    IFEND;

  FUNCEND interpret_if;
?? TITLE := 'clp$elseif_statement', EJECT ??

  PROCEDURE clp$elseif_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      if_block: ^clt$block,
      elseif_condition: boolean;


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

    CASE if_block^.kind OF
    = clc$if_block =
      IF NOT if_block^.if_else_allowed THEN
        osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSEIF', status);
        RETURN; {----->
      IFEND;
    = clc$block_block, clc$case_block, clc$check_block, clc$command_proc_block, clc$for_block,
          clc$function_proc_block, clc$loop_block, clc$repeat_block, clc$when_block, clc$while_block =
      osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, 'ELSEIF', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, if_block^.kind_end_name, status);
      RETURN; {----->
    ELSE
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSEIF', status);
      RETURN; {----->
    CASEND;

    IF if_block^.if_condition_met THEN
      IF if_block^.interpreter_mode = clc$interpret_mode THEN
        clp$set_if_block (clc$skip_mode, TRUE, TRUE);
      IFEND;
    ELSEIF if_block^.previous_block^.interpreter_mode = clc$interpret_mode THEN
      evaluate_boolean_expression ('ELSEIF', parse, work_area, 'THEN', elseif_condition, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      clp$set_if_block (interpret_if (elseif_condition), elseif_condition, TRUE);
    IFEND;

  PROCEND clp$elseif_statement;
?? TITLE := 'clp$else_statement', EJECT ??

  PROCEDURE clp$else_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      block: ^clt$block;


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

    CASE block^.kind OF
    = clc$case_block =
      IF (NOT block^.case_else_allowed) {OR (NOT block^.case_selection_encounterred)} THEN
        osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSE', status);
        RETURN; {----->
      ELSEIF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
        osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'ELSE', status);
        RETURN; {----->
      IFEND;

      clp$set_case_block (interpret_if ((NOT block^.case_selection_made) AND
            (block^.previous_block^.interpreter_mode = clc$interpret_mode)), TRUE, TRUE, FALSE);

    = clc$if_block =
      IF NOT block^.if_else_allowed THEN
        osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSE', status);
        RETURN; {----->
      ELSEIF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
        osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'ELSE', status);
        RETURN; {----->
      IFEND;

      clp$set_if_block (interpret_if ((NOT block^.if_condition_met) AND
            (block^.previous_block^.interpreter_mode = clc$interpret_mode)), TRUE, FALSE);

    = clc$block_block, clc$check_block, clc$command_proc_block, clc$for_block, clc$function_proc_block,
          clc$loop_block, clc$repeat_block, clc$when_block, clc$while_block =
      osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, 'ELSE', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, block^.kind_end_name, status);
      RETURN; {----->
    ELSE
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSE', status);
      RETURN; {----->
    CASEND;

  PROCEND clp$else_statement;
?? TITLE := 'clp$ifend_statement', EJECT ??

  PROCEDURE clp$ifend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      if_block: ^clt$block;


    check_statement_terminator ('IFEND', clc$if_block, parse, if_block, status);
    IF (NOT status.normal) AND ((status.condition = cle$unexpected_control_statemnt) OR
          (status.condition = cle$unbalanced_block_structure)) THEN
      RETURN; {----->
    IFEND;
    clp$pop_block_stack (if_block);

  PROCEND clp$ifend_statement;
?? TITLE := 'clp$case_statement', EJECT ??

  PROCEDURE clp$case_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      case_block: ^clt$block,
      internal_input_block: ^clt$block,
      selection_value: ^clt$internal_data_value;

    VAR
      case_expression_result: ^clt$data_value;

    status.normal := TRUE;
    selection_value := NIL;
    IF info.interpreter_mode = clc$interpret_mode THEN
      evaluate_unqual_union_expr ('CASE', parse, work_area, 'OF', case_expression_result, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      clp$convert_ext_value_to_int (NIL, case_expression_result, NIL, work_area, selection_value, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    prepare_interactive_statement ('CASE', 'CASEND', 'case', work_area, internal_input_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$push_case_block (selection_value, case_block);

    IF internal_input_block <> NIL THEN
      process_interactive_statement (internal_input_block, status);
    IFEND;

  PROCEND clp$case_statement;
?? TITLE := 'clp$case_selection_statement', EJECT ??

  PROCEDURE [XDCL] clp$case_selection_statement
    (    interpreter_mode: clt$interpreter_modes;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR status: ost$status);

    VAR
      case_block: ^clt$block,
      case_condition: boolean;

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

    CASE case_block^.kind OF
    = clc$case_block =
      IF case_block^.case_selection_made THEN
        IF case_block^.interpreter_mode = clc$interpret_mode THEN
          clp$set_case_block (clc$skip_mode, TRUE, TRUE, TRUE);
        IFEND;

      ELSEIF case_block^.previous_block^.interpreter_mode = clc$interpret_mode THEN
        evaluate_case_selection (case_block^.case_selection_value, parse, work_area, case_condition, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;

        clp$set_case_block (interpret_if (case_condition), TRUE, case_condition, TRUE);
      IFEND;

    = clc$block_block, clc$check_block, clc$command_proc_block, clc$for_block, clc$function_proc_block,
          clc$if_block, clc$loop_block, clc$repeat_block, clc$when_block, clc$while_block =
      osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, 'case selection', status);
      osp$append_status_parameter (osc$status_parameter_delimiter, case_block^.kind_end_name, status);
      RETURN; {----->
    ELSE
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'case selection', status);
      RETURN; {----->
    CASEND;

  PROCEND clp$case_selection_statement;
?? TITLE := 'clp$casend_statement', EJECT ??

  PROCEDURE clp$casend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      case_block: ^clt$block;


    check_statement_terminator ('CASEND', clc$case_block, parse, case_block, status);
    IF (NOT status.normal) AND ((status.condition = cle$unexpected_control_statemnt) OR
          (status.condition = cle$unbalanced_block_structure)) THEN
      RETURN; {----->
    IFEND;
    clp$pop_block_stack (case_block);

  PROCEND clp$casend_statement;
?? TITLE := 'clp$loop_statement', EJECT ??

  PROCEDURE clp$loop_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      internal_input_block: ^clt$block,
      loop_block: ^clt$block;


    status.normal := TRUE;
    IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'LOOP', status);
      RETURN; {----->
    IFEND;

    prepare_interactive_statement ('LOOP', 'LOOPEND', 'loop', work_area, internal_input_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$push_loop_block (info.label, loop_block);

    IF internal_input_block <> NIL THEN
      process_interactive_statement (internal_input_block, status);
    IFEND;

  PROCEND clp$loop_statement;
?? TITLE := 'clp$loopend_statement', EJECT ??

  PROCEDURE clp$loopend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      loop_block: ^clt$block;


    check_statement_terminator ('LOOPEND', clc$loop_block, parse, loop_block, status);
    IF (NOT status.normal) AND ((status.condition = cle$unexpected_control_statemnt) OR
          (status.condition = cle$unbalanced_block_structure)) THEN
      RETURN; {----->
    IFEND;
    IF status.normal AND (NOT loop_block^.being_exited) AND
          (loop_block^.previous_block^.interpreter_mode = clc$interpret_mode) THEN
      clp$reset_input_position (loop_block^.line_identifier, loop_block^.line_parse);
      RETURN; {----->
    IFEND;
    clp$pop_block_stack (loop_block);

  PROCEND clp$loopend_statement;
?? TITLE := 'clp$while_statement', EJECT ??

  PROCEDURE clp$while_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      expression_parse: clt$parse_state,
      expression_text: ^clt$string_value,
      expression_units_array: ^clt$lexical_units,
      internal_input_block: ^clt$block,
      while_block: ^clt$block,
      while_condition: boolean;


    status.normal := TRUE;
    expression_parse := parse;
    IF info.interpreter_mode <> clc$interpret_mode THEN
      while_condition := FALSE;
    ELSE
      evaluate_boolean_expression ('WHILE', parse, work_area, 'DO', while_condition, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      expression_parse.index_limit := parse.unit_index;
      PUSH expression_text: [STRLENGTH (expression_parse.text^)];
      expression_text^ := expression_parse.text^;
      expression_parse.text := expression_text;
      PUSH expression_units_array: [1 .. UPPERBOUND (expression_parse.units_array^)];
      expression_units_array^ := expression_parse.units_array^;
      expression_parse.units_array := expression_units_array;
    IFEND;

    prepare_interactive_statement ('WHILE', 'WHILEND', 'while', work_area, internal_input_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$push_while_block (info.label, while_condition, expression_parse, while_block);

    IF internal_input_block <> NIL THEN
      process_interactive_statement (internal_input_block, status);
    IFEND;

  PROCEND clp$while_statement;
?? TITLE := 'clp$whilend_statement', EJECT ??

  PROCEDURE clp$whilend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      expression_parse: clt$parse_state,
      while_block: ^clt$block,
      while_condition: boolean;


    check_statement_terminator ('WHILEND', clc$while_block, parse, while_block, status);
    IF (NOT status.normal) AND ((status.condition = cle$unexpected_control_statemnt) OR
          (status.condition = cle$unbalanced_block_structure)) THEN
      RETURN; {----->
    IFEND;
    IF status.normal AND (NOT while_block^.being_exited) AND
          (while_block^.previous_block^.interpreter_mode = clc$interpret_mode) THEN
      expression_parse := while_block^.expression_parse;
      evaluate_boolean_expression ('WHILE', expression_parse, work_area, 'DO', while_condition, status);
      IF status.normal AND while_condition THEN
        clp$reset_input_position (while_block^.line_identifier, while_block^.line_parse);
        RETURN; {----->
      IFEND;
    IFEND;
    clp$pop_block_stack (while_block);

  PROCEND clp$whilend_statement;
?? TITLE := 'clp$repeat_statement', EJECT ??

  PROCEDURE clp$repeat_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      internal_input_block: ^clt$block,
      repeat_block: ^clt$block;


    status.normal := TRUE;
    IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'REPEAT', status);
      RETURN; {----->
    IFEND;

    prepare_interactive_statement ('REPEAT', 'UNTIL', 'repeat', work_area, internal_input_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$push_repeat_block (info.label, repeat_block);

    IF internal_input_block <> NIL THEN
      process_interactive_statement (internal_input_block, status);
    IFEND;

  PROCEND clp$repeat_statement;
?? TITLE := 'clp$until_statement', EJECT ??

  PROCEDURE clp$until_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      expression_parse: clt$parse_state,
      repeat_block: ^clt$block,
      until_condition: boolean;


    status.normal := TRUE;
    clp$find_current_block (repeat_block);
    IF repeat_block^.kind <> clc$repeat_block THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'UNTIL', status);
      RETURN; {----->
    IFEND;

    IF (NOT repeat_block^.being_exited) AND (repeat_block^.previous_block^.interpreter_mode =
          clc$interpret_mode) THEN
      expression_parse := parse;
      evaluate_boolean_expression ('UNTIL', parse, work_area, '', until_condition, status);
      IF status.normal AND (NOT until_condition) THEN
        IF repeat_block^.expression_area = NIL THEN
          expression_parse.index_limit := parse.unit_index;
          clp$set_repeat_until (expression_parse);
        IFEND;
        clp$reset_input_position (repeat_block^.line_identifier, repeat_block^.line_parse);
        RETURN; {----->
      IFEND;
    IFEND;
    clp$pop_block_stack (repeat_block);

  PROCEND clp$until_statement;
?? TITLE := 'clp$for_statement', EJECT ??

  PROCEDURE clp$for_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      for_condition: boolean,
      for_increment: integer,
      for_initial: clt$integer,
      for_limit: integer,
      for_list: ^clt$internal_data_value,
      for_variable_already_declared: boolean,
      for_variable_expression: ^clt$variable_ref_expression,
      for_variable_name: clt$variable_name;

?? NEWTITLE := 'setup_for_incremental_control', EJECT ??

    PROCEDURE setup_for_incremental_control;

{ TYPE
{   for_integer_type_spec = integer
{ TYPEND

?? PUSH (LISTEXT := ON) ??

      VAR
        for_integer_type_spec: [STATIC, READ, cls$declaration_section] record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend := [[1, 0, clc$integer_type], [clc$min_integer, clc$max_integer, 10]];

?? POP ??

      VAR
        clause_name: ost$name,
        for_value: clt$data_value,
        for_value_description: clt$variable_value_description,
        result: clt$integer;


      IF parse.unit.kind <> clc$lex_equal THEN
        osp$set_status_condition (cle$expecting_for_assign, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement; {----->
      IFEND;
      clp$scan_non_space_lexical_unit (parse);

      clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, parse, for_initial,
            status);
      IF NOT status.normal THEN
        IF status.condition = cle$unspecified_value_for_req THEN
          osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'FOR', status);
        IFEND;
        EXIT clp$for_statement; {----->
      IFEND;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_condition (cle$unexpected_after_for_init, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement; {----->
      IFEND;
      IF parse.unit.kind <> clc$lex_name THEN
        osp$set_status_condition (cle$expecting_for_to, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement; {----->
      IFEND;
      #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
      IF clause_name <> 'TO' THEN
        osp$set_status_abnormal ('CL', cle$expecting_for_to, clause_name, status);
        EXIT clp$for_statement; {----->
      IFEND;
      clp$scan_non_space_lexical_unit (parse);
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_condition (cle$unexpected_after_for_to, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement; {----->
      IFEND;

      clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, parse, result, status);
      IF NOT status.normal THEN
        IF status.condition = cle$unspecified_value_for_req THEN
          osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'FOR', status);
        IFEND;
        EXIT clp$for_statement; {----->
      IFEND;
      for_limit := result.value;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      for_increment := 1;

    /optional_part/
      BEGIN
        CASE parse.unit.kind OF
        = clc$lex_end_of_line, clc$lex_semicolon =
          EXIT /optional_part/; {----->
        = clc$lex_name =
          IF NOT parse.previous_unit_is_space THEN
            osp$set_status_condition (cle$unexpected_after_for_final, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$for_statement; {----->
          IFEND;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT clp$for_statement; {----->
        ELSE
          osp$set_status_condition (cle$expecting_for_by_or_do, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT clp$for_statement; {----->
        CASEND;
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);

        IF clause_name <> 'DO' THEN
          IF clause_name <> 'BY' THEN
            osp$set_status_abnormal ('CL', cle$expecting_for_by_or_do, clause_name, status);
            EXIT clp$for_statement; {----->
          IFEND;
          clp$scan_non_space_lexical_unit (parse);
          IF NOT parse.previous_unit_is_space THEN
            osp$set_status_condition (cle$unexpected_after_for_by, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$for_statement; {----->
          IFEND;

          clp$evaluate_integer_expression (clc$min_integer, clc$max_integer, work_area, parse, result,
                status);
          IF NOT status.normal THEN
            IF status.condition = cle$unspecified_value_for_req THEN
              osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'FOR', status);
            IFEND;
            EXIT clp$for_statement; {----->
          IFEND;
          for_increment := result.value;

          IF parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;
          CASE parse.unit.kind OF
          = clc$lex_end_of_line, clc$lex_semicolon =
            EXIT /optional_part/; {----->
          = clc$lex_name =
            IF NOT parse.previous_unit_is_space THEN
              osp$set_status_condition (cle$unexpected_after_for_step, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              EXIT clp$for_statement; {----->
            IFEND;
          = clc$lex_long_name =
            osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                  status);
            EXIT clp$for_statement; {----->
          ELSE
            osp$set_status_condition (cle$expecting_for_by_or_do, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$for_statement; {----->
          CASEND;
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
          IF clause_name <> 'DO' THEN
            osp$set_status_abnormal ('CL', cle$unexpected_after_for_step, clause_name, status);
            EXIT clp$for_statement; {----->
          IFEND;
        IFEND;

        clp$scan_non_space_lexical_unit (parse);
        IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_then_or_do, 'DO', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT clp$for_statement; {----->
        IFEND;
      END /optional_part/;

      for_value.kind := clc$integer;
      for_value.integer_value := for_initial;
      IF for_variable_already_declared THEN
        clp$produce_variable_ref_expr (for_variable_information.class, for_variable_name,
              for_variable_information.value_qualifiers, work_area, for_variable_expression, status);
        IF NOT status.normal THEN
          EXIT clp$for_statement; {----->
        IFEND;
        for_value_description.kind := clc$variable_data_value;
        for_value_description.data_value := ^for_value;
        clp$update_variable (for_variable_expression, for_value_description, work_area, status);
      ELSE
        for_variable_expression := ^for_variable_name (1, clp$trimmed_string_size (for_variable_name));
        clp$create_var_from_type_spec (for_variable_name, clc$local_scope, clc$read_write,
              clc$immediate_evaluation, #SEQ (for_integer_type_spec), ^for_value, FALSE, work_area, status);
      IFEND;
      IF NOT status.normal THEN
        EXIT clp$for_statement; {----->
      IFEND;
      for_control_is_incremental := ((for_increment >= 0) AND (for_initial.value <= for_limit)) OR
            ((for_increment < 0) AND (for_initial.value >= for_limit));

    PROCEND setup_for_incremental_control;
?? TITLE := 'setup_for_list_control', EJECT ??

    PROCEDURE setup_for_list_control;

      VAR
        clause_name: ost$name,
        for_list_element_type_desc: ^clt$type_description,
        for_list_element_type_spec: ^clt$type_specification,
        for_list_node: ^clt$i_data_value,
        for_value: ^clt$data_value,
        for_value_description: clt$variable_value_description,
        result_type_description: ^clt$type_description;


      IF parse.unit.kind <> clc$lex_name THEN
        osp$set_status_condition (cle$expecting_for_in, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement; {----->
      IFEND;
      #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
      IF clause_name <> 'IN' THEN
        osp$set_status_abnormal ('CL', cle$expecting_for_in, clause_name, status);
        EXIT clp$for_statement; {----->
      IFEND;
      clp$scan_non_space_lexical_unit (parse);
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_condition (cle$unexpected_after_for_in, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement; {----->
      IFEND;

      clp$evaluate_list_expression (0, clc$max_list_size, FALSE, NIL, work_area, parse,
            result_type_description, for_value, status);
      IF NOT status.normal THEN
        IF status.condition = cle$unspecified_value_for_req THEN
          osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'FOR', status);
        IFEND;
        EXIT clp$for_statement; {----->
      IFEND;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;

    /optional_part/
      BEGIN
        CASE parse.unit.kind OF
        = clc$lex_end_of_line, clc$lex_semicolon =
          EXIT /optional_part/; {----->
        = clc$lex_name =
          IF NOT parse.previous_unit_is_space THEN
            osp$set_status_condition (cle$unexpected_after_for_list, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$for_statement; {----->
          IFEND;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT clp$for_statement; {----->
        ELSE
          osp$set_status_condition (cle$unexpected_after_for_list, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT clp$for_statement; {----->
        CASEND;
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
        IF clause_name <> 'DO' THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_for_list, clause_name, status);
          EXIT clp$for_statement; {----->
        IFEND;

        clp$scan_non_space_lexical_unit (parse);
        IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_then_or_do, 'DO', status);
          osp$append_status_parameter (osc$status_parameter_delimiter, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT clp$for_statement; {----->
        IFEND;
      END /optional_part/;

      IF for_variable_already_declared THEN
        IF for_value^.element_value <> NIL THEN
          clp$produce_variable_ref_expr (for_variable_information.class, for_variable_name,
                for_variable_information.value_qualifiers, work_area, for_variable_expression, status);
          IF NOT status.normal THEN
            EXIT clp$for_statement; {----->
          IFEND;
          for_value_description.kind := clc$variable_data_value;
          for_value_description.data_value := for_value^.element_value;
          clp$update_variable (for_variable_expression, for_value_description, work_area, status);
        IFEND;
        for_list_element_type_desc := NIL;
      ELSE
        for_variable_expression := ^for_variable_name (1, clp$trimmed_string_size (for_variable_name));
        IF (result_type_description = NIL) OR (result_type_description^.kind <> clc$list_type) THEN
          NEXT result_type_description IN work_area;
          IF result_type_description = NIL THEN
            osp$set_status_condition (cle$work_area_overflow, status);
            EXIT clp$for_statement; {----->
          IFEND;
          clp$derive_type_desc_from_value (for_value, work_area, result_type_description^, status);
          IF NOT status.normal THEN
            EXIT clp$for_statement; {----->
          IFEND;
        IFEND;
        for_list_element_type_desc := result_type_description^.list_element_type_description;
        clp$convert_type_desc_to_spec (for_list_element_type_desc, work_area, for_list_element_type_spec,
              status);
        IF NOT status.normal THEN
          EXIT clp$for_statement; {----->
        IFEND;
        clp$create_var_from_type_spec (for_variable_name, clc$local_scope, clc$read_write,
              clc$immediate_evaluation, for_list_element_type_spec, for_value^.element_value, FALSE,
              work_area, status);
      IFEND;
      IF NOT status.normal THEN
        EXIT clp$for_statement; {----->
      IFEND;

      IF for_value^.element_value = NIL THEN
        for_list := NIL;
      ELSE
        clp$convert_ext_value_to_int (for_list_element_type_desc, for_value, NIL, work_area, for_list,
              status);
        IF NOT status.normal THEN
          EXIT clp$for_statement; {----->
        IFEND;
        for_list_node := #PTR (for_list^.header.value, for_list^);
        for_list^.header.value := for_list_node^.link;
      IFEND;

    PROCEND setup_for_list_control;
?? OLDTITLE, EJECT ??

    VAR
      access_variable_requests: clt$access_variable_requests,
      for_block: ^clt$block,
      for_control_is_incremental: boolean,
      for_variable: clt$variable_name,
      for_variable_information: clt$variable_information,
      ignore_access_handle: clt$variable_access_handle,
      ignore_type_description: ^clt$type_description,
      internal_input_block: ^clt$block;


    status.normal := TRUE;
    for_control_is_incremental := FALSE;
    for_list := NIL;

    IF info.interpreter_mode = clc$interpret_mode THEN
      CASE parse.unit.kind OF
      = clc$lex_name =
        ;
      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
              status);
        RETURN; {----->
      ELSE
        osp$set_status_condition (cle$expecting_for_var_or_each, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN; {----->
      CASEND;
      #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), for_variable);
      for_control_is_incremental := for_variable <> 'EACH';
      IF NOT for_control_is_incremental THEN
        clp$scan_non_space_lexical_unit (parse);
        CASE parse.unit.kind OF
        = clc$lex_name =
          ;
        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          RETURN; {----->
        ELSE
          osp$set_status_condition (cle$expecting_for_variable, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN; {----->
        CASEND;
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), for_variable);
      IFEND;
      clp$scan_any_lexical_unit (parse);
      access_variable_requests := $clt$access_variable_requests [clc$return_value_qualifiers];
      clp$evaluate_name_for_write (for_variable, access_variable_requests, FALSE, parse, work_area,
            for_variable_name, for_variable_information, ignore_access_handle, ignore_type_description,
            for_variable_already_declared, status);
      IF NOT status.normal THEN

{ Ignore the error if it is the result of attempting to write to a read only parameter variable,
{ not through $VALUE or $PARAMETER_VALUE, and it is an unqualified reference.  Then go ahead
{ and implicitly create the variable as it would if the parameter variable did not exist.

        IF (status.condition <> cle$cannot_assign_to_a_read_var) OR (for_variable (1) = '$') OR
              (for_variable_information.class <> clc$param_variable) OR
              (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_left_parenthesis, clc$lex_dot]) THEN
          RETURN; {----->
        IFEND;
        for_variable_already_declared := FALSE;
        status.normal := TRUE;
      IFEND;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      IF for_control_is_incremental THEN
        setup_for_incremental_control;
      ELSE
        setup_for_list_control;
      IFEND;
    IFEND;

    prepare_interactive_statement ('FOR', 'FOREND', 'for', work_area, internal_input_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF for_control_is_incremental THEN
      clp$push_for_incremental_block (info.label, for_variable_expression, for_initial, for_limit,
            for_increment, for_block);
    ELSE
      clp$push_for_list_block (info.label, for_variable_expression, for_list, for_block);
    IFEND;

    IF internal_input_block <> NIL THEN
      process_interactive_statement (internal_input_block, status);
    IFEND;

  PROCEND clp$for_statement;
?? TITLE := 'advance_for_increment', EJECT ??

  PROCEDURE [INLINE] advance_for_increment
    (    for_block: ^clt$block;
     VAR work_area {input, output} : ^clt$work_area;
     VAR status: ost$status);

    VAR
      new_value: clt$data_value,
      new_value_description: clt$variable_value_description;


    status.normal := TRUE;

    new_value.kind := clc$integer;
    new_value.integer_value.value := for_block^.for_control.value.value + for_block^.for_control.increment;
    new_value.integer_value.radix := for_block^.for_control.value.radix;
    new_value.integer_value.radix_specified := for_block^.for_control.value.radix_specified;

    new_value_description.kind := clc$variable_data_value;
    new_value_description.data_value := ^new_value;
    clp$update_variable (for_block^.for_variable, new_value_description, work_area, status);

  PROCEND advance_for_increment;
?? TITLE := 'advance_for_list', EJECT ??

  PROCEDURE [INLINE] advance_for_list
    (    for_block: ^clt$block;
         for_list: ^clt$internal_data_value;
         for_list_element: REL (clt$internal_data_value) ^clt$i_data_value;
     VAR work_area {input, output} : ^clt$work_area;
     VAR status: ost$status);

    VAR
      for_list_element_value: ^clt$data_value,
      for_list_element_value_desc: clt$variable_value_description;


    clp$convert_int_value_to_ext (for_list, for_list_element, work_area, for_list_element_value, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    for_list_element_value_desc.kind := clc$variable_data_value;
    for_list_element_value_desc.data_value := for_list_element_value;
    clp$update_variable (for_block^.for_variable, for_list_element_value_desc, work_area, status);

  PROCEND advance_for_list;
?? TITLE := 'clp$forend_statement', EJECT ??

  PROCEDURE clp$forend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      for_block: ^clt$block,
      for_list_node: ^clt$i_data_value,
      for_value: integer,
      forend_condition: boolean;


    check_statement_terminator ('FOREND', clc$for_block, parse, for_block, status);
    IF (NOT status.normal) AND ((status.condition = cle$unexpected_control_statemnt) OR
          (status.condition = cle$unbalanced_block_structure)) THEN
      RETURN; {----->
    IFEND;

    IF status.normal AND (NOT for_block^.being_exited) AND
          (for_block^.previous_block^.interpreter_mode = clc$interpret_mode) THEN
      IF for_block^.for_control.style = clc$for_control_incremental THEN
        for_value := for_block^.for_control.value.value + for_block^.for_control.increment;
        forend_condition := ((for_block^.for_control.increment > 0) AND
              (for_value <= for_block^.for_control.limit)) OR ((for_block^.for_control.increment < 0) AND
              (for_value >= for_block^.for_control.limit));
        IF forend_condition THEN
          advance_for_increment (for_block, work_area, status);
        IFEND;
      ELSE {clc$for_control_list}
        for_list_node := #PTR (for_block^.for_control.list^.header.value, for_block^.for_control.list^);
        forend_condition := for_list_node <> NIL;
        IF forend_condition THEN
          advance_for_list (for_block, for_block^.for_control.list, for_list_node^.element_value, work_area,
                status);
        IFEND;
      IFEND;

      IF status.normal AND forend_condition THEN
        clp$advance_for_block (TRUE);
        clp$reset_input_position (for_block^.line_identifier, for_block^.line_parse);
        RETURN; {----->
      IFEND;
    IFEND;

    clp$pop_block_stack (for_block);

  PROCEND clp$forend_statement;
?? TITLE := 'clp$when_statement', EJECT ??

  PROCEDURE clp$when_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      any_condition: boolean,
      any_fault: boolean,
      do_clause_name: [STATIC, READ, oss$job_paged_literal] array [1 .. 1] of ost$name := ['DO'],
      ignore_found_clause_name: ost$name,
      next_parse: clt$parse_state,
      specific_conditions: ^clt$when_conditions,
      substitution_mark: clt$substitution_mark,
      when_can_be_echoed: boolean,
      when_statement_area: ^clt$collect_statement_area;


    status.normal := TRUE;
    IF info.interpreter_mode = clc$interpret_mode THEN
      find_clause_name (do_clause_name, TRUE, parse, next_parse, ignore_found_clause_name);
      get_when_conditions ('WHEN', parse, work_area, specific_conditions, any_fault, any_condition, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    substitution_mark.specified := FALSE;
    clp$prepare_delayed_block (info.interpreter_mode, 'WHEN', 'WHENEND', 'when', '', substitution_mark,
          when_statement_area, when_can_be_echoed, status);
    IF (NOT status.normal) OR (info.interpreter_mode <> clc$interpret_mode) THEN
      RETURN; {----->
    IFEND;

    clp$establish_condition_handler (any_condition, any_fault, specific_conditions, when_statement_area,
          when_can_be_echoed, status);

  PROCEND clp$when_statement;
?? TITLE := 'get_when_conditions', EJECT ??

  PROCEDURE get_when_conditions
    (    statement_name: ost$name_reference;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR specific_conditions: ^clt$when_conditions;
     VAR any_fault: boolean;
     VAR any_condition: boolean;
     VAR status: ost$status);

    TYPE
      t$condition_name = record
        link: ^t$condition_name,
        name: clt$when_condition,
      recend;

    VAR
      condition_name_count: clt$list_size,
      condition_name_list: ^t$condition_name,
      condition_name_node: ^^t$condition_name,
      i: clt$list_size,
      original_work_area: ^clt$work_area;


    status.normal := TRUE;
    any_condition := FALSE;
    any_fault := FALSE;
    specific_conditions := NIL;

    original_work_area := work_area;
    condition_name_count := 0;
    condition_name_list := NIL;
    condition_name_node := ^condition_name_list;

  /evaluate_condition_names/
    WHILE TRUE DO
      IF condition_name_node^ = NIL THEN
        PUSH condition_name_node^;
        condition_name_node^^.link := NIL;
      IFEND;

      clp$evaluate_data_name_expr (work_area, parse, condition_name_node^^.name, status);
      IF NOT status.normal THEN
        IF status.condition = cle$unspecified_value_for_req THEN
          osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, statement_name, status);
        IFEND;
        RETURN; {----->
      IFEND;

    /process_condition_name/
      BEGIN
        IF condition_name_node^^.name = clc$wc_any_condition THEN
          any_condition := TRUE;
          EXIT /process_condition_name/; {----->
        ELSEIF condition_name_node^^.name = clc$wc_any_fault THEN
          any_fault := TRUE;
          EXIT /process_condition_name/; {----->
        ELSEIF condition_name_node^^.name = 'PROGRAM_FAULT' THEN
          condition_name_node^^.name := clc$wc_command_fault;
        ELSEIF condition_name_node^^.name = 'RESOURCE_FAULT' THEN
          condition_name_node^^.name := clc$wc_limit_fault;
        ELSEIF condition_name_node^^.name = 'INTERRUPT' THEN
          condition_name_node^^.name := clc$wc_pause;
        ELSEIF condition_name_node^^.name = osc$unseen_mail_condition THEN
          condition_name_node^^.name := clc$wc_unseen_mail;
        IFEND;
        condition_name_node := ^condition_name_node^^.link;
        condition_name_count := condition_name_count + 1;
      END /process_condition_name/;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      IF parse.unit_index >= parse.index_limit THEN
        EXIT /evaluate_condition_names/; {----->
      IFEND;
      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_semicolon =
        EXIT /evaluate_condition_names/; {----->
      = clc$lex_comma =
        clp$scan_non_space_lexical_unit (parse);
      = clc$lex_long_name =
        osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
              status);
        RETURN; {----->
      = clc$lex_name =
        ;
      ELSE
        osp$set_status_condition (cle$unexpected_after_cond_name, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN; {----->
      CASEND;
    WHILEND /evaluate_condition_names/;

    work_area := original_work_area;

    IF condition_name_count = 0 THEN
      RETURN; {----->
    IFEND;

    NEXT specific_conditions: [1 .. condition_name_count] IN work_area;
    condition_name_node := ^condition_name_list;
    FOR i := 1 TO condition_name_count DO
      specific_conditions^ [i] := condition_name_node^^.name;
      condition_name_node := ^condition_name_node^^.link;
    FOREND;

  PROCEND get_when_conditions;
?? TITLE := 'clp$whenend_statement', EJECT ??

  PROCEDURE clp$whenend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      when_block: ^clt$block;


    check_statement_terminator ('WHENEND', clc$when_block, parse, when_block, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;
    clp$skip_block;

  PROCEND clp$whenend_statement;
?? TITLE := 'clp$continue_statement', EJECT ??

  PROCEDURE clp$continue_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      clause_name: ost$name,
      continue_when_condition_option: clt$condition_processed_state,
      expecting_when: ost$status_condition,
      process_continue: boolean,
      when_block: ^clt$block;


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

  /find_when_block/
    WHILE when_block <> NIL DO
      CASE when_block^.kind OF
      = clc$block_block, clc$command_block, clc$for_block, clc$if_block, clc$input_block, clc$loop_block,
            clc$repeat_block, clc$while_block =
        when_block := when_block^.previous_block;
      = clc$when_block =
        EXIT /find_when_block/; {----->
      ELSE
        when_block := NIL;
        EXIT /find_when_block/; {----->
      CASEND;
    WHILEND /find_when_block/;

    IF when_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'CONTINUE', status);
      RETURN; {----->
    IFEND;

  /process_continue_parameters/
    BEGIN
      continue_when_condition_option := clc$continue_next;

      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_semicolon =
        EXIT /process_continue_parameters/; {----->
      = clc$lex_name =
        ;
      ELSE
        osp$set_status_condition (cle$expecting_retry_or_when, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN; {----->
      CASEND;

      #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
      expecting_when := cle$expecting_retry_or_when;

    /process_continue_option/
      BEGIN
        IF clause_name = 'WHEN' THEN
          EXIT /process_continue_option/; {----->
        ELSEIF clause_name = 'RETRY' THEN
          continue_when_condition_option := clc$continue_retry;
        ELSEIF clause_name = 'NEXT_USER_HANDLER' THEN
          continue_when_condition_option := clc$continue_next_user_handler;
        ELSEIF clause_name = 'NEXT_HANDLER' THEN
          continue_when_condition_option := clc$continue_next_handler;
        ELSEIF clause_name <> 'NEXT' THEN
          osp$set_status_condition (cle$expecting_retry_or_when, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN; {----->
        IFEND;

        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon] THEN
          EXIT /process_continue_parameters/; {----->
        IFEND;
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_condition (cle$unexpected_after_retry, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, clause_name, status);
          RETURN; {----->
        IFEND;
        IF parse.unit.kind <> clc$lex_name THEN
          osp$set_status_condition (cle$expecting_continue_when, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN; {----->
        IFEND;
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
        expecting_when := cle$expecting_continue_when;
      END /process_continue_option/;

      IF clause_name <> 'WHEN' THEN
        osp$set_status_condition (expecting_when, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN; {----->
      IFEND;
      clp$scan_non_space_lexical_unit (parse);
      process_when_clause ('CONTINUE', parse, work_area, process_continue, status);
      IF NOT (status.normal AND process_continue) THEN
        RETURN; {----->
      IFEND;
    END /process_continue_parameters/;

    CASE continue_when_condition_option OF

    = clc$continue_retry =
      IF (when_block^.when_condition^.name <> clc$wc_command_fault) AND
            (when_block^.when_condition^.name <> clc$wc_execution_fault) THEN
        continue_when_condition_option := clc$continue_next;
      IFEND;

    = clc$continue_next_handler, clc$continue_next_user_handler =
      IF NOT when_block^.when_condition^.exit_on_continue_condition THEN
        IF when_block^.when_condition^.default_handler <> NIL THEN
          clp$process_continued_condition (when_block, continue_when_condition_option, status);
        ELSEIF continue_when_condition_option = clc$continue_next_handler THEN
          pmp$continue_to_cause (pmc$execute_standard_procedure, status);
        ELSE
          pmp$continue_to_cause (pmc$inhibit_standard_procedure, status);
        IFEND;
        RETURN; {----->
      IFEND;

    ELSE
      ;
    CASEND;

    clp$continue (continue_when_condition_option, status);

  PROCEND clp$continue_statement;
?? TITLE := 'clp$cancel_statement', EJECT ??

  PROCEDURE clp$cancel_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      any_condition: boolean,
      any_fault: boolean,
      specific_conditions: ^clt$when_conditions;


    get_when_conditions ('CANCEL', parse, work_area, specific_conditions, any_fault, any_condition, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clp$disestablish_cond_handler (any_condition, any_fault, specific_conditions);

  PROCEND clp$cancel_statement;
?? TITLE := 'clp$cause_statement', EJECT ??

  PROCEDURE clp$cause_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      cause_status: ost$status,
      clause_name: ost$name;


    status.normal := TRUE;
    cause_condition := clc$wc_command_fault;
    cause_status.normal := TRUE;

  /determine_condition_to_cause/
    BEGIN
      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
        IF clause_name = 'CONDITION' THEN
          clp$scan_non_space_lexical_unit (parse);
          clp$evaluate_data_name_expr (work_area, parse, cause_condition, status);
          IF NOT status.normal THEN
            IF status.condition = cle$unspecified_value_for_req THEN
              osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'CAUSE', status);
            IFEND;
            cause_condition := osc$null_name;
            RETURN; {----->
          ELSEIF (cause_condition = clc$wc_exit) OR (cause_condition = clc$wc_any_fault) OR
                (cause_condition = clc$wc_any_condition) THEN
            osp$set_status_abnormal ('CL', cle$cannot_cause_condition, cause_condition, status);
            cause_condition := osc$null_name;
            RETURN; {----->
          IFEND;

          IF parse.unit_is_space THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;
          CASE parse.unit.kind OF
          = clc$lex_end_of_line, clc$lex_semicolon =
            EXIT /determine_condition_to_cause/; {----->
          = clc$lex_name =
            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
            IF clause_name <> 'WITH' THEN
              osp$set_status_condition (cle$expecting_with_for_cause, status);
              clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
              cause_condition := osc$null_name;
              RETURN; {----->
            IFEND;
            clp$scan_non_space_lexical_unit (parse);
          ELSE
            osp$set_status_condition (cle$expecting_with_for_cause, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            cause_condition := osc$null_name;
            RETURN; {----->
          CASEND;
        IFEND;
      IFEND;

      clp$evaluate_status_expression (work_area, parse, cause_status, status);
      IF NOT status.normal THEN
        IF status.condition = cle$unspecified_value_for_req THEN
          osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'CAUSE', status);
        IFEND;
        cause_condition := osc$null_name;
        RETURN; {----->
      IFEND;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
        osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'CAUSE status', status);
        cause_condition := osc$null_name;
        RETURN; {----->
      IFEND;
    END /determine_condition_to_cause/;

    status := cause_status;

  PROCEND clp$cause_statement;
?? TITLE := 'TASK/TASKEND processing TYPEs and VARiables', EJECT ??

  TYPE
    clt$task_parameters = record
      task_name: ost$name,
      can_be_echoed: boolean,
      statement_area_size: integer,
    recend,
    clt$task_statement_area = clt$collect_statement_area;

*copyc clv$task_name
?? TITLE := 'clp$_task', EJECT ??

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

{ PROCEDURE (osm$task) task (
{   task_name, tn: name = $optional
{   ring, r: integer osc$min_ring..osc$max_ring = $ring
{   debug_mode, dm: boolean = no
{   substitution_mark, sm: any of
{       key
{         none
{       keyend
{       string 1
{     anyend = none
{   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$name_type_qualifier,
        recend,
        type2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
          default_value: string (5),
        recend,
        type3: record
          header: clt$type_specification_header,
          default_value: string (2),
        recend,
        type4: 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$keyword_type_qualifier,
            keyword_specs: array [1 .. 1] of clt$keyword_specification,
          recend,
          type_size_2: clt$type_specification_size,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$string_type_qualifier,
          recend,
          default_value: string (4),
        recend,
        type5: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [87, 10, 21, 19, 50, 14, 987], clc$command, 9, 5, 0, 0, 0, 0, 5, 'OSM$TASK'],
            [['DEBUG_MODE                     ', clc$nominal_entry, 3],
            ['DM                             ', clc$abbreviation_entry, 3],
            ['R                              ', clc$abbreviation_entry, 2],
            ['RING                           ', clc$nominal_entry, 2],
            ['SM                             ', clc$abbreviation_entry, 4],
            ['STATUS                         ', clc$nominal_entry, 5],
            ['SUBSTITUTION_MARK              ', clc$nominal_entry, 4],
            ['TASK_NAME                      ', clc$nominal_entry, 1],
            ['TN                             ', clc$abbreviation_entry, 1]], [

{ PARAMETER 1

      [8, 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, 5, clc$optional_parameter, 0, 0],

{ PARAMETER 2

      [4, 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, 20, clc$optional_default_parameter, 0, 5],

{ PARAMETER 3

      [1, 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$optional_default_parameter, 0, 2],

{ PARAMETER 4

      [7, 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, 72, clc$optional_default_parameter, 0, 4],

{ PARAMETER 5

      [6, 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$name_type], [1, osc$max_name_size]],

{ PARAMETER 2

      [[1, 0, clc$integer_type], [osc$min_ring, osc$max_ring, 10], '$ring'],

{ PARAMETER 3

      [[1, 0, clc$boolean_type], 'no'],

{ PARAMETER 4

      [[1, 0, clc$union_type], [[clc$keyword_type, clc$string_type], FALSE, 2], 44,
            [[1, 0, clc$keyword_type], [1], [['NONE                           ', clc$nominal_entry,
            clc$normal_usage_entry, 1]]], 8, [[1, 0, clc$string_type], [1, 1, FALSE]], 'none'],

{ PARAMETER 5

      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$task_name = 1,
      p$ring = 2,
      p$debug_mode = 3,
      p$substitution_mark = 4,
      p$status = 5;

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

    VAR
      program_description_area: SEQ (pmt$program_attributes, amt$local_file_name),
      program_description: ^pmt$program_description,
      program_attributes: ^pmt$program_attributes,
      program_library_list: ^pmt$object_library_list,
      program_parameters: ^pmt$program_parameters,
      task_parameters: ^clt$task_parameters,
      search_mode: clt$command_search_modes,
      statement_area: ^clt$collect_statement_area,
      can_be_echoed: boolean,
      area_size: integer,
      block: ^clt$block,
      use_command_search_mode: boolean,
      task_statement_area: ^clt$task_statement_area,
      ignore_task_id: pmt$task_id,
      interpreter_mode: clt$interpreter_modes,
      substitution_mark: clt$substitution_mark;


    status.normal := TRUE;
    substitution_mark.specified := FALSE;

    clp$find_current_block (block);
    use_command_search_mode := block^.use_command_search_mode;
    interpreter_mode := block^.interpreter_mode;
    #SPOIL (use_command_search_mode, interpreter_mode);

    IF interpreter_mode = clc$skip_mode THEN
      PUSH task_parameters;
      clp$prepare_delayed_block (clc$skip_mode, 'TASK', 'TASKEND', 'task', '', substitution_mark,
            statement_area, can_be_echoed, status);
      RETURN; {----->
    IFEND;

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

    IF pvt [p$substitution_mark].value^.kind = clc$string THEN
      IF clv$non_substitution_mark [pvt [p$substitution_mark].value^.string_value^ (1)] THEN
        osp$set_status_abnormal ('CL', cle$improper_substitution_mark,
              pvt [p$substitution_mark].value^.string_value^ (1), status);
        RETURN; {----->
      IFEND;
      substitution_mark.specified := TRUE;
      substitution_mark.value := pvt [p$substitution_mark].value^.string_value^ (1);
    IFEND;

    IF (NOT pvt [p$task_name].specified) AND substitution_mark.specified THEN
      osp$set_status_condition (cle$improper_use_of_subst_mark, status);
      RETURN; {----->
    IFEND;

    program_description := ^program_description_area;
    RESET program_description;
    NEXT program_attributes IN program_description;
    program_attributes^.contents := $pmt$prog_description_contents
          [pmc$starting_proc_specified, pmc$library_list_specified, pmc$load_map_file_specified,
          pmc$load_map_options_specified, pmc$term_error_level_specified, pmc$max_stack_size_specified,
          pmc$abort_file_specified, pmc$debug_mode_specified];
    program_attributes^.starting_procedure := 'CLP$TASK_TASKEND';
    program_attributes^.number_of_libraries := 1;
    NEXT program_library_list: [1 .. 1] IN program_description;
    program_library_list^ [1] := loc$task_services_library_name;
    program_attributes^.load_map_file := clv$standard_files [clc$sf_null_file].path_handle_name;
    program_attributes^.load_map_options := $pmt$load_map_options [pmc$no_load_map];
    program_attributes^.termination_error_level := LOWERVALUE (pmt$termination_error_level);
    program_attributes^.maximum_stack_size := UPPERVALUE (ost$segment_length);
    program_attributes^.abort_file := clv$standard_files [clc$sf_null_file].path_handle_name;
    program_attributes^.debug_mode := pvt [p$debug_mode].value^.boolean_value.value;

    clp$get_command_search_mode (search_mode);

    IF pvt [p$task_name].specified THEN

{ Asynchronous mode.

      IF (search_mode = clc$exclusive_command_search) AND use_command_search_mode THEN
        osp$set_status_abnormal ('CL', cle$not_allowed_in_exclusive, 'TASK/TASKEND', status);
        RETURN; {----->
      IFEND;

      clp$prepare_delayed_block (interpreter_mode, 'TASK', 'TASKEND', 'task', '', substitution_mark,
            statement_area, can_be_echoed, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      IF statement_area = NIL THEN
        osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$task_taskend', status);
        RETURN; {----->
      IFEND;

      area_size := #SIZE (statement_area^);
      PUSH program_parameters: [[clt$task_parameters, REP area_size OF cell]];
      RESET program_parameters;

      NEXT task_parameters IN program_parameters;
      task_parameters^.task_name := pvt [p$task_name].value^.name_value;
      task_parameters^.can_be_echoed := can_be_echoed;
      task_parameters^.statement_area_size := area_size;
      NEXT task_statement_area: [[REP area_size OF cell]] IN program_parameters;
      task_statement_area^ := statement_area^;

      clp$execute_named_task (pvt [p$task_name].value^.name_value, pvt [p$ring].value^.integer_value.value,
            program_description^, program_parameters^, ignore_command_file, ignore_task_id, status);
    ELSE

{ Synchronous mode.

      IF (search_mode = clc$exclusive_command_search) AND use_command_search_mode AND
            (pvt [p$ring].value^.integer_value.value < #RING (block)) THEN
        osp$set_status_abnormal ('CL', cle$not_allowed_in_exclusive, 'TASK/TASKEND', status);
        RETURN; {----->
      IFEND;

      PUSH program_parameters: [[clt$task_parameters]];
      RESET program_parameters;
      NEXT task_parameters IN program_parameters;
      task_parameters^.task_name := osc$null_name;
      clp$execute_named_task (osc$null_name, pvt [p$ring].value^.integer_value.value, program_description^,
            program_parameters^, ignore_command_file, ignore_task_id, status);
    IFEND;

  PROCEND clp$_task;
?? TITLE := 'clp$task_taskend', EJECT ??

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

    VAR
      block: ^clt$block,
      connected_files: ^clt$connected_files,
      end_block: ^clt$block,
      ignore_status: ost$status,
      parameters: ^pmt$program_parameters,
      substitution_mark: clt$substitution_mark,
      task_name: ost$name,
      task_parameters: ^clt$task_parameters,
      task_statement_area: ^clt$task_statement_area,
      valid_local_file_name: boolean,
      valid_task_name: boolean;

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

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

      clp$process_exit_condition (block, status);

      IF task_parameters^.can_be_echoed THEN
        clp$find_connected_files (connected_files);
        IF connected_files^.echo_count > 0 THEN
          clp$echo_trace_information ('CLC$ECHO_TASK_END', ^task_name, NIL, ^status, ignore_status);
        IFEND;
      IFEND;

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    parameters := ^program_parameters;
    RESET parameters;
    NEXT task_parameters IN parameters;
    IF task_parameters <> NIL THEN
      IF clv$task_name <> osc$null_name THEN
        valid_task_name := FALSE;
      ELSEIF task_parameters^.task_name = osc$null_name THEN
        task_name := osc$null_name;
        valid_task_name := TRUE;
      ELSE
        clp$validate_name (task_parameters^.task_name, task_name, valid_task_name);
      IFEND;
    IFEND;
    clp$find_current_block (block);
    IF (task_parameters = NIL) OR (NOT valid_task_name) OR (block^.kind <> clc$task_block) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$task_taskend', status);
      pmp$abort (status);
    IFEND;

    clp$set_task_statement_task (task_name);

    IF task_name = osc$null_name THEN
      clp$include_file (clc$current_command_input, 'task', osc$null_name, status);
    ELSE
      NEXT task_statement_area: [[REP task_parameters^.statement_area_size OF cell]] IN parameters;
      IF task_statement_area = NIL THEN
        osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$task_taskend', status);
        pmp$abort (status);
      IFEND;

      IF task_parameters^.can_be_echoed THEN
        clp$find_connected_files (connected_files);
        IF connected_files^.echo_count > 0 THEN
          clp$echo_trace_information ('CLC$ECHO_TASK_BEGIN', ^task_name, NIL, NIL, ignore_status);
        IFEND;
      IFEND;

      osp$establish_block_exit_hndlr (^abort_handler);

      clp$push_input_internal_block (osc$null_name, task_parameters^.can_be_echoed, task_statement_area,
            block);

      clp$process_command_file (block, NIL, status);
      IF status.normal AND (NOT block^.being_exited) THEN
        clp$find_current_block (end_block);
        IF end_block <> block THEN
          osp$set_status_abnormal ('CL', cle$unbalanced_block_structure, block^.kind_end_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, end_block^.kind_end_name, status);
        IFEND;
      IFEND;

      clp$process_exit_condition (block, status);

      IF task_parameters^.can_be_echoed THEN
        clp$find_connected_files (connected_files);
        IF connected_files^.echo_count > 0 THEN
          clp$echo_trace_information ('CLC$ECHO_TASK_END', ^task_name, NIL, ^status, ignore_status);
        IFEND;
      IFEND;

      osp$disestablish_cond_handler;

      IF status.normal THEN
        clp$pop_input_stack (end_block, status);
      ELSE
        clp$pop_input_stack (end_block, ignore_status);
      IFEND;
    IFEND;

  PROCEND clp$task_taskend;
?? TITLE := 'clp$$task_name', EJECT ??

  PROCEDURE [XDCL] clp$$task_name
    (    function_name: clt$name;
         argument_list: string ( * );
     VAR value: clt$value;
     VAR status: ost$status);


    clp$scan_argument_list (function_name, argument_list, NIL, NIL, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    value.descriptor := clv$value_descriptors [clc$string_value];
    value.kind := clc$string_value;
    value.str.size := osc$max_name_size;
    WHILE (value.str.size > 0) AND (clv$task_name (value.str.size) = ' ') DO
      value.str.size := value.str.size - 1;
    WHILEND;
    value.str.value := clv$task_name;

  PROCEND clp$$task_name;
?? TITLE := 'clp$taskend_statement', EJECT ??

  PROCEDURE clp$taskend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      current_block: ^clt$block;


    status.normal := TRUE;
    clp$find_current_block (current_block);
    IF (current_block^.previous_block^.kind <> clc$task_block) OR
          (current_block^.previous_block^.task_kind <> clc$task_statement_task) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'TASKEND', status);
    ELSE
      clp$skip_block;
    IFEND;

  PROCEND clp$taskend_statement;
?? TITLE := 'clp$push_commands', EJECT ??

  PROCEDURE clp$push_commands
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      context: ^ost$ecp_exception_context;

    status.normal := TRUE;

    context := NIL;

    IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'PUSH_COMMANDS', status);
      RETURN; {----->
    IFEND;

    REPEAT
      clp$push_dynamic_command_list (status);
      IF osp$file_access_condition (status) THEN
        IF context = NIL THEN
          PUSH context;
          context^ := osv$initial_exception_context;
        IFEND;
        context^.condition_status := status;
        osp$enforce_exception_policies (context^);
        status := context^.condition_status;
      IFEND;
    UNTIL status.normal OR (NOT osp$file_access_condition (status)) OR (NOT context^.wait);
  PROCEND clp$push_commands;
?? TITLE := 'clp$push_statement', EJECT ??

  PROCEDURE clp$push_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      name: ost$name;


    status.normal := TRUE;

  /process_object_names/
    WHILE TRUE DO
      clp$evaluate_data_name_expr (work_area, parse, name, status);
      IF NOT status.normal THEN
        IF status.condition = cle$unspecified_value_for_req THEN
          osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'PUSH', status);
        IFEND;
        RETURN {----->
      IFEND;

      clp$push_environment (name, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_semicolon =
        EXIT /process_object_names/; {----->
      = clc$lex_comma =
        clp$scan_non_space_lexical_unit (parse);
      ELSE
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_condition (cle$unexpected_after_obj_name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        IFEND;
      CASEND;
    WHILEND /process_object_names/;

  PROCEND clp$push_statement;
?? TITLE := 'clp$pop_statement', EJECT ??

  PROCEDURE clp$pop_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      name: ost$name;


    status.normal := TRUE;

  /process_object_names/
    WHILE TRUE DO
      clp$evaluate_data_name_expr (work_area, parse, name, status);
      IF NOT status.normal THEN
        IF status.condition = cle$unspecified_value_for_req THEN
          osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'POP', status);
        IFEND;
        RETURN {----->
      IFEND;

      clp$pop_environment (name, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      IF parse.unit_is_space THEN
        clp$scan_non_space_lexical_unit (parse);
      IFEND;
      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_semicolon =
        EXIT /process_object_names/; {----->
      = clc$lex_comma =
        clp$scan_non_space_lexical_unit (parse);
      ELSE
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_condition (cle$unexpected_after_obj_name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        IFEND;
      CASEND;
    WHILEND /process_object_names/;

  PROCEND clp$pop_statement;
?? TITLE := 'clp$type_statement', EJECT ??

  PROCEDURE clp$type_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

{ TYPE
{   type = type
{ TYPEND

?? PUSH (LISTEXT := ON) ??

    VAR
      type_specification: [STATIC, READ, cls$declaration_section] record
        header: clt$type_specification_header,
      recend := [[1, 0, clc$type_specification_type]];

?? POP ??

    VAR
      echoing_completed: boolean,
      get_command_line: clt$internal_input_procedure,
      ignore_new_prompt_string: string (ifc$max_prompt_string_size),
      input_block: ^clt$block,
      logging_completed: boolean,
      original_prompt_string: string (ifc$max_prompt_string_size),
      start_index: clt$string_index,
      type_name: clt$type_name,
      type_specification_value: clt$data_value;

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


      log_and_or_echo;

      clp$change_prompt_string (original_prompt_string, ignore_new_prompt_string);

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

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


      log_and_or_echo;

      clp$get_command_line (parse, end_of_input, status);
      IF (NOT status.normal) OR end_of_input THEN
        RETURN; {----->
      IFEND;

      start_index := 1;
      logging_completed := FALSE;
      echoing_completed := FALSE;

    PROCEND get_and_log_echo_command_line;
?? TITLE := 'get_next_line', EJECT ??

    PROCEDURE [INLINE] get_next_line;

      VAR
        end_of_input: boolean;


      REPEAT
        get_command_line^ (parse, end_of_input, status);
        IF NOT status.normal THEN
          EXIT clp$type_statement; {----->
        ELSEIF end_of_input THEN
          osp$set_status_abnormal ('CL', cle$eoi_in_declaration, 'type', status);
          EXIT clp$type_statement; {----->
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
      UNTIL parse.unit.kind <> clc$lex_end_of_line;

    PROCEND get_next_line;
?? TITLE := 'log_and_or_echo', EJECT ??

    PROCEDURE log_and_or_echo;

      VAR
        ignore_status: ost$status;


      IF parse.unit_index <= start_index THEN
        RETURN; {----->
      IFEND;

      IF info.logging_required AND (NOT logging_completed) THEN
        clp$log_command_line (parse.text^ (start_index, parse.unit_index - start_index), ignore_status);
        logging_completed := TRUE;
      IFEND;

      IF info.echoing_required AND (NOT echoing_completed) THEN
        clp$echo_command (info.interpreter_mode, parse.text^ (start_index, parse.unit_index - start_index),
              ignore_status);
        echoing_completed := TRUE;
      IFEND;

    PROCEND log_and_or_echo;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    logging_completed := TRUE;
    echoing_completed := TRUE;
    IF info.logging_required OR info.echoing_required THEN
      get_command_line := ^get_and_log_echo_command_line;
    ELSE
      get_command_line := ^clp$get_command_line;
    IFEND;

    clp$find_input_block (FALSE, input_block);
    IF (input_block^.input.kind = clc$file_input) AND input_block^.input.interactive_device THEN
      clp$change_prompt_string ('type', original_prompt_string);
      osp$establish_block_exit_hndlr (^abort_handler);
    IFEND;

    start_index := input_block^.line_parse.unit_index;
    parse.index_limit := input_block^.line_parse.index_limit;

    CASE parse.unit.kind OF
    = clc$lex_end_of_line =
      get_next_line;
    = clc$lex_semicolon =
      clp$scan_non_space_lexical_unit (parse);
      IF parse.unit.kind = clc$lex_end_of_line THEN
        get_next_line;
      ELSE
        logging_completed := FALSE;
        echoing_completed := FALSE;
      IFEND;
    ELSE
      ;
    CASEND;

    type_specification_value.kind := clc$type_specification;

  /type_typend/
    WHILE TRUE DO
      CASE parse.unit.kind OF
      = clc$lex_name =
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), type_name);
        IF type_name = 'TYPEND' THEN
          clp$scan_non_space_lexical_unit (parse);
          IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
            osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'TYPEND', status);
          IFEND;
          EXIT /type_typend/; {----->
        IFEND;
      = clc$lex_long_name =
        IF info.interpreter_mode = clc$interpret_mode THEN
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT /type_typend/; {----->
        IFEND;
      ELSE
        IF info.interpreter_mode = clc$interpret_mode THEN
          osp$set_status_condition (cle$expecting_type_name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT /type_typend/; {----->
        IFEND;
      CASEND;

      IF info.interpreter_mode = clc$interpret_mode THEN
        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        IFEND;
        IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_colon, clc$lex_equal]) THEN
          osp$set_status_condition (cle$expecting_after_type_name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT /type_typend/; {----->
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        IFEND;

        clp$internal_gen_type_spec (type_name, FALSE, get_command_line, NIL, work_area, parse,
              type_specification_value.type_specification_value, status);
        IF NOT status.normal THEN
          EXIT /type_typend/; {----->
        IFEND;

        IF info.interpreter_mode = clc$interpret_mode THEN
          clp$create_var_from_type_spec (type_name, clc$environment_scope, clc$read_only,
                clc$immediate_evaluation, #SEQ (type_specification), ^type_specification_value, FALSE,
                work_area, status);
          IF NOT status.normal THEN
            EXIT /type_typend/; {----->
          IFEND;
        IFEND;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

      ELSE { info.interprteter = clc$skip_mode }
        clp$scan_unnested_cmnd_lex_unit (parse);
      IFEND;

      CASE parse.unit.kind OF
      = clc$lex_semicolon =
        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        ELSE
          logging_completed := FALSE;
          echoing_completed := FALSE;
        IFEND;
      = clc$lex_end_of_line =
        get_next_line;
      ELSE
        osp$set_status_condition (cle$expecting_after_type_def, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT /type_typend/; {----->
      CASEND;
    WHILEND /type_typend/;

    IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
      clp$scan_unnested_cmnd_lex_unit (parse);
    IFEND;

    log_and_or_echo;

    IF parse.unit.kind <> clc$lex_end_of_line THEN
      clp$scan_any_lexical_unit (parse);
    IFEND;

    IF (input_block^.input.kind = clc$file_input) AND input_block^.input.interactive_device THEN
      clp$change_prompt_string (original_prompt_string, ignore_new_prompt_string);
      osp$disestablish_cond_handler;
    IFEND;

    clp$set_input_line_parse (parse);

  PROCEND clp$type_statement;
?? TITLE := 'clp$typend_statement', EJECT ??

  PROCEDURE clp$typend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);


    osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'TYPEND', status);

  PROCEND clp$typend_statement;
?? TITLE := 'clp$var_statement', EJECT ??

  PROCEDURE clp$var_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);

    VAR
      access_mode: clt$data_access_mode,
      echoing_completed: boolean,
      end_of_line_found: boolean,
      evaluation_method: clt$expression_eval_method,
      get_command_line: clt$internal_input_procedure,
      ignore_new_prompt_string: string (ifc$max_prompt_string_size),
      initial_value: ^clt$data_value,
      input_block: ^clt$block,
      logging_completed: boolean,
      original_prompt_string: string (ifc$max_prompt_string_size),
      scope: clt$variable_declaration_scope,
      start_index: clt$string_index,
      type_specification: ^clt$type_specification,
      variable_name: clt$variable_name;

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


      log_and_or_echo;

      clp$change_prompt_string (original_prompt_string, ignore_new_prompt_string);

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

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


      log_and_or_echo;

      clp$get_command_line (parse, end_of_input, status);
      IF (NOT status.normal) OR end_of_input THEN
        RETURN; {----->
      IFEND;

      start_index := 1;
      logging_completed := FALSE;
      echoing_completed := FALSE;

    PROCEND get_and_log_echo_command_line;
?? TITLE := 'get_next_line', EJECT ??

    PROCEDURE [INLINE] get_next_line;

      VAR
        end_of_input: boolean;


      REPEAT
        get_command_line^ (parse, end_of_input, status);
        IF NOT status.normal THEN
          EXIT clp$var_statement; {----->
        ELSEIF end_of_input THEN
          osp$set_status_abnormal ('CL', cle$eoi_in_declaration, 'var', status);
          EXIT clp$var_statement; {----->
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
      UNTIL parse.unit.kind <> clc$lex_end_of_line;

    PROCEND get_next_line;
?? TITLE := 'log_and_or_echo', EJECT ??

    PROCEDURE log_and_or_echo;

      VAR
        ignore_status: ost$status;


      IF parse.unit_index <= start_index THEN
        RETURN; {----->
      IFEND;

      IF info.logging_required AND (NOT logging_completed) THEN
        clp$log_command_line (parse.text^ (start_index, parse.unit_index - start_index), ignore_status);
        logging_completed := TRUE;
      IFEND;

      IF info.echoing_required AND (NOT echoing_completed) THEN
        clp$echo_command (info.interpreter_mode, parse.text^ (start_index, parse.unit_index - start_index),
              ignore_status);
        echoing_completed := TRUE;
      IFEND;

    PROCEND log_and_or_echo;
?? TITLE := 'process_initial_value', EJECT ??

    PROCEDURE process_initial_value;

      VAR
        access_variable_requests: clt$access_variable_requests,
        expression_parse: clt$parse_state,
        ignore_result_type_description: ^clt$type_description,
        initial_name: clt$variable_name,
        initial_name_found: boolean,
        initial_name_parse: clt$parse_state,
        initial_name_text: ^clt$string_value,
        initial_value_text: ^clt$expression_text,
        lexical_units: ^clt$lexical_units,
        type_description: clt$type_description;


      initial_name := '';
      expression_parse := parse;

      IF parse.unit.kind = clc$lex_name THEN
        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_comma THEN
          #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.previous_non_space_unit_index,
                parse.previous_non_space_unit.size), initial_name);
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;
          expression_parse := parse;
        ELSE
          parse := expression_parse;
        IFEND;
      IFEND;

      clp$scan_unnested_cmnd_lex_unit (parse);

      IF info.interpreter_mode <> clc$interpret_mode THEN
        RETURN; {----->
      IFEND;

      expression_parse.index_limit := parse.unit_index;

      initial_value_text := ^expression_parse.text^ (expression_parse.unit_index,
            expression_parse.index_limit - expression_parse.unit_index);

      IF initial_name <> '' THEN
        PUSH initial_name_text: [0];
        clp$identify_lexical_units (initial_name_text, work_area, lexical_units, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        clp$initialize_parse_state (initial_name_text, lexical_units, initial_name_parse);
        clp$scan_non_space_lexical_unit (initial_name_parse);
        access_variable_requests := $clt$access_variable_requests [];
        clp$evaluate_name (initial_name, access_variable_requests, initial_name_parse, work_area,
              initial_value, initial_name_found, status);
        IF NOT status.normal THEN
          RETURN; {----->
        IFEND;
        IF initial_name_found AND (initial_value <> NIL) THEN
          IF initial_value^.kind <> clc$string THEN
            osp$set_status_abnormal ('CL', cle$initial_name_not_string, initial_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, variable_name, status);
            RETURN; {----->
          IFEND;
          initial_value_text := initial_value^.string_value;
          initial_value := NIL;
          IF evaluation_method = clc$immediate_evaluation THEN
            clp$identify_lexical_units (initial_value_text, work_area, lexical_units, status);
            IF NOT status.normal THEN
              RETURN; {----->
            IFEND;
            clp$initialize_parse_state (initial_value_text, lexical_units, expression_parse);
            clp$scan_non_space_lexical_unit (expression_parse);
          IFEND;
        IFEND;
      IFEND;

      IF evaluation_method = clc$deferred_evaluation THEN
        clp$make_deferred_value (initial_value_text^, type_specification, work_area, initial_value);
        IF initial_value = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
        IFEND;
        RETURN; {----->
      IFEND;

      clp$convert_type_spec_to_desc (type_specification, work_area, type_description, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      clp$internal_evaluate_expr (expression_parse, ^type_description, work_area,
            ignore_result_type_description, initial_value, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;

      IF expression_parse.unit_index < expression_parse.index_limit THEN
        osp$set_status_condition (cle$expecting_end_of_expression, status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, expression_parse, status);
        RETURN; {----->
      IFEND;

      IF initial_value^.kind = clc$unspecified THEN
        initial_value := NIL;
      IFEND;

    PROCEND process_initial_value;
?? TITLE := 'process_variable_attributes', EJECT ??

    PROCEDURE process_variable_attributes;

      VAR
        scope_given: boolean;

?? NEWTITLE := 'process_variable_attribute', EJECT ??

      PROCEDURE [INLINE] process_variable_attribute;

        VAR
          name: ost$name;


        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), name);

        IF name = 'DEFER' THEN
          IF evaluation_method <> clc$deferred_evaluation THEN
            evaluation_method := clc$deferred_evaluation;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'ENVIRONMENT' THEN
          IF NOT scope_given THEN
            scope := clc$environment_scope;
            scope_given := TRUE;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'JOB' THEN
          IF NOT scope_given THEN
            scope := clc$job_scope;
            scope_given := TRUE;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'LOCAL' THEN
          IF NOT scope_given THEN
            scope := clc$local_scope;
            scope_given := TRUE;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'PUSH' THEN
          IF NOT scope_given THEN
            scope := clc$push_scope;
            scope_given := TRUE;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'READ' THEN
          IF access_mode <> clc$read_only THEN
            access_mode := clc$read_only;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'TASK' THEN
          IF NOT scope_given THEN
            scope := clc$task_scope;
            scope_given := TRUE;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'UTILITY' THEN
          IF NOT scope_given THEN
            scope := clc$utility_scope;
            scope_given := TRUE;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'XDCL' THEN
          IF NOT scope_given THEN
            scope := clc$xdcl_scope;
            scope_given := TRUE;
            RETURN; {----->
          IFEND;

        ELSEIF name = 'XREF' THEN
          IF NOT scope_given THEN
            scope := clc$xref_scope;
            scope_given := TRUE;
            RETURN; {----->
          IFEND;

        ELSE
          osp$set_status_abnormal ('CL', cle$not_a_variable_attribute, name, status);
          EXIT process_variable_attributes; {----->
        IFEND;

        osp$set_status_abnormal ('CL', cle$duplicate_variable_attr, name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, variable_name, status);
        EXIT process_variable_attributes; {----->

      PROCEND process_variable_attribute;
?? OLDTITLE, EJECT ??

      scope_given := FALSE;

      clp$scan_non_space_lexical_unit (parse);

      WHILE TRUE DO
        CASE parse.unit.kind OF

        = clc$lex_right_parenthesis =
          IF parse.previous_non_space_unit.kind <> clc$lex_name THEN
            osp$set_status_abnormal ('CL', cle$expecting_variable_attr, variable_name, status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            RETURN; {----->
          IFEND;
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;
          RETURN; {----->

        = clc$lex_name =
          process_variable_attribute;
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_comma THEN
            clp$scan_non_space_lexical_unit (parse);
          IFEND;

        = clc$lex_long_name =
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          RETURN; {----->

        ELSE
          osp$set_status_abnormal ('CL', cle$expecting_variable_attr, variable_name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN; {----->

        CASEND;
      WHILEND;

    PROCEND process_variable_attributes;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    logging_completed := TRUE;
    echoing_completed := TRUE;
    IF info.logging_required OR info.echoing_required THEN
      get_command_line := ^get_and_log_echo_command_line;
    ELSE
      get_command_line := ^clp$get_command_line;
    IFEND;

    clp$find_input_block (FALSE, input_block);
    IF (input_block^.input.kind = clc$file_input) AND input_block^.input.interactive_device THEN
      clp$change_prompt_string ('var', original_prompt_string);
      osp$establish_block_exit_hndlr (^abort_handler);
    IFEND;

    start_index := input_block^.line_parse.unit_index;
    parse.index_limit := input_block^.line_parse.index_limit;

    CASE parse.unit.kind OF
    = clc$lex_end_of_line =
      get_next_line;
    = clc$lex_semicolon =
      clp$scan_non_space_lexical_unit (parse);
      IF parse.unit.kind = clc$lex_end_of_line THEN
        get_next_line;
      ELSE
        logging_completed := FALSE;
        echoing_completed := FALSE;
      IFEND;
    ELSE
      ;
    CASEND;

  /var_varend/
    WHILE TRUE DO
      CASE parse.unit.kind OF
      = clc$lex_name =
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), variable_name);
        IF variable_name = 'VAREND' THEN
          clp$scan_non_space_lexical_unit (parse);
          IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
            osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'VAREND', status);
          IFEND;
          EXIT /var_varend/; {----->
        IFEND;
      = clc$lex_long_name =
        IF info.interpreter_mode = clc$interpret_mode THEN
          osp$set_status_abnormal ('CL', cle$name_too_long, parse.text^ (parse.unit_index, parse.unit.size),
                status);
          EXIT /var_varend/; {----->
        IFEND;
      ELSE
        IF info.interpreter_mode = clc$interpret_mode THEN
          osp$set_status_condition (cle$expecting_variable_name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT /var_varend/; {----->
        IFEND;
      CASEND;

      IF info.interpreter_mode = clc$interpret_mode THEN
        clp$evaluate_data_name_expr (work_area, parse, variable_name, status);
        IF NOT status.normal THEN
          IF status.condition = cle$unspecified_value_for_req THEN
            osp$set_status_abnormal ('CL', cle$unspecified_value_for_state, 'VAR', status);
          IFEND;
          EXIT /var_varend/; {----->
        IFEND;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        IFEND;
        IF parse.unit.kind <> clc$lex_colon THEN
          osp$set_status_condition (cle$expecting_after_var_name, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT /var_varend/; {----->
        IFEND;
        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        IFEND;

        access_mode := clc$read_write;
        evaluation_method := clc$immediate_evaluation;
        scope := clc$local_scope;
        IF parse.unit.kind = clc$lex_left_parenthesis THEN
          process_variable_attributes;
          IF NOT status.normal THEN
            EXIT /var_varend/; {----->
          IFEND;
        IFEND;

        clp$internal_gen_type_spec (osc$null_name, FALSE, get_command_line, NIL, work_area, parse,
              type_specification, status);
        IF NOT status.normal THEN
          EXIT /var_varend/; {----->
        IFEND;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;
        end_of_line_found := parse.unit.kind = clc$lex_end_of_line;
        IF end_of_line_found THEN
          get_next_line;
        IFEND;
        initial_value := NIL;
        IF parse.unit.kind = clc$lex_equal THEN
          clp$scan_non_space_lexical_unit (parse);
          IF parse.unit.kind = clc$lex_end_of_line THEN
            get_next_line;
          IFEND;
          process_initial_value;
          IF NOT status.normal THEN
            EXIT /var_varend/; {----->
          ELSEIF (scope = clc$xref_scope) AND (initial_value <> NIL) THEN
            osp$set_status_abnormal ('CL', cle$xref_var_cannot_have_value, variable_name, status);
            EXIT /var_varend/; {----->
          IFEND;
        IFEND;

        IF info.interpreter_mode = clc$interpret_mode THEN
          clp$create_var_from_type_spec (variable_name, scope, access_mode, evaluation_method,
                type_specification, initial_value, FALSE, work_area, status);
          IF NOT status.normal THEN
            EXIT /var_varend/; {----->
          IFEND;
        IFEND;

        IF parse.unit_is_space THEN
          clp$scan_non_space_lexical_unit (parse);
        IFEND;

      ELSE { info.interpreter_mode = clc$skip_mode }
        clp$scan_unnested_cmnd_lex_unit (parse);
      IFEND;

      CASE parse.unit.kind OF
      = clc$lex_semicolon =
        clp$scan_non_space_lexical_unit (parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          get_next_line;
        ELSE
          logging_completed := FALSE;
          echoing_completed := FALSE;
        IFEND;
      = clc$lex_end_of_line =
        get_next_line;
      ELSE
        IF NOT end_of_line_found THEN
          osp$set_status_condition (cle$expecting_after_var_def, status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          EXIT /var_varend/; {----->
        IFEND;
      CASEND;
    WHILEND /var_varend/;

    IF NOT (parse.unit.kind IN $clt$lexical_unit_kinds [clc$lex_end_of_line, clc$lex_semicolon]) THEN
      clp$scan_unnested_cmnd_lex_unit (parse);
    IFEND;

    log_and_or_echo;

    IF parse.unit.kind <> clc$lex_end_of_line THEN
      clp$scan_any_lexical_unit (parse);
    IFEND;

    IF (input_block^.input.kind = clc$file_input) AND input_block^.input.interactive_device THEN
      clp$change_prompt_string (original_prompt_string, ignore_new_prompt_string);
      osp$disestablish_cond_handler;
    IFEND;

    clp$set_input_line_parse (parse);

  PROCEND clp$var_statement;
?? TITLE := 'clp$varend_statement', EJECT ??

  PROCEDURE clp$varend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);


    osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'VAREND', status);

  PROCEND clp$varend_statement;
?? TITLE := 'clp$lock_statement', EJECT ??

  PROCEDURE clp$lock_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);


    osp$set_status_abnormal ('CL', cle$not_yet_implemented, 'LOCK statement', status);

  PROCEND clp$lock_statement;
?? TITLE := 'clp$unlock_statement', EJECT ??

  PROCEDURE clp$unlock_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);


    osp$set_status_abnormal ('CL', cle$not_yet_implemented, 'UNLOCK statement', status);

  PROCEND clp$unlock_statement;
?? TITLE := 'clp$pipe_statement', EJECT ??

  PROCEDURE clp$pipe_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);


    osp$set_status_abnormal ('CL', cle$not_yet_implemented, 'PIPE statement', status);

  PROCEND clp$pipe_statement;
?? TITLE := 'clp$pipend_statement', EJECT ??

  PROCEDURE clp$pipend_statement
    (    info: clt$control_statement_info;
     VAR parse {input, output} : clt$parse_state;
     VAR work_area {input, output} : ^clt$work_area;
     VAR cause_condition {input, output} : clt$when_condition;
     VAR status: ost$status);


    osp$set_status_abnormal ('CL', cle$not_yet_implemented, 'PIPEND statement', status);

  PROCEND clp$pipend_statement;

MODEND clm$control_statements;
