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

{
{ PURPOSE:
{   This module contains the procedures that manage the Block stack which is used to keep track of the
{   current state of the SCL interpreter.
{   Included in this module are the procedures called by task management when a child task of the current
{   task is being created or has terminated.
{

?? NEWTITLE := 'Global Declarations' ??
?? NEWTITLE := 'Block Stack', EJECT ??
*copyc clt$block
?? OLDTITLE, EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc avc$accounting_statistics
*copyc clc$compiling_for_test_harness
*copyc clc$declaration_version
*copyc clc$exiting_condition
*copyc clc$standard_file_names
*copyc cle$bad_application_task_link
*copyc cle$block_access_count_error
*copyc cle$cannot_access_unit_array
*copyc cle$ecc_control_statement
*copyc cle$multiple_applic_unit_arrays
*copyc cle$negative_application_units
*copyc cle$parameters_displayed
*copyc cle$terminated_application_task
*copyc cle$unable_to_free_block
*copyc cle$unexpected_call_to
*copyc clk$erase_child_task
*copyc clk$pop_block_stack
*copyc clk$push_block_stack
*copyc clk$record_child_task
*copyc clt$application_unit_info
*copyc clt$block_handle
*copyc clt$command_name
*copyc clt$command_or_function
*copyc clt$established_handler_index
*copyc clt$initial_application
*copyc clt$parameter_eval_context
*copyc clt$parameter_help_context
*copyc clt$processing_phase
*copyc clt$string_size
*copyc clt$task_list
*copyc clt$user_identification
*copyc clt$utility_attributes
*copyc clt$when_condition_definition
*copyc cyd$run_time_error_condition
*copyc fst$file_reference
*copyc jmt$ijl_ordinal
*copyc osc$timesharing_terminal_file
*copyc osd$integer_limits
*copyc osd$virtual_address
*copyc ose$heap_full_exceptions
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc oss$task_shared
*copyc ost$caller_identifier
*copyc ost$name
*copyc ost$status
*copyc ost$user_identification
*copyc pme$system_exceptions
?? SKIP := 3 ??

{
{ PURPOSE:
{   The following procedure exists solely to provide a "shelter" for the
{   declarations contained in certain decks that are *COPYC'd into this
{   deck.  For example, this module defines an XDCL'd variable that is
{   referenced by an INLINE procedure.  In order to make the deck containing
{   the INLINE procedure "self-contained" it *COPYCs the deck containing the
{   XREF declaration of the variable.  Since the INLINE procedure is needed
{   in this module, both the XDCL and XREF declaration will appear in this
{   module.  The following "dummy" procedure is used to hide the XREF
{   declaration of the variable from the rest of the module.
{

  PROCEDURE [INLINE] dummy;

*copyc clp$find_task_block_first_time
*copyc clv$current_task_block

  PROCEND dummy;
?? SKIP := 3 ??
?? POP ??
*copyc avp$calculate_application_srus
*copyc avp$emit_interactive_interval
*copyc avp$ring_nominal
*copyc avp$security_option_active
*copyc avv$active_sou_capabilities
*copyc avv$cond_capability_names
*copyc clp$convert_ext_value_to_int
*copyc clp$delete_expandable_string
*copyc clp$delete_util_from_cmnd_list
*copyc clp$delete_parameters
*copyc clp$delete_variables
*copyc clp$environment_object_in_block
*copyc clp$find_block_via_handle
*copyc clp$find_current_block
*copyc clp$find_task_block
*copyc clp$find_utility_block
*copyc clp$free_all_handlers_in_block
*copyc clp$get_command_search_mode
*copyc clp$get_non_standard_cmnd_line
*copyc clp$get_non_standard_line
*copyc clp$get_segment_cmnd_line
*copyc clp$get_segment_cmnd_line_v0
*copyc clp$get_segment_line
*copyc clp$get_segment_line_v0
*copyc clp$get_standard_cmnd_line
*copyc clp$get_standard_line
*copyc clp$get_system_file_id
*copyc clp$get_work_area
*copyc clp$initialize_parse_state
*copyc clp$init_all_environment
*copyc clp$internal_convert_to_string
*copyc clp$pop_all_environment
*copyc clp$pop_input_stack
*copyc clp$push_all_environment
*copyc clp$reset_input_position
*copyc clp$save_collect_statement_area
*copyc clp$send_exiting_signal
*copyc clp$set_prompt_string
*copyc clp$store_expandable_string
*copyc clp$trimmed_string_size
*copyc clp$update_all_environment
*copyc clv$standard_files
*copyc clv$var_access_assignment_count
*copyc i#current_sequence_position
*copyc iip$direct_fetch_trm_conn_atts
*copyc iip$direct_store_trm_conn_atts
*copyc jmp$job_file_fap
*copyc jmp$end_application_scheduling
*copyc jmp$read_application_record
*copyc jmp$set_application_scheduling
*copyc jmp$system_job
*copyc jmv$jcb
*copyc mmp$delete_segment
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$clear_job_signature_lock
*copyc osp$decrement_locked_variable
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$fetch_locked_variable
*copyc osp$find_interaction_info
*copyc osp$generate_log_message
*copyc osp$increment_locked_variable
*copyc osp$initialize_sig_lock
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$system_error
*copyc osp$verify_system_privilege
*copyc osv$task_shared_heap
*copyc pmp$abort
*copyc pmp$cause_task_condition
*copyc pmp$continue_to_cause
*copyc pmp$find_executing_task_xcb
*copyc pmp$find_prog_options_and_libs
*copyc pmp$get_application_information
*copyc pmp$get_task_cp_time
*copyc pmp$get_task_id
*copyc pmp$get_task_jobmode_statistics
*copyc pmp$get_unique_name
*copyc pmp$get_user_identification
*copyc pmp$init_default_prog_options
*copyc pmp$log_ascii
*copyc pmp$terminate
*copyc sfp$emit_audit_statistic
*copyc sfp$emit_statistic
?? TITLE := 'clv$nil_block_handle', EJECT ??

{
{ This variable contains the equivalent of a NIL pointer in the form of a block handle.
{

  VAR
    clv$nil_block_handle: [XDCL, #GATE, READ, oss$job_paged_literal] clt$block_handle := [0, 0];

?? TITLE := 'clv$initial_blocks', EJECT ??

{
{ This variable contains initialized instances of each generic kind of block.
{

?? FMT (FORMAT := OFF) ??

  VAR
    clv$initial_blocks: [STATIC, READ, oss$job_paged_literal] array [clt$block_kind] of clt$block := [

{ CLC$BLOCK_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'BLOCK',
          { kind_end_name ............................................ } 'BLOCKEND',
          { kind ..................................................... } clc$block_block],

{ CLC$CASE_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'CASE',
          { kind_end_name ............................................ } 'CASEND',
          { kind ..................................................... } clc$case_block,
          { case_selection_value ..................................... } NIL,
          { case_selection_encounterred .............................. } FALSE,
          { case_selected ............................................ } FALSE,
          { case_else_allowed ........................................ } TRUE],

{ CLC$CHECK_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'CHECK',
          { kind_end_name ............................................ } 'CHECKEND',
          { kind ..................................................... } clc$check_block,
          { check_status ............................................. } [TRUE]],

{ CLC$COMMAND_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } FALSE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'command',
          { kind_end_name ............................................ } 'command_end',
          { kind ..................................................... } clc$command_block,
          { command_kind ............................................. } clc$regular_command,
          { command_logging_completed ................................ } FALSE,
          { command_echoing_completed ................................ } FALSE,
          { help_output_file ......................................... } NIL,
          { help_output_options ...................................... } [],
          { edited_parameters_max_size ............................... } 0,
          { edited_parameters ........................................ } NIL],

{ CLC$COMMAND_PROC_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } FALSE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } TRUE,
          { parameters. command_status_specified ..................... } FALSE,
          { parameters. accesses ..................................... } NIL,
          { parameters. values ....................................... } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'PROCEDURE',
          { kind_end_name ............................................ } 'PROCEND',
          { kind ..................................................... } clc$command_proc_block,
          { inherited_input. found ................................... } [FALSE],
          { input. internal .......................................... } [FALSE,
          { input. prompting_input ................................... } FALSE,
          { input. line. area ........................................ } [NIL,
          { input. line. text ........................................ } NIL,
          { input. line. lexical_units ............................... } NIL],
          { input. pushed_line ....................................... } NIL,
          { input. kind .............................................. } clc$file_input,
          { input. local_file_name ................................... } osc$null_name,
          { input. file_id. ordinal .................................. } [0,
          { input. file_id. sequence ................................. } 1],
          { input. line_layout. physical_line_size ................... } [clc$max_physical_line_size,
          { input. line_layout. element .............................. } [REP 3 of
          { input. line_layout. element. kind......................... } [clc$null_line_element,
          { input. line_layout. element. size......................... } 0]]],
          { input. get_command_line .................................. } NIL,
          { input. get_line .......................................... } NIL,
          { input. data_line. area ................................... } [NIL,
          { input. data_line. text ................................... } NIL,
          { input. data_line. lexical_units .......................... } NIL],
          { input. line_address_is_for_previous ...................... } FALSE,
          { input. line_address ...................................... } 0,
          { input. record_number ..................................... } 0,
          { input. data .............................................. } NIL,
          { input. file_rereadable ................................... } FALSE,
          { input. interactive_device ................................ } FALSE,
          { input. device_class ...................................... } rmc$mass_storage_device,
          { input. base_prompt_string. size .......................... } [0,
          { input. base_prompt_string. value ......................... } ''],
          { input. current_prompt_string. size ....................... } [0,
          { input. current_prompt_string. value ...................... } ''],
          { input. state ............................................. } clc$continue_input],
          { previous_command. area ................................... } [NIL,
          { previous_command. text ................................... } NIL,
          { previous_command. lexical_units .......................... } NIL],
          { previous_command_name .................................... } osc$null_name,
          { previous_command_status .................................. } [TRUE],
          { proc_name ................................................ } osc$null_name,
          { command_proc_status ...................................... } NIL,
          { command_proc_logging_completed ........................... } FALSE,
          { command_proc_echoing_completed ........................... } FALSE,
          { function_proc_result ..................................... } NIL,
          { expected_function_proc_type .............................. } NIL,
          { when_condition ........................................... } NIL,
          { associated_utility ....................................... } NIL,
          { line_preprocessor_specified .............................. } FALSE],

{ CLC$FOR_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'FOR',
          { kind_end_name ............................................ } 'FOREND',
          { kind ..................................................... } clc$for_block,
          { for_variable ............................................. } NIL,
          { for_control. style ....................................... } [clc$for_control_list,
          { for_control. list ........................................ } NIL]],

{ CLC$FUNCTION_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } FALSE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'function',
          { kind_end_name ............................................ } 'function_end',
          { kind ..................................................... } clc$function_block,
          { expected_function_type ................................... } NIL],

{ CLC$FUNCTION_PROC_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } FALSE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } TRUE,
          { parameters. command_status_specified ..................... } FALSE,
          { parameters. accesses ..................................... } NIL,
          { parameters. values ....................................... } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'FUNCTION',
          { kind_end_name ............................................ } 'FUNCEND',
          { kind ..................................................... } clc$function_proc_block,
          { inherited_input. found ................................... } [FALSE],
          { input. internal .......................................... } [FALSE,
          { input. prompting_input ................................... } FALSE,
          { input. line. area ........................................ } [NIL,
          { input. line. text ........................................ } NIL,
          { input. line. lexical_units ............................... } NIL],
          { input. pushed_line ....................................... } NIL,
          { input. kind .............................................. } clc$file_input,
          { input. local_file_name ................................... } osc$null_name,
          { input. file_id. ordinal .................................. } [0,
          { input. file_id. sequence ................................. } 1],
          { input. line_layout. physical_line_size ................... } [clc$max_physical_line_size,
          { input. line_layout. element .............................. } [REP 3 of
          { input. line_layout. element. kind......................... } [clc$null_line_element,
          { input. line_layout. element. size......................... } 0]]],
          { input. get_command_line .................................. } NIL,
          { input. get_line .......................................... } NIL,
          { input. data_line. area ................................... } [NIL,
          { input. data_line. text ................................... } NIL,
          { input. data_line. lexical_units .......................... } NIL],
          { input. line_address_is_for_previous ...................... } FALSE,
          { input. line_address ...................................... } 0,
          { input. record_number ..................................... } 0,
          { input. data .............................................. } NIL,
          { input. file_rereadable ................................... } FALSE,
          { input. interactive_device ................................ } FALSE,
          { input. device_class ...................................... } rmc$mass_storage_device,
          { input. base_prompt_string. size .......................... } [0,
          { input. base_prompt_string. value ......................... } ''],
          { input. current_prompt_string. size ....................... } [0,
          { input. current_prompt_string. value ...................... } ''],
          { input. state ............................................. } clc$continue_input],
          { previous_command. area ................................... } [NIL,
          { previous_command. text ................................... } NIL,
          { previous_command. lexical_units .......................... } NIL],
          { previous_command_name .................................... } osc$null_name,
          { previous_command_status .................................. } [TRUE],
          { proc_name ................................................ } osc$null_name,
          { command_proc_status ...................................... } NIL,
          { command_proc_logging_completed ........................... } FALSE,
          { command_proc_echoing_completed ........................... } FALSE,
          { function_proc_result ..................................... } NIL,
          { expected_function_proc_type .............................. } NIL,
          { when_condition ........................................... } NIL,
          { associated_utility ....................................... } NIL,
          { line_preprocessor_specified .............................. } FALSE],

{ CLC$IF_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'IF',
          { kind_end_name ............................................ } 'IFEND',
          { kind ..................................................... } clc$if_block,
          { if_condition_met ......................................... } FALSE,
          { if_else_allowed .......................................... } TRUE],

{ CLC$INPUT_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'input',
          { kind_end_name ............................................ } 'end_of_input',
          { kind ..................................................... } clc$input_block,
          { inherited_input. found ................................... } [FALSE],
          { input. internal .......................................... } [FALSE,
          { input. prompting_input ................................... } FALSE,
          { input. line. area ........................................ } [NIL,
          { input. line. text ........................................ } NIL,
          { input. line. lexical_units ............................... } NIL],
          { input. pushed_line ....................................... } NIL,
          { input. kind .............................................. } clc$file_input,
          { input. local_file_name ................................... } osc$null_name,
          { input. file_id. ordinal .................................. } [0,
          { input. file_id. sequence ................................. } 1],
          { input. line_layout. physical_line_size ................... } [clc$max_physical_line_size,
          { input. line_layout. element .............................. } [REP 3 of
          { input. line_layout. element. kind......................... } [clc$null_line_element,
          { input. line_layout. element. size......................... } 0]]],
          { input. get_command_line .................................. } NIL,
          { input. get_line .......................................... } NIL,
          { input. data_line. area ................................... } [NIL,
          { input. data_line. text ................................... } NIL,
          { input. data_line. lexical_units .......................... } NIL],
          { input. line_address_is_for_previous ...................... } FALSE,
          { input. line_address ...................................... } 0,
          { input. record_number ..................................... } 0,
          { input. data .............................................. } NIL,
          { input. file_rereadable ................................... } FALSE,
          { input. interactive_device ................................ } FALSE,
          { input. device_class ...................................... } rmc$mass_storage_device,
          { input. base_prompt_string. size .......................... } [0,
          { input. base_prompt_string. value ......................... } ''],
          { input. current_prompt_string. size ....................... } [0,
          { input. current_prompt_string. value ...................... } ''],
          { input. state ............................................. } clc$continue_input],
          { previous_command. area ................................... } [NIL,
          { previous_command. text ................................... } NIL,
          { previous_command. lexical_units .......................... } NIL],
          { previous_command_name .................................... } osc$null_name,
          { previous_command_status .................................. } [TRUE],
          { proc_name ................................................ } osc$null_name,
          { command_proc_status ...................................... } NIL,
          { command_proc_logging_completed ........................... } FALSE,
          { command_proc_echoing_completed ........................... } FALSE,
          { function_proc_result ..................................... } NIL,
          { expected_function_proc_type .............................. } NIL,
          { when_condition ........................................... } NIL,
          { associated_utility ....................................... } NIL,
          { line_preprocessor_specified .............................. } FALSE],

{ CLC$LOOP_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'LOOP',
          { kind_end_name ............................................ } 'LOOPEND',
          { kind ..................................................... } clc$loop_block],

{ CLC$REPEAT_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'REPEAT',
          { kind_end_name ............................................ } 'UNTIL',
          { kind ..................................................... } clc$repeat_block,
          { expression_area .......................................... } NIL,
          { expression_parse. text ................................... } [NIL,
          { expression_parse. index .................................. } 1,
          { expression_parse. units_array ............................ } NIL,
          { expression_parse. units_array_index ...................... } 1,
          { expression_parse. index_limit ............................ } 1,
          { expression_parse. unit. size ............................. } [0,
          { expression_parse. unit. kind ............................. } clc$lex_end_of_line],
          { expression_parse. unit_index ............................. } 1,
          { expression_parse. unit_is_space .......................... } FALSE,
          { expression_parse. previous_unit_is_space ................. } FALSE,
          { expression_parse. previous_non_space_unit. size .......... } [0,
          { expression_parse. previous_non_space_unit. kind .......... } clc$lex_end_of_line],
          { expression_parse. previous_non_space_unit_index .......... } 1]],

{ CLC$SUB_PARAMETERS_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } FALSE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'sub_parameters',
          { kind_end_name ............................................ } 'sub_parameters_end',
          { kind ..................................................... } clc$sub_parameters_block,
          { sub_parameters_work_area_ptr ............................. } NIL,
          { sub_parameters_work_area ................................. } NIL,
          { lookup_functions_and_variables ........................... } TRUE],


{ CLC$TASK_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } FALSE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'task',
          { kind_end_name ............................................ } 'end_of_task',
          { kind ..................................................... } clc$task_block,
          { task_id .................................................. } 0,
          { task_kind ................................................ } clc$other_task,
          { task_link ................................................ } NIL,
          { application_task_link .................................... } NIL,
          { parent ................................................... } NIL,
          { current_block ............................................ } NIL,
          { display_log_indices ...................................... } [REP 3 of
          { display_log_indices. last_log_entry ...................... } [0,
          { display_log_indices. last_display_log_entry .............. } 0,
          { display_log_indices. last_log_cycle ...................... } 0]],
          { synchronous_with_job ..................................... } FALSE,
          { synchronous_with_parent .................................. } FALSE,
          { command_file ............................................. } osc$null_name,
          { named_task_list .......................................... } NIL,
          { default_session_file ..................................... } NIL],

{ CLC$UTILITY_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'utility',
          { kind_end_name ............................................ } 'end_of_utility',
          { kind ..................................................... } clc$utility_block,
          { notify_before_command_read ............................... } NIL,
          { command_environment. commands ............................ } [NIL,
          { command_environment. contemporary_functions .............. } NIL,
          { command_environment. original_functions .................. } NIL,
          { command_environment. libraries ........................... } NIL,
          { command_environment. subcommand_logging_enabled .......... } TRUE,
          { command_environment. command_level ....................... } FALSE,
          { command_environment. task_id ............................. } 0,
          { command_environment. previous_search_mode ................ } clc$global_command_search,
          { command_environment. termination_command_ordinal ......... } 1,
          { command_environment. termination_command_index ........... } 1,
          { command_environment. auxiliary_libraries ................. } NIL,
          { command_environment. dialog_info. commands ............... } [NIL,
          { command_environment. dialog_info. functions .............. } NIL,
          { command_environment. dialog_info. scratch_segment ........ } NIL]],
          { command_search_mode ...................................... } clc$global_command_search,
          { interactive_include_processor. call_method ............... } [clc$unspecified_call],
          { libraries ................................................ } NIL,
          { line_preprocessor. call_method ........................... } [clc$unspecified_call],
          { online_manual_name ....................................... } osc$null_name,
          { prompt. size ............................................. } [0,
          { prompt. value ............................................ } ''],
          { termination_command_found ................................ } FALSE,
          { include_processor_active ................................. } FALSE,
          { active_sou_capabilities.saved ... ........................ } [FALSE]],

{ CLC$WHEN_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'WHEN',
          { kind_end_name ............................................ } 'WHENEND',
          { kind ..................................................... } clc$when_block,
          { inherited_input. found ................................... } [FALSE],
          { input. internal .......................................... } [FALSE,
          { input. prompting_input ................................... } FALSE,
          { input. line. area ........................................ } [NIL,
          { input. line. text ........................................ } NIL,
          { input. line. lexical_units ............................... } NIL],
          { input. pushed_line ....................................... } NIL,
          { input. kind .............................................. } clc$file_input,
          { input. local_file_name ................................... } osc$null_name,
          { input. file_id. ordinal .................................. } [0,
          { input. file_id. sequence ................................. } 1],
          { input. line_layout. physical_line_size ................... } [clc$max_physical_line_size,
          { input. line_layout. element .............................. } [REP 3 of
          { input. line_layout. element. kind......................... } [clc$null_line_element,
          { input. line_layout. element. size......................... } 0]]],
          { input. get_command_line .................................. } NIL,
          { input. get_line .......................................... } NIL,
          { input. data_line. area ................................... } [NIL,
          { input. data_line. text ................................... } NIL,
          { input. data_line. lexical_units .......................... } NIL],
          { input. line_address_is_for_previous ...................... } FALSE,
          { input. line_address ...................................... } 0,
          { input. record_number ..................................... } 0,
          { input. data .............................................. } NIL,
          { input. file_rereadable ................................... } FALSE,
          { input. interactive_device ................................ } FALSE,
          { input. device_class ...................................... } rmc$mass_storage_device,
          { input. base_prompt_string. size .......................... } [0,
          { input. base_prompt_string. value ......................... } ''],
          { input. current_prompt_string. size ....................... } [0,
          { input. current_prompt_string. value ...................... } ''],
          { input. state ............................................. } clc$continue_input],
          { previous_command. area ................................... } [NIL,
          { previous_command. text ................................... } NIL,
          { previous_command. lexical_units .......................... } NIL],
          { previous_command_name .................................... } osc$null_name,
          { previous_command_status .................................. } [TRUE],
          { proc_name ................................................ } osc$null_name,
          { command_proc_status ...................................... } NIL,
          { command_proc_logging_completed ........................... } FALSE,
          { command_proc_echoing_completed ........................... } FALSE,
          { function_proc_result ..................................... } NIL,
          { expected_function_proc_type .............................. } NIL,
          { when_condition ........................................... } NIL,
          { associated_utility ....................................... } NIL,
          { line_preprocessor_specified .............................. } FALSE],

{ CLC$WHILE_BLOCK }

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 0,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'WHILE',
          { kind_end_name ............................................ } 'WHILEND',
          { kind ..................................................... } clc$while_block,
          { expression_area .......................................... } NIL,
          { expression_parse. text ................................... } [NIL,
          { expression_parse. index .................................. } 1,
          { expression_parse. units_array ............................ } NIL,
          { expression_parse. units_array_index ...................... } 1,
          { expression_parse. index_limit ............................ } 1,
          { expression_parse. unit. size ............................. } [0,
          { expression_parse. unit. kind ............................. } clc$lex_end_of_line],
          { expression_parse. unit_index ............................. } 1,
          { expression_parse. unit_is_space .......................... } FALSE,
          { expression_parse. previous_unit_is_space ................. } FALSE,
          { expression_parse. previous_non_space_unit. size .......... } [0,
          { expression_parse. previous_non_space_unit. kind .......... } clc$lex_end_of_line],
          { expression_parse. previous_non_space_unit_index .......... } 1]]];


?? FMT (FORMAT := ON) ??
?? TITLE := 'clv$job_monitor_task_block', EJECT ??

{
{ This variable contains the initialized task block for the "job monitor" task.
{

?? FMT (FORMAT := OFF) ??

  VAR
    clv$job_monitor_task_block: [STATIC, oss$task_shared] clt$block :=

          { access_count ............................................. } [0,
          { assignment_counter ....................................... } 1,
          { previous_block ........................................... } NIL,
          { static_link .............................................. } NIL,
          { started_application ...................................... } FALSE,
          { application_info ......................................... } NIL,
          { caller_ring .............................................. } osc$user_ring_2,
          { active_capabilities ...................................... } - $avt$conditional_capabilities [],
          { interpreter_mode ......................................... } clc$interpret_mode,
          { variables. hash_groups ................................... } [[REP clc$max_variable_hash_groups of
          { variables. hash_groups. procedure_variables_in_group ..... } [0,
          { variables. hash_groups. environment_variables_in_group ... } 0,
          { variables. hash_groups. root ............................. } NIL]],
          { variables. thread ........................................ } NIL],
          { parameters. area ......................................... } [NIL,
          { parameters. evaluated .................................... } TRUE,
          { parameters. names ........................................ } NIL,
          { parameters. procedure_parameters ......................... } FALSE,
          { parameters. unbundled_pdt ................................ } NIL,
          { parameters. command_status_variable ...................... } NIL,
          { parameters. parameter_value_table ........................ } NIL],
          { source. index ............................................ } [1,
          { source. size ............................................. } 0,
          { source. reference_index .................................. } 1,
          { source. reference_size ................................... } 0,
          { source. ordinal .......................................... } 1,
          { source. function_interface ............................... } clc$fi_contemporary,
          { source. kind ............................................. } clc$system_commands,
          { source. system_command_table ............................. } NIL],
          { use_command_search_mode .................................. } TRUE,
          { prompting_requested ...................................... } FALSE,
          { established_handler_info. any_condition_handler .......... } [NIL,
          { established_handler_info. any_fault_handler .............. } NIL,
          { established_handler_info. specific_handler_count ......... } 0,
          { established_handler_info. specific_handlers .............. } NIL],
          { environment_object_info .................................. } NIL,
          { line_identifier. byte_address ............................ } [0,
          { line_identifier. record_number ........................... } 0,
          { line_identifier. line_number_size ........................ } 0,
          { line_identifier. line_number ............................. } '',
          { line_identifier. statement_identifier_size ............... } 0,
          { line_identifier. statement_identifier .................... } ''],
          { line_parse. text ......................................... } [NIL,
          { line_parse. index ........................................ } 1,
          { line_parse. units_array .................................. } NIL,
          { line_parse. units_array_index ............................ } 1,
          { line_parse. index_limit .................................. } 1,
          { line_parse. unit. size ................................... } [0,
          { line_parse. unit. kind ................................... } clc$lex_end_of_line],
          { line_parse. unit_index ................................... } 1,
          { line_parse. unit_is_space ................................ } FALSE,
          { line_parse. previous_unit_is_space ....................... } FALSE,
          { line_parse. previous_non_space_unit. size ................ } [0,
          { line_parse. previous_non_space_unit. kind ................ } clc$lex_end_of_line],
          { line_parse. previous_non_space_unit_index ................ } 1],
          { input_can_be_echoed ...................................... } FALSE,
          { being_exited ............................................. } FALSE,
          { exit_position. defined ................................... } [FALSE],
          { inheriting_block ......................................... } NIL,
          { label .................................................... } osc$null_name,
          { kind_name ................................................ } 'job',
          { kind_end_name ............................................ } 'end_of_job',
          { kind ..................................................... } clc$task_block,
          { task_id .................................................. } 0,
          { task_kind ................................................ } clc$job_monitor_task,
          { task_link ................................................ } NIL,
          { application_task_link .................................... } NIL,
          { parent ................................................... } NIL,
          { current_block ............................................ } ^clv$job_monitor_task_block,
          { display_log_indices ...................................... } [REP 3 of
          { display_log_indices. last_log_entry ...................... } [0,
          { display_log_indices. last_display_log_entry .............. } 0,
          { display_log_indices. last_log_cycle ...................... } 0]],
          { synchronous_with_job ..................................... } TRUE,
          { synchronous_with_parent .................................. } FALSE,
          { command_file ............................................. } osc$null_name,
          { named_task_list .......................................... } NIL,
          { default_session_file ..................................... } ^osv$timesharing_terminal_file];

  VAR
    osv$timesharing_terminal_file: [STATIC, READ, oss$job_paged_literal] amt$local_file_name :=
          osc$timesharing_terminal_file;

?? FMT (FORMAT := ON) ??
?? TITLE := 'clv$processing_phase', EJECT ??

{
{ This variable contains the current phase of a job execution, from the
{ clc$job_begin_phase through the clc$job_end_phase.  The user's phase is
{ clc$command_phase.  The other phase's designate the prolog's and epilog's.
{

  VAR
    clv$processing_phase: [XDCL, #GATE, oss$task_shared] clt$processing_phase := clc$job_begin_phase;

?? TITLE := 'clv$initial_application', EJECT ??

{
{ This variable contains the definition of the initial application to be
{ executed within the job.
{

  VAR
    clv$initial_application: [XDCL, #GATE, oss$task_shared] clt$initial_application := [FALSE];

?? TITLE := 'clv$task_list', EJECT ??

{
{ This variable contains information that enables tasks to locate the
{ clt$block's that belong to them.  The HEAD field points to the first entry in
{ the linked list of clc$task_block's.  The LOCK field is used to lock the task
{ list when it is being searched or updated.  The CURRENT_JOB_SYNCHRONOUS_TASK
{ field points to the clt$block for the "innermost" task in the job that is
{ running synchronously with the job's "job monitor" task.  This is needed to
{ determine which task in a job should receive interactive conditions.
{

  VAR
    clv$task_list: [XDCL, oss$task_shared] clt$task_list := [NIL, [0], NIL];

?? TITLE := 'clv$user_identification', EJECT ??

{
{ This variable contains information about the user, i.e. the user name, user
{ name size, family name, and family name size.
{

  VAR
    clv$user_identification: [XDCL, #GATE, oss$task_shared] clt$user_identification := [[0, ''], [0, '']];

?? TITLE := 'clv$ijl_ordinal', EJECT ??

{
{ This variable contains the IJL ordinal for the job. It is used to emit the
{ ijl ordinal as part of the user keypoints.

  VAR
    clv$ijl_ordinal: [XDCL, #GATE, oss$task_shared] jmt$ijl_ordinal := [0, 0];

?? TITLE := 'clv$unique_name', EJECT ??

{
{ This variable contains a unique name generated via pmp$get_unique_name.
{

  VAR
    clv$unique_name: [XDCL, #GATE, oss$task_shared] ost$name := osc$null_name;

?? TITLE := 'clv$current_task_block', EJECT ??

{
{ This variable contains the pointer to the clc$task_block for the current
{ task.  It is initialized by clp$find_task_block_first_time (see below).
{

  VAR
    clv$current_task_block: [XDCL, #GATE, oss$task_private] ^clt$block := NIL;

?? TITLE := 'clv$block_assignment_counter', EJECT ??

{
{ This variable is incremented (via osp$increment_locked_variable) every time
{ a new block is created.  The incremented value is then assigned to the
{ assignment_counter field of the new block.  When a block is freed its
{ assignment_counter field is zeroed.  This field therefore can serve as a
{ check that the expected block has been located, e.g. via a clt$block_handle.
{

  VAR
    clv$block_assignment_counter: [STATIC, oss$task_shared] integer := 1;

?? TITLE := 'clv$task_name', EJECT ??

{
{ This variable contains the name of the current task.
{

  VAR
    clv$task_name: [XDCL, #GATE, oss$task_private] ost$name := osc$null_name;

?? TITLE := 'clv$default_session_file', EJECT ??



{
{ This variable contains a pointer to the default interaction "session file"
{ to be used by this task.
{ It is initialized by clp$find_def_ses_file_1st_time (see below).
{

  VAR
    clv$default_session_file: [XDCL, oss$task_private] ^fst$file_reference := NIL;

?? TITLE := 'clv$applications_active', EJECT ??


{
{ This variable contains an integer value that contains the number of
{ applications active in the job.
{

  VAR
    clv$applications_active: [XDCL, #GATE, oss$task_shared] ost$non_negative_integers := 0;

?? TITLE := 'last_scheduled_application', EJECT ??


{
{ This variable contains a pointer to the most recent block which has special
{ application scheduling.
{

  VAR
    last_scheduled_application: [STATIC, oss$task_shared] record
      lock: ost$signature_lock,
      block: ^clt$block,
    recend := [[0], NIL];

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

{
{ PURPOSE:
{   This procedure is called the first time in a task that the task's clc$task_block is needed.
{   It is only called by clp$find_task_block.
{   If the task list is empty, then this procedure assumes it is being called within the job monitor task
{   for a job and creates a task block for itself and initializes the task list to contain that block.
{

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

    VAR
      current_task_id: pmt$task_id,
      ignore_task_link: ^^clt$block,
      prog_options_and_libraries: ^pmt$prog_options_and_libraries;


    pmp$get_task_id (current_task_id, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    osp$set_job_signature_lock (clv$task_list.lock);

    IF clv$task_list.head <> NIL THEN
      search_task_list (current_task_id, clv$current_task_block, ignore_task_link);
    ELSE
      ?IF clc$compiling_for_test_harness THEN
        ALLOCATE clv$current_task_block IN osv$task_shared_heap^;
        clv$current_task_block^ := clv$job_monitor_task_block;
        clv$current_task_block^.current_block := clv$current_task_block;
      ?ELSE
        clv$current_task_block := ^clv$job_monitor_task_block;
      ?IFEND;
      clv$current_task_block^.caller_ring := avp$ring_nominal ();
      clv$current_task_block^.task_id := current_task_id;
      clp$init_all_environment (clv$current_task_block^.environment_object_info);
      pmp$find_prog_options_and_libs (prog_options_and_libraries);
      pmp$init_default_prog_options (prog_options_and_libraries^.default_options, status);
      IF NOT status.normal THEN
        osp$clear_job_signature_lock (clv$task_list.lock);
        RETURN; {----->
      IFEND;
      clv$task_list.head := clv$current_task_block;
    IFEND;

    osp$clear_job_signature_lock (clv$task_list.lock);

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

    task_block := clv$current_task_block;

  PROCEND clp$find_task_block_first_time;
?? TITLE := 'clp$find_def_ses_file_1st_time', EJECT ??

{
{ PURPOSE:
{   This procedure is called the first time in a task that the task's default
{   interactive "sesion file" is needed.
{   It is only called by clp$find_default_session_file.
{


  PROCEDURE [XDCL] clp$find_def_ses_file_1st_time
    (VAR default_session_file: ^fst$file_reference);

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


    clp$find_task_block (block, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to get pointer to SCL Task Block', ^status);
    IFEND;

    WHILE block^.synchronous_with_parent OR (block^.default_session_file = NIL) DO
      block := block^.parent;
    WHILEND;

    clv$default_session_file := block^.default_session_file;
    default_session_file := clv$default_session_file;

  PROCEND clp$find_def_ses_file_1st_time;

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

{
{ PURPOSE:
{   This procedure is called when the job is begun in order to retrieve the user identification
{   information, the user ijl ordinal and a unique name for later references.
{

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

    VAR
      user_id: ost$user_identification;


    status.normal := TRUE;
    ?IF NOT clc$compiling_for_test_harness THEN
      clv$ijl_ordinal := jmv$jcb.ijl_ordinal;
    ?IFEND

    pmp$get_user_identification (user_id, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    clv$user_identification.user.value := user_id.user;
    clv$user_identification.user.size := osc$max_name_size;
    WHILE (clv$user_identification.user.size > 1) AND (clv$user_identification.user.
          value (clv$user_identification.user.size) = ' ') DO
      clv$user_identification.user.size := clv$user_identification.user.size - 1;
    WHILEND;
    clv$user_identification.family.value := user_id.family;
    clv$user_identification.family.size := osc$max_name_size;
    WHILE (clv$user_identification.family.size > 1) AND (clv$user_identification.family.
          value (clv$user_identification.family.size) = ' ') DO
      clv$user_identification.family.size := clv$user_identification.family.size - 1;
    WHILEND;

    pmp$get_unique_name (clv$unique_name, status);

  PROCEND clp$get_user_identification;
?? TITLE := 'search_task_list', EJECT ??

  PROCEDURE [INLINE] search_task_list
    (    task_id: pmt$task_id;
     VAR task_block: ^clt$block;
     VAR task_link: ^^clt$block);


    task_link := ^clv$task_list.head;
    task_block := clv$task_list.head;
    WHILE (task_block <> NIL) AND (task_block^.task_id <> task_id) DO
      task_link := ^task_block^.task_link;
      task_block := task_link^;
    WHILEND;

  PROCEND search_task_list;
?? TITLE := 'clp$record_child_task', EJECT ??
*copyc clh$record_child_task

  PROCEDURE [XDCL] clp$record_child_task
    (    caller_ring: ost$valid_ring;
         child_task_id: pmt$task_id;
         synchronous_with_parent: boolean;
         command_file: amt$local_file_name;
     VAR status: ost$status);

    VAR
      ignore_access_count: integer,
      ignore_cmnd_list_found_in_task: boolean,
      parent_task_block: ^clt$block,
      child_task_block: ^clt$block;


    status.normal := TRUE;

  /record_child_task/
    BEGIN
      clp$find_task_block (parent_task_block, status);
      IF NOT status.normal THEN
        EXIT /record_child_task/; {----->
      IFEND;

      create_block (clc$task_block, parent_task_block, child_task_block);

      child_task_block^.caller_ring := caller_ring;
      child_task_block^.task_id := child_task_id;
      child_task_block^.parent := parent_task_block;
      child_task_block^.current_block := child_task_block;
      child_task_block^.display_log_indices := parent_task_block^.display_log_indices;
      child_task_block^.synchronous_with_job := parent_task_block^.synchronous_with_job AND
            synchronous_with_parent;
      child_task_block^.synchronous_with_parent := synchronous_with_parent;

      IF NOT synchronous_with_parent THEN
        IF child_task_block^.previous_block^.application_info = NIL THEN
          child_task_block^.previous_block := parent_task_block;
        ELSE

        /find_previous_block_for_appl/
          WHILE TRUE DO
            CASE child_task_block^.previous_block^.kind OF
            = clc$task_block =
              EXIT /find_previous_block_for_appl/; {----->
            = clc$command_block, clc$command_proc_block =
              IF child_task_block^.previous_block^.started_application THEN
                EXIT /find_previous_block_for_appl/; {----->
              IFEND;
            ELSE
              ;
            CASEND;
            child_task_block^.previous_block := child_task_block^.previous_block^.previous_block;
          WHILEND /find_previous_block_for_appl/;
          child_task_block^.application_info := child_task_block^.previous_block^.application_info;
        IFEND;

        child_task_block^.command_file := command_file;

        clp$push_all_environment (child_task_block, status);
        IF NOT status.normal THEN
          FREE child_task_block IN osv$task_shared_heap^;
          EXIT /record_child_task/; {----->
        IFEND;
      IFEND;

      osp$set_job_signature_lock (clv$task_list.lock);
      child_task_block^.task_link := clv$task_list.head;
      clv$task_list.head := child_task_block;
      IF child_task_block^.synchronous_with_job THEN
        clv$task_list.current_job_synchronous_task := child_task_block;
      IFEND;
      osp$clear_job_signature_lock (clv$task_list.lock);

      IF child_task_block^.previous_block^.started_application THEN
        osp$set_job_signature_lock (child_task_block^.application_info^.lock);
        child_task_block^.application_task_link := child_task_block^.previous_block^.application_info^.
              task_link_head;
        child_task_block^.previous_block^.application_info^.task_link_head := child_task_block;
        osp$clear_job_signature_lock (child_task_block^.application_info^.lock);
      IFEND;

      osp$increment_locked_variable (child_task_block^.previous_block^.access_count, 0, ignore_access_count);
    END /record_child_task/;

  PROCEND clp$record_child_task;
?? TITLE := 'clp$erase_child_task', EJECT ??
*copyc clh$erase_child_task

  PROCEDURE [XDCL] clp$erase_child_task
    (    child_task_id: pmt$task_id;
     VAR status: ost$status);

    VAR
      child_task_block: ^clt$block,
      child_task_link: ^^clt$block,
      current_child_block: ^clt$block,
      current_task_link: ^clt$block,
      ignore_status: ^ost$status,
      local_status: ost$status,
      parent_task_block: ^clt$block,
      previous_child_block: ^clt$block,
      synchronous_with_job: boolean,
      synchronous_with_parent: boolean;


    status.normal := TRUE;

  /erase_child_task/
    BEGIN
      osp$set_job_signature_lock (clv$task_list.lock);
      search_task_list (child_task_id, child_task_block, child_task_link);
      child_task_link^ := child_task_block^.task_link;
      synchronous_with_parent := child_task_block^.synchronous_with_parent;
      synchronous_with_job := child_task_block^.synchronous_with_job;
      IF synchronous_with_job AND (child_task_block = clv$task_list.current_job_synchronous_task) THEN
        clv$task_list.current_job_synchronous_task := clv$task_list.current_job_synchronous_task^.parent;
      IFEND;
      osp$clear_job_signature_lock (clv$task_list.lock);

      IF child_task_block^.previous_block^.started_application THEN
        osp$set_job_signature_lock (child_task_block^.application_info^.lock);
        IF child_task_block^.application_info^.task_link_head <> NIL THEN
          current_task_link := child_task_block^.application_info^.task_link_head;
          IF child_task_block = current_task_link THEN
            child_task_block^.application_info^.task_link_head := child_task_block^.application_task_link;
          ELSE
            WHILE (current_task_link^.application_task_link <> NIL) AND
                  (current_task_link^.application_task_link <> child_task_block) DO
              current_task_link := current_task_link^.application_task_link;
            WHILEND;
            IF current_task_link^.application_task_link <> NIL THEN
              current_task_link^.application_task_link := current_task_link^.application_task_link^.
                    application_task_link;
            ELSE
              osp$set_status_abnormal ('CL', cle$bad_application_task_link,
                    child_task_block^.application_info^.identifier.name, local_status);
              PUSH ignore_status;
              osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], local_status,
                    ignore_status^);
            IFEND;
          IFEND;
        IFEND;
        osp$clear_job_signature_lock (child_task_block^.application_info^.lock);
      IFEND;

      parent_task_block := child_task_block^.parent;

      current_child_block := child_task_block^.current_block;
      WHILE current_child_block <> child_task_block DO
        previous_child_block := current_child_block^.previous_block;
        free_block (clc$eo_pop_for_task, current_child_block);
        current_child_block := previous_child_block;
      WHILEND;

      IF synchronous_with_parent THEN
        parent_task_block^.display_log_indices := child_task_block^.display_log_indices;
      ELSE
        parent_task_block^.display_log_indices [clc$display_system_log] :=
              child_task_block^.display_log_indices [clc$display_system_log];
      IFEND;

      free_block (clc$eo_pop_for_task, child_task_block);

      clp$update_all_environment (synchronous_with_parent, synchronous_with_job, local_status);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    END /erase_child_task/;

  PROCEND clp$erase_child_task;
?? TITLE := 'clp$find_current_job_synch_task', EJECT ??
*copyc clh$find_current_job_synch_task

  PROCEDURE [XDCL] clp$find_current_job_synch_task
    (VAR task_id: pmt$task_id;
     VAR status: ost$status);


    status.normal := TRUE;
    osp$set_job_signature_lock (clv$task_list.lock);
    IF clv$task_list.current_job_synchronous_task = NIL THEN
      pmp$get_task_id (task_id, status);
    ELSE
      task_id := clv$task_list.current_job_synchronous_task^.task_id;
    IFEND;
    osp$clear_job_signature_lock (clv$task_list.lock);

  PROCEND clp$find_current_job_synch_task;
?? TITLE := 'clp$get_processing_phase', EJECT ??

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


    status.normal := TRUE;
    processing_phase := clv$processing_phase;

  PROCEND clp$get_processing_phase;
?? TITLE := 'clp$set_processing_phase', EJECT ??

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


    status.normal := TRUE;
    clv$processing_phase := processing_phase;

  PROCEND clp$set_processing_phase;
?? TITLE := 'clp$define_initial_application', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$define_initial_application
    (    application: ^clt$command_line;
         logout_upon_termination: boolean;
     VAR status: ost$status);


    status.normal := TRUE;

    IF clv$processing_phase > clc$user_prolog_phase THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'DEFINE_INITIAL_APPLICATION', status);
      RETURN; {----->
    IFEND;

    IF clv$initial_application.defined THEN
      FREE clv$initial_application.application IN osv$task_shared_heap^;
      clv$initial_application.defined := FALSE;
    IFEND;

    IF application <> NIL THEN
      clv$initial_application.defined := TRUE;
      ALLOCATE clv$initial_application.application: [STRLENGTH (application^)] IN osv$task_shared_heap^;
      clv$initial_application.application^ := application^;
      clv$initial_application.logout_upon_termination := logout_upon_termination;
    IFEND;

  PROCEND clp$define_initial_application;
?? TITLE := 'clp$set_primary_task', EJECT ??

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

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


    status.normal := TRUE;
    clp$find_task_block (task_block, local_status);
    IF NOT local_status.normal THEN
      osp$system_error ('Unable to get pointer to SCL Task Block', ^local_status);
    IFEND;
    osp$set_job_signature_lock (clv$task_list.lock);
    task_block^.synchronous_with_job := TRUE;
    clv$task_list.current_job_synchronous_task := task_block;
    osp$clear_job_signature_lock (clv$task_list.lock);

  PROCEND clp$set_primary_task;
?? TITLE := 'clp$get_synchronous_with_parent', EJECT ??
*copyc clh$get_synchronous_with_parent

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

    VAR
      block: ^clt$block;

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

    synchronous_with_parent := block^.synchronous_with_parent;

  PROCEND clp$get_synchronous_with_parent;
?? TITLE := 'clp$push_block_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_block_block
    (    label: ost$name;
     VAR block_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$block_block, block);

    block^.label := label;

    block_block := block;

  PROCEND clp$push_block_block;
?? TITLE := 'clp$push_case_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_case_block
    (    selection_value: ^clt$internal_data_value;
     VAR case_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$case_block, block);

    IF selection_value <> NIL THEN
      ALLOCATE block^.case_selection_value: [[REP #SIZE (selection_value^.allocated_space) OF cell]] IN
            osv$task_shared_heap^;
      block^.case_selection_value^ := selection_value^;
    IFEND;

    case_block := block;

  PROCEND clp$push_case_block;
?? TITLE := 'clp$push_check_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_check_block
    (    parameter_name: clt$parameter_name;
     VAR check_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$check_block, block);

    block^.label := parameter_name;

    check_block := block;

  PROCEND clp$push_check_block;
?? TITLE := 'clp$push_command_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_command_block
    (    caller_ring: ost$valid_ring;
         command_name: clt$command_name;
         command_source: clt$command_or_function_source;
         command_logging_completed: boolean;
         command_echoing_completed: boolean;
         prompting_requested: boolean;
         command_kind: clt$command_kind;
         parameter_list_parse: clt$parse_state;
     VAR command_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier;

    push_block (clc$command_block, block);

    #CALLER_ID (caller_id);
    IF caller_ring > caller_id.ring THEN
      block^.caller_ring := caller_ring;
    ELSE
      block^.caller_ring := caller_id.ring;
    IFEND;
    block^.line_parse := parameter_list_parse;
    save_parameter_list (block);
    block^.source := command_source;
    block^.prompting_requested := prompting_requested;
    block^.label := command_name;
    block^.command_kind := command_kind;
    block^.command_logging_completed := command_logging_completed;
    block^.command_echoing_completed := command_echoing_completed;

    command_block := block;

  PROCEND clp$push_command_block;
?? TITLE := 'clp$push_command_proc_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_command_proc_block
    (    caller_ring: ost$valid_ring;
         command_name: clt$command_name;
         command_source: clt$command_or_function_source;
         command_proc_logging_completed: boolean;
         command_proc_echoing_completed: boolean;
         prompting_requested: boolean;
         proc_can_be_echoed: boolean;
         file_name: fst$path_handle_name;
         file_id: amt$file_identifier;
         line_layout: clt$line_layout;
         proc_data: ^clt$input_data;
         proc_data_version: clt$declaration_version;
         device_class: rmt$device_class;
     VAR command_proc_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier;

    push_block (clc$command_proc_block, block);

    #CALLER_ID (caller_id);
    IF caller_ring > caller_id.ring THEN
      block^.caller_ring := caller_ring;
    ELSE
      block^.caller_ring := caller_id.ring;
    IFEND;
    block^.interpreter_mode := clc$interpret_mode;
    block^.source := command_source;
    block^.prompting_requested := prompting_requested;
    block^.label := command_name;

    block^.input_can_be_echoed := proc_can_be_echoed;
    block^.input.local_file_name := file_name;
    block^.input.file_id := file_id;
    block^.input.data := proc_data;
    IF proc_data <> NIL THEN
      block^.input.line_address := i#current_sequence_position (proc_data);
      IF proc_data_version = 0 THEN
        block^.input.get_command_line := ^clp$get_segment_cmnd_line_v0;
        block^.input.get_line := ^clp$get_segment_line_v0;
      ELSE
        block^.input.get_command_line := ^clp$get_segment_cmnd_line;
        block^.input.get_line := ^clp$get_segment_line;
      IFEND;
      block^.input.file_rereadable := TRUE;
    ELSE
      block^.input.line_layout := line_layout;
      block^.input.get_command_line := ^clp$get_standard_cmnd_line;
      block^.input.get_line := ^clp$get_standard_line;
      block^.input.file_rereadable := device_class = rmc$mass_storage_device;
      block^.input.device_class := device_class;
    IFEND;
    block^.command_proc_logging_completed := command_proc_logging_completed;
    block^.command_proc_echoing_completed := command_proc_echoing_completed;

    command_proc_block := block;

  PROCEND clp$push_command_proc_block;
?? TITLE := 'clp$push_edit_parameters_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_edit_parameters_block
    (    max_string: clt$string_size;
     VAR edit_parameters_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$command_block, block);

    block^.interpreter_mode := clc$help_mode;
    block^.label := 'CLP$EDIT_COMMAND_PARAMETER_LIST';
    block^.edited_parameters_max_size := max_string;

    edit_parameters_block := block;

  PROCEND clp$push_edit_parameters_block;
?? TITLE := 'clp$push_for_incremental_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_for_incremental_block
    (    label: ost$name;
         variable: ^clt$variable_ref_expression;
         initial: clt$integer;
         limit: integer;
         increment: integer;
     VAR for_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$for_block, block);

    capture_input_position (block, block^.line_identifier, block^.line_parse);
    block^.label := label;
    ALLOCATE block^.for_variable: [STRLENGTH (variable^)] IN osv$task_shared_heap^;
    block^.for_variable^ := variable^;
    block^.for_control.style := clc$for_control_incremental;
    block^.for_control.value := initial;
    block^.for_control.limit := limit;
    block^.for_control.increment := increment;

    for_block := block;

  PROCEND clp$push_for_incremental_block;
?? TITLE := 'clp$push_for_list_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_for_list_block
    (    label: ost$name;
         variable: ^clt$variable_ref_expression;
         list: ^clt$internal_data_value;
     VAR for_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$for_block, block);

    block^.label := label;
    IF list = NIL THEN
      block^.interpreter_mode := clc$skip_mode;
      block^.being_exited := TRUE;
      block^.for_control.list := NIL;
    ELSE
      capture_input_position (block, block^.line_identifier, block^.line_parse);
      ALLOCATE block^.for_variable: [STRLENGTH (variable^)] IN osv$task_shared_heap^;
      block^.for_variable^ := variable^;
      block^.for_control.style := clc$for_control_list;
      ALLOCATE block^.for_control.list: [[REP #SIZE (list^.allocated_space) OF cell]] IN
            osv$task_shared_heap^;
      block^.for_control.list^ := list^;
    IFEND;

    for_block := block;

  PROCEND clp$push_for_list_block;
?? TITLE := 'clp$push_function_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_function_block
    (    caller_ring: ost$valid_ring;
         function_name: ost$name;
         function_source: clt$command_or_function_source;
         parameter_list_parse: clt$parse_state;
         expected_result_type: ^clt$type_description;
     VAR function_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier;

    push_block (clc$function_block, block);

    #CALLER_ID (caller_id);
    IF caller_ring > caller_id.ring THEN
      block^.caller_ring := caller_ring;
    ELSE
      block^.caller_ring := caller_id.ring;
    IFEND;
    block^.line_parse := parameter_list_parse;
    save_parameter_list (block);
    block^.source := function_source;
    block^.prompting_requested := block^.previous_block^.prompting_requested AND
          (NOT block^.previous_block^.parameters.evaluated);
    block^.label := function_name;

    block^.expected_function_type := expected_result_type;

    function_block := block;

  PROCEND clp$push_function_block;
?? TITLE := 'clp$push_function_proc_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_function_proc_block
    (    caller_ring: ost$valid_ring;
         function_name: ost$name;
         function_source: clt$command_or_function_source;
         proc_can_be_echoed: boolean;
         file_name: fst$path_handle_name;
         file_id: amt$file_identifier;
         proc_data: ^clt$input_data;
         expected_result_type: ^clt$type_specification;
     VAR function_proc_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier;

    push_block (clc$function_proc_block, block);

    #CALLER_ID (caller_id);
    IF caller_ring > caller_id.ring THEN
      block^.caller_ring := caller_ring;
    ELSE
      block^.caller_ring := caller_id.ring;
    IFEND;
    block^.interpreter_mode := clc$interpret_mode;
    block^.source := function_source;
    block^.prompting_requested := block^.previous_block^.prompting_requested AND
          (NOT block^.previous_block^.parameters.evaluated);

    block^.input_can_be_echoed := proc_can_be_echoed;
    block^.input.local_file_name := file_name;
    block^.input.file_id := file_id;
    block^.input.data := proc_data;
    block^.input.line_address := i#current_sequence_position (proc_data);
    block^.input.get_command_line := ^clp$get_segment_cmnd_line;
    block^.input.get_line := ^clp$get_segment_line;
    block^.input.file_rereadable := TRUE;

    IF expected_result_type <> NIL THEN
      ALLOCATE block^.expected_function_proc_type: [[REP #SIZE (expected_result_type^) OF cell]] IN
            osv$task_shared_heap^;
      block^.expected_function_proc_type^ := expected_result_type^;
    IFEND;

    function_proc_block := block;

  PROCEND clp$push_function_proc_block;
?? TITLE := 'clp$push_if_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_if_block
    (    condition_met: boolean;
     VAR if_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$if_block, block);

    IF NOT condition_met THEN
      block^.interpreter_mode := clc$skip_mode;
    IFEND;
    block^.if_condition_met := condition_met;

    if_block := block;

  PROCEND clp$push_if_block;
?? TITLE := 'clp$push_input_$command_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_input_$command_block
    (    inherited_input_block_offset: ost$segment_offset;
         utility_name: clt$utility_name;
         prompt_string: clt$prompt_string;
         file_id: amt$file_identifier;
         data: ^clt$input_data;
         input_can_be_echoed: boolean;
         inherited_input_in_current_task: boolean;
     VAR input_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier,
      ignore_access_count: integer,
      inherited_input_block: ^clt$block,
      status: ^ost$status,
      utility_block: ^clt$block;

    IF utility_name <> osc$null_name THEN
      find_associated_utility (utility_name, utility_block);
    IFEND;

    push_block (clc$input_block, block);

    #CALLER_ID (caller_id);
    block^.caller_ring := caller_id.ring;
    block^.interpreter_mode := clc$interpret_mode;
    block^.input_can_be_echoed := input_can_be_echoed;
    IF utility_name <> osc$null_name THEN
      block^.label := utility_name;
      associate_input_with_utility (block, utility_block);
    ELSEIF (block^.previous_block^.kind = clc$task_block) AND
          (block^.previous_block^.task_kind = clc$job_monitor_task) THEN
      block^.established_handler_info := block^.previous_block^.established_handler_info;
      block^.previous_block^.established_handler_info := clv$initial_blocks [clc$task_block].
            established_handler_info;
    IFEND;

  /find_caller_input/
    BEGIN
      inherited_input_block := block^.previous_block;
      WHILE inherited_input_block <> NIL DO
        IF inherited_input_block_offset = #OFFSET (inherited_input_block) THEN
          EXIT /find_caller_input/; {----->
        IFEND;
        inherited_input_block := inherited_input_block^.previous_block;
      WHILEND;
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$push_input_block', status^);
      pmp$abort (status^);
    END /find_caller_input/;

    block^.inherited_input.found := TRUE;
    block^.inherited_input.block := inherited_input_block;
    osp$increment_locked_variable (block^.inherited_input.block^.access_count, 1, ignore_access_count);

    block^.use_command_search_mode := block^.inherited_input.block^.use_command_search_mode;
    block^.line_identifier := block^.inherited_input.block^.line_identifier;
    block^.line_parse := block^.inherited_input.block^.line_parse;
    block^.inherited_input.in_current_task := inherited_input_in_current_task;
    block^.inherited_input.block^.inheriting_block := block;
    block^.input := block^.inherited_input.block^.input;
    block^.input.internal := FALSE;

    IF block^.input.kind <> clc$line_input THEN
      IF (NOT inherited_input_in_current_task) AND (block^.input.kind = clc$file_input) THEN
        block^.input.file_id := file_id;
        block^.input.data := data;
      IFEND;

      IF block^.input.interactive_device THEN
        clp$set_prompt_string (block, prompt_string);
        IF block^.input.device_class = rmc$terminal_device THEN
          set_prompt_file_identifier (block^.input.file_id);
        IFEND;
        IF (NOT inherited_input_in_current_task) AND (block^.input.kind = clc$file_input) THEN
          block^.input.current_prompt_string.size := 0;
          block^.input.current_prompt_string.value := '';
        IFEND;
      IFEND;
    IFEND;

    input_block := block;

  PROCEND clp$push_input_$command_block;
?? TITLE := 'clp$push_input_file_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_input_file_block
    (    file_name: fst$path_handle_name;
         file_id: amt$file_identifier;
         utility_name: clt$utility_name;
         prompt_string: clt$prompt_string;
         input_can_be_echoed: boolean;
         line_layout: clt$line_layout;
         device_class: rmt$device_class;
         file_has_fap: boolean;
         process_utility_end_include: boolean;
     VAR input_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier,
      ignore_access_count: integer,
      inherited_input_block: ^clt$block,
      utility_block: ^clt$block;

    IF utility_name <> osc$null_name THEN
      find_associated_utility (utility_name, utility_block);
    IFEND;

    push_block (clc$input_block, block);

    #CALLER_ID (caller_id);
    block^.caller_ring := caller_id.ring;
    block^.interpreter_mode := clc$interpret_mode;
    block^.use_command_search_mode := TRUE;
    block^.input_can_be_echoed := input_can_be_echoed;
    IF utility_name <> osc$null_name THEN
      IF process_utility_end_include THEN
        block^.label := utility_name;
      IFEND;
      associate_input_with_utility (block, utility_block);
    ELSEIF (block^.previous_block^.kind = clc$task_block) AND
          (block^.previous_block^.task_kind = clc$job_monitor_task) THEN
      block^.established_handler_info := block^.previous_block^.established_handler_info;
      block^.previous_block^.established_handler_info := clv$initial_blocks [clc$task_block].
            established_handler_info;
    IFEND;

    block^.input.local_file_name := file_name;
    block^.input.file_id := file_id;

    IF block^.input.local_file_name = clv$standard_files [clc$sf_null_file].path_handle_name THEN
      block^.input.device_class := rmc$null_device;
      block^.input.get_command_line := ^clp$get_non_standard_cmnd_line;
      block^.input.get_line := ^clp$get_non_standard_line;
      block^.input.state := clc$end_of_input;
    ELSE
      block^.input.line_layout := line_layout;
      IF jmp$job_file_fap (file_name) <> NIL THEN
        block^.input.interactive_device := TRUE;
        block^.input.device_class := rmc$null_device;
      ELSE
        block^.input.device_class := device_class;
        block^.input.interactive_device := block^.input.device_class = rmc$terminal_device;
        block^.input.file_rereadable := block^.input.device_class = rmc$mass_storage_device;
      IFEND;


      IF (block^.input.device_class = rmc$mass_storage_device) AND
            (block^.input.line_layout.element [2].kind = clc$null_line_element) AND (NOT file_has_fap) THEN
        block^.input.get_command_line := ^clp$get_standard_cmnd_line;
        block^.input.get_line := ^clp$get_standard_line;
      ELSE
        block^.input.get_command_line := ^clp$get_non_standard_cmnd_line;
        block^.input.get_line := ^clp$get_non_standard_line;
      IFEND;
    IFEND;

    IF block^.input.interactive_device THEN
      clp$set_prompt_string (block, prompt_string);
      IF block^.input.device_class = rmc$terminal_device THEN
        set_prompt_file_identifier (block^.input.file_id);
      IFEND;
    IFEND;

    input_block := block;

  PROCEND clp$push_input_file_block;
?? TITLE := 'clp$push_input_internal_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_input_internal_block
    (    utility_name: clt$utility_name;
         input_can_be_echoed: boolean;
         input_data: ^clt$input_data;
     VAR internal_input_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier,
      utility_block: ^clt$block;

    IF utility_name <> osc$null_name THEN
      find_associated_utility (utility_name, utility_block);
    IFEND;

    push_block (clc$input_block, block);

    #CALLER_ID (caller_id);
    block^.caller_ring := caller_id.ring;
    block^.interpreter_mode := clc$interpret_mode;
    block^.input_can_be_echoed := input_can_be_echoed;
    IF utility_name <> osc$null_name THEN
      block^.label := utility_name;
      associate_input_with_utility (block, utility_block);
    ELSEIF (block^.previous_block^.kind = clc$task_block) AND
          (block^.previous_block^.task_kind = clc$job_monitor_task) THEN
      block^.established_handler_info := block^.previous_block^.established_handler_info;
      block^.previous_block^.established_handler_info := clv$initial_blocks [clc$task_block].
            established_handler_info;
    IFEND;

    block^.input.internal := TRUE;
    block^.input.kind := clc$sequence_input;
    clp$save_collect_statement_area (input_data, block^.input.data);
    block^.input.line_address := i#current_sequence_position (input_data);
    block^.input.get_command_line := ^clp$get_segment_cmnd_line;
    block^.input.get_line := ^clp$get_segment_line;
    block^.input.file_rereadable := TRUE;

    internal_input_block := block;

  PROCEND clp$push_input_internal_block;
?? TITLE := 'clp$push_input_line_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_input_line_block
    (    utility_name: clt$utility_name;
         input_can_be_echoed: boolean;
         statement_list: ^clt$command_line;
         lexical_units: ^clt$lexical_units;
     VAR input_line_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier,
      utility_block: ^clt$block;

    IF utility_name <> osc$null_name THEN
      find_associated_utility (utility_name, utility_block);
    IFEND;

    push_block (clc$input_block, block);

    #CALLER_ID (caller_id);
    block^.caller_ring := caller_id.ring;
    block^.interpreter_mode := clc$interpret_mode;
    block^.use_command_search_mode := TRUE;
    block^.input_can_be_echoed := input_can_be_echoed;
    IF utility_name <> osc$null_name THEN
      block^.label := utility_name;
      associate_input_with_utility (block, utility_block);
    ELSEIF (block^.previous_block^.kind = clc$task_block) AND
          (block^.previous_block^.task_kind = clc$job_monitor_task) THEN
      block^.established_handler_info := block^.previous_block^.established_handler_info;
      block^.previous_block^.established_handler_info := clv$initial_blocks [clc$task_block].
            established_handler_info;
    IFEND;

    clp$store_expandable_string (statement_list, lexical_units, block^.input.line);
    clp$initialize_parse_state (block^.input.line.text, block^.input.line.lexical_units, block^.line_parse);
    block^.input.kind := clc$line_input;

    input_line_block := block;

  PROCEND clp$push_input_line_block;
?? TITLE := 'clp$push_loop_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_loop_block
    (    label: ost$name;
     VAR loop_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$loop_block, block);

    capture_input_position (block, block^.line_identifier, block^.line_parse);
    block^.label := label;

    loop_block := block;

  PROCEND clp$push_loop_block;
?? TITLE := 'clp$push_repeat_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_repeat_block
    (    label: ost$name;
     VAR repeat_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$repeat_block, block);

    capture_input_position (block, block^.line_identifier, block^.line_parse);
    block^.label := label;

    repeat_block := block;

  PROCEND clp$push_repeat_block;
?? TITLE := 'clp$push_sub_parameters_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_sub_parameters_block
    (    lookup_functions_and_variables: boolean);

    VAR
      block: ^clt$block;

    push_block (clc$sub_parameters_block, block);

    block^.lookup_functions_and_variables := lookup_functions_and_variables;

  PROCEND clp$push_sub_parameters_block;
?? TITLE := 'clp$push_utility_block', EJECT ??

  PROCEDURE [XDCL] clp$push_utility_block
    (    utility_name: clt$utility_name;
     VAR utility_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$utility_block, block);

    block^.label := utility_name;

    utility_block := block;

  PROCEND clp$push_utility_block;
?? TITLE := 'clp$push_when_input_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_when_input_block
    (    condition_definition: clt$when_condition_definition;
         exit_on_continue_condition: boolean;
         default_handler: ^procedure (VAR status: ost$status);
         command: ^clt$command_line;
         command_name: clt$command_name;
         handler_statements: ^clt$established_handler_stmnts;
         static_link_handle: clt$block_handle;
     VAR when_block: ^clt$block);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier,
      command_string: ^clt$command_line,
      ignore_block_in_current_task: boolean,
      ignore_block_is_synchronous: boolean;


    ?IF NOT clc$compiling_for_test_harness THEN
      osp$verify_system_privilege;
    ?IFEND;

    push_block (clc$when_block, block);

    clp$find_block_via_handle (static_link_handle, block^.static_link, ignore_block_in_current_task,
          ignore_block_is_synchronous);

    #CALLER_ID (caller_id);
    block^.caller_ring := caller_id.ring;
    block^.interpreter_mode := clc$interpret_mode;
    block^.use_command_search_mode := block^.static_link^.use_command_search_mode;
    block^.input_can_be_echoed := handler_statements^.can_be_echoed;
    block^.input.kind := clc$sequence_input;
    block^.input.get_command_line := ^clp$get_segment_cmnd_line;
    block^.input.get_line := ^clp$get_segment_line;
    block^.input.data := ^handler_statements^.statement_area;
    RESET block^.input.data;
    block^.input.file_rereadable := TRUE;

    IF command = NIL THEN
      PUSH command_string: [0];
    ELSE
      command_string := command;
    IFEND;
    ALLOCATE block^.when_condition: [STRLENGTH (command_string^)] IN osv$task_shared_heap^;
    block^.when_condition^.name := condition_definition.name;
    IF condition_definition.status.normal THEN
      block^.when_condition^.status.normal := TRUE;
    ELSE
      block^.when_condition^.status := condition_definition.status;
    IFEND;
    block^.when_condition^.limit_name := condition_definition.limit_name;
    block^.when_condition^.exit_on_continue_condition := exit_on_continue_condition;
    block^.when_condition^.default_handler := default_handler;
    block^.when_condition^.condition_processed_state := clc$continue_next;
    block^.when_condition^.command_name := command_name;
    block^.when_condition^.command := command_string^;

    clp$store_expandable_string (command_string, NIL, block^.previous_command);
    block^.previous_command_name := command_name;
    block^.previous_command_status := condition_definition.status;

    IF (condition_definition.name = clc$wc_execution_fault) OR
          (condition_definition.name = clc$wc_command_fault) THEN

{ Since an EXECUTION_FAULT condition is intended for "debugging" purposes,
{ remove the "static link" for a "when block" invoked for that condition.
{ This allows the condition handler to "see" everything at the point where
{ the error occurred (e.g. variables).
{ This is also necessary for a COMMAND_FAULT because its handler may have
{ been established in an "inherited input" block.

      block^.static_link := NIL;
    IFEND;

    when_block := block;

  PROCEND clp$push_when_input_block;
?? TITLE := 'clp$push_while_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$push_while_block
    (    label: ost$name;
         condition: boolean;
         expression_parse: clt$parse_state;
     VAR while_block: ^clt$block);

    VAR
      block: ^clt$block;

    push_block (clc$while_block, block);

    block^.label := label;
    IF NOT condition THEN
      block^.interpreter_mode := clc$skip_mode;
      block^.being_exited := TRUE;
    ELSE
      capture_input_position (block, block^.line_identifier, block^.line_parse);
      ALLOCATE block^.expression_area: [[REP STRLENGTH (expression_parse.text^) OF
            char, REP UPPERBOUND (expression_parse.units_array^) OF clt$lexical_unit]] IN
            osv$task_shared_heap^;
      RESET block^.expression_area;
      block^.expression_parse := expression_parse;
      NEXT block^.expression_parse.text: [STRLENGTH (expression_parse.text^)] IN block^.expression_area;
      block^.expression_parse.text^ := expression_parse.text^;
      NEXT block^.expression_parse.units_array: [1 .. UPPERBOUND (expression_parse.units_array^)] IN
            block^.expression_area;
      block^.expression_parse.units_array^ := expression_parse.units_array^;
    IFEND;

    while_block := block;

  PROCEND clp$push_while_block;
?? TITLE := 'push_block', EJECT ??

  PROCEDURE [INLINE] push_block
    (    block_kind: clt$block_kind;
     VAR block: ^clt$block);

    VAR
      ignore_access_count: integer,
      status: ost$status,
      task_block: ^clt$block;


    clp$find_task_block (task_block, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to get pointer to SCL Task Block', ^status);
    IFEND;

    create_block (block_kind, task_block, block);
    task_block^.current_block := block;

    osp$increment_locked_variable (block^.previous_block^.access_count, 0, ignore_access_count);

  PROCEND push_block;
?? TITLE := 'create_block', EJECT ??

  PROCEDURE [INLINE] create_block
    (    block_kind: clt$block_kind;
         task_block: ^clt$block;
     VAR new_block: ^clt$block);


    ALLOCATE new_block IN osv$task_shared_heap^;
    new_block^ := clv$initial_blocks [block_kind];

{! Subsequent to the above initialization, any further references to the
{! access_count field MUST be made via the OSP$xxx_LOCKED_VARIABLE interfaces.

    new_block^.previous_block := task_block^.current_block;
    new_block^.application_info := new_block^.previous_block^.application_info;
    new_block^.caller_ring := new_block^.previous_block^.caller_ring;
    new_block^.active_capabilities := new_block^.previous_block^.active_capabilities;
    new_block^.interpreter_mode := new_block^.previous_block^.interpreter_mode;
    new_block^.source := new_block^.previous_block^.source;
    new_block^.use_command_search_mode := new_block^.previous_block^.use_command_search_mode;
    new_block^.input_can_be_echoed := new_block^.previous_block^.input_can_be_echoed;

    osp$increment_locked_variable (clv$block_assignment_counter, 0, new_block^.assignment_counter);

  PROCEND create_block;
?? TITLE := 'find_associated_utility', EJECT ??

  PROCEDURE [INLINE] find_associated_utility
    (    utility_name: clt$utility_name;
     VAR utility_block: ^clt$block);

    VAR
      block_in_current_task: boolean,
      status: ^ost$status;


    clp$find_utility_block (utility_name, utility_block, block_in_current_task);

    IF (utility_block = NIL) OR (NOT (utility_block^.command_environment.command_level OR
          block_in_current_task)) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'find_associated_utility', status^);
      pmp$abort (status^);
    IFEND;

  PROCEND find_associated_utility;
?? TITLE := 'associate_input_with_utility', EJECT ??

  PROCEDURE [INLINE] associate_input_with_utility
    (    input_block: ^clt$block;
         utility_block: ^clt$block);

    VAR
      ignore_access_count: integer;


    utility_block^.termination_command_found := FALSE;

    input_block^.associated_utility := utility_block;
    input_block^.line_preprocessor_specified := utility_block^.line_preprocessor.call_method <>
          clc$unspecified_call;

    osp$increment_locked_variable (utility_block^.access_count, 1, ignore_access_count);

  PROCEND associate_input_with_utility;
?? TITLE := 'capture_input_position', EJECT ??

  PROCEDURE [INLINE] capture_input_position
    (    block: ^clt$block;
     VAR line_identifier: clt$line_identifier;
     VAR line_parse: clt$parse_state);

    VAR
      input_block: ^clt$block;


    input_block := block;
    WHILE (input_block <> NIL) AND (NOT (input_block^.kind IN $clt$block_kinds
          [clc$command_proc_block, clc$input_block, clc$function_proc_block, clc$when_block])) DO
      input_block := input_block^.previous_block;
    WHILEND;
    IF input_block <> NIL THEN
      line_identifier := input_block^.line_identifier;
      line_parse := input_block^.line_parse;
    IFEND;

  PROCEND capture_input_position;
?? TITLE := 'save_parameter_list', EJECT ??

  PROCEDURE [INLINE] save_parameter_list
    (    block: ^clt$block);

    VAR
      amount_to_save: integer,
      saved_text: ^clt$string_value,
      saved_units_array: ^clt$lexical_units;


    IF #SEGMENT (block^.line_parse.text) <> #SEGMENT (block) THEN
      amount_to_save := #SIZE (block^.line_parse.text^);
    ELSE
      amount_to_save := 0;
    IFEND;
    IF #SEGMENT (block^.line_parse.units_array) <> #SEGMENT (block) THEN
      amount_to_save := amount_to_save + #SIZE (block^.line_parse.units_array^);
    IFEND;

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

    ALLOCATE block^.parameters.area: [[REP amount_to_save OF cell]] IN osv$task_shared_heap^;
    RESET block^.parameters.area;
    IF #SEGMENT (block^.line_parse.text) <> #SEGMENT (block) THEN
      NEXT saved_text: [STRLENGTH (block^.line_parse.text^)] IN block^.parameters.area;
      saved_text^ := block^.line_parse.text^;
      block^.line_parse.text := saved_text;
    IFEND;
    IF #SEGMENT (block^.line_parse.units_array) <> #SEGMENT (block) THEN
      NEXT saved_units_array: [1 .. UPPERBOUND (block^.line_parse.units_array^)] IN block^.parameters.area;
      saved_units_array^ := block^.line_parse.units_array^;
      block^.line_parse.units_array := saved_units_array;
    IFEND;

  PROCEND save_parameter_list;
?? TITLE := 'set_prompt_file_identifier', EJECT ??

  PROCEDURE set_prompt_file_identifier
    (    input_file_id: amt$file_identifier);

    CONST
      default_prompt_file = '$LOCAL.OUTPUT.1';

    VAR
      connection_attributes: array [1 .. 1] of ift$connection_attribute,
      get_connection_attributes: array [1 .. 1] of ift$get_connection_attribute,
      ignore_status: ost$status;


    get_connection_attributes [1].key := ifc$prompt_file;
    get_connection_attributes [1].prompt_file := default_prompt_file;
    iip$direct_fetch_trm_conn_atts (input_file_id, get_connection_attributes, ignore_status);
    IF get_connection_attributes [1].prompt_file = default_prompt_file THEN
      connection_attributes [1].key := ifc$prompt_file_identifier;
      clp$get_system_file_id (clc$job_output, connection_attributes [1].prompt_file_identifier,
            ignore_status);
      iip$direct_store_trm_conn_atts (input_file_id, connection_attributes, ignore_status);
    IFEND;

  PROCEND set_prompt_file_identifier;
?? TITLE := 'clp$pop_block_stack', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$pop_block_stack
    (VAR current_block: ^clt$block);

    VAR
      audit_information: sft$audit_information,
      conditional_capability: avt$conditional_capability,
      deactivated_capabilities: avt$conditional_capabilities,
      task_block: ^clt$block,
      old_block: ^clt$block,
      segment_pointer: mmt$segment_pointer,
      status: ost$status;

    clp$find_task_block (task_block, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to get pointer to SCL Task Block', ^status);
    ELSEIF task_block^.current_block = task_block THEN
      osp$system_error ('Unexpected call to clp$pop_block_stack', ^status);
    IFEND;
    old_block := task_block^.current_block^.previous_block;

    IF (task_block^.current_block^.kind = clc$utility_block) AND
          (task_block^.current_block^.command_environment.dialog_info.scratch_segment <> NIL) THEN
      segment_pointer.kind := mmc$sequence_pointer;
      segment_pointer.seq_pointer := task_block^.current_block^.command_environment.dialog_info.
            scratch_segment;
      mmp$delete_segment (segment_pointer, osc$tsrv_ring, status);
      status.normal := TRUE; { delete status intentionally ignored }
    IFEND;

    IF task_block^.current_block^.started_application AND
          (task_block^.current_block^.kind = clc$command_proc_block) THEN
      end_application_procedure (task_block^.current_block^.application_info);
    IFEND;

{ Emit audit statistic when conditional capabilities are being deactivated.

    IF avp$security_option_active (avc$vso_security_audit) THEN
      deactivated_capabilities := task_block^.current_block^.active_capabilities -
            old_block^.active_capabilities;
      IF deactivated_capabilities <> $avt$conditional_capabilities [] THEN
        audit_information.audited_operation := sfc$ao_val_deact_capability;
        status.normal := TRUE; { status to be reported on the audit statistic }
        FOR conditional_capability := LOWERVALUE (conditional_capability)
              TO UPPERVALUE (conditional_capability) DO
          IF conditional_capability IN deactivated_capabilities THEN
            audit_information.activate_capability.field_name_p :=
                  ^avv$cond_capability_names [conditional_capability];
            sfp$emit_audit_statistic (audit_information, status);
          IFEND;
        FOREND;
      IFEND;
    IFEND;

    IF (task_block^.current_block^.kind = clc$sub_parameters_block) AND
          (task_block^.current_block^.sub_parameters_work_area_ptr <> NIL) THEN
      task_block^.current_block^.sub_parameters_work_area_ptr^ :=
            task_block^.current_block^.sub_parameters_work_area;
    IFEND;

    free_block (clc$eo_pop_for_block, task_block^.current_block);

    task_block^.current_block := old_block;
    current_block := old_block;

  PROCEND clp$pop_block_stack;
?? TITLE := 'free_block', EJECT ??

  PROCEDURE free_block
    (    pop_reason: clc$eo_pop_for_block .. clc$eo_pop_for_task;
     VAR block {input, output} : ^clt$block);

?? NEWTITLE := 'delete_util_from_cmnd_list', EJECT ??

    PROCEDURE delete_util_from_cmnd_list;

      VAR
        delete_status: ost$status,
        ignore_status: ost$status;


      clp$delete_util_from_cmnd_list (block, delete_status);
      IF NOT delete_status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], delete_status,
              ignore_status);
      IFEND;

    PROCEND delete_util_from_cmnd_list;
?? TITLE := 'record_block_access_count_error', EJECT ??

    PROCEDURE record_block_access_count_error
      (    problem_block: ^clt$block);

      VAR
        local_status: ost$status,
        problem_status: ost$status;


      osp$set_status_abnormal ('CL', cle$block_access_count_error, problem_block^.kind_name, problem_status);
      osp$append_status_integer (osc$status_parameter_delimiter, #RING (problem_block), 16, FALSE,
            problem_status);
      osp$append_status_integer (' ', #SEGMENT (problem_block), 16, FALSE, problem_status);
      osp$append_status_integer (' ', #OFFSET (problem_block), 16, FALSE, problem_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], problem_status,
            local_status);
      IF NOT local_status.normal THEN
        pmp$log_ascii ('** ** ** **   FATAL  -- -- -- -- CLE$BLOCK_ACCESS_COUNT_ERROR ...',
              $pmt$ascii_logset [pmc$job_log, pmc$system_log], pmc$msg_origin_system, local_status);
        pmp$log_ascii (problem_status.text.value (1, problem_status.text.size), $pmt$ascii_logset
              [pmc$job_log, pmc$system_log], pmc$msg_origin_system, local_status);
      IFEND;

    PROCEND record_block_access_count_error;
?? TITLE := 'record_unable_to_free_block', EJECT ??

    PROCEDURE record_unable_to_free_block
      (    problem_block: ^clt$block;
           access_count: integer);

      VAR
        local_status: ost$status,
        problem_status: ost$status;


      osp$set_status_abnormal ('CL', cle$unable_to_free_block, problem_block^.kind_name, problem_status);
      osp$append_status_integer (osc$status_parameter_delimiter, access_count, 10, FALSE, problem_status);
      osp$append_status_integer (osc$status_parameter_delimiter, #RING (problem_block), 16, FALSE,
            problem_status);
      osp$append_status_integer (' ', #SEGMENT (problem_block), 16, FALSE, problem_status);
      osp$append_status_integer (' ', #OFFSET (problem_block), 16, FALSE, problem_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], problem_status,
            local_status);
      IF NOT local_status.normal THEN
        pmp$log_ascii ('** ** ** **   FATAL  -- -- -- -- CLE$UNABLE_TO_FREE_BLOCK ...',
              $pmt$ascii_logset [pmc$job_log, pmc$system_log], pmc$msg_origin_system, local_status);
        pmp$log_ascii (problem_status.text.value (1, problem_status.text.size), $pmt$ascii_logset
              [pmc$job_log, pmc$system_log], pmc$msg_origin_system, local_status);
      IFEND;

    PROCEND record_unable_to_free_block;
?? OLDTITLE, EJECT ??

    VAR
      access_count: integer,
      access_count_error: boolean,
      current_task: ^clt$named_task,
      data_positioner: ^array [1 .. * ] of cell,
      ignore_status: ost$status,
      next_task: ^clt$named_task,
      previous_pushed_line: ^clt$pushed_line,
      previous_unseen_mail_block: ^clt$block;


    IF block^.started_application THEN
      end_application (block^.application_info);
      FREE block^.application_info IN osv$task_shared_heap^;
    IFEND;

    IF block^.variables.thread <> NIL THEN
      clp$delete_variables (block^.variables);
    IFEND;

    IF block^.parameters.area <> NIL THEN
      clp$delete_parameters (block^.parameters);
    IFEND;

    IF (block^.kind = clc$input_block) AND (block^.previous_block^.kind = clc$task_block) AND
          (block^.previous_block^.task_kind = clc$job_monitor_task) THEN
      block^.previous_block^.established_handler_info := block^.established_handler_info;
    ELSE
      clp$free_all_handlers_in_block (block);
    IFEND;

    IF block^.environment_object_info <> NIL THEN
      clp$pop_all_environment (pop_reason, block);
    IFEND;

    CASE block^.kind OF

    = clc$case_block =
      IF block^.case_selection_value <> NIL THEN
        FREE block^.case_selection_value IN osv$task_shared_heap^;
      IFEND;

    = clc$command_block =
      IF block^.help_output_file <> NIL THEN
        FREE block^.help_output_file IN osv$task_shared_heap^;
      IFEND;
      IF block^.edited_parameters <> NIL THEN
        FREE block^.edited_parameters IN osv$task_shared_heap^;
      IFEND;

    = clc$command_proc_block, clc$function_proc_block, clc$input_block, clc$when_block =
      IF block^.command_proc_status <> NIL THEN
        FREE block^.command_proc_status IN osv$task_shared_heap^;
      IFEND;
      IF block^.function_proc_result <> NIL THEN
        FREE block^.function_proc_result IN osv$task_shared_heap^;
      IFEND;
      IF block^.expected_function_proc_type <> NIL THEN
        FREE block^.expected_function_proc_type IN osv$task_shared_heap^;
      IFEND;
      IF block^.input.internal THEN
        FREE block^.input.data IN osv$task_shared_heap^;
      IFEND;
      IF block^.when_condition <> NIL THEN
        FREE block^.when_condition IN osv$task_shared_heap^;
      IFEND;

      IF NOT block^.inherited_input.found THEN
        clp$delete_expandable_string (block^.input.line);
        IF block^.input.kind <> clc$line_input THEN
          clp$delete_expandable_string (block^.input.data_line);
        IFEND;
        WHILE block^.input.pushed_line <> NIL DO
          clp$delete_expandable_string (block^.input.pushed_line^.line);
          previous_pushed_line := block^.input.pushed_line^.previous;
          FREE block^.input.pushed_line IN osv$task_shared_heap^;
          block^.input.pushed_line := previous_pushed_line;
        WHILEND;

      ELSE
        block^.inherited_input.block^.inheriting_block := NIL;
        IF block^.input.kind <> clc$line_input THEN
          CASE block^.input.state OF
          = clc$reset_input, clc$update_input =
            block^.inherited_input.block^.input.state := block^.input.state;
          = clc$end_of_input =
            IF NOT block^.input.interactive_device THEN
              block^.inherited_input.block^.input.state := block^.input.state;
            IFEND;
          ELSE {clc$continue_input}
            IF block^.input.file_rereadable AND (NOT block^.inherited_input.in_current_task) AND
                  (block^.input.line_address <> block^.inherited_input.block^.input.line_address) THEN
              block^.inherited_input.block^.input.state := clc$update_input;
            IFEND;
          CASEND;
          block^.inherited_input.block^.input.data_line := block^.input.data_line;
          IF (block^.inherited_input.block^.input.state <> clc$reset_input) OR
                block^.inherited_input.in_current_task THEN
            block^.inherited_input.block^.input.line_address_is_for_previous :=
                  block^.input.line_address_is_for_previous;
            block^.inherited_input.block^.input.line_address := block^.input.line_address;
          IFEND;
          IF (block^.inherited_input.block^.input.data <> NIL) THEN
            RESET block^.inherited_input.block^.input.data;
            IF block^.input.line_address > 0 THEN
              NEXT data_positioner: [1 .. block^.input.line_address] IN
                    block^.inherited_input.block^.input.data;
            IFEND;
          IFEND;
          IF block^.inherited_input.in_current_task THEN
            block^.inherited_input.block^.input.current_prompt_string := block^.input.current_prompt_string;
          IFEND;
        IFEND;
        block^.inherited_input.block^.input.line := block^.input.line;
        block^.inherited_input.block^.line_parse := block^.line_parse;
        block^.inherited_input.block^.line_identifier := block^.line_identifier;
        block^.inherited_input.block^.input.pushed_line := block^.input.pushed_line;

        osp$decrement_locked_variable (block^.inherited_input.block^.access_count, 2, access_count,
              access_count_error);
        IF access_count_error THEN
          record_block_access_count_error (block^.inherited_input.block);
        IFEND;
        block^.inherited_input.block := NIL;
        block^.inherited_input.found := FALSE;
      IFEND;

      IF block^.associated_utility <> NIL THEN
        osp$decrement_locked_variable (block^.associated_utility^.access_count, 2, access_count,
              access_count_error);
        IF access_count_error THEN
          record_block_access_count_error (block^.associated_utility);
        IFEND;
        block^.associated_utility := NIL;
      IFEND;

    = clc$for_block =
      IF block^.for_variable <> NIL THEN
        FREE block^.for_variable IN osv$task_shared_heap^;
      IFEND;
      IF (block^.for_control.style = clc$for_control_list) AND (block^.for_control.list <> NIL) THEN
        FREE block^.for_control.list IN osv$task_shared_heap^;
      IFEND;

    = clc$repeat_block, clc$while_block =
      IF block^.expression_area <> NIL THEN
        FREE block^.expression_area IN osv$task_shared_heap^;
      IFEND;

    = clc$utility_block =
      delete_util_from_cmnd_list;
      IF block^.command_environment.commands <> NIL THEN
        FREE block^.command_environment.commands IN osv$task_shared_heap^;
      IFEND;
      IF block^.command_environment.contemporary_functions <> NIL THEN
        FREE block^.command_environment.contemporary_functions IN osv$task_shared_heap^;
      IFEND;
      IF block^.command_environment.original_functions <> NIL THEN
        FREE block^.command_environment.original_functions IN osv$task_shared_heap^;
      IFEND;
      IF block^.command_environment.libraries <> NIL THEN
        FREE block^.command_environment.libraries IN osv$task_shared_heap^;
      IFEND;
      IF block^.command_environment.auxiliary_libraries <> NIL THEN
        FREE block^.command_environment.auxiliary_libraries IN osv$task_shared_heap^;
      IFEND;
      IF block^.command_environment.dialog_info.commands <> NIL THEN
        FREE block^.command_environment.dialog_info.commands IN osv$task_shared_heap^;
      IFEND;
      IF block^.command_environment.dialog_info.functions <> NIL THEN
        FREE block^.command_environment.dialog_info.functions IN osv$task_shared_heap^;
      IFEND;
      IF block^.libraries <> NIL THEN
        FREE block^.libraries IN osv$task_shared_heap^;
      IFEND;
      CASE block^.active_sou_capabilities.saved OF
      = TRUE =
        avv$active_sou_capabilities := block^.active_sou_capabilities.value;
      = FALSE =
      CASEND;

    = clc$task_block =
      IF NOT block^.synchronous_with_parent THEN
        IF block^.default_session_file <> NIL THEN
          FREE block^.default_session_file IN osv$task_shared_heap^;
        IFEND;

        current_task := block^.named_task_list;
        WHILE current_task <> NIL DO
          next_task := current_task^.link;
          FREE current_task IN osv$task_shared_heap^;
          current_task := next_task;
        WHILEND;
      IFEND;

    ELSE
      ;
    CASEND;

    IF block^.previous_block <> NIL THEN
      osp$decrement_locked_variable (block^.previous_block^.access_count, 1, access_count,
            access_count_error);
      IF access_count_error THEN
        record_block_access_count_error (block^.previous_block);
      ELSEIF (access_count = 0) AND (block^.previous_block^.previous_block = NIL) AND
            ((block^.previous_block^.kind <> clc$task_block) OR
            (block^.previous_block^.task_kind <> clc$job_monitor_task)) THEN
        FREE block^.previous_block IN osv$task_shared_heap^;
      IFEND;
    IFEND;

    block^.assignment_counter := 0;

    osp$fetch_locked_variable (block^.access_count, access_count);

    IF access_count = 0 THEN
      FREE block IN osv$task_shared_heap^;
    ELSE
      block^.previous_block := NIL;
      record_unable_to_free_block (block, access_count);
    IFEND;

  PROCEND free_block;
?? TITLE := 'clp$pop_terminated_blocks', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$pop_terminated_blocks
    (    first_block_to_keep: ^clt$block;
     VAR status {input,output} : ost$status);

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


    clp$find_current_block (current_block);

    IF #SEGMENT (current_block) <> #SEGMENT (first_block_to_keep) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$pop_terminated_blocks', local_status);
      pmp$abort (local_status);
    IFEND;

    block := current_block;
    WHILE #OFFSET (block) <> #OFFSET (first_block_to_keep) DO
      IF block^.kind = clc$task_block THEN
        RETURN; {----->
      IFEND;
      block := block^.previous_block;
    WHILEND;

    block := current_block;
    WHILE #OFFSET (block) <> #OFFSET (first_block_to_keep) DO
      CASE block^.kind OF
      = clc$command_proc_block, clc$function_proc_block, clc$input_block, clc$when_block =
        clp$pop_input_stack (block, local_status);
        IF status.normal AND (NOT local_status.normal) THEN
          status := local_status;
        IFEND;
      ELSE
        clp$pop_block_stack (block);
      CASEND;
    WHILEND;

  PROCEND clp$pop_terminated_blocks;
?? TITLE := 'application accounting support routines' ??
?? NEWTITLE := 'get_procedure_stats', EJECT ??

  PROCEDURE get_procedure_stats
    (VAR cp_time: pmt$task_cp_time;
     VAR paging_stats: ost$paging_statistics);

    VAR
      jobmode_statistics: pmt$task_jobmode_statistics,
      local_status: ost$status,
      xcb: ^ost$execution_control_block;


    ?IF NOT clc$compiling_for_test_harness THEN
      pmp$find_executing_task_xcb (xcb);
      IF xcb = NIL THEN
        osp$system_error ('task XCB lost', NIL);
      ELSE
        paging_stats := xcb^.paging_statistics;
      IFEND;
      pmp$get_task_cp_time (cp_time, local_status);
      IF NOT local_status.normal THEN
        cp_time.task_time := 0;
        cp_time.monitor_time := 0;
      IFEND;
    ?ELSE
      pmp$get_task_jobmode_statistics (jobmode_statistics, local_status);
      IF NOT local_status.normal THEN
        paging_stats.page_fault_count := 0;
        paging_stats.page_in_count := 0;
        paging_stats.pages_reclaimed_from_queue := 0;
        paging_stats.new_pages_assigned := 0;
      ELSE
        paging_stats := jobmode_statistics.paging_statistics;
      IFEND;
      pmp$get_task_cp_time (cp_time, local_status);
      IF NOT local_status.normal THEN
        cp_time.task_time := 0;
        cp_time.monitor_time := 0;
      ELSE
        cp_time.monitor_time := 0;
      IFEND;
    ?IFEND;

  PROCEND get_procedure_stats;
?? TITLE := 'end_application_procedure', EJECT ??

  PROCEDURE end_application_procedure
    (    application_info: ^clt$application_info);

    VAR
      cp_time: pmt$task_cp_time,
      ignored_status: ost$status,
      local_status: ost$status,
      paging_stats: ost$paging_statistics,
      task_id: pmt$task_id;


    IF application_info <> NIL THEN
      osp$set_job_signature_lock (application_info^.lock);
      IF application_info^.task_link_head <> NIL THEN
        osp$set_status_abnormal ('CL', cle$terminated_application_task, application_info^.identifier.name,
              local_status);
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], local_status, ignored_status);
        WHILE application_info^.task_link_head <> NIL DO
          task_id := application_info^.task_link_head^.task_id;
          osp$clear_job_signature_lock (application_info^.lock);
          pmp$terminate (application_info^.task_link_head^.task_id, ignored_status);
          osp$set_job_signature_lock (application_info^.lock);
        WHILEND;
      IFEND;
      osp$clear_job_signature_lock (application_info^.lock);

      get_procedure_stats (cp_time, paging_stats);
      application_info^.procedure_cp_time.task_time := cp_time.task_time -
            application_info^.procedure_cp_time.task_time;
      application_info^.procedure_cp_time.monitor_time := cp_time.monitor_time -
            application_info^.procedure_cp_time.monitor_time;
      application_info^.procedure_paging_stats.page_fault_count :=
            paging_stats.page_fault_count - application_info^.procedure_paging_stats.page_fault_count;
      application_info^.procedure_paging_stats.page_in_count :=
            paging_stats.page_in_count - application_info^.procedure_paging_stats.page_in_count;
      application_info^.procedure_paging_stats.pages_reclaimed_from_queue :=
            paging_stats.pages_reclaimed_from_queue - application_info^.procedure_paging_stats.
            pages_reclaimed_from_queue;
      application_info^.procedure_paging_stats.new_pages_assigned :=
            paging_stats.new_pages_assigned - application_info^.procedure_paging_stats.new_pages_assigned;
    IFEND;

  PROCEND end_application_procedure;
?? TITLE := 'end_application', EJECT ??

  PROCEDURE end_application
    (    application_info: ^clt$application_info);

    VAR
      accumulated_srus: sft$counter,
      application_attributes: jmt$application_attributes,
      counters: sft$counters,
      description: string (osc$max_string_size),
      ignored_service_accumulator: jmt$service_accumulator,
      last_application_info: ^clt$application_info,
      local_status: ost$status,
      size: integer;


    IF application_info = NIL THEN
      RETURN; {----->
    IFEND;

    clv$applications_active := clv$applications_active - 1;

    IF application_info^.application_scheduling THEN
      osp$set_job_signature_lock (last_scheduled_application.lock);
      last_scheduled_application.block := application_info^.previous_scheduled_block;

    /find_previous_application/
      WHILE last_scheduled_application.block <> NIL DO
        last_application_info := last_scheduled_application.block^.application_info;
        jmp$read_application_record (last_application_info^.identifier.name,
              last_application_info^.application_index, application_attributes, local_status);
        IF local_status.normal AND application_attributes.enable_application_scheduling THEN
          jmp$set_application_scheduling (application_attributes, last_application_info^.service_accumulator,
                ignored_service_accumulator, {ignored} local_status);
          EXIT /find_previous_application/; {----->
        IFEND;
        last_scheduled_application.block := last_application_info^.previous_scheduled_block;
        last_application_info^.application_scheduling := FALSE;
        last_application_info^.previous_scheduled_block := NIL;
      WHILEND /find_previous_application/;
      IF last_scheduled_application.block = NIL THEN
        jmp$end_application_scheduling ({ignored} local_status);
      IFEND;
      osp$clear_job_signature_lock (last_scheduled_application.lock);
    IFEND;

{ If the module kind is load module then this is only a place holder for a unit application, and
{ no resource end statistic should be emitted.

    IF application_info^.module_kind <> llc$load_module THEN

      osp$set_job_signature_lock (application_info^.lock);

      IF application_info^.previous_info <> NIL THEN
        osp$set_job_signature_lock (application_info^.previous_info^.lock);
        application_info^.previous_info^.accumulated_cp_time.task_time :=
              application_info^.previous_info^.accumulated_cp_time.task_time +
              application_info^.accumulated_cp_time.task_time;
        application_info^.previous_info^.accumulated_cp_time.monitor_time :=
              application_info^.previous_info^.accumulated_cp_time.monitor_time +
              application_info^.accumulated_cp_time.monitor_time;
        application_info^.previous_info^.accumulated_paging_stats.page_fault_count :=
              application_info^.previous_info^.accumulated_paging_stats.page_fault_count +
              application_info^.accumulated_paging_stats.page_fault_count;
        application_info^.previous_info^.accumulated_paging_stats.page_in_count :=
              application_info^.previous_info^.accumulated_paging_stats.page_in_count +
              application_info^.accumulated_paging_stats.page_in_count;
        application_info^.previous_info^.accumulated_paging_stats.pages_reclaimed_from_queue :=
              application_info^.previous_info^.accumulated_paging_stats.pages_reclaimed_from_queue +
              application_info^.accumulated_paging_stats.pages_reclaimed_from_queue;
        application_info^.previous_info^.accumulated_paging_stats.new_pages_assigned :=
              application_info^.previous_info^.accumulated_paging_stats.new_pages_assigned +
              application_info^.accumulated_paging_stats.new_pages_assigned;
        osp$clear_job_signature_lock (application_info^.previous_info^.lock);
      IFEND;

{ Augment the current application information (for statistic emission) if necessary

      IF (application_info^.module_kind = llc$applic_command_procedure) OR
            (application_info^.module_kind = llc$applic_command_description) THEN
        application_info^.accumulated_cp_time.task_time := application_info^.accumulated_cp_time.task_time +
              application_info^.procedure_cp_time.task_time;
        application_info^.accumulated_cp_time.monitor_time :=
              application_info^.accumulated_cp_time.monitor_time +
              application_info^.procedure_cp_time.monitor_time;
        application_info^.accumulated_paging_stats.page_fault_count :=
              application_info^.accumulated_paging_stats.page_fault_count +
              application_info^.procedure_paging_stats.page_fault_count;
        application_info^.accumulated_paging_stats.page_in_count :=
              application_info^.accumulated_paging_stats.page_in_count +
              application_info^.procedure_paging_stats.page_in_count;
        application_info^.accumulated_paging_stats.pages_reclaimed_from_queue :=
              application_info^.accumulated_paging_stats.pages_reclaimed_from_queue +
              application_info^.procedure_paging_stats.pages_reclaimed_from_queue;
        application_info^.accumulated_paging_stats.new_pages_assigned :=
              application_info^.accumulated_paging_stats.new_pages_assigned +
              application_info^.procedure_paging_stats.new_pages_assigned;
      IFEND;

      local_status.normal := TRUE;
      avp$calculate_application_srus (application_info^.accumulated_cp_time,
            application_info^.accumulated_paging_stats, accumulated_srus, local_status);
      IF local_status.normal THEN
        PUSH counters: [1 .. 7];
        counters^ [1] := accumulated_srus;
        counters^ [2] := application_info^.accumulated_cp_time.task_time;
        counters^ [3] := application_info^.accumulated_cp_time.monitor_time;
        counters^ [4] := application_info^.accumulated_paging_stats.page_fault_count;
        counters^ [5] := application_info^.accumulated_paging_stats.page_in_count;
        counters^ [6] := application_info^.accumulated_paging_stats.pages_reclaimed_from_queue;
        counters^ [7] := application_info^.accumulated_paging_stats.new_pages_assigned;

        STRINGREP (description, size, application_info^.identifier.
              name (1, clp$trimmed_string_size (application_info^.identifier.name)), ', ',
              application_info^.nested_identifier.name (1, clp$trimmed_string_size
              (application_info^.nested_identifier.name)));

        avp$emit_interactive_interval;
        sfp$emit_statistic (avc$end_application, description (1, size), counters, {ignored} local_status);
      IFEND;

      osp$clear_job_signature_lock (application_info^.lock)
    IFEND;

  PROCEND end_application;
?? TITLE := 'clp$update_applic_resources', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$update_applic_resources
    (    cp_time: pmt$task_cp_time;
         paging_stats: ost$paging_statistics);

    VAR
      block: ^clt$block;


    clp$find_current_block (block);

    IF block^.application_info <> NIL THEN
      osp$set_job_signature_lock (block^.application_info^.lock);

      block^.application_info^.accumulated_cp_time.task_time :=
            block^.application_info^.accumulated_cp_time.task_time + cp_time.task_time;
      block^.application_info^.accumulated_cp_time.monitor_time :=
            block^.application_info^.accumulated_cp_time.monitor_time + cp_time.monitor_time;
      block^.application_info^.accumulated_paging_stats.page_fault_count :=
            block^.application_info^.accumulated_paging_stats.page_fault_count +
            paging_stats.page_fault_count;
      block^.application_info^.accumulated_paging_stats.page_in_count :=
            block^.application_info^.accumulated_paging_stats.page_in_count + paging_stats.page_in_count;
      block^.application_info^.accumulated_paging_stats.pages_reclaimed_from_queue :=
            block^.application_info^.accumulated_paging_stats.pages_reclaimed_from_queue +
            paging_stats.pages_reclaimed_from_queue;
      block^.application_info^.accumulated_paging_stats.new_pages_assigned :=
            block^.application_info^.accumulated_paging_stats.new_pages_assigned +
            paging_stats.new_pages_assigned;

      osp$clear_job_signature_lock (block^.application_info^.lock);
    IFEND;

  PROCEND clp$update_applic_resources;
?? TITLE := 'clp$record_application_units', EJECT ??

{
{ PURPOSE:
{  This procedure is called at task termination time.  It retrieves all
{ of the application units from the storage areas defined by any calls to
{ CLP$DEFINE_APPLIC_UNIT_ARRAY, and places them on and emits an
{ AVC$APPLICATION_UNITS statistic for each array defined.
{

  PROCEDURE [XDCL] clp$record_application_units;

    VAR
      block: ^clt$block,
      current_unit_info: ^clt$application_unit_info,
      ignore_status: ost$status;

?? NEWTITLE := 'emit_application_unit_statistic', EJECT ??

    PROCEDURE emit_application_unit_statistic
      (    current_unit_info: ^clt$application_unit_info);

      VAR
        ignore_status: ost$status,
        message_status: ost$status,
        error_counter: array [1 .. 1] of sft$counter,
        error_descriptive_data: string (sfc$max_descriptive_data_size),
        index: integer,
        size: integer,
        counters: sft$counters,
        description: string (osc$max_string_size);

?? NEWTITLE := 'invalid_array_cond_handler', EJECT ??

      PROCEDURE invalid_array_cond_handler
        (    condition: pmt$condition;
             condition_information: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR handler_status: ost$status);

        VAR
          ignore_status: ost$status;

?? NEWTITLE := 'set_invalid_array_status', EJECT ??

        PROCEDURE set_invalid_array_status;

          VAR
            ignore_status: ost$status;


{ ';' is used as the status parameter delimiter so that the error statistic descriptive data is displayable.

          osp$set_status_condition (cle$cannot_access_unit_array, message_status);
          osp$append_status_parameter (';', current_unit_info^.identifier.name, message_status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], message_status,
                ignore_status);
          error_counter [1] := message_status.condition;
          error_descriptive_data := message_status.text.value;
          sfp$emit_statistic (avc$applic_accounting_error, error_descriptive_data
                (1, message_status.text.size), ^error_counter, ignore_status);
          EXIT emit_application_unit_statistic; {----->

        PROCEND set_invalid_array_status;
?? OLDTITLE, EJECT ??

        handler_status.normal := TRUE;

        CASE condition.selector OF
        = pmc$system_conditions =
          set_invalid_array_status;
        = mmc$segment_access_condition =
          set_invalid_array_status;
        = pmc$user_defined_condition =
          IF condition.user_condition_name = cye$run_time_condition THEN
            set_invalid_array_status;
          ELSE
            pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
          IFEND;
        ELSE;
          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
        CASEND;

      PROCEND invalid_array_cond_handler;
?? OLDTITLE, EJECT ??

      PUSH counters: [1 .. current_unit_info^.unit_array_size];

{ Verify that the array defined by the application is accessable.

      osp$establish_condition_handler (^invalid_array_cond_handler, FALSE);

    /retrieve_unit_array_values/
      FOR index := 1 TO current_unit_info^.unit_array_size DO
        counters^ [index] := current_unit_info^.unit_array^ [index];
        IF counters^ [index] < 0 THEN
          osp$set_status_condition (cle$negative_application_units, message_status);
          osp$append_status_parameter (';', current_unit_info^.identifier.name, message_status);
          osp$append_status_integer (';', index, 10, FALSE, message_status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log, pmc$system_log], message_status,
                ignore_status);
          error_counter [1] := message_status.condition;
          error_descriptive_data := message_status.text.value;
          sfp$emit_statistic (avc$applic_accounting_error, error_descriptive_data
                (1, message_status.text.size), ^error_counter, ignore_status);
          RETURN; {----->
        IFEND;
      FOREND /retrieve_unit_array_values/;
      osp$disestablish_cond_handler;

{ Build and emit the application units statistic.

      STRINGREP (description, size, current_unit_info^.identifier.
            name (1, clp$trimmed_string_size (current_unit_info^.identifier.name)), ', ',
            current_unit_info^.nested_identifier.name (1, clp$trimmed_string_size
            (current_unit_info^.nested_identifier.name)));
      sfp$emit_statistic (avc$application_units, description (1, size), counters, ignore_status);

    PROCEND emit_application_unit_statistic;
?? OLDTITLE, EJECT ??

    clp$find_current_block (block);

    IF block^.application_info <> NIL THEN
      current_unit_info := block^.application_info^.unit_info;

    /process_application_unit_list/
      WHILE current_unit_info <> NIL DO
        emit_application_unit_statistic (current_unit_info);
        current_unit_info := current_unit_info^.unit_info;
      WHILEND /process_application_unit_list/;
    IFEND;

  PROCEND clp$record_application_units;
?? TITLE := 'clp$define_applic_unit_array', EJECT ??
*copyc clh$define_applic_unit_array

  PROCEDURE [XDCL, #GATE] clp$define_applic_unit_array
    (    application_unit_array: ^clt$application_unit_array;
         application_unit_array_size: clt$application_unit_array_size;
         application_address: ost$pva;
     VAR status: ost$status);

{
{ NOTES:
{
{   The storage area for the array of integers MUST be staticly allocated!  If
{ it is not the array may not be accessable by SCL when the application
{ terminates.
{
{   The application address does NOT have to be an entry point or some other
{ externally declared address.
{
{   Only one call to CLP$DEFINE_APPLIC_UNIT_ARRAY is allowed from any given load
{ module.
{
{ DESIGN:
{
{   Call the loader to determine if an application identifier has been assigned
{ to the module pointed to by application address.  If no application
{ identifier has been assigned then this module is not considered an
{ application and the control is returned with normal status.
{
{   If the pointer to the application unit array is NIL then return abnormal status.
{
{   If the ring of the application unit array pointer is less than the ring of
{ the application address then the application is attempting to reference a
{ storage area in a more secure module so an abnormal status is returned.
{
{   If a resource measured application is currently active there will aready be
{ an application information block in the block stack, if not a dummy
{ application information block is allocated.  The application information
{ block points to a list of unit application information blocks.  If a unit
{ application information block does not already exist for the calling load
{ module a new unit application information block with the appropriate
{ information is inserted as the first entry in the list.  If one already
{ exists for the calling load module an error status is returned.
{

    VAR
      block: ^clt$block,
      new_unit_info: ^clt$application_unit_info,
      current_unit_info: ^clt$application_unit_info,
      index: integer,
      size: integer,
      string_wsa: string (osc$max_string_size),
      application_module_name: ost$name,
      application_identifier: llt$application_identifier,
      null_application_identifier: llt$application_identifier,
      library_privilege: ost$name;


    status.normal := TRUE;

    pmp$get_application_information (application_address, application_module_name, application_identifier,
          library_privilege, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

{ If the module does not have an application identifier it is not an application.

    IF application_identifier.name = osc$null_name THEN
      RETURN; {----->
    IFEND;

{ Verify that the array defined by the application is accessable.

    IF application_unit_array = NIL THEN
      osp$set_status_abnormal ('CL', cle$cannot_access_unit_array, application_identifier.name, status);
      RETURN; {----->
    IFEND;

    IF #RING (application_unit_array) < application_address.ring THEN
      osp$set_status_abnormal ('CL', cle$cannot_access_unit_array, application_identifier.name, status);
      RETURN; {----->
    IFEND;

{ Allocate and insert the application unit block information into the stack.

    clp$find_current_block (block);

{ Create a dummy resource application block as a placeholder if one doesn't already exist.

    IF block^.application_info = NIL THEN
      null_application_identifier.name := osc$null_name;
      clp$initialize_application_info (null_application_identifier, osc$null_name, llc$load_module, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

{ Only one call to CLP$DEFINE_APPLIC_UNIT_ARRAY  is allowed per load module.

    current_unit_info := block^.application_info^.unit_info;

  /look_for_duplicate_module_name/
    WHILE current_unit_info <> NIL DO
      IF current_unit_info^.module_name = application_module_name THEN
        osp$set_status_abnormal ('CL', cle$multiple_applic_unit_arrays, application_identifier.name, status);
        RETURN; {----->
      IFEND;
      current_unit_info := current_unit_info^.unit_info;
    WHILEND /look_for_duplicate_module_name/;

{ Enter a new unit application block.

    ALLOCATE new_unit_info IN osv$task_shared_heap^;

    new_unit_info^.module_name := application_module_name;
    new_unit_info^.identifier := application_identifier;
    IF block^.application_info^.identifier.name = osc$null_name THEN
      new_unit_info^.nested_identifier := application_identifier;
    ELSEIF block^.application_info^.identifier = application_identifier THEN
      new_unit_info^.nested_identifier := block^.application_info^.nested_identifier;
    ELSE
      STRINGREP (string_wsa, size, block^.application_info^.nested_identifier.
            name (1, clp$trimmed_string_size (block^.application_info^.nested_identifier.name)), '#',
            application_identifier.name);
      new_unit_info^.nested_identifier.name := string_wsa (1, osc$max_name_size);
    IFEND;
    new_unit_info^.library_privilege := library_privilege;
    new_unit_info^.unit_array := application_unit_array;
    new_unit_info^.unit_array_size := application_unit_array_size;

{ Insert it as the first entry in the list.

    new_unit_info^.unit_info := block^.application_info^.unit_info;
    block^.application_info^.unit_info := new_unit_info;

  PROCEND clp$define_applic_unit_array;
?? TITLE := 'clp$initialize_application_info', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$initialize_application_info
    (    application_identifier: llt$application_identifier;
         library_privilege: ost$name;
         module_kind: llt$library_module_kind;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      new_info: ^clt$application_info,
      application_attributes: jmt$application_attributes,
      task_block: ^clt$block,
      last_scheduled_task_block: ^clt$block,
      old_service_accumulator: jmt$service_accumulator,
      local_status: ost$status,
      size: integer,
      string_wsa: string (osc$max_string_size);


    status.normal := TRUE;

    clp$find_current_block (block);

    ALLOCATE new_info IN osv$task_shared_heap^;

    new_info^.identifier := application_identifier;
    new_info^.nested_identifier := application_identifier;
    IF block^.application_info <> NIL THEN
      STRINGREP (string_wsa, size, block^.application_info^.nested_identifier.
            name (1, clp$trimmed_string_size (block^.application_info^.nested_identifier.name)), '#',
            application_identifier.name);
      new_info^.nested_identifier.name := string_wsa (1, osc$max_name_size);
    IFEND;
    new_info^.library_privilege := library_privilege;
    new_info^.task_link_head := NIL;
    new_info^.previous_info := block^.application_info;
    new_info^.accumulated_cp_time.task_time := 0;
    new_info^.accumulated_cp_time.monitor_time := 0;
    new_info^.accumulated_paging_stats.page_fault_count := 0;
    new_info^.accumulated_paging_stats.page_in_count := 0;
    new_info^.accumulated_paging_stats.pages_reclaimed_from_queue := 0;
    new_info^.accumulated_paging_stats.new_pages_assigned := 0;
    new_info^.unit_info := NIL;
    new_info^.application_scheduling := FALSE;
    new_info^.application_index := 0;
    new_info^.previous_scheduled_block := NIL;
    new_info^.module_kind := module_kind;
    IF (module_kind = llc$applic_command_procedure) OR (module_kind = llc$applic_command_description) THEN
      get_procedure_stats (new_info^.procedure_cp_time, new_info^.procedure_paging_stats);
    IFEND;

{ Check for application scheduling only if it is not a call for a load module
{ application.  Only applications defined by program descriptors and SCL
{ procedures are supported for application scheduling.

    IF module_kind <> llc$load_module THEN

{ Application scheduling is set if
{  - The site has selected special scheduling for the application in the active
{    scheduling profile AND
{  - Application scheduling is not currently set for the job OR this task is
{    synchronous with the previous task that set application scheduling.

      jmp$read_application_record (new_info^.identifier.name, new_info^.application_index,
            application_attributes, local_status);
      IF local_status.normal AND application_attributes.enable_application_scheduling AND
            NOT jmp$system_job () THEN
        task_block := NIL;

        osp$set_job_signature_lock (last_scheduled_application.lock);

        last_scheduled_task_block := last_scheduled_application.block;
        IF last_scheduled_task_block <> NIL THEN
          WHILE last_scheduled_task_block^.kind <> clc$task_block DO
            last_scheduled_task_block := last_scheduled_task_block^.previous_block;
          WHILEND;
          clp$find_task_block (task_block, local_status);
          IF NOT local_status.normal THEN
            task_block := NIL;
          IFEND;
          WHILE (task_block <> NIL) AND (last_scheduled_task_block <> task_block) AND
                task_block^.synchronous_with_parent DO
            task_block := task_block^.parent;
          WHILEND;
        IFEND;
        IF task_block = last_scheduled_task_block THEN
          new_info^.application_scheduling := TRUE;
          new_info^.previous_scheduled_block := last_scheduled_application.block;
          last_scheduled_application.block := block;
        IFEND;

        osp$clear_job_signature_lock (last_scheduled_application.lock);

        IF new_info^.application_scheduling THEN
          jmp$set_application_scheduling (application_attributes, 0, old_service_accumulator, local_status);
          IF new_info^.previous_scheduled_block <> NIL THEN
            new_info^.previous_scheduled_block^.application_info^.service_accumulator :=
                  old_service_accumulator;
          IFEND;
        IFEND;
      IFEND;
    IFEND;

    osp$initialize_sig_lock (new_info^.lock);

{!
{!  task_link_head, and accumulated fields in application_info should only be accessed after
{!  locking the application_info record.
{!

    block^.started_application := TRUE;
    block^.application_info := new_info;

    clv$applications_active := clv$applications_active + 1;

{ If the module kind is load module then this is only a place holder for a unit application, and
{ no resource application begin statistic should be emitted.

    IF module_kind <> llc$load_module THEN
      STRINGREP (string_wsa, size, new_info^.identifier.name
            (1, clp$trimmed_string_size (new_info^.identifier.name)),
            ', ', new_info^.nested_identifier.name (1, clp$trimmed_string_size
            (new_info^.nested_identifier.name)));

      avp$emit_interactive_interval;
      sfp$emit_statistic (avc$begin_application, string_wsa (1, size), NIL, status);
    IFEND;

  PROCEND clp$initialize_application_info;
?? OLDTITLE, TITLE := '"Helper" routines for clp$evaluate_parameters, etc.' ??
?? NEWTITLE := 'clp$setup_parameter_evaluation', EJECT ??

{
{ PURPOSE:
{   This procedure is called in all command or function parameter evaluation
{   contexts except clp$evaluate_sub_parameters.  It gathers information from
{   the block stack and returns it in the evaluation_context and help_context
{   records.
{
{ NOTES:
{   1. Help_context is used only for parameter information displays.
{   2. Parameter_list_parse is not returned for a procedure.
{   3. Work_area_ptr is not returned for a procedure.
{   4. The current position of the work_area is saved for a sub_parameters
{      block so that when the block is popped the work_area can be reset.
{   5. The parameters.names and parameters.accesses fields of a block for a
{      procedure are initialized.  This allows for the passing of VAR
{      parameters to occur "on the fly" during parameter evaluation.
{

  PROCEDURE [XDCL, #GATE] clp$setup_parameter_evaluation
    (    proc_pdt: ^clt$unbundled_pdt;
         proc_name: clt$command_name;
         reset_interpreter_mode: boolean;
     VAR parameter_list_parse: clt$parse_state;
     VAR work_area_ptr: ^^clt$work_area;
     VAR evaluation_context: clt$parameter_eval_context;
     VAR help_context: clt$parameter_help_context;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      caller_id: ost$caller_identifier,
      command_or_function_block: ^clt$block,
      interaction_information: ^clt$interaction_information,
      parameters_block: ^clt$block,
      task_interaction_information: ^clt$interaction_information;

?? NEWTITLE := 'initialize_proc_parameters', EJECT ??

    PROCEDURE [INLINE] initialize_proc_parameters;

      VAR
        area_size: integer,
        i: clt$parameter_number;


      area_size := #SIZE (proc_pdt^.names^) + (proc_pdt^.header^.number_of_parameters *
            #SIZE (clt$parameter_access));
      FOR i := 1 TO proc_pdt^.header^.number_of_parameters DO
        area_size := area_size + #SIZE (clt$variable_descriptor:
              [[REP proc_pdt^.parameters^ [i].type_specification_size OF cell]]);
      FOREND;

      ALLOCATE parameters_block^.parameters.area: [[REP area_size OF cell]] IN osv$task_shared_heap^;
      RESET parameters_block^.parameters.area;

      NEXT parameters_block^.parameters.names: [1 .. proc_pdt^.header^.number_of_parameter_names] IN
            parameters_block^.parameters.area;
      parameters_block^.parameters.names^ := proc_pdt^.names^;
      NEXT parameters_block^.parameters.accesses: [1 .. proc_pdt^.header^.number_of_parameters] IN
            parameters_block^.parameters.area;

      FOR i := 1 TO proc_pdt^.header^.number_of_parameters DO
        parameters_block^.parameters.accesses^ [i].name_index := proc_pdt^.parameters^ [i].name_index;
        parameters_block^.parameters.accesses^ [i].security := proc_pdt^.parameters^ [i].security;
        parameters_block^.parameters.accesses^ [i].specified := FALSE;
        parameters_block^.parameters.accesses^ [i].qualifiers_area := NIL;
        parameters_block^.parameters.accesses^ [i].passed_variable_reference := NIL;
        parameters_block^.parameters.accesses^ [i].info.class := clc$param_variable;
        parameters_block^.parameters.accesses^ [i].info.parameter_passed := FALSE;
        osp$increment_locked_variable (clv$var_access_assignment_count, 0,
              parameters_block^.parameters.accesses^ [i].info.assignment_counter);
        parameters_block^.parameters.accesses^ [i].info.qualifiers := NIL;

        IF proc_pdt^.parameters^ [i].passing_method = clc$pass_by_reference THEN
          parameters_block^.parameters.accesses^ [i].info.access_mode := clc$read_write;
        ELSE {clc$pass_by_value}
          parameters_block^.parameters.accesses^ [i].info.access_mode := clc$read_only;
        IFEND;

        NEXT parameters_block^.parameters.accesses^ [i].info.descriptor:
              [[REP proc_pdt^.parameters^ [i].type_specification_size OF cell]] IN
              parameters_block^.parameters.area;
        parameters_block^.parameters.accesses^ [i].info.descriptor^.header.access_count := 1;
        parameters_block^.parameters.accesses^ [i].info.descriptor^.header.evaluation_method :=
              proc_pdt^.parameters^ [i].evaluation_method;
        parameters_block^.parameters.accesses^ [i].info.descriptor^.header.value := NIL;
        parameters_block^.parameters.accesses^ [i].info.descriptor^.header.library := NIL;
        parameters_block^.parameters.accesses^ [i].info.descriptor^.type_specification :=
              proc_pdt^.type_descriptions^ [i].specification^;

        parameters_block^.parameters.accesses^ [i].info.original_parameter_descriptor :=
              parameters_block^.parameters.accesses^ [i].info.descriptor;

      FOREND;

    PROCEND initialize_proc_parameters;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;

    clp$find_current_block (block);
    parameters_block := NIL;
    evaluation_context.command_logging_completed := TRUE;
    evaluation_context.command_echoing_completed := TRUE;
    CASE block^.kind OF
    = clc$command_block =
      IF proc_pdt = NIL THEN
        command_or_function_block := block;
        parameters_block := block;
        evaluation_context.command_or_function := clc$command;
        evaluation_context.procedure_parameters := FALSE;
        evaluation_context.command_logging_completed := parameters_block^.command_logging_completed;
        evaluation_context.command_echoing_completed := parameters_block^.command_echoing_completed;
      IFEND;
    = clc$command_proc_block =
      IF proc_pdt <> NIL THEN
        command_or_function_block := block;
        parameters_block := block;
        evaluation_context.command_or_function := clc$command;
        evaluation_context.procedure_parameters := TRUE;
        evaluation_context.command_logging_completed := parameters_block^.command_proc_logging_completed;
        evaluation_context.command_echoing_completed := parameters_block^.command_proc_echoing_completed;
      IFEND;
    = clc$function_block =
      IF proc_pdt = NIL THEN
        command_or_function_block := block;
        parameters_block := block;
        evaluation_context.command_or_function := clc$function;
        evaluation_context.procedure_parameters := FALSE;
        evaluation_context.command_logging_completed := TRUE;
        evaluation_context.command_echoing_completed := TRUE;
      IFEND;
    = clc$function_proc_block =
      IF proc_pdt <> NIL THEN
        command_or_function_block := block;
        parameters_block := block;
        evaluation_context.command_or_function := clc$function;
        evaluation_context.procedure_parameters := TRUE;
        evaluation_context.command_logging_completed := TRUE;
        evaluation_context.command_echoing_completed := TRUE;
      IFEND;
    = clc$task_block =
      IF (block^.task_kind = clc$other_task) AND (proc_pdt = NIL) THEN
        evaluation_context.command_or_function := clc$command;
        evaluation_context.procedure_parameters := FALSE;
        command_or_function_block := block;
        parameters_block := block;
        IF block^.synchronous_with_parent AND (block^.previous_block^.kind = clc$command_block) AND
              (block^.previous_block^.command_kind = clc$program_command) THEN
          command_or_function_block := block^.previous_block;
          evaluation_context.command_logging_completed := command_or_function_block^.
                command_logging_completed;
          evaluation_context.command_echoing_completed := command_or_function_block^.
                command_echoing_completed;
          parameters_block^.line_parse := command_or_function_block^.line_parse;
          IF command_or_function_block^.parameters.evaluated THEN
            parameters_block := NIL;
          IFEND;
        ELSE
          evaluation_context.command_logging_completed := TRUE;
          evaluation_context.command_echoing_completed := TRUE;
        IFEND;
      IFEND;
    = clc$sub_parameters_block =
      IF proc_pdt = NIL THEN
        command_or_function_block := block;
        parameters_block := block;
        evaluation_context.command_or_function := clc$command;
        evaluation_context.procedure_parameters := FALSE;
        evaluation_context.command_logging_completed := TRUE;
        evaluation_context.command_echoing_completed := TRUE;
      IFEND;
    ELSE
      ;
    CASEND;
    IF (parameters_block = NIL) OR parameters_block^.parameters.evaluated THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$setup_parameter_evaluation', status);
      RETURN; {----->
    IFEND;

    #CALLER_ID (caller_id);

    IF proc_pdt <> NIL THEN
      IF proc_pdt^.header^.number_of_parameters > 0 THEN
        initialize_proc_parameters;
      IFEND;
      command_or_function_block^.proc_name := proc_name;

      IF command_or_function_block^.previous_block^.interpreter_mode = clc$help_mode THEN
        command_or_function_block^.interpreter_mode := clc$help_mode;
      IFEND;

    ELSE
      parameter_list_parse := parameters_block^.line_parse;

      clp$get_work_area (caller_id.ring, work_area_ptr, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    evaluation_context.interpreter_mode := command_or_function_block^.interpreter_mode;

    IF (evaluation_context.interpreter_mode = clc$help_mode) AND
          (command_or_function_block^.previous_block^.kind = clc$command_block) AND
          reset_interpreter_mode THEN
      block^.interpreter_mode := clc$interpret_mode;
      block^.being_exited := TRUE;
    IFEND;

    evaluation_context.interactive_origin := FALSE;

    osp$find_interaction_info (interaction_information);
    evaluation_context.interaction_style := interaction_information^.style;

    IF parameters_block^.kind = clc$sub_parameters_block THEN
      block^.sub_parameters_work_area_ptr := work_area_ptr;
      block^.sub_parameters_work_area := work_area_ptr^;
    ELSEIF caller_id.ring > osc$tsrv_ring THEN
      block := command_or_function_block^.previous_block;

    /search_for_interactive_origin/
      WHILE block <> NIL DO
        CASE block^.kind OF
        = clc$command_proc_block, clc$function_proc_block, clc$input_block, clc$when_block =
          evaluation_context.interactive_origin := (block^.input.kind = clc$file_input) AND
                (block^.input.device_class = rmc$terminal_device);
          EXIT /search_for_interactive_origin/; {----->
        = clc$task_block =
          IF NOT block^.synchronous_with_parent THEN
            task_interaction_information := clp$environment_object_in_block
                  (clc$eo_interaction_information, block);
            evaluation_context.interactive_origin := (task_interaction_information <> NIL) AND
                  (task_interaction_information^.style = osc$desktop_interaction);
            EXIT /search_for_interactive_origin/; {----->
          IFEND;
          block := block^.previous_block;
        = clc$sub_parameters_block =
          EXIT /search_for_interactive_origin/; {----->
        ELSE
          block := block^.previous_block;
        CASEND;
      WHILEND /search_for_interactive_origin/;
    IFEND;

    evaluation_context.command_or_function_name := command_or_function_block^.label;
    evaluation_context.command_or_function_source := ^command_or_function_block^.source;

    IF (evaluation_context.interpreter_mode = clc$help_mode) AND
          (command_or_function_block^.previous_block^.kind = clc$command_block) THEN
      evaluation_context.prompting_requested := TRUE;
      help_context.help_output_file := command_or_function_block^.previous_block^.help_output_file;
      help_context.help_output_ring := command_or_function_block^.previous_block^.caller_ring;
      help_context.help_output_options := command_or_function_block^.previous_block^.help_output_options;
    ELSE
      evaluation_context.prompting_requested := command_or_function_block^.prompting_requested;
      help_context.help_output_file := NIL;
      help_context.help_output_ring := command_or_function_block^.caller_ring;
      help_context.help_output_options := $clt$parameter_help_options [];
    IFEND;

  PROCEND clp$setup_parameter_evaluation;
?? TITLE := 'clp$save_evaluated_parameters', EJECT ??

{
{ PURPOSE:
{   This procedure completes the parameter evaluation process for commands and
{   functions.  It sets the parameters.evaluated field of the block and saves
{   other information in the block dependent upon the context.
{
{ NOTES:
{   1. For a procedure the values for non-VAR parameters are saved along with a
{      boolean indicating whether the standard status parameter for a command
{      procedure was specified on the call.
{   2. For parameters evaluated by the clp$scan_parameter_list request, the
{      parameter value table is saved.
{   3. For a command a pointer to its "unbundled" parameter descriptor table is
{      saved.  Also, if the command's standard status parameter was specified
{      on the call, a pointer to the specified variable is saved.
{   4. For a command, command procedure or task the logging/echoing completed flags
{      are set to true.
{   5. If the command was called via clp$edit_command_parameter_list, the
{      evaluated_parameters are converted to a string representation and saved.
{

  PROCEDURE [XDCL, #GATE] clp$save_evaluated_parameters
    (    pdt: ^clt$unbundled_pdt;
         pvt: ^clt$parameter_value_table;
         evaluated_by_scan_param_list: boolean;
     VAR work_area {input, output} : ^clt$work_area;
     VAR status {input, output} : ost$status);

    VAR
      block: ^clt$block,
      command_block: ^clt$block,
      parameters_block: ^clt$block,
      search_mode: clt$command_search_modes;

?? NEWTITLE := 'save_edited_parameter_list', EJECT ??

    PROCEDURE save_edited_parameter_list;

      VAR
        edited_parameters: ^clt$data_representation,
        request: clt$convert_to_string_request;


      request.initial_indentation := 0;
      request.continuation_indentation := 0;
      request.max_string := command_block^.edited_parameters_max_size;
      request.include_advanced_items := TRUE;
      request.include_hidden_items := TRUE;
      request.kind := clc$convert_parameters;
      request.initial_text := NIL;
      request.include_secure_parameters := TRUE;
      request.evaluated_pdt := pdt;
      request.evaluated_pvt := pvt;
      request.parameter_substitutions := NIL;
      clp$internal_convert_to_string (request, work_area, edited_parameters, status);
      IF NOT status.normal THEN
        EXIT clp$save_evaluated_parameters; {----->
      IFEND;

      ALLOCATE command_block^.edited_parameters: [[REP #SIZE (edited_parameters^) OF cell]] IN
            osv$task_shared_heap^;
      command_block^.edited_parameters^ := edited_parameters^;

      osp$set_status_condition (cle$parameters_displayed, status);

    PROCEND save_edited_parameter_list;
?? TITLE := 'save_proc_parameters', EJECT ??

    PROCEDURE save_proc_parameters;

      VAR
        area_size: integer,
        first_saved_parameter: 0 .. clc$max_parameters,
        i: clt$parameter_number,
        local_status: ost$status,
        values: ^array [1 .. * ] of ^clt$internal_data_value;


      PUSH values: [1 .. pdt^.header^.number_of_parameters];

      first_saved_parameter := 0;
      area_size := 0;

      FOR i := 1 TO pdt^.header^.number_of_parameters DO
        values^ [i] := NIL;
        IF pvt^ [i].passing_method = clc$pass_by_reference THEN
          IF pvt^ [i].variable <> NIL THEN
            area_size := area_size + #SIZE (pvt^ [i].variable^);
          IFEND;
        ELSEIF pvt^ [i].value <> NIL THEN
          clp$convert_ext_value_to_int (NIL, pvt^ [i].value, NIL, work_area, values^ [i], local_status);
          IF NOT local_status.normal THEN
            IF status.normal THEN
              status := local_status;
            IFEND;
            EXIT clp$save_evaluated_parameters; {----->
          IFEND;
          area_size := area_size + #SIZE (values^ [i]^);
          IF first_saved_parameter = 0 THEN
            first_saved_parameter := i;
          IFEND;
        IFEND;
      FOREND;

      IF area_size > 0 THEN
        ALLOCATE parameters_block^.parameters.values: [[REP area_size OF cell]] IN osv$task_shared_heap^;
        RESET parameters_block^.parameters.values;
      IFEND;

      FOR i := 1 TO pdt^.header^.number_of_parameters DO
        parameters_block^.parameters.accesses^ [i].specified := pvt^ [i].specified;
        IF pvt^ [i].passing_method = clc$pass_by_reference THEN
          IF pvt^ [i].variable <> NIL THEN
            NEXT parameters_block^.parameters.accesses^ [i].passed_variable_reference:
                  [STRLENGTH (pvt^ [i].variable^)] IN parameters_block^.parameters.values;
            parameters_block^.parameters.accesses^ [i].passed_variable_reference^ := pvt^ [i].variable^;
            parameters_block^.parameters.accesses^ [i].info.parameter_passed := TRUE;
          IFEND;
        ELSEIF values^ [i] <> NIL THEN
          NEXT parameters_block^.parameters.accesses^ [i].info.descriptor^.header.value:
                [[REP #SIZE (values^ [i]^.allocated_space) OF cell]] IN parameters_block^.parameters.values;
          parameters_block^.parameters.accesses^ [i].info.descriptor^.header.value^ := values^ [i]^;
          parameters_block^.parameters.accesses^ [i].info.parameter_passed := TRUE;
        IFEND;
      FOREND;

    PROCEND save_proc_parameters;
?? OLDTITLE, EJECT ??

    clp$find_current_block (block);
    command_block := NIL;
    parameters_block := NIL;
    CASE block^.kind OF
    = clc$command_block, clc$function_block, clc$sub_parameters_block =
      parameters_block := block;
    = clc$command_proc_block, clc$function_proc_block =
      parameters_block := block;
      IF parameters_block^.being_exited THEN
        parameters_block^.interpreter_mode := clc$skip_mode;
      IFEND;
    = clc$task_block =
      IF block^.task_kind = clc$other_task THEN
        parameters_block := block;
        IF block^.synchronous_with_parent AND (block^.previous_block^.kind = clc$command_block) AND
              (block^.previous_block^.command_kind = clc$program_command) THEN
          IF block^.previous_block^.parameters.evaluated THEN
            parameters_block := NIL;
          ELSE
            command_block := block^.previous_block;
          IFEND;
        IFEND;
      IFEND;
    ELSE
      ;
    CASEND;
    IF parameters_block <> NIL THEN
      IF parameters_block^.parameters.evaluated OR (pdt = NIL) THEN
        parameters_block := NIL;
      ELSEIF pdt^.header^.number_of_parameters = 0 THEN
        IF pvt <> NIL THEN
          parameters_block := NIL;
        IFEND;
      ELSEIF (pvt = NIL) OR (UPPERBOUND (pvt^) <> pdt^.header^.number_of_parameters) THEN
        parameters_block := NIL;
      IFEND;
    IFEND;
    IF parameters_block = NIL THEN
      IF status.normal THEN
        osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$save_evaluated_parameters', status);
      IFEND;
      RETURN; {----->
    IFEND;

    clp$get_command_search_mode (search_mode);
    parameters_block^.parameters.evaluated := TRUE;
    CASE parameters_block^.kind OF

    = clc$command_block =
      parameters_block^.parameters.unbundled_pdt := pdt;
      IF evaluated_by_scan_param_list THEN
        parameters_block^.parameters.names := pdt^.names;
        parameters_block^.parameters.parameter_value_table := pvt;
      IFEND;
      IF (pdt^.header^.status_parameter_number > 0) AND pvt^ [pdt^.header^.status_parameter_number].
            specified THEN
        parameters_block^.parameters.command_status_variable :=
              pvt^ [pdt^.header^.status_parameter_number].variable;
      IFEND;
      parameters_block^.command_logging_completed := TRUE;
      parameters_block^.command_echoing_completed := TRUE;
      IF (search_mode <> clc$global_command_search) AND (parameters_block^.command_kind <>
            clc$command_is_include_file) AND (parameters_block^.command_kind <> clc$command_is_include_line)
            THEN
        parameters_block^.use_command_search_mode := FALSE;
      IFEND;

    = clc$command_proc_block =
      IF pdt^.header^.number_of_parameters > 0 THEN
        save_proc_parameters;
      IFEND;
      IF (pdt^.header^.status_parameter_number > 0) AND pvt^ [pdt^.header^.status_parameter_number].
            specified THEN
        parameters_block^.parameters.command_status_specified := TRUE;
      IFEND;
      parameters_block^.command_proc_logging_completed := TRUE;
      parameters_block^.command_proc_echoing_completed := TRUE;
      IF search_mode <> clc$global_command_search THEN
        parameters_block^.use_command_search_mode := FALSE;
      IFEND;

    = clc$function_block =
      parameters_block^.parameters.unbundled_pdt := pdt;
      IF search_mode <> clc$global_command_search THEN
        parameters_block^.use_command_search_mode := FALSE;
      IFEND;

    = clc$function_proc_block =
      IF pdt^.header^.number_of_parameters > 0 THEN
        save_proc_parameters;
      IFEND;
      IF search_mode <> clc$global_command_search THEN
        parameters_block^.use_command_search_mode := FALSE;
      IFEND;

    = clc$sub_parameters_block =
      parameters_block^.parameters.unbundled_pdt := pdt;
      IF evaluated_by_scan_param_list THEN
        parameters_block^.parameters.names := pdt^.names;
        parameters_block^.parameters.parameter_value_table := pvt;
      IFEND;

    ELSE { clc$task_block }
      parameters_block^.parameters.unbundled_pdt := pdt;
      IF evaluated_by_scan_param_list THEN
        parameters_block^.parameters.names := pdt^.names;
        parameters_block^.parameters.parameter_value_table := pvt;
      IFEND;
      IF (pdt^.header^.status_parameter_number > 0) AND (pvt^ [pdt^.header^.status_parameter_number].
            variable <> NIL) THEN
        IF command_block <> NIL THEN
          IF command_block^.parameters.area <> NIL THEN
            FREE command_block^.parameters.area IN osv$task_shared_heap^;
          IFEND;
          ALLOCATE command_block^.parameters.area: [[REP STRLENGTH (pvt^
                [pdt^.header^.status_parameter_number].variable^) OF char]] IN osv$task_shared_heap^;
          RESET command_block^.parameters.area;
          NEXT command_block^.parameters.command_status_variable:
                [STRLENGTH (pvt^ [pdt^.header^.status_parameter_number].variable^)] IN
                command_block^.parameters.area;
          command_block^.parameters.command_status_variable^ :=
                pvt^ [pdt^.header^.status_parameter_number].variable^;
        IFEND;
      IFEND;
      IF command_block <> NIL THEN
        command_block^.command_logging_completed := TRUE;
        command_block^.command_echoing_completed := TRUE;
      IFEND;
    CASEND;

    IF command_block <> NIL THEN
      command_block := command_block^.previous_block;
    ELSE
      command_block := parameters_block^.previous_block;
    IFEND;
    IF status.normal AND (command_block <> NIL) AND (command_block^.kind = clc$command_block) AND
          (command_block^.edited_parameters_max_size > 0) THEN
      save_edited_parameter_list;
    IFEND;

  PROCEND clp$save_evaluated_parameters;
?? OLDTITLE, TITLE := '"Helper" routines for command and control statement processing' ??
?? TITLE := 'clp$set_case_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_case_block
    (    interpreter_mode: clt$interpreter_modes;
         case_selection_encounterred: boolean;
         case_selection_made: boolean;
         case_else_allowed: boolean);

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

    clp$find_current_block (block);
    IF (block^.kind <> clc$case_block) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_case_block', status^);
      pmp$abort (status^);
    IFEND;
    block^.interpreter_mode := interpreter_mode;
    block^.case_selection_encounterred := case_selection_encounterred;
    block^.case_selection_made := case_selection_made;
    block^.case_else_allowed := case_else_allowed;

  PROCEND clp$set_case_block;
?? NEWTITLE := 'clp$set_command_kind', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_command_kind
    (    command_kind: clt$command_kind);

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


    clp$find_current_block (block);

    IF block^.kind <> clc$command_block THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_command_kind', status^);
      pmp$abort (status^);
    IFEND;

    block^.command_kind := command_kind;

  PROCEND clp$set_command_kind;
?? TITLE := 'clp$set_help_mode', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_help_mode
    (    help_output_file: ^fst$file_reference;
         help_output_options: clt$parameter_help_options);

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


    clp$find_current_block (block);
    IF block^.kind <> clc$command_block THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_help_mode', status^);
      pmp$abort (status^);
    IFEND;

    block^.interpreter_mode := clc$help_mode;
    block^.use_command_search_mode := block^.previous_block^.use_command_search_mode;

    ALLOCATE block^.help_output_file: [STRLENGTH (help_output_file^)] IN osv$task_shared_heap^;
    block^.help_output_file^ := help_output_file^;

    block^.help_output_options := help_output_options;

  PROCEND clp$set_help_mode;
?? TITLE := 'clp$set_if_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_if_block
    (    interpreter_mode: clt$interpreter_modes;
         if_condition_met: boolean;
         if_else_allowed: boolean);

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

    clp$find_current_block (block);
    IF block^.kind <> clc$if_block THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_if_block', status^);
      pmp$abort (status^);
    IFEND;
    block^.interpreter_mode := interpreter_mode;
    block^.if_condition_met := if_condition_met;
    block^.if_else_allowed := if_else_allowed;

  PROCEND clp$set_if_block;
?? TITLE := 'clp$set_repeat_until', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_repeat_until
    (    expression_parse: clt$parse_state);

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


    clp$find_current_block (block);
    IF (block^.kind <> clc$repeat_block) OR (block^.expression_area <> NIL) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_repeat_until', status^);
      pmp$abort (status^);
    IFEND;

    ALLOCATE block^.expression_area: [[REP STRLENGTH (expression_parse.text^) OF
          char, REP UPPERBOUND (expression_parse.units_array^) OF clt$lexical_unit]] IN osv$task_shared_heap^;
    RESET block^.expression_area;
    block^.expression_parse := expression_parse;
    NEXT block^.expression_parse.text: [STRLENGTH (expression_parse.text^)] IN block^.expression_area;
    block^.expression_parse.text^ := expression_parse.text^;
    NEXT block^.expression_parse.units_array: [1 .. UPPERBOUND (expression_parse.units_array^)] IN
          block^.expression_area;
    block^.expression_parse.units_array^ := expression_parse.units_array^;

    block^.exit_position.defined := TRUE;
    capture_input_position (block, block^.exit_position.line_identifier, block^.exit_position.line_parse);

    block^.interpreter_mode := clc$interpret_mode;

  PROCEND clp$set_repeat_until;
?? TITLE := 'clp$advance_for_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$advance_for_block
    (    set_exit_position: boolean);

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


    clp$find_current_block (block);
    IF block^.kind <> clc$for_block THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$advance_for_block', status^);
      pmp$abort (status^);
    IFEND;

    IF block^.for_control.style = clc$for_control_incremental THEN
      block^.for_control.value.value := block^.for_control.value.value + block^.for_control.increment;
    ELSE {clc$for_control_list}
      list_node := #PTR (block^.for_control.list^.header.value, block^.for_control.list^);
      IF list_node <> NIL THEN
        block^.for_control.list^.header.value := list_node^.link;
      IFEND;
    IFEND;

    IF set_exit_position AND (NOT block^.exit_position.defined) THEN
      block^.exit_position.defined := TRUE;
      capture_input_position (block, block^.exit_position.line_identifier, block^.exit_position.line_parse);
    IFEND;

  PROCEND clp$advance_for_block;
?? TITLE := 'clp$set_task_statement_task', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_task_statement_task
    (    task_name: ost$name);

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


    clp$find_current_block (block);
    IF (block^.kind <> clc$task_block) OR (block^.task_kind <> clc$other_task) THEN
      PUSH status;
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$set_task_statement_task', status^);
      pmp$abort (status^);
    IFEND;
    block^.task_kind := clc$task_statement_task;
    clv$task_name := task_name;

  PROCEND clp$set_task_statement_task;
?? TITLE := 'clp$skip_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$skip_block;

    VAR
      block: ^clt$block;


    clp$find_current_block (block);
    block^.interpreter_mode := clc$skip_mode;
    block^.being_exited := TRUE;

  PROCEND clp$skip_block;
?? TITLE := 'clp$find_exit_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$find_exit_block
    (    target_label: ost$name;
     VAR target_block: ^clt$block;
     VAR terminating_utility: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      input_block: ^clt$block,
      target_is_statement: boolean,
      target_kind: (labelled_structure, any_structure, any_utility, any_command_procedure,
            any_function_procedure, any_check_statement, any_task),
      targets_input_block: ^clt$block;


    status.normal := TRUE;

    IF target_label = '' THEN
      target_kind := any_structure;
    ELSEIF target_label = 'UTILITY' THEN
      target_kind := any_utility;
    ELSEIF (target_label = 'PROCEDURE') OR (target_label = 'PROC') THEN
      target_kind := any_command_procedure;
    ELSEIF target_label = 'FUNCTION' THEN
      target_kind := any_function_procedure;
    ELSEIF target_label = 'CHECK' THEN
      target_kind := any_check_statement;
    ELSEIF target_label = 'TASK' THEN
      target_kind := any_task;
    ELSE
      target_kind := labelled_structure;
    IFEND;

    input_block := NIL;
    target_is_statement := FALSE;

    clp$find_current_block (block);
    target_block := block;
    terminating_utility := FALSE;

  /find_block_to_be_exited/
    WHILE target_block <> NIL DO
      CASE target_block^.kind OF

      = clc$block_block, clc$for_block, clc$loop_block, clc$repeat_block, clc$while_block =
        CASE target_kind OF
        = labelled_structure =
          IF target_label = target_block^.label THEN
            target_is_statement := TRUE;
            EXIT /find_block_to_be_exited/; {----->
          IFEND;
        = any_structure =
          target_is_statement := TRUE;
          EXIT /find_block_to_be_exited/; {----->
        ELSE
          ;
        CASEND;

      = clc$check_block =
        CASE target_kind OF
        = labelled_structure =
          IF target_label = target_block^.label THEN
            target_is_statement := TRUE;
            EXIT /find_block_to_be_exited/; {----->
          IFEND;
        = any_structure, any_check_statement =
          target_is_statement := TRUE;
          EXIT /find_block_to_be_exited/; {----->
        ELSE
          ;
        CASEND;

      = clc$command_block =
        IF (target_block^.source.kind = clc$sub_commands) AND
              target_block^.source.utility_termination_command THEN
          terminating_utility := TRUE;
        IFEND;

      = clc$command_proc_block =
        IF input_block = NIL THEN
          input_block := target_block;
        IFEND;

        CASE target_kind OF
        = labelled_structure =
          IF target_label = target_block^.proc_name THEN
            EXIT /find_block_to_be_exited/; {----->
          IFEND;
        = any_structure, any_command_procedure =
          EXIT /find_block_to_be_exited/; {----->
        ELSE
          ;
        CASEND;

        IF (target_block^.source.kind = clc$sub_commands) AND
              target_block^.source.utility_termination_command THEN
          terminating_utility := TRUE;
        IFEND;

      = clc$function_proc_block =
        IF input_block = NIL THEN
          input_block := target_block;
        IFEND;

        CASE target_kind OF
        = labelled_structure =
          IF target_label = target_block^.proc_name THEN
            EXIT /find_block_to_be_exited/; {----->
          IFEND;
        = any_structure, any_function_procedure =
          EXIT /find_block_to_be_exited/; {----->
        ELSE
          ;
        CASEND;

      = clc$input_block =
        IF (target_block^.previous_block^.kind = clc$task_block) AND
              (target_block^.previous_block^.task_kind = clc$job_monitor_task) AND
              (target_block^.input.kind = clc$file_input) AND (clv$processing_phase = clc$command_phase) THEN
          target_block := NIL;
          EXIT /find_block_to_be_exited/; {----->
        IFEND;

        IF input_block = NIL THEN
          input_block := target_block;
        IFEND;

        CASE target_kind OF
        = labelled_structure =
          IF target_label = target_block^.label THEN
            EXIT /find_block_to_be_exited/; {----->
          IFEND;
        = any_structure =
          EXIT /find_block_to_be_exited/; {----->
        = any_utility =
          IF target_block^.label <> osc$null_name THEN
            EXIT /find_block_to_be_exited/; {----->
          IFEND;
        = any_command_procedure, any_function_procedure =
          IF target_block^.inherited_input.found THEN
            target_block := target_block^.inherited_input.block;
            CYCLE /find_block_to_be_exited/; {----->
          IFEND;
        ELSE
          ;
        CASEND;

      = clc$task_block =
        CASE target_kind OF
        = any_task =
          EXIT /find_block_to_be_exited/; {----->
        ELSE
          IF NOT target_block^.synchronous_with_parent THEN
            target_block := NIL;
            EXIT /find_block_to_be_exited/; {----->
          IFEND;
        CASEND;

      = clc$when_block =
        IF input_block = NIL THEN
          input_block := target_block;
        IFEND;

        IF target_kind = any_structure THEN
          EXIT /find_block_to_be_exited/; {----->
        IFEND;

        IF target_block^.static_link <> NIL THEN
          target_block := target_block^.static_link;
          CYCLE /find_block_to_be_exited/; {----->
        IFEND;

      ELSE
        ;
      CASEND;

      target_block := target_block^.previous_block;
    WHILEND /find_block_to_be_exited/;

    IF target_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'EXIT', status);
      IF target_label <> '' THEN
        osp$append_status_parameter (' ', target_label, status);
      IFEND;
      RETURN; {----->
    IFEND;

    IF target_is_statement AND (input_block <> NIL) THEN

    /check_statement_accessibility/
      BEGIN
        IF NOT input_block^.inherited_input.found THEN
          target_block := NIL;
          EXIT /check_statement_accessibility/; {----->
        IFEND;

        targets_input_block := target_block^.previous_block;

      /find_target_blocks_input_block/
        BEGIN
          WHILE targets_input_block <> NIL DO
            CASE targets_input_block^.kind OF
            = clc$command_proc_block, clc$function_proc_block, clc$input_block, clc$when_block =
              EXIT /find_target_blocks_input_block/; {----->
            = clc$task_block =
              IF NOT targets_input_block^.synchronous_with_parent THEN
                target_block := NIL;
                EXIT /check_statement_accessibility/; {----->
              IFEND;
            ELSE
              ;
            CASEND;
            targets_input_block := targets_input_block^.previous_block;
          WHILEND;
          target_block := NIL;
          EXIT /check_statement_accessibility/; {----->
        END /find_target_blocks_input_block/;

        WHILE input_block^.inherited_input.found DO
          input_block := input_block^.inherited_input.block;
          IF #OFFSET (input_block) = #OFFSET (targets_input_block) THEN
            EXIT /check_statement_accessibility/; {----->
          IFEND;
        WHILEND;

        target_block := NIL;
      END /check_statement_accessibility/;

    ELSEIF (target_block^.kind = clc$input_block) AND (target_block^.associated_utility <> NIL) AND
          terminating_utility THEN
      terminating_utility := FALSE;

    /recheck_terminating_utility/
      WHILE block <> target_block DO
        CASE block^.kind OF
        = clc$command_block, clc$command_proc_block =
          IF (block^.source.kind = clc$sub_commands) AND block^.source.utility_termination_command AND
                (#OFFSET (block^.source.utility_info) = #OFFSET (^target_block^.associated_utility^.
                command_environment)) THEN
            terminating_utility := TRUE;
            EXIT /recheck_terminating_utility/; {----->
          IFEND;
        ELSE
          ;
        CASEND;
        block := block^.previous_block;
      WHILEND /recheck_terminating_utility/;
    IFEND;

    IF target_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'EXIT', status);
      IF target_label <> '' THEN
        osp$append_status_parameter (' ', target_label, status);
      IFEND;
    IFEND;

  PROCEND clp$find_exit_block;
?? TITLE := 'clp$exit_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$exit_block
    (    target_block_offset: ost$segment_offset;
         exit_status: ^ost$status;
         function_result: ^clt$internal_data_value;
         terminating_utility: boolean;
     VAR status: ost$status);

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


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

    WHILE (target_block <> NIL) AND (#OFFSET (target_block) <> target_block_offset) DO
      target_block := target_block^.previous_block;
    WHILEND;

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

    child_task_block := NIL;
    exit_control_block := NIL;

  /mark_exit/
    WHILE block <> target_block DO
      CASE block^.kind OF

      = clc$block_block, clc$case_block, clc$for_block, clc$if_block, clc$loop_block, clc$repeat_block,
            clc$while_block =
        IF target_block^.exit_position.defined AND (exit_control_block = NIL) AND
              (child_task_block = NIL) THEN
          clp$pop_block_stack (block);
          CYCLE /mark_exit/; {----->
        IFEND;

      = clc$check_block, clc$command_block, clc$command_proc_block, clc$function_block,
            clc$function_proc_block, clc$input_block, clc$when_block =
        exit_control_block := block;

      = clc$task_block =
        child_task_block := block;
        exit_control_block := NIL;

      ELSE
        ;
      CASEND;

      block^.interpreter_mode := clc$skip_mode;
      block^.being_exited := TRUE;
      block := block^.previous_block;
    WHILEND /mark_exit/;

    IF target_block^.exit_position.defined AND (exit_control_block = NIL) AND (child_task_block = NIL) THEN
      clp$reset_input_position (target_block^.exit_position.line_identifier,
            target_block^.exit_position.line_parse);
      clp$pop_block_stack (block);
      RETURN; {----->
    IFEND;

    target_block^.interpreter_mode := clc$skip_mode;
    target_block^.being_exited := TRUE;

    CASE target_block^.kind OF

    = clc$check_block =
      target_block^.check_status := exit_status^;
      exit_control_block := target_block;

    = clc$command_block, clc$function_block, clc$when_block =
      exit_control_block := target_block;

    = clc$command_proc_block =
      IF (exit_status <> NIL) AND (NOT exit_status^.normal) AND (target_block^.command_proc_status = NIL) THEN
        ALLOCATE target_block^.command_proc_status IN osv$task_shared_heap^;
      IFEND;
      IF target_block^.command_proc_status <> NIL THEN
        target_block^.command_proc_status^ := exit_status^;
      IFEND;
      exit_control_block := target_block;

    = clc$function_proc_block =
      IF function_result <> NIL THEN
        IF (target_block^.function_proc_result <> NIL) AND (#SIZE (function_result^) <>
              #SIZE (target_block^.function_proc_result^)) THEN
          FREE target_block^.function_proc_result IN osv$task_shared_heap^;
        IFEND;
        IF target_block^.function_proc_result = NIL THEN
          ALLOCATE target_block^.function_proc_result: [[REP #SIZE (function_result^.allocated_space) OF
                cell]] IN osv$task_shared_heap^;
        IFEND;
        target_block^.function_proc_result^ := function_result^;
      IFEND;
      exit_control_block := target_block;

    = clc$input_block =
      IF terminating_utility AND (target_block^.associated_utility <> NIL) THEN
        target_block^.associated_utility^.termination_command_found := TRUE;
      IFEND;
      exit_control_block := target_block;

    ELSE
      ;
    CASEND;

    IF child_task_block <> NIL THEN
      clp$send_exiting_signal (child_task_block^.parent^.task_id, child_task_block^.task_id,
            exit_control_block, status);
    ELSEIF exit_control_block <> NIL THEN
      pmp$cause_task_condition (clc$exiting_condition, exit_control_block, {notify_scl=} FALSE,
            {notify_debug=} FALSE, {propagate_to_parent=} FALSE, {call_default_handler=} FALSE, status);
    IFEND;

  PROCEND clp$exit_block;
?? TITLE := 'clp$find_cycle_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$find_cycle_block
    (    target_label: ost$name;
     VAR current_block: ^clt$block;
     VAR target_block: ^clt$block;
     VAR status: ost$status);


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

  /find_block_to_be_cycled/
    WHILE target_block <> NIL DO
      CASE target_block^.kind OF
      = clc$block_block =
        IF (target_label <> '') AND (target_label = target_block^.label) THEN
          osp$set_status_abnormal ('CL', cle$statement_cant_be_cycled, 'BLOCK', status);
          RETURN; {----->
        IFEND;
      = clc$case_block, clc$if_block =
        ;
      = clc$for_block, clc$loop_block, clc$repeat_block, clc$while_block =
        IF (target_label = '') OR (target_label = target_block^.label) THEN
          RETURN; {----->
        IFEND;
      ELSE
        target_block := NIL;
        EXIT /find_block_to_be_cycled/; {----->
      CASEND;
      target_block := target_block^.previous_block;
    WHILEND /find_block_to_be_cycled/;
    IF target_block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unexpected_control_statemnt, 'CYCLE', status);
      IF target_label <> '' THEN
        osp$append_status_parameter (' ', target_label, status);
      IFEND;
      RETURN; {----->
    IFEND;

  PROCEND clp$find_cycle_block;
?? TITLE := 'clp$cycle_block', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$cycle_block
    (    target_label: ost$name;
         no_more_iterations: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      reset_line_identifier: clt$line_identifier,
      reset_line_parse: clt$parse_state,
      target_block: ^clt$block;


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

    IF target_block^.exit_position.defined THEN
      WHILE block <> target_block DO
        clp$pop_block_stack (block);
      WHILEND;
      clp$reset_input_position (target_block^.exit_position.line_identifier,
            target_block^.exit_position.line_parse);
      clp$pop_block_stack (block);
    ELSE
      WHILE block <> target_block DO
        block^.interpreter_mode := clc$skip_mode;
        block^.being_exited := TRUE;
        block := block^.previous_block;
      WHILEND;
      target_block^.interpreter_mode := clc$skip_mode;
      target_block^.being_exited := no_more_iterations;
    IFEND;

  PROCEND clp$cycle_block;
?? TITLE := 'clp$set_exit_position', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$set_exit_position;

    VAR
      block: ^clt$block;


    clp$find_current_block (block);
    block^.exit_position.defined := TRUE;
    capture_input_position (block, block^.exit_position.line_identifier, block^.exit_position.line_parse);

  PROCEND clp$set_exit_position;
?? TITLE := 'clp$fetch_display_log_indices', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$fetch_display_log_indices
    (VAR indices: clt$display_log_indices);

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


    clp$find_task_block (block, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to get pointer to SCL Task Block', ^status);
    IFEND;
    indices := block^.display_log_indices;

  PROCEND clp$fetch_display_log_indices;
?? TITLE := 'clp$store_display_log_indices', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$store_display_log_indices
    (    indices: clt$display_log_indices);

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


    clp$find_task_block (block, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to get pointer to SCL Task Block', ^status);
    IFEND;
    block^.display_log_indices := indices;

  PROCEND clp$store_display_log_indices;
?? TITLE := 'clp$notify_before_command_read', EJECT ??

  PROCEDURE [XDCL, #GATE] clp$notify_before_command_read
    (    notification_procedure: ^procedure
           (VAR status: ost$status));

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


    clp$find_current_block (block);
    IF block^.kind <> clc$utility_block THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$notify_before_command_read', status);
      pmp$abort (status);
    IFEND;
    block^.notify_before_command_read := notification_procedure;

  PROCEND clp$notify_before_command_read;
?? TITLE := 'clp$get_command_name', EJECT ??
*copy clh$get_command_name

  PROCEDURE [XDCL, #GATE] clp$get_command_name
    (VAR name: clt$command_name;
     VAR status: ost$status);

    VAR
      block: ^clt$block;


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

    CASE block^.kind OF
    = clc$command_block, clc$command_proc_block =
      name := block^.label;
      RETURN; {----->
    = clc$task_block =
      IF (block^.task_kind = clc$other_task) AND block^.synchronous_with_parent AND
            (block^.previous_block^.kind = clc$command_block) THEN
        name := block^.previous_block^.label;
        RETURN; {----->
      IFEND;
    ELSE
      ;
    CASEND;

    osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_command_name', status);

  PROCEND clp$get_command_name;
?? TITLE := 'clp$get_command_image', EJECT ??
*copy clh$get_command_image

  PROCEDURE [XDCL, #GATE] clp$get_command_image
    (VAR command_image: ^clt$command_line;
     VAR status: ost$status);

    VAR
      block: ^clt$block;


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

    clp$find_current_block (block);

  /find_command/
    WHILE block <> NIL DO
      CASE block^.kind OF
      = clc$command_block, clc$command_proc_block =
        IF block^.source.size <= (STRLENGTH (block^.line_parse.text^) - block^.source.index + 1) THEN
          command_image := ^block^.line_parse.text^ (block^.source.index, block^.source.size);
          RETURN; {----->
        IFEND;
        EXIT /find_command/; {----->
      ELSE
        block := block^.previous_block;
      CASEND;
    WHILEND /find_command/;

    osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$get_command_image', status);

  PROCEND clp$get_command_image;

MODEND clm$block_stack_manager;
