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

{
{ 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 amt$file_byte_address
*copyc clc$standard_file_names
*copyc clt$parameter_list
*copyc cle$ecc_command_processing
*copyc cle$ecc_control_statement
*copyc cle$ecc_expression
*copyc cle$ecc_expression_result
*copyc cle$ecc_miscellaneous
*copyc clt$command_processor
*copyc clt$f_control_statement
*copyc clt$f_control_statement_desc
*copyc clt$interpreter_modes
*copyc clt$lexical_unit_kinds
*copyc clt$name
*copyc clt$when_conditions
*copyc osd$virtual_address
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*copyc clp$add_format_token
*copyc clp$append_status_parse_state
*copyc clp$f_expression_scanner
*copyc clp$f_find_current_block
*copyc clp$f_find_cycle_block
*copyc clp$f_note_unended_block
*copyc clp$f_pop_block_stack
*copyc clp$f_process_collect_text
*copyc clp$f_process_proc_header
*copyc clp$f_process_task_or_job
*copyc clp$f_process_var_or_type
*copyc clp$f_push_block_stack
*copyc clp$f_scan_parameter_list
*copyc clp$f_scan_token
*copyc clp$f_set_command_header_type
*copyc clp$f_set_substitution_mark
*copyc clp$initialize_parse_state
*copyc clp$search_format_utilities
*copyc clp$set_format_type
*copyc clp$trimmed_string_size
*copyc clv$formatting_in_effect
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper

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

  CONST
    number_of_control_names = 63,
    min_control_name_size = 2 {IF} ,
    max_control_name_size = 31 {CREATE_PARAMETER_PROMPT_MESSAGE} ;

  VAR
    save_format_flag: boolean;

  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$f_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, FALSE, ^clp$case_statement]],
          {} ['CASEND                         ', [TRUE, clc$control_statement, FALSE, ^clp$casend_statement]],
          {} ['CAUSE                          ', [FALSE, clc$control_statement, FALSE, ^clp$cause_statement]],
          {} ['COLLECT_TEXT                   ', [TRUE, clc$control_command, ^clp$collect_text_command]],
          {} ['COLT                           ', [TRUE, clc$control_command, ^clp$collect_text_command]],
          {} ['CONTINUE                       ', [FALSE, clc$control_statement, FALSE,
          ^clp$continue_statement]],
          {} ['CREATE_BRIEF_HELP_MESSAGE      ', [TRUE, clc$control_command, ^clp$crebhm]],
          {} ['CREATE_FULL_HELP_MESSAGE       ', [TRUE, clc$control_command, ^clp$crefhm]],
          {} ['CREATE_PARAMETER_ASSIST_MESSAGE', [TRUE, clc$control_command, ^clp$crepam]],
          {} ['CREATE_PARAMETER_HELP_MESSAGE  ', [TRUE, clc$control_command, ^clp$crephm]],
          {} ['CREATE_PARAMETER_PROMPT_MESSAGE', [TRUE, clc$control_command, ^clp$creppm]],
          {} ['CREATE_STATUS_MESSAGE          ', [TRUE, clc$control_command, ^clp$cresm]],
          {} ['CREBHM                         ', [TRUE, clc$control_command, ^clp$crebhm]],
          {} ['CREFHM                         ', [TRUE, clc$control_command, ^clp$crefhm]],
          {} ['CREPAM                         ', [TRUE, clc$control_command, ^clp$crepam]],
          {} ['CREPHM                         ', [TRUE, clc$control_command, ^clp$crephm]],
          {} ['CREPPM                         ', [TRUE, clc$control_command, ^clp$creppm]],
          {} ['CRESM                          ', [TRUE, clc$control_command, ^clp$cresm]],
          {} ['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$procend_statement]],
          {} ['FUNCTION                       ', [TRUE, clc$control_statement, FALSE, ^clp$proc_statement]],
          {} ['IF                             ', [TRUE, clc$control_statement, FALSE, ^clp$if_statement]],
          {} ['IFEND                          ', [TRUE, clc$control_statement, FALSE, ^clp$ifend_statement]],
          {} ['JOB                            ', [TRUE, clc$control_command, ^clp$job_statement]],
          {} ['JOBEND                         ', [TRUE, clc$control_statement, FALSE, ^clp$jobend_statement]],
          {} ['LOGIN                          ', [FALSE, clc$control_command, ^clp$login_command]],
          {} ['LOGOUT                         ', [FALSE, clc$control_command, ^clp$logout_command]],
          {} ['LOOP                           ', [TRUE, clc$control_statement, TRUE, ^clp$loop_statement]],
          {} ['LOOPEND                        ', [TRUE, clc$control_statement, FALSE,
          ^clp$loopend_statement]],
          {} ['MANAGE_REMOTE_FILES            ', [TRUE, clc$control_command, ^clp$manrf_command]],
          {} ['MANRF                          ', [TRUE, clc$control_command, ^clp$manrf_command]],
          {} ['PDT                            ', [TRUE, clc$control_statement, FALSE, ^clp$proc_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$push_statement]],
          {} ['PROC                           ', [TRUE, clc$control_statement, FALSE, ^clp$proc_statement]],
          {} ['PROCEDURE                      ', [TRUE, clc$control_statement, FALSE, ^clp$proc_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_statement]],
          {} ['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]],
          {} ['UNTIL                          ', [TRUE, clc$control_statement, FALSE, ^clp$until_statement]],
          {} ['UTILITY                        ', [TRUE, clc$control_command, ^clp$utility_statement]],
          {} ['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]]];

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

  PROCEDURE [XDCL] clp$f_check_name_for_control
    (    name: clt$name;
     VAR control_statement_descriptor: ^clt$f_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;

    clp$search_format_utilities (name, control_statement_descriptor);

  PROCEND clp$f_check_name_for_control;
?? TITLE := 'clp$collect_text_command', EJECT ??

  PROCEDURE clp$collect_text_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_collect_text ('COLLECT_TEXT', status);
    IFEND;

  PROCEND clp$collect_text_command;
?? TITLE := 'clp$crebhm', EJECT ??

  PROCEDURE clp$crebhm
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_collect_text ('CREATE_BRIEF_HELP_MESSAGE', status);
    IFEND;

  PROCEND clp$crebhm;
?? TITLE := 'clp$crefhm', EJECT ??

  PROCEDURE clp$crefhm
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_collect_text ('CREATE_FULL_HELP_MESSAGE', status);
    IFEND;

  PROCEND clp$crefhm;
?? TITLE := 'clp$creppm', EJECT ??

  PROCEDURE clp$creppm
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_collect_text ('CREATE_PARAMETER_PROMPT_MESSAGE', status);
    IFEND;

  PROCEND clp$creppm;
?? TITLE := 'clp$crepam', EJECT ??

  PROCEDURE clp$crepam
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_collect_text ('CREATE_PARAMETER_ASSIST_MESSAGE', status);
    IFEND;

  PROCEND clp$crepam;
?? TITLE := 'clp$crephm', EJECT ??

  PROCEDURE clp$crephm
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_collect_text ('CREATE_PARAMETER_HELP_MESSAGE', status);
    IFEND;

  PROCEND clp$crephm;
?? TITLE := 'clp$cresm', EJECT ??

  PROCEDURE clp$cresm
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_collect_text ('CREATE_STATUS_MESSAGE', status);
    IFEND;

  PROCEND clp$cresm;
?? TITLE := 'clp$manrf_command', EJECT ??

  PROCEDURE clp$manrf_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_collect_text ('MANAGE_REMOTE_FILES', status);
    IFEND;

  PROCEND clp$manrf_command;
?? TITLE := 'clp$login_command', EJECT ??

  PROCEDURE clp$login_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      label: ost$name,
      log_block: ^clt$f_block;

    label := '';
    clp$f_set_command_header_type (clc$control_statement_begin);
    clp$f_push_block_stack (clc$formatter_log_block, label, log_block);
    clp$f_scan_parameter_list (parameter_list, status);

  PROCEND clp$login_command;
?? TITLE := 'clp$logout_command', EJECT ??

  PROCEDURE clp$logout_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      log_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('LOGOUT', clc$formatter_log_block, '', log_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      status.normal := TRUE;
      RETURN;
    IFEND;
    clp$f_pop_block_stack (log_block);
    clp$f_scan_parameter_list (parameter_list, status);

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

  PROCEDURE evaluate_boolean_expression
    (VAR parse {input, output} : clt$parse_state;
         optional_termination_name: string ( * <= osc$max_name_size);
     VAR result: boolean;
     VAR status: ost$status);

    VAR
      boolean_value_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
            [NIL, clc$boolean_value],
      space: [STATIC] string (1) := ' ',
      terminator_name: ost$name,
      value: clt$value;


    IF optional_termination_name <> '' THEN
      clp$f_expression_scanner (boolean_value_specifier, TRUE, parse, value, status);
    ELSE
      clp$f_expression_scanner (boolean_value_specifier, FALSE, parse, value, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    result := value.bool.value;

    IF parse.unit_is_space THEN
      clp$f_scan_token (clc$slu_non_space, parse);
    IFEND;

    CASE parse.unit.kind OF
    = clc$lex_end_of_line =
      IF optional_termination_name <> '' THEN
        clp$add_format_token (^space, clc$lex_space, clc$unassigned);
        clp$add_format_token (^optional_termination_name, clc$lex_name, clc$reserved_name);
      IFEND;
      RETURN;
    = 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_abnormal ('CL', cle$unexpected_after_bool_expr, '', status);
      RETURN;
    CASEND;

    IF (NOT parse.previous_unit_is_space) OR (optional_termination_name = '') THEN
      osp$set_status_abnormal ('CL', cle$unexpected_after_bool_expr, '', status);
      RETURN;
    IFEND;

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

    IF optional_termination_name <> terminator_name THEN
      osp$set_status_abnormal ('CL', cle$unexpected_after_bool_expr, terminator_name, status);
      RETURN;
    IFEND;

    clp$set_format_type (clc$reserved_name);

    clp$f_scan_token (clc$slu_non_space, parse);

    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_after_then_or_do, optional_termination_name, status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN;
    IFEND;

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

  PROCEDURE evaluate_any_expression
    (VAR parse {input, output} : clt$parse_state;
         optional_termination_name: string ( * <= osc$max_name_size);
     VAR status: ost$status);

    VAR
      any_value_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
            [NIL, clc$any_value],
      space: [STATIC] string (1) := ' ',
      terminator_name: ost$name,
      value: clt$value;


    IF optional_termination_name <> '' THEN
      clp$f_expression_scanner (any_value_specifier, TRUE, parse, value, status);
    ELSE
      clp$f_expression_scanner (any_value_specifier, FALSE, parse, value, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parse.unit_is_space THEN
      clp$f_scan_token (clc$slu_non_space, parse);
    IFEND;

    CASE parse.unit.kind OF
    = clc$lex_end_of_line =
      IF optional_termination_name <> '' THEN
        clp$add_format_token (^space, clc$lex_space, clc$unassigned);
        clp$add_format_token (^optional_termination_name, clc$lex_name, clc$reserved_name);
      IFEND;
      RETURN;
    = 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_abnormal ('CL', cle$unexpected_after_bool_expr, '', status);
      RETURN;
    CASEND;

    IF (NOT parse.previous_unit_is_space) OR (optional_termination_name = '') THEN
      osp$set_status_abnormal ('CL', cle$unexpected_after_bool_expr, '', status);
      RETURN;
    IFEND;

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

    IF optional_termination_name <> terminator_name THEN
      osp$set_status_abnormal ('CL', cle$unexpected_after_bool_expr, terminator_name, status);
      RETURN;
    IFEND;

    clp$set_format_type (clc$reserved_name);

    clp$f_scan_token (clc$slu_non_space, parse);

    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_after_then_or_do, optional_termination_name, status);
      clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
      RETURN;
    IFEND;

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

  PROCEDURE check_statement_terminator
    (    statement_name: string ( * );
         block_kind: clt$block_kind;
         parameters: string ( * );
     VAR statement_block: ^clt$f_block;
     VAR status: ost$status);

    VAR
      block_count: integer,
      block_exists: boolean,
      space: [STATIC] string (1) := ' ',
      temp_block: ^clt$f_block,
      terminator_name: ost$name,
      parse: clt$parse_state;

    status.normal := TRUE;
    clp$f_find_current_block (statement_block);
    temp_block := statement_block;
    block_exists := FALSE;
    block_count := 0;

  /find_block/
    WHILE temp_block <> NIL DO
      IF temp_block^.kind = block_kind THEN
        block_exists := TRUE;
        EXIT /find_block/;
      IFEND;
      block_count := block_count + 1;
      temp_block := temp_block^.previous_block;
    WHILEND /find_block/;

    IF block_exists THEN
      IF block_count > 0 THEN
        clp$f_note_unended_block (block_count, statement_block, status);
      IFEND; {block_count > 0
    ELSE {block doesnt exist
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, statement_name, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), terminator_name);
        IF terminator_name <> statement_block^.label THEN
          osp$set_status_abnormal ('CL', cle$wrong_statement_label, statement_name, status);
        ELSE
          clp$f_scan_token (clc$slu_non_space, parse);
          IF parse.unit.kind <> clc$lex_end_of_line THEN
            osp$set_status_abnormal ('CL', 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);
          IFEND;
        IFEND;
      ELSE
        osp$set_status_abnormal ('CL', 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);
      IFEND;
    ELSEIF status.normal AND (statement_block^.label <> osc$null_name) THEN
      clp$add_format_token (^space, clc$lex_space, clc$unassigned);
      clp$add_format_token (^statement_block^.label (1, clp$trimmed_string_size (statement_block^.label)),
            clc$lex_name, clc$unassigned);
    IFEND;

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

  PROCEDURE process_when_clause
    (    statement_name: string ( * <= osc$max_name_size);
     VAR parse {input, output} : clt$parse_state;
     VAR when_condition: boolean;
     VAR status: ost$status);


    status.normal := TRUE;
    clp$set_format_type (clc$reserved_name);
    clp$f_scan_token (clc$slu_any, parse);
    IF NOT parse.previous_unit_is_space THEN
      osp$set_status_abnormal ('CL', 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);
    IFEND;

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

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

  PROCEDURE process_exit_and_cycle_label
    (    statement_name: string ( * <= osc$max_name_size);
         parameters: ^string ( * );
     VAR parse: clt$parse_state;
     VAR target_label: ost$name;
     VAR following_clause_name: ost$name;
     VAR status: ost$status);


    VAR

      block_label_matched: boolean,
      temp_block: ^clt$f_block;

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

    clp$initialize_parse_state (parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);

    CASE parse.unit.kind OF
    = clc$lex_end_of_line =
      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_abnormal ('CL', cle$expecting_label_when_with, '', status);
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_label_or_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 ((following_clause_name = 'WITH') AND (statement_name = 'EXIT'))
          THEN
      RETURN;
    IFEND;

    target_label := following_clause_name;

    IF (target_label <> ' ') AND (target_label(1,parse.unit.size) <> 'PROCEDURE')
          AND (target_label(1,parse.unit.size) <> 'PROC') AND (target_label(1,parse.unit.size) <> 'UTILITY')
          AND (target_label(1,parse.unit.size) <> 'FUNCTION') THEN
      clp$f_find_current_block(temp_block);
      /find_block/
        WHILE temp_block <> NIL DO
          IF (temp_block^.label = target_label) THEN
            block_label_matched := TRUE;
            EXIT /find_block/;
          IFEND;
          temp_block := temp_block^.previous_block;
        WHILEND /find_block/;
      IF (NOT block_label_matched) then
        osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt,target_label, status);
        RETURN;
      IFEND;
    IFEND;

    clp$f_scan_token (clc$slu_non_space, parse);

    CASE parse.unit.kind OF
    = clc$lex_end_of_line =
      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_abnormal ('CL', cle$expecting_with_or_when, '', status);
      ELSE
        osp$set_status_abnormal ('CL', 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 ((following_clause_name = 'WITH') AND (statement_name = 'EXIT'))
          THEN
      RETURN;
    IFEND;

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

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

  PROCEDURE clp$case_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      case_block: ^clt$f_block,
      internal_input_block: ^clt$f_block,
      parse: clt$parse_state;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    evaluate_any_expression (parse, 'OF', status);

    clp$f_push_block_stack (clc$case_block, label, case_block);

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

  PROCEDURE clp$casend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      case_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('CASEND', clc$case_block, parameters, case_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (case_block);

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

  PROCEDURE clp$cycle_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      clause_name: ost$name,
      for_variable: clt$variable_reference,
      for_value: array [1 .. 1] of clt$integer,
      current_block: ^clt$f_block,
      parse: clt$parse_state,
      target_block: ^clt$f_block,
      target_label: ost$name,
      cycle_condition: boolean;

    status.normal := TRUE;
    process_exit_and_cycle_label ('CYCLE', ^parameters, parse, target_label, clause_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$f_find_cycle_block (target_label, current_block, target_block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$f_set_command_header_type (clc$control_statement_no_switch);

    IF clause_name = 'WHEN' THEN
      process_when_clause ('CYCLE', parse, cycle_condition, status);
      IF NOT status.normal THEN
        RETURN;
      ELSEIF parse.unit.kind <> clc$lex_end_of_line THEN
        osp$set_status_abnormal ('CL', cle$unexpected_after_bool_expr, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN;
      ELSEIF NOT cycle_condition THEN
        RETURN;
      IFEND;
    IFEND;

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

  PROCEDURE clp$exit_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      initial_clause_name: ost$name,
      target_label: ost$name,
      exit_condition: boolean;

    status.normal := TRUE;
    process_exit_and_cycle_label ('EXIT', ^parameters, parse, target_label, initial_clause_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    exit_statement (target_label, initial_clause_name, parse, status);

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

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


?? NEWTITLE := 'process_with_clause', EJECT ??

    PROCEDURE process_with_clause
      (VAR status: ost$status);

      VAR
        status_value_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
              [NIL, clc$status_value],
        value: clt$value;

      clp$f_scan_token (clc$slu_non_space, parse);
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_abnormal ('CL', cle$unexpected_after_with, '', status);
        RETURN;
      IFEND;

      clp$f_expression_scanner (status_value_specifier, FALSE, parse, value, status);
      IF NOT status.normal THEN
        IF (clc$min_ecc_expression_result <= status.condition) AND
              (status.condition <= clc$max_ecc_expression_result) THEN
          osp$append_status_parameter (osc$status_parameter_delimiter,
                ' for WITH value of EXIT PROC statement', status);
        IFEND;
        RETURN;
      IFEND;

      CASE parse.unit.kind OF
      = clc$lex_end_of_line =
        RETURN;
      = clc$lex_name =
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_with_value, '', 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_abnormal ('CL', cle$unexpected_after_with_value, parse.text^ (parse.unit_index,
              parse.unit.size), status);
        RETURN;
      CASEND;

    PROCEND process_with_clause;
?? OLDTITLE, EJECT ??

    VAR
      clause_name: ost$name,
      error_condition: ost$status_condition_code,
      exit_condition: boolean,
      target_block: ^clt$f_block,
      terminating_utility: boolean,
      unexpected_condition: ost$status_condition_code,
      when_clause_specified: boolean,
      with_clause_allowed: boolean,
      with_clause_specified: boolean;

    IF (target_label = '') OR (target_label = 'UTILITY') OR (target_label = 'PROCEDURE') OR (target_label =
          'PROC') OR (target_label = 'FUNCTION') OR (target_label = 'FUNC') OR (target_label = 'CHECK') THEN
      clp$set_format_type (clc$reserved_name);
    IFEND;

    clause_name := initial_clause_name;
    when_clause_specified := FALSE;
    with_clause_specified := FALSE;

    clp$f_set_command_header_type (clc$control_statement_no_switch);

  /process_exit_parameters/
    WHILE parse.unit.kind <> clc$lex_end_of_line DO

      IF clause_name = 'WITH' THEN
        clp$set_format_type (clc$reserved_name);
        IF with_clause_specified THEN
          osp$set_status_abnormal ('CL', cle$duplicate_with_clause, '', status);
          RETURN;
        IFEND;

        with_clause_specified := TRUE;
        process_with_clause (status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

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

      ELSEIF clause_name = 'WHEN' THEN
        clp$set_format_type (clc$reserved_name);
        IF when_clause_specified THEN
          osp$set_status_abnormal ('CL', cle$duplicate_when_clause, '', status);
          RETURN;
        IFEND;
        when_clause_specified := TRUE;
        process_when_clause ('EXIT', parse, exit_condition, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        unexpected_condition := cle$unexpected_after_when_value;
        error_condition := 0;

      ELSEIF 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;

      IF error_condition <> 0 THEN
        osp$set_status_abnormal ('CL', error_condition, '', status);
        RETURN;
      IFEND;

      IF parse.unit.kind = clc$lex_name THEN
        #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), clause_name);
      IFEND;

    WHILEND /process_exit_parameters/;

    IF NOT exit_condition THEN
      RETURN;
    IFEND;

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

  PROCEDURE clp$exit_proc_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      status_value_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
            [NIL, clc$status_value],
      clause_name: ost$name,
      parse: clt$parse_state,
      token_status: ost$status,
      expecting_when: ost$status_condition,
      value: clt$value,
      initial_clause_name: ost$name,
      target_label: ost$name,
      proc_status: ost$status,
      exit_proc_condition: boolean;

    status.normal := TRUE;
    proc_status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);

    CASE parse.unit.kind OF
    = clc$lex_end_of_line =
      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_abnormal ('CL', cle$expecting_with_or_when, '', status);
      RETURN;
    CASEND;

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

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

  PROCEDURE clp$proc_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    clp$f_process_proc_header (parameters, status);

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

  PROCEDURE clp$procend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      proc_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('PROCEND', clc$proc_block, parameters, proc_block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (proc_block);
    clp$f_set_command_header_type (clc$procend_command);

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

  PROCEDURE clp$block_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      internal_input_block: ^clt$f_block,
      block_block: ^clt$f_block;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'BLOCK', status);
      RETURN;
    IFEND;

    clp$f_push_block_stack (clc$block_block, label, block_block);

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

  PROCEDURE clp$blockend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      block_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('BLOCKEND', clc$block_block, parameters, block_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (block_block);

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

  PROCEDURE clp$var_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'VAR', status);
      RETURN;
    IFEND;

    clp$f_set_command_header_type (clc$var_or_type_statement);
    clp$f_process_var_or_type ('VAR', status);

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

  PROCEDURE clp$varend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

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

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

  PROCEDURE clp$type_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'TYPE', status);
      RETURN;
    IFEND;

    clp$f_set_command_header_type (clc$var_or_type_statement);
    clp$f_process_var_or_type ('TYPE', status);

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

  PROCEDURE clp$typend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

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

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

  PROCEDURE clp$if_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      if_block: ^clt$f_block,
      internal_input_block: ^clt$f_block,
      parse: clt$parse_state,
      if_condition: boolean;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    evaluate_boolean_expression (parse, 'THEN', if_condition, status);

    clp$f_push_block_stack (clc$if_block, label, if_block);

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

  PROCEDURE clp$elseif_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      if_block: ^clt$f_block,
      parse: clt$parse_state,
      elseif_condition: boolean;

    clp$f_set_command_header_type (clc$control_statement_switch);
    status.normal := TRUE;
    clp$f_find_current_block (if_block);
    IF (if_block^.kind <> clc$if_block) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSEIF', status);
      RETURN;
    IFEND;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    evaluate_boolean_expression (parse, 'THEN', elseif_condition, status);

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

  PROCEDURE clp$else_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      if_block: ^clt$f_block;

    clp$f_set_command_header_type (clc$control_statement_switch);
    status.normal := TRUE;
    clp$f_find_current_block (if_block);
    CASE if_block^.kind OF
    = clc$if_block =
      IF if_block^.if_else_allowed THEN
        if_block^.if_else_allowed := FALSE;
      ELSE
        osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSE', status);
        RETURN;
      IFEND;

    = clc$case_block =
      IF if_block^.case_else_allowed THEN
        if_block^.case_else_allowed := FALSE;
      ELSE
        osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSE', status);
        RETURN;
      IFEND;

    ELSE
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'ELSE', status);
      RETURN;
    CASEND;

    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'ELSE', status);
      RETURN;
    IFEND;

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

  PROCEDURE clp$ifend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      if_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('IFEND', clc$if_block, parameters, if_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (if_block);

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

  PROCEDURE clp$loop_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      internal_input_block: ^clt$f_block,
      loop_block: ^clt$f_block;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'LOOP', status);
    IFEND;

    clp$f_push_block_stack (clc$loop_block, label, loop_block);

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

  PROCEDURE clp$loopend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      loop_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('LOOPEND', clc$loop_block, parameters, loop_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (loop_block);

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

  PROCEDURE clp$while_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      internal_input_block: ^clt$f_block,
      parse: clt$parse_state,
      while_block: ^clt$f_block,
      while_condition: boolean;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    evaluate_boolean_expression (parse, 'DO', while_condition, status);

    clp$f_push_block_stack (clc$while_block, label, while_block);

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

  PROCEDURE clp$whilend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      while_block: ^clt$f_block,
      while_condition: boolean;

    status.normal := TRUE;
    check_statement_terminator ('WHILEND', clc$while_block, parameters, while_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (while_block);

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

  PROCEDURE clp$repeat_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      internal_input_block: ^clt$f_block,
      repeat_block: ^clt$f_block;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'REPEAT', status);
    IFEND;

    clp$f_push_block_stack (clc$repeat_block, label, repeat_block);

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

  PROCEDURE clp$until_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      repeat_block: ^clt$f_block,
      until_condition: boolean;

    status.normal := TRUE;
    clp$f_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;
    clp$f_pop_block_stack (repeat_block);
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    evaluate_boolean_expression (parse, '', until_condition, status);

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

  PROCEDURE clp$for_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

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

    PROCEDURE setup_for_incremental_control;


      clp$f_expression_scanner (integer_value_specifier, TRUE, parse, value, status);
      IF NOT status.normal THEN
        EXIT clp$for_statement;
      IFEND;
      IF parse.unit.kind <> clc$lex_equal THEN
        osp$set_status_abnormal ('CL', cle$expecting_for_assign, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement;
      IFEND;
      clp$f_scan_token (clc$slu_non_space, parse);
      clp$f_expression_scanner (integer_value_specifier, TRUE, parse, value, status);
      IF NOT status.normal THEN
        IF (clc$min_ecc_expression_result <= status.condition) AND
              (status.condition <= clc$max_ecc_expression_result) THEN
          osp$append_status_parameter (osc$status_parameter_delimiter,
                ' for initial value of FOR statement control variable', status);
        IFEND;
        EXIT clp$for_statement;
      IFEND;

      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_abnormal ('CL', 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_abnormal ('CL', 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$set_format_type (clc$reserved_name);
      clp$f_scan_token (clc$slu_non_space, parse);
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_abnormal ('CL', cle$unexpected_after_for_to, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement;
      IFEND;
      clp$f_expression_scanner (integer_value_specifier, TRUE, parse, value, status);
      IF NOT status.normal THEN
        IF (clc$min_ecc_expression_result <= status.condition) AND
              (status.condition <= clc$max_ecc_expression_result) THEN
          osp$append_status_parameter (osc$status_parameter_delimiter,
                ' for final value of FOR statement control variable', status);
        IFEND;
        EXIT clp$for_statement;
      IFEND;
      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;

      for_increment := 1;
      IF (parse.previous_unit_is_space) AND (parse.unit.kind <> clc$lex_end_of_line) THEN
        IF parse.unit.kind <> clc$lex_name THEN
          osp$set_status_abnormal ('CL', cle$expecting_for_by_or_do, '', 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 <> '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$set_format_type (clc$reserved_name);
          clp$f_scan_token (clc$slu_non_space, parse);
          IF NOT parse.previous_unit_is_space THEN
            osp$set_status_abnormal ('CL', cle$unexpected_after_for_by, '', status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$for_statement;
          IFEND;
          clp$f_expression_scanner (integer_value_specifier, TRUE, parse, value, status);
          IF NOT status.normal THEN
            IF (clc$min_ecc_expression_result <= status.condition) AND
                  (status.condition <= clc$max_ecc_expression_result) THEN
              osp$append_status_parameter (osc$status_parameter_delimiter,
                    ' for step value of FOR statement control variable', status);
            IFEND;
            EXIT clp$for_statement;
          IFEND;
          for_increment := value.int.value;
          IF parse.unit_is_space THEN
            clp$f_scan_token (clc$slu_non_space, parse);
          IFEND;
          IF (parse.previous_unit_is_space) AND (parse.unit.kind <> clc$lex_end_of_line) THEN
            IF parse.unit.kind <> clc$lex_name THEN
              osp$set_status_abnormal ('CL', cle$unexpected_after_for_step, '', 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 <> 'DO' THEN
              osp$set_status_abnormal ('CL', cle$unexpected_after_for_step, clause_name, status);
              EXIT clp$for_statement;
            IFEND;
            clp$set_format_type (clc$reserved_name);
          ELSEIF parse.unit.kind <> clc$lex_end_of_line THEN
            osp$set_status_abnormal ('CL', cle$unexpected_after_for_step, '', status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$for_statement;
          ELSE
            clp$add_format_token (^space, clc$lex_space, clc$unassigned);
            clp$add_format_token (^do_name, clc$lex_name, clc$reserved_name);
          IFEND;
        ELSE
          clp$set_format_type (clc$reserved_name);
        IFEND;
        IF parse.unit.kind <> clc$lex_end_of_line THEN
          clp$f_scan_token (clc$slu_non_space, parse);
          IF parse.unit.kind <> clc$lex_end_of_line 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;
        IFEND;
      ELSEIF parse.unit.kind <> clc$lex_end_of_line THEN
        osp$set_status_abnormal ('CL', cle$unexpected_after_for_final, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement;
      ELSE
        clp$add_format_token (^space, clc$lex_space, clc$unassigned);
        clp$add_format_token (^do_name, clc$lex_name, clc$reserved_name);
      IFEND;
    PROCEND setup_for_incremental_control;
?? TITLE := 'setup_for_list_control', EJECT ??

    PROCEDURE setup_for_list_control;

      VAR
        nesting_level: integer;


      clp$set_format_type (clc$reserved_name);

      clp$f_scan_token (clc$slu_non_space, 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);
        EXIT clp$for_statement;
      ELSE
        osp$set_status_abnormal ('CL', cle$expecting_for_variable, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement;
      CASEND;

      clp$f_scan_token (clc$slu_non_space, parse);
      IF parse.unit.kind <> clc$lex_name THEN
        osp$set_status_abnormal ('CL', 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$set_format_type (clc$reserved_name);

      clp$f_scan_token (clc$slu_non_space, parse);
      IF NOT parse.previous_unit_is_space THEN
        osp$set_status_abnormal ('CL', cle$unexpected_after_for_in, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement;
      IFEND;
      IF parse.unit.kind = clc$lex_left_parenthesis THEN
        nesting_level := 1;
        WHILE nesting_level <> 0 DO
          clp$f_scan_token (clc$slu_non_space, parse);
          CASE parse.unit.kind OF
          = clc$lex_left_parenthesis =
            nesting_level := nesting_level + 1;
          = clc$lex_right_parenthesis =
            nesting_level := nesting_level - 1;
          = clc$lex_end_of_line =
            osp$set_status_abnormal ('CL', cle$expecting_rparen, '', status);
            clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
            EXIT clp$for_statement;
          ELSE
            ;
          CASEND;
        WHILEND;
        clp$f_scan_token (clc$slu_non_space, parse);
      ELSE
        clp$f_expression_scanner (integer_value_specifier, TRUE, parse, value, status);
        IF NOT status.normal THEN
          EXIT clp$for_statement;
        IFEND;
        IF parse.unit_is_space THEN
          clp$f_scan_token (clc$slu_non_space, parse);
        IFEND;
      IFEND;

      CASE parse.unit.kind OF
      = clc$lex_end_of_line, clc$lex_semicolon =
        clp$add_format_token (^space, clc$lex_space, clc$unassigned);
        clp$add_format_token (^do_name, clc$lex_name, clc$reserved_name);
      = clc$lex_name =
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_for_list, '', 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 <> 'DO' THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_for_list, clause_name, status);
          EXIT clp$for_statement;
        IFEND;
        clp$set_format_type (clc$reserved_name);
        clp$f_scan_token (clc$slu_non_space, 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;
      ELSE
        osp$set_status_abnormal ('CL', cle$unexpected_after_for_list, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        EXIT clp$for_statement;
      CASEND;

    PROCEND setup_for_list_control;
?? OLDTITLE, EJECT ??

    VAR
      integer_value_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
            [NIL, clc$integer_value, -0ffffffffffff(16), 0ffffffffffff(16)],
      interpreter_mode: clt$interpreter_modes,
      internal_input_block: ^clt$f_block,
      for_block: ^clt$f_block,
      for_control_is_incremental: boolean,
      for_variable: ost$name,
      for_value: array [1 .. 1] of clt$integer,
      for_limit: integer,
      for_increment: integer,
      for_condition: boolean,
      value: clt$value,
      do_name: [STATIC] string (2) := 'DO',
      clause_name: ost$name,
      parse: clt$parse_state,
      space: [STATIC] string (1) := ' ';

    status.normal := TRUE;
    clp$f_push_block_stack (clc$for_block, label, for_block);
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, 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_abnormal ('CL', 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 for_control_is_incremental THEN
      setup_for_incremental_control;
    ELSE
      setup_for_list_control;
    IFEND;


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

  PROCEDURE clp$forend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      for_block: ^clt$f_block,
      for_variable: clt$variable_reference,
      for_value: array [1 .. 1] of clt$integer,
      forend_condition: boolean;

    status.normal := TRUE;
    check_statement_terminator ('FOREND', clc$for_block, parameters, for_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (for_block);

  PROCEND clp$forend_statement;
?? TITLE := 'when condition names', EJECT ??

  VAR
    condition_names_value_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
          [^condition_names, clc$keyword_value],
    condition_names: [STATIC, READ, oss$job_paged_literal] array [1 .. 6] of ost$name := ['ANY_FAULT',
          'COMMAND_FAULT', 'INTERRUPT', 'LIMIT_FAULT', 'PROGRAM_FAULT', 'RESOURCE_FAULT'];

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

  PROCEDURE clp$when_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      do_name: [STATIC] string (2) := 'DO',
      space: [STATIC] string (1) := ' ',
      interpreter_mode: clt$interpreter_modes,
      when_file_name: amt$local_file_name,
      terminator_name: ost$name,
      parse: clt$parse_state,
      when_block: ^clt$f_block,
      value: clt$value;

    status.normal := TRUE;
    clp$f_push_block_stack (clc$when_block, label, when_block);
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);

  /scan_condition_names/
    WHILE TRUE DO
      clp$f_expression_scanner (condition_names_value_specifier, TRUE, parse, value, status);
      IF NOT status.normal THEN
        IF (clc$min_ecc_expression_result <= status.condition) AND
              (status.condition <= clc$max_ecc_expression_result) THEN
          osp$append_status_parameter (osc$status_parameter_delimiter, ' for WHEN condition name', status);
        IFEND;
        RETURN;
      IFEND;
      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      CASE parse.unit.kind OF
      = clc$lex_end_of_line =
        clp$add_format_token (^space, clc$lex_space, clc$unassigned);
        clp$add_format_token (^do_name, clc$lex_name, clc$reserved_name); {||?
        EXIT /scan_condition_names/;
      = clc$lex_comma =
        clp$f_scan_token (clc$slu_non_space, parse);
      ELSE
        IF parse.previous_unit_is_space THEN
          IF parse.unit.kind = clc$lex_name THEN
            #TRANSLATE (osv$lower_to_upper, parse.text^ (parse.unit_index, parse.unit.size), terminator_name);
            IF terminator_name = 'DO' THEN
              clp$set_format_type (clc$reserved_name);
              clp$f_scan_token (clc$slu_non_space, parse);
              IF parse.unit.kind <> clc$lex_end_of_line THEN
                osp$set_status_abnormal ('CL', cle$unexpected_after_then_or_do, 'DO', status);
                clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
                RETURN;
              IFEND;
              EXIT /scan_condition_names/;
            IFEND;
          IFEND;
        ELSE
          osp$set_status_abnormal ('CL', cle$unexpected_after_cond_name, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN;
        IFEND;
      CASEND;
    WHILEND /scan_condition_names/;

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

  PROCEDURE clp$whenend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      when_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('WHENEND', clc$when_block, parameters, when_block, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (when_block)

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

  PROCEDURE clp$continue_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      continue_condition: boolean,
      retry: boolean,
      clause_name: ost$name,
      parse: clt$parse_state,
      expecting_when: ost$status_condition;

    clp$f_set_command_header_type (clc$control_statement_no_switch);
    status.normal := TRUE;

  /process_continue_parameters/
    BEGIN
      retry := FALSE;
      clp$initialize_parse_state (^parameters, NIL, parse);
      clp$f_scan_token (clc$slu_non_space, parse);
      IF parse.unit.kind = clc$lex_end_of_line THEN
        EXIT /process_continue_parameters/;
      IFEND;
      IF parse.unit.kind <> clc$lex_name THEN
        osp$set_status_abnormal ('CL', cle$expecting_retry_or_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_retry_or_when;

      IF (clause_name = 'RETRY') OR (clause_name = 'NEXT') OR (clause_name = 'NEXT_HANDLER') OR
            (clause_name = 'NEXT_USER_HANDLER') THEN
        clp$set_format_type (clc$reserved_name);
        retry := TRUE;
        clp$f_scan_token (clc$slu_non_space, parse);
        IF parse.unit.kind = clc$lex_end_of_line THEN
          EXIT /process_continue_parameters/;
        IFEND;
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_retry, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN;
        IFEND;
        IF parse.unit.kind <> clc$lex_name THEN
          osp$set_status_abnormal ('CL', 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;
      IFEND;

      IF clause_name <> 'WHEN' THEN
        osp$set_status_abnormal ('CL', expecting_when, '', status);
        clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        RETURN;
      IFEND;
      process_when_clause ('CONTINUE', parse, continue_condition, status);
      IF NOT (status.normal AND continue_condition) THEN
        RETURN;
      IFEND;
    END /process_continue_parameters/;

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

  PROCEDURE clp$push_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      object_names_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
            [NIL, clc$name_value, 1, osc$max_name_size],
      parse: clt$parse_state,
      value: clt$value;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);

  /scan_object_names/
    WHILE TRUE DO
      clp$f_expression_scanner (object_names_specifier, TRUE, parse, value, status);
      IF NOT status.normal THEN
        IF (clc$min_ecc_expression_result <= status.condition) AND
              (status.condition <= clc$max_ecc_expression_result) THEN
          osp$append_status_parameter (osc$status_parameter_delimiter, ' for PUSH object name', status);
        IFEND;
        RETURN
      IFEND;

      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      CASE parse.unit.kind OF
      = clc$lex_end_of_line =
        EXIT /scan_object_names/;
      = clc$lex_comma =
        clp$f_scan_token (clc$slu_non_space, parse);
      ELSE
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_obj_name, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        IFEND;
      CASEND;
    WHILEND /scan_object_names/;

    clp$f_set_command_header_type (clc$control_statement_no_switch);

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

  PROCEDURE clp$pop_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      object_names_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
            [NIL, clc$name_value, 1, osc$max_name_size],
      parse: clt$parse_state,
      value: clt$value;

    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);

  /scan_object_names/
    WHILE TRUE DO
      clp$f_expression_scanner (object_names_specifier, TRUE, parse, value, status);
      IF NOT status.normal THEN
        IF (clc$min_ecc_expression_result <= status.condition) AND
              (status.condition <= clc$max_ecc_expression_result) THEN
          osp$append_status_parameter (osc$status_parameter_delimiter, ' for POP object name', status);
        IFEND;
        RETURN
      IFEND;

      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      CASE parse.unit.kind OF
      = clc$lex_end_of_line =
        EXIT /scan_object_names/;
      = clc$lex_comma =
        clp$f_scan_token (clc$slu_non_space, parse);
      ELSE
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_obj_name, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
        IFEND;
      CASEND;
    WHILEND /scan_object_names/;

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

  PROCEDURE clp$cancel_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state,
      value: clt$value;

    clp$f_set_command_header_type (clc$control_statement_no_switch);
    status.normal := TRUE;
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);

  /scan_condition_names/
    WHILE TRUE DO
      clp$f_expression_scanner (condition_names_value_specifier, TRUE, parse, value, status);
      IF NOT status.normal THEN
        IF (clc$min_ecc_expression_result <= status.condition) AND
              (status.condition <= clc$max_ecc_expression_result) THEN
          osp$append_status_parameter (osc$status_parameter_delimiter, ' for WHEN condition name', status);
        IFEND;
        RETURN;
      IFEND;
      IF parse.unit_is_space THEN
        clp$f_scan_token (clc$slu_non_space, parse);
      IFEND;
      CASE parse.unit.kind OF
      = clc$lex_end_of_line =
        EXIT /scan_condition_names/;
      = clc$lex_comma =
        clp$f_scan_token (clc$slu_non_space, parse);
      ELSE
        IF NOT parse.previous_unit_is_space THEN
          osp$set_status_abnormal ('CL', cle$unexpected_after_cond_name, '', status);
          clp$append_status_parse_state (osc$status_parameter_delimiter, parse, status);
          RETURN;
        IFEND;
      CASEND;
    WHILEND /scan_condition_names/;

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

  PROCEDURE clp$cause_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      status_value_specifier: [STATIC, READ, oss$job_paged_literal] clt$value_kind_specifier :=
            [NIL, clc$status_value],
      parse: clt$parse_state,
      value: clt$value;

    status.normal := TRUE;
    clp$f_set_command_header_type (clc$control_statement_no_switch);
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    clp$f_expression_scanner (status_value_specifier, TRUE, parse, value, status);
    IF NOT status.normal THEN
      IF (clc$min_ecc_expression_result <= status.condition) AND
            (status.condition <= clc$max_ecc_expression_result) THEN
        osp$append_status_parameter (osc$status_parameter_delimiter, ' for status value of CAUSE statement',
              status);
      IFEND;
      RETURN;
    IFEND;
    IF parse.unit_is_space THEN
      clp$f_scan_token (clc$slu_non_space, parse);
    IFEND;
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'CAUSE status', status);
      RETURN;
    IFEND;

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

  TYPE
    clt$task_parameters = record
      local_file_name: amt$local_file_name,
      task_name: ost$name,
    recend;

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

  PROCEDURE clp$task_statement
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      label: ost$name,
      task_block: ^clt$f_block;

    label := '';
    clp$f_set_command_header_type (clc$control_statement_begin);
    clp$f_push_block_stack (clc$formatter_task_block, label, task_block);
    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_task_or_job ('TASK', status);
    IFEND;

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

  PROCEDURE clp$taskend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      task_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('TASKEND', clc$formatter_task_block, '', task_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_set_substitution_mark (' ');
    clp$f_pop_block_stack (task_block);

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

  PROCEDURE clp$utility_statement
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      label: ost$name,
      utility_block: ^clt$f_block;

    label := '';
    clp$f_set_command_header_type (clc$control_statement_begin);
    clp$f_push_block_stack (clc$formatter_utility_block, label, utility_block);
    clp$f_scan_parameter_list (parameter_list, status);

  PROCEND clp$utility_statement;
?? TITLE := 'clp$utilityend_statement', EJECT ??

  PROCEDURE clp$utilityend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      utility_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('UTILITYEND', clc$formatter_utility_block, '', utility_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (utility_block);

  PROCEND clp$utilityend_statement;
?? TITLE := 'clp$job_statement', EJECT ??

  PROCEDURE clp$job_statement
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      label: ost$name,
      job_block: ^clt$f_block;

    label := '';
    clp$f_set_command_header_type (clc$control_statement_begin);
    clp$f_push_block_stack (clc$formatter_job_block, label, job_block);
    clp$f_scan_parameter_list (parameter_list, status);
    IF status.normal THEN
      clp$f_process_task_or_job ('JOB', status);
    IFEND;

  PROCEND clp$job_statement;
?? TITLE := 'clp$jobend_statement', EJECT ??

  PROCEDURE clp$jobend_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      job_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('JOBEND', clc$formatter_job_block, '', job_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_set_substitution_mark (' ');
    clp$f_pop_block_stack (job_block);

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

  PROCEDURE clp$push_commands
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parse: clt$parse_state;

    status.normal := TRUE;
    clp$f_set_command_header_type (clc$control_statement_no_switch);
    clp$initialize_parse_state (^parameters, NIL, parse);
    clp$f_scan_token (clc$slu_non_space, parse);
    IF parse.unit.kind <> clc$lex_end_of_line THEN
      osp$set_status_abnormal ('CL', cle$unexpected_statement_params, 'PUSH_COMMANDS', status);
      RETURN;
    IFEND;

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

  PROCEDURE clp$pipe_statement
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      parameter_string: ost$string,
      pipe_block: ^clt$f_block;

    clp$f_set_command_header_type (clc$control_statement_begin);
    clp$f_push_block_stack (clc$formatter_pipe_block, label, pipe_block);

    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
    (    label: ost$name;
         parameters: string ( * );
     VAR status: ost$status);

    VAR
      pipe_block: ^clt$f_block;

    status.normal := TRUE;
    check_statement_terminator ('PIPEND', clc$formatter_pipe_block, '', pipe_block, status);
    IF (NOT status.normal) AND (status.condition = cle$unexpected_control_statemnt) THEN
      RETURN;
    IFEND;
    clp$f_pop_block_stack (pipe_block);

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

  PROCEND clp$pipend_statement;

MODEND clm$f_control_statements;
