
?? RIGHT := 110 ??
MODULE tmm$dispatcher_test_harness;

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc ame$access_validation_errors
*copyc cle$ecc_ct_generator
*copyc cle$ecc_lexical
*copyc cle$ecc_miscellaneous
*copyc cle$ecc_proc_declaration
*copyc clt$command_table
*copyc clt$function_table
*copyc clt$parameter_list_size
*copyc jmt$cda_record
*copyc jmt$dispatching_priority
*copyc jmt$dispatching_priority_set
*copyc jmt$ijle_size
*copyc jmt$initiated_job_list_entry
*copyc oss$job_paged_literal
*copyc ost$cpu_state_table
*copyc ost$execution_control_block
*copyc ost$free_running_clock
*copyc ost$status
*copyc syt$monitor_status
*copyc tmt$primary_task_list
*copyc tmt$dispatch_control_table
*copyc tmt$dispatching_controls
*copyc tmt$dispatching_control_sets
*copyc tmt$dispatching_prio_controls

*copyc jmv$ijl_p
*copyc osv$upper_to_lower
*copyc tmv$dct
*copyc tmv$dispatching_controls
*copyc tmv$dispatching_control_time
*copyc tmv$dispatching_control_sets
*copyc tmv$null_global_task_id
*copyc tmv$ptl_p
*copyc tmv$tables_initialized
?? POP ??
*copyc amp$fetch
*copyc amp$put_next
*copyc amp$return
*copyc clp$begin_utility
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_name
*copyc clp$put_job_command_response
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$get_command_origin
*copyc jmp$get_ijle_p
*copyc clp$get_parameter_list_text
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$include_file
*copyc clp$scan_parameter_list
*copyc clp$test_parameter
*copyc clp$trimmed_string_size
*copyc fsp$close_file
*copyc fsp$open_file
*copyc mmp$create_scratch_segment
*copyc osp$append_status_parameter
*copyc osp$generate_error_message
*copyc osp$set_status_abnormal
*copyc pmp$zero_out_table
*copyc tmp$assign_ptl
*copyc tmp$remove_task_from_dct
*copyc tmp$set_task_ready

?? EJECT ??

  TYPE
    entry = record
      name: ost$name,
      class: clt$named_entry_class,
      availability: ost$name,
      ordinal: integer,
      log_option: clt$command_log_option,
      call_method: clt$call_method,
      procedure_name: ost$name,
    recend;

  TYPE
    entry_sequence = SEQ ( * );

  TYPE
    xref_sequence = SEQ ( * );

  TYPE
    chunk_array = array [1 .. clc$max_command_chunk] of record
      position: integer,
      length: integer,
    recend;

  TYPE
    type_record = record
      size: 0 .. max_line_size,
      line: string (max_line_size),
    recend;

  CONST
    max_line_size = 79,
    number_of_common_lines = 69,
    number_of_command_lines = 40,
    number_of_function_lines = 185;

  CONST
    prompt_string = 'dth',
    prompt_string_size = 3;

  CONST
    clc$max_command_chunk = clc$max_parameter_list_size DIV 31,
    min_page_width = 79,
    max_page_width = 110;

  VAR
    entry_count: [STATIC] integer := 0,
    entry_pointer: ^entry,
    entry_sequence_pointer: ^entry_sequence,
    module_name: ost$name,
    module_name_size: integer,
    name_size: integer,
    new_table_started: [STATIC] boolean := FALSE,
    ordinal_count: [STATIC] integer := 0,
    output_file: amt$local_file_name,
    output_file_id: amt$file_identifier,
    page_width: 0 .. amc$max_page_width,
    scope: ost$name,
    section_name: [STATIC] ost$name := '',
    status: ost$status,
    table_name: [STATIC] ost$name := '',
    table_type: ost$name,
    type_size: integer,
    utility_name: [STATIC, READ, oss$job_paged_literal] ost$name := 'dispatcher_test_harness',
    value: clt$value,
    xref_count: [STATIC] integer := 0,
    xref_pointer: ^ost$name,
    xref_sequence_pointer: ^xref_sequence;

{   ************************* CAUTION !!! *************************    }
{                                                                      }
{    When modifying the following 'hard-coded' types, use a different  }
{  MODIFICATION and FEATURE than ones used to modify the logic of      }
{  this program or any other deck.  This division is neccessary to     }
{  ensure ease of building various versions of command tables and      }
{  GENCT.                                                              }
{                                                                      }
{   ***************************************************************    }

  VAR
    common_types: [STATIC, READ] array [1 .. number_of_common_lines] of type_record := [
{}
{  *copyc clt$named_entry_availability
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [77, '    clt$named_entry_availability = (clc$normal_usage_entry, clc$hidden_entry,'],
{} [36, '          clc$advanced_usage_entry);'],
{} [0, ''],
{} [7, '  CONST'],
{} [50, '    clc$advertised_entry = clc$normal_usage_entry;'],
{}
{  *copyc clt$named_entry_class
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [64, '    clt$named_entry_class = (clc$nominal_entry, clc$alias_entry,'],
{} [30, '      clc$abbreviation_entry);'],
{}
{  *copyc clt$named_entry_ordinal
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [48, '    clt$named_entry_ordinal = 1 .. 7fffffff(16);'],
{}
{  *copyc pmt$program_name
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [32, '    pmt$program_name = ost$name;'],
{}
{  *copyc ost$status
{}
{} [0, ''],
{} [7, '  CONST'],
{} [54, '    osc$max_condition = osc$max_status_condition_code,'],
{} [64, '    osc$status_parameter_delimiter = CHR (31) {Unit Separator} ;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [67, '    ost$status_condition_code = 0 .. osc$max_status_condition_code,'],
{} [71, '    ost$status_condition_number = 0 .. osc$max_status_condition_number;'],
{} [0, ''],
{} [7, '  CONST'],
{} [52, '    osc$max_status_condition_code = 0ffffffffff(16),'],
{} [50, '    osc$max_status_condition_number = 0ffffff(16);'],
{} [0, ''],
{} [6, '  TYPE'],
{} [23, '    ost$status = record'],
{} [29, '      case normal: boolean of'],
{} [15, '      = FALSE ='],
{} [45, '        condition: ost$status_condition_code,'],
{} [25, '        text: ost$string,'],
{} [14, '      = TRUE ='],
{} [9, '        ,'],
{} [13, '      casend,'],
{} [11, '    recend;'],
{}
{  *copyc ost$string
{}
{} [0, ''],
{} [7, '  CONST'],
{} [27, '    osc$max_name_size = 31,'],
{} [54, '    osc$null_name = ''                               '';'],
{} [0, ''],
{} [6, '  TYPE'],
{} [43, '    ost$name_size = 1 .. osc$max_name_size;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [42, '    ost$name = string (osc$max_name_size);'],
{}
{  *copyc ost$string
{}
{} [0, ''],
{} [7, '  CONST'],
{} [30, '    osc$max_string_size = 256;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [47, '    ost$string_size = 0 .. osc$max_string_size;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [52, '    ost$string_index = 1 .. osc$max_string_size + 1;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [23, '    ost$string = record'],
{} [28, '      size: ost$string_size,'],
{} [42, '      value: string (osc$max_string_size),'],
{} [11, '    recend;'],
{}
{  *copyc clt$call_method
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [61, '    clt$call_method = (clc$unspecified_call, clc$linked_call,'],
{} [58, '      clc$unlinked_call, clc$proc_call, clc$program_call);']];

  VAR
    command_types: [STATIC, READ] array [1 .. number_of_command_lines] of type_record := [
{}
{  *copyc clt$command_table
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [67, '    clt$command_table = array [1 .. * ] of clt$command_table_entry;'],
{}
{  *copyc clt$command_table_entry
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [36, '    clt$command_table_entry = record'],
{} [29, '      name: clt$command_name,'],
{} [35, '      class: clt$named_entry_class,'],
{} [49, '      availability: clt$named_entry_availability,'],
{} [39, '      ordinal: clt$named_entry_ordinal,'],
{} [41, '      log_option: clt$command_log_option,'],
{} [50, '      case call_method: clt$command_call_method of'],
{} [25, '      = clc$linked_call ='],
{} [29, '        command: clt$command,'],
{} [60, '      = clc$unlinked_call, clc$proc_call, clc$program_call ='],
{} [41, '        procedure_name: pmt$program_name,'],
{} [13, '      casend,'],
{} [11, '    recend;'],
{}
{  *copyc clt$command
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [65, '    clt$command = ^procedure (parameter_list: clt$parameter_list;'],
{} [30, '      VAR status: ost$status);'],
{}
{  *copyc clt$command_call_method
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [66, '    clt$command_call_method = clc$linked_call .. clc$program_call;'],
{}
{  *copyc clt$command_log_option
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [71, '    clt$command_log_option = (clc$automatically_log, clc$manually_log);'],
{}
{  *copyc clt$command_name
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [32, '    clt$command_name = ost$name;'],
{}
{  *copyc cld$parameter_list
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [48, '    clt$parameter_list = pmt$program_parameters;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [45, '    clt$parameter_list_contents = ost$string;'],
{}
{  *copyc pmt$program_parameters
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [39, '    pmt$program_parameters = SEQ ( * );']];

  VAR
    function_types: [STATIC, READ] array [1 .. number_of_function_lines] of type_record := [
{}
{  *copyc clt$function_table
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [69, '    clt$function_table = array [1 .. * ] of clt$function_table_entry;'],
{}
{  *copyc clt$function_table_entry
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [37, '    clt$function_table_entry = record'],
{} [30, '      name: clt$function_name,'],
{} [35, '      class: clt$named_entry_class,'],
{} [49, '      availability: clt$named_entry_availability,'],
{} [39, '      ordinal: clt$named_entry_ordinal,'],
{} [51, '      case call_method: clt$function_call_method of'],
{} [25, '      = clc$linked_call ='],
{} [27, '        func: clt$function,'],
{} [42, '      = clc$unlinked_call, clc$proc_call ='],
{} [41, '        procedure_name: pmt$program_name,'],
{} [13, '      casend,'],
{} [11, '    recend;'],
{}
{  *copyc clt$function
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [55, '    clt$function = ^procedure (function_name: clt$name;'],
{} [34, '      argument_list: string ( * );'],
{} [27, '      VAR value: clt$value;'],
{} [30, '      VAR status: ost$status);'],
{}
{  *copyc clt$function_call_method
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [64, '    clt$function_call_method = clc$linked_call .. clc$proc_call;'],
{}
{  *copyc clt$function_name
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [33, '    clt$function_name = ost$name;'],
{}
{  *copyc cld$value
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [22, '    clt$value = record'],
{} [45, '      descriptor: string (osc$max_name_size),'],
{} [57, '      case kind: clc$unknown_value .. clc$status_value of'],
{} [27, '      = clc$unknown_value ='],
{} [9, '        ,'],
{} [31, '      = clc$application_value ='],
{} [43, '        application: clt$application_value,'],
{} [32, '      = clc$variable_reference ='],
{} [40, '        var_ref: clt$variable_reference,'],
{} [26, '      = clc$string_value ='],
{} [24, '        str: ost$string,'],
{} [24, '      = clc$file_value ='],
{} [23, '        file: clt$file,'],
{} [24, '      = clc$name_value ='],
{} [23, '        name: clt$name,'],
{} [24, '      = clc$real_value ='],
{} [23, '        rnum: clt$real,'],
{} [27, '      = clc$integer_value ='],
{} [25, '        int: clt$integer,'],
{} [27, '      = clc$boolean_value ='],
{} [26, '        bool: clt$boolean,'],
{} [26, '      = clc$status_value ='],
{} [27, '        status: ost$status,'],
{} [13, '      casend,'],
{} [11, '    recend;'],
{}
{  *copyc CLT$APPLICATION_VALUE
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [45, '    clt$application_value = SEQ (ost$string);'],
{} [0, ''],
{} [6, '  TYPE'],
{} [42, '    clt$application_value_name = ost$name;'],
{}
{  *copyc clt$boolean
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [24, '    clt$boolean = record'],
{} [21, '      value: boolean,'],
{} [30, '      kind: clt$boolean_kinds,'],
{} [11, '    recend;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [68, '    clt$boolean_kinds = (clc$true_false_boolean, clc$yes_no_boolean,'],
{} [26, '      clc$on_off_boolean);'],
{}
{  *copyc clt$data_value_kind
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [72, '    clt$data_value_kind = (clc$unspecified_value, clc$application_value,'],
{} [75, '      clc$deferred_value, clc$file_value, clc$name_value, clc$string_value,'],
{} [77, '      clc$real_value, clc$integer_value, clc$boolean_value, clc$status_value,'],
{} [65, '      clc$array_value, clc$cobol_name_value, clc$date_time_value,'],
{} [73, '      clc$entry_point_reference_value, clc$keyword_value, clc$list_value,'],
{} [63, '      clc$lock_value, clc$network_title_value, clc$range_value,'],
{} [55, '      clc$record_value, clc$scu_line_identifier_value,'],
{} [57, '      clc$string_pattern_value, clc$time_increment_value,'],
{} [36, '      clc$type_specification_value);'],
{}
{  *copyc clt$file
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [21, '    clt$file = record'],
{} [43, '      local_file_name: amt$local_file_name,'],
{} [11, '    recend;'],
{}
{  *copyc clt$integer
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [24, '    clt$integer = record'],
{} [21, '      value: integer,'],
{} [21, '      radix: 2 .. 16,'],
{} [31, '      radix_specified: boolean,'],
{} [11, '    recend;'],
{}
{  *copyc clt$name
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [21, '    clt$name = record'],
{} [26, '      size: ost$name_size,'],
{} [22, '      value: ost$name,'],
{} [11, '    recend;'],
{}
{  *copyc clt$real
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [21, '    clt$real = record'],
{} [22, '      value: longreal,'],
{} [52, '      number_of_digits: clt$real_number_digit_count,'],
{} [11, '    recend;'],
{}
{  *copyc cltreal_number_digit_count
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [67, '     clt$real_number_digit_count = 1 .. clc$max_real_number_digits;'],
{}
{  *copyc clc$max_real_number_digits
{}
{} [0, ''],
{} [7, '  CONST'],
{} [36, '    clc$max_real_number_digits = 28;'],
{}
{  *copyc cld$variable_reference
{}
{} [0, ''],
{} [7, '  TYPE'],
{} [35, '    clt$variable_reference = record'],
{} [28, '      reference: ost$string,'],
{} [42, '      lower_bound: clt$variable_dimension,'],
{} [42, '      upper_bound: clt$variable_dimension,'],
{} [32, '      value: clt$variable_value,'],
{} [11, '    recend;'],
{} [0, ''],
{} [7, '  TYPE'],
{} [31, '    clt$variable_value = record'],
{} [45, '      descriptor: string (osc$max_name_size),'],
{} [38, '      case kind: clt$variable_kinds of'],
{} [26, '      = clc$string_value ='],
{} [41, '        max_string_size: ost$string_size,'],
{} [47, '        string_value: ^array [1 .. * ] of cell,'],
{} [24, '      = clc$real_value ='],
{} [49, '        real_value: ^array [1 .. * ] of clt$real,'],
{} [27, '      = clc$integer_value ='],
{} [55, '        integer_value: ^array [1 .. * ] of clt$integer,'],
{} [27, '      = clc$boolean_value ='],
{} [55, '        boolean_value: ^array [1 .. * ] of clt$boolean,'],
{} [26, '      = clc$status_value ='],
{} [53, '        status_value: ^array [1 .. * ] of clt$status,'],
{} [13, '      casend,'],
{} [11, '    recend;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [23, '    clt$status = record'],
{} [26, '      normal: clt$boolean,'],
{} [40, '      identifier: clt$status_identifier,'],
{} [29, '      condition: clt$integer,'],
{} [23, '      text: ost$string,'],
{} [11, '    recend,'],
{} [34, '    clt$status_identifier = record'],
{} [28, '      size: ost$string_size,'],
{} [24, '      value: string (2),'],
{} [11, '    recend;'],
{} [0, ''],
{} [6, '  TYPE'],
{} [58, '    clt$variable_dimension = clc$min_variable_dimension ..'],
{} [33, '      clc$max_variable_dimension;'],
{} [0, ''],
{} [7, '  CONST'],
{} [48, '    clc$min_variable_dimension = - 7fffffff(16),'],
{} [46, '    clc$max_variable_dimension = 7fffffff(16);'],
{} [0, ''],
{} [6, '  TYPE'],
{} [31, '    clt$variable_scope = record'],
{} [43, '      case kind: clt$variable_scope_kind of'],
{} [49, '      = clc$local_variable .. clc$xref_variable ='],
{} [9, '        ,'],
{} [30, '      = clc$utility_variable ='],
{} [31, '        utility_name: ost$name,'],
{} [13, '      casend,'],
{} [11, '    recend,'],
{} [68, '    clt$variable_scope_kind = (clc$local_variable, clc$job_variable,'],
{} [66, '      clc$xdcl_variable, clc$xref_variable, clc$utility_variable);'],
{}
{  *copyc clt$value_kinds
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [42, '    clt$value_kinds = clt$data_value_kind;'],
{} [0, ''],
{} [7, '  CONST'],
{} [48, '    clc$variable_reference = clc$deferred_value,'],
{} [36, '    clc$any_value = clc$array_value,'],
{} [46, '    clc$unknown_value = clc$unspecified_value;'],
{}
{  *copyc clt$variable_kinds
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [62, '    clt$variable_kinds = clc$string_value .. clc$status_value;'],
{}
{  *copyc amt$local_file_name
{}
{} [0, ''],
{} [6, '  TYPE'],
{} [35, '    amt$local_file_name = ost$name;']];

?? EJECT ??

  PROCEDURE [XREF] tmp$switch_task
    (     dummy: ^cell;
          cst_p: ^ost$cpu_state_table);

   VAR
      jmv$ijle_size: [XDCL] jmt$ijle_size := 264,
      osv$cpus_logically_on: [XDCL] 0 .. osc$max_number_of_processors,
      mtv$cst0: [XDCL] ost$state_tables,
      xcb: array [0 ..49] OF ost$execution_control_block;

?? TITLE := 'create_command', EJECT ??

  PROCEDURE create_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{         PDT  create_pdt (
{           task_number, tn: INTEGER 0 .. 49 = $REQUIRED
{           priority, p: INTEGER  0 .. 15 = $REQUIRED
{           relative_priority, pr: INTEGER  0 .. 255 = 0
{           major_timeslice, mjt: INTEGER  0 .. 50 = 50
{           minor_timeslice, mnt: INTEGER  0 .. 50 = 50
{           STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    create_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^create_pdt_names,
      ^create_pdt_params];

  VAR
    create_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 11] of
      clt$parameter_name_descriptor := [['TASK_NUMBER', 1], ['TN', 1], ['PRIORITY', 2], ['P', 2], [
      'RELATIVE_PRIORITY', 3], ['PR', 3], ['MAJOR_TIMESLICE', 4], ['MJT', 4], ['MINOR_TIMESLICE', 5], ['MNT',
      5], ['STATUS', 6]];

  VAR
    create_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 6] of clt$parameter_descriptor := [

{ TASK_NUMBER TN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 49]],

{ PRIORITY P }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 15]],

{ RELATIVE_PRIORITY PR }
    [[clc$optional_with_default, ^create_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, 0, 255]],

{ MAJOR_TIMESLICE MJT }
    [[clc$optional_with_default, ^create_pdt_dv4], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, 0, 50]],

{ MINOR_TIMESLICE MNT }
    [[clc$optional_with_default, ^create_pdt_dv5], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, 0, 50]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    create_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    create_pdt_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '50';

  VAR
    create_pdt_dv5: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '50';

?? POP ??
    VAR
      ijl_ord: 1 .. 5,
      ijl_ordinal: jmt$ijl_ordinal,
      ijl_p: ^jmt$initiated_job_list_entry,
      major_timeslice: 0 .. 50,
      minor_timeslice: 0 .. 50,
      mtr_status: syt$monitor_status,
      priority: 0 .. 15,
      ptlo: ost$task_index,
      relative_priority: 0 .. 255,
      taskid: ost$global_task_id,
      task_number: 0 ..49;

    clp$scan_parameter_list (parameter_list, create_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('TASK_NUMBER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    task_number := value.int.value;

    clp$get_value ('PRIORITY', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    priority := value.int.value;

    clp$get_value ('RELATIVE_PRIORITY', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    relative_priority := value.int.value;

    clp$get_value ('MAJOR_TIMESLICE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    major_timeslice := value.int.value;

    clp$get_value ('MINOR_TIMESLICE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    minor_timeslice := value.int.value;

    xcb [task_number].dispatching_priority := priority;
    xcb [task_number].relative_task_priority := relative_priority;
    xcb [task_number].timeslice.major := major_timeslice;
    xcb [task_number].timeslice.minor := minor_timeslice;
    xcb [task_number].processor_selections := - $ost$processor_id_set [ ];
    xcb [task_number].requested_processor_selections := $ost$processor_id_set [ ];

    IF task_number < 10 THEN
      ijl_ord := 1;
    ELSEIF (task_number < 20) AND (task_number >= 10) THEN
      ijl_ord := 2;
    ELSEIF (task_number < 30) AND (task_number >= 20) THEN
      ijl_ord := 3;
    ELSEIF (task_number < 40) AND (task_number >= 30) THEN
      ijl_ord := 4;
    ELSE
      ijl_ord := 5;
    IFEND;

    ijl_ordinal.block_index := ijl_ord;
    ijl_ordinal.block_number := 0;
    jmp$get_ijle_p (ijl_ordinal, ijl_p);
    ijl_p^.ajl_ordinal := #SEGMENT (^xcb [task_number]) - 14(16);

    IF relative_priority = 0 THEN
      ijl_p^.relative_priority_enabled := FALSE;
    ELSE
      ijl_p^.relative_priority_enabled := TRUE;
    IFEND;

    ijl_p^.dispatching_control.dispatching_control_index := 1;
    ijl_p^.dispatching_control.service_remaining := UPPERVALUE (OST$FREE_RUNNING_CLOCK);

    tmp$assign_ptl (^xcb [task_number], ijl_ordinal, taskid, mtr_status);
    xcb [task_number].global_task_id := taskid;
    tmv$ptl_p^ [taskid.index].xcb_offset := #OFFSET (^xcb [task_number]);

  PROCEND create_command;

?? TITLE := 'delete_command', EJECT ??

  PROCEDURE delete_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{         PDT  delete_pdt (
{           task_number, tn: INTEGER 0 .. 49 = $REQUIRED
{           STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    delete_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^delete_pdt_names,
      ^delete_pdt_params];

  VAR
    delete_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['TASK_NUMBER', 1], ['TN', 1], ['STATUS', 2]];

  VAR
    delete_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ TASK_NUMBER TN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 49]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
    VAR
      ptlo: ost$task_index,
      taskid: ost$global_task_id,
      task_number: 0 ..49;

    clp$scan_parameter_list (parameter_list, delete_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('TASK_NUMBER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    task_number := value.int.value;

    ptlo := xcb [task_number].global_task_id.index;

    tmp$remove_task_from_dct (ptlo);

  PROCEND delete_command;

?? TITLE := 'ready_command', EJECT ??

  PROCEDURE ready_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{             PDT  ready_pdt (
{               task_number, tn: INTEGER 0 .. 49 = $REQUIRED
{               STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    ready_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^ready_pdt_names, ^ready_pdt_params
      ];

  VAR
    ready_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['TASK_NUMBER', 1], ['TN', 1], ['STATUS', 2]];

  VAR
    ready_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ TASK_NUMBER TN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 49]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
    VAR
      ijl_p: ^jmt$initiated_job_list_entry,
      ijl_ordinal: 1 .. 5,
      ptlo: ost$task_index,
      s: string (100),
      sl: integer,
      t: integer,
      taskid: ost$global_task_id,
      task_number: 0 ..49;

    clp$scan_parameter_list (parameter_list, ready_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('TASK_NUMBER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    task_number := value.int.value;

    IF task_number < 10 THEN
      ijl_ordinal := 1;
    ELSEIF (task_number < 20) AND (task_number >= 10) THEN
      ijl_ordinal := 2;
    ELSEIF (task_number < 30) AND (task_number >= 20) THEN
      ijl_ordinal := 3;
    ELSEIF (task_number < 40) AND (task_number >= 30) THEN
      ijl_ordinal := 4;
    ELSE
      ijl_ordinal := 5;
    IFEND;

    ptlo := xcb [task_number].global_task_id.index;
    tmv$ptl_p^ [ptlo].status := tmc$ts_timeout_reqexp_inflong;
    mtv$cst0 [0].xcb_p := ^xcb [task_number];
    t := #read_register (0c9(16));
    tmp$set_task_ready (xcb [task_number].global_task_id, tmc$rc_ready_conditional_wi);
    t := t - #read_register (0c9(16));
    STRINGREP (s, sl, ' time = ', t:8);
    clp$put_job_command_response (s (1, sl), status);
  PROCEND ready_command;

?? TITLE := 'switch_command', EJECT ??

  PROCEDURE switch_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{           PDT  switch_pdt (
{             task_number, tn: INTEGER 0 .. 49 = 0
{             table_lock_count, tablc: INTEGER 0 .. 256 = 0
{             time_used, timu: INTEGER 0 .. 50 = 50
{             STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    switch_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^switch_pdt_names,
      ^switch_pdt_params];

  VAR
    switch_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
      clt$parameter_name_descriptor := [['TASK_NUMBER', 1], ['TN', 1], ['TABLE_LOCK_COUNT', 2], ['TABLC', 2],
      ['TIME_USED', 3], ['TIMU', 3], ['STATUS', 4]];

  VAR
    switch_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of clt$parameter_descriptor := [

{ TASK_NUMBER TN }
    [[clc$optional_with_default, ^switch_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, 0, 49]],

{ TABLE_LOCK_COUNT TABLC }
    [[clc$optional_with_default, ^switch_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, 0, 256]],

{ TIME_USED TIMU }
    [[clc$optional_with_default, ^switch_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
      clc$integer_value, 0, 50]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

  VAR
    switch_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    switch_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (1) := '0';

  VAR
    switch_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (2) := '50';

?? POP ??
    VAR
      ijl_ordinal: jmt$ijl_ordinal,
      ijl_p: ^jmt$initiated_job_list_entry,
      ijl_ord: 1 .. 5,
      ptlo: ost$task_index,
      s: string (100),
      sl: integer,
      task_number: 0 ..49,
      taskid: ost$global_task_id,
      t: integer;

    clp$scan_parameter_list (parameter_list, switch_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('TASK_NUMBER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    task_number := value.int.value;

    clp$get_value ('TABLE_LOCK_COUNT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    xcb [task_number].system_table_lock_count := value.int.value;

    IF task_number < 10 THEN
      ijl_ord := 1;
    ELSEIF (task_number < 20) AND (task_number >= 10) THEN
      ijl_ord := 2;
    ELSEIF (task_number < 30) AND (task_number >= 20) THEN
      ijl_ord := 3;
    ELSEIF (task_number < 40) AND (task_number >= 30) THEN
      ijl_ord := 4;
    ELSE
      ijl_ord := 5;
    IFEND;
    ijl_ordinal.block_number := 0;
    ijl_ordinal.block_index := ijl_ord;
    jmp$get_ijle_p (ijl_ordinal, ijl_p);

    mtv$cst0 [0].xcb_p := ^xcb [task_number];

    clp$get_value ('TIME_USED', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    mtv$cst0 [0].accumulated_job_cptime := value.int.value * 1000;
    mtv$cst0 [0].dispatching_priority := xcb [task_number].dispatching_priority;
    mtv$cst0 [0].jcb_p := #ADDRESS (1, ijl_p^.ajl_ordinal + 14(16), 0);
    mtv$cst0 [0].ijle_p := ijl_p;
    mtv$cst0 [0].equal_priority_subpriority := 6;
    mtv$cst0 [0].cst_index := 0;
    t := #read_register (0c9(16));
    tmp$switch_task (NIL, ^mtv$cst0 [0]);
    t := t - #read_register (0c9(16));
    STRINGREP (s, sl, ' PTLO selected was ', mtv$cst0 [0].taskid.index:8);
    clp$put_job_command_response (s (1, sl), status);
    STRINGREP (s, sl, ' time = ', t:8);
    clp$put_job_command_response (s (1, sl), status);
  PROCEND switch_command;

?? TITLE := 'idle_command', EJECT ??

  PROCEDURE idle_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{             PDT  idle_pdt (
{               task_number, tn: INTEGER 0 .. 49 = $REQUIRED
{               STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    idle_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^idle_pdt_names, ^idle_pdt_params];

  VAR
    idle_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['TASK_NUMBER', 1], ['TN', 1], ['STATUS', 2]];

  VAR
    idle_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ TASK_NUMBER TN }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 49]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
    VAR
      ijl_ord: 1 .. 5,
      ijl_ordinal: jmt$ijl_ordinal,
      ijl_p: ^jmt$initiated_job_list_entry,
      ptlo: ost$task_index,
      taskid: ost$global_task_id,
      task_number: 0 ..49;

    clp$scan_parameter_list (parameter_list, idle_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('TASK_NUMBER', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    task_number := value.int.value;

    IF task_number < 10 THEN
      ijl_ord := 1;
    ELSEIF (task_number < 20) AND (task_number >= 10) THEN
      ijl_ord := 2;
    ELSEIF (task_number < 30) AND (task_number >= 20) THEN
      ijl_ord := 3;
    ELSEIF (task_number < 40) AND (task_number >= 30) THEN
      ijl_ord := 4;
    ELSE
      ijl_ord := 5;
    IFEND;
    ijl_ordinal.block_number := 0;
    ijl_ordinal.block_index := ijl_ord;
    jmp$get_ijle_p (ijl_ordinal, ijl_p);

    ptlo := xcb [task_number].global_task_id.index;
    tmv$ptl_p^ [ptlo].idle_status := tmc$is_idle_initiated;
    mtv$cst0 [0].xcb_p := ^xcb [task_number];
    mtv$cst0 [0].jcb_p := #ADDRESS (1, ijl_p^.ajl_ordinal + 14(16), 0);
    mtv$cst0 [0].ijle_p := ijl_p;
    mtv$cst0 [0].equal_priority_subpriority := 6;
    mtv$cst0 [0].cst_index := 0;
    tmp$switch_task (NIL, ^mtv$cst0 [0]);
  PROCEND idle_command;

?? TITLE := 'display_command', EJECT ??

  PROCEDURE display_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{    PDT display_pdt (
{      PRIORITY: INTEGER 0 .. 10 = $REQUIRED
{      STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    display_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^display_pdt_names,
      ^display_pdt_params];

  VAR
    display_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of
      clt$parameter_name_descriptor := [['PRIORITY', 1], ['STATUS', 2]];

  VAR
    display_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ PRIORITY }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 10]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
     VAR
       priority: 1 .. 10,
       ptlo: ost$task_index,
       s: string (100),
       sl: integer;

    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, display_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('PRIORITY', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    priority := value.int.value;

   STRINGREP (s, sl, ' DCT = ', tmv$dct [priority].queue_head:6, tmv$dct [priority].minor_priority:6,
       tmv$dct [priority].major_priority:6, tmv$dct [priority].queue_tail:6);
   clp$put_job_command_response (s (1, sl), status);
   STRINGREP (s, sl, ' DCT CHAIN ');
   clp$put_job_command_response (s (1, sl), status);
   ptlo := tmv$dct [priority].queue_head;
   REPEAT
     STRINGREP (s, sl, ptlo: 6);
     clp$put_job_command_response (s (1, sl), status);
     ptlo := tmv$ptl_p^ [ptlo].ptl_thread;
   UNTIL ptlo = 0;
  PROCEND display_command;

?? TITLE := 'controls_command', EJECT ??

  PROCEDURE controls_command
    (    param_list: clt$parameter_list;
     VAR status: ost$status);

{    PDT controls_pdt (
{    cda: LIST 1..8, 4 OF ANY
{    cdi: integer 0..600
{    STATUS);

?? PUSH (LISTEXT := ON) ??

  VAR
    controls_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^controls_pdt_names,
      ^controls_pdt_params];

  VAR
    controls_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
      clt$parameter_name_descriptor := [['CDA', 1], ['CDI', 2], ['STATUS', 3]];

  VAR
    controls_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ CDA }
    [[clc$optional], 1, 8, 4, 4, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ CDI }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 600]],

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
    CONST
      u_second = 1000000;

    VAR
      cda_record: [STATIC] jmt$cda_record := [2, [REP 8 of [0, 100, FALSE]]],
      controls_defined: boolean,
      dp: jmt$dispatching_priority,
      normalized_interval: integer,
      param_specified: boolean,
      set_index: integer,
      value_set_count: 0 .. clc$max_value_sets,
      value: clt$value;

    clp$scan_parameter_list (param_list, controls_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$test_parameter ('CDA', param_specified, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF param_specified THEN
      clp$get_set_count ('CDA', value_set_count, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      FOR set_index := 1 to value_set_count DO
        clp$get_value ('CDA', set_index, 1, clc$low, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dp := value.int.value;

        clp$get_value ('CDA', set_index, 2, clc$low, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        cda_record.control [dp].minimum := value.int.value;

        clp$get_value ('CDA', set_index, 3, clc$low, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        cda_record.control [dp].maximum := value.int.value;

        clp$get_value ('CDA', set_index, 4, clc$low, value, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        cda_record.control [dp].enforce_maximum := value.bool.value;
      FOREND;
    IFEND;

    clp$get_value ('CDI', 1, 1, clc$low, value, status);
    IF value.kind <> clc$unknown_value THEN
      cda_record.interval := value.int.value;
    IFEND;


{ Decide if controls are being defined; the user may be setting controls back to defaults
{ (0% minimum and 100% maximum).

    controls_defined := FALSE;
  /check_controls/
    FOR dp := jmc$priority_p1 TO jmc$priority_p8 DO
      IF (cda_record.control [dp].minimum <> 0) OR (cda_record.control [dp].maximum <> 100) THEN
        controls_defined := TRUE;
        EXIT /check_controls/;
      IFEND;
    FOREND /check_controls/;

{ Clear the dispatching control sets.
{ If controls are not defined, clear the controls_defined field in the dispatching table and return.
{ If controls are defined, reset the values in the dispatching table.

    tmv$dispatching_control_sets.minimums_to_satisfy := $jmt$dispatching_priority_set [1,2,3,4,5,6];
    tmv$dispatching_control_sets.maximums_exceeded := $jmt$dispatching_priority_set [];
    tmv$dispatching_control_sets.enforce_maximums := $jmt$dispatching_priority_set [];

    IF NOT controls_defined THEN
      tmv$dispatching_controls.controls_defined := FALSE;
    ELSE
      tmv$dispatching_controls.controls_defined := TRUE;
      tmv$dispatching_controls.minimums_to_satisfy := $jmt$dispatching_priority_set [1,2,3,4,5,6];
      tmv$dispatching_controls.maximums_defined := $jmt$dispatching_priority_set [];
      tmv$dispatching_controls.controls.time_left_in_interval := cda_record.interval * u_second;
      normalized_interval := tmv$dispatching_controls.controls.time_left_in_interval DIV 100;
      FOR dp := jmc$priority_p1 TO jmc$priority_p8 DO
        IF cda_record.control [dp].minimum <> 0 THEN
          tmv$dispatching_controls.controls.dispatching_priority_time [dp].minimum_time :=
                (normalized_interval) * cda_record.control [dp].minimum;
          tmv$dispatching_controls.minimums_to_satisfy := tmv$dispatching_controls.minimums_to_satisfy +
                $jmt$dispatching_priority_set [jmc$dp_conversion - dp];
        ELSE
          tmv$dispatching_controls.controls.dispatching_priority_time [dp].minimum_time := 0;
        IFEND;
        IF cda_record.control [dp].maximum <> 100 THEN
          tmv$dispatching_controls.controls.dispatching_priority_time [dp].maximum_time :=
                (normalized_interval) * cda_record.control [dp].maximum;
          tmv$dispatching_controls.maximums_defined := tmv$dispatching_controls.maximums_defined +
                $jmt$dispatching_priority_set [jmc$dp_conversion - dp];
        ELSE
          tmv$dispatching_controls.controls.dispatching_priority_time [dp].maximum_time := 0;
        IFEND;
        IF cda_record.control [dp].enforce_maximum THEN
          tmv$dispatching_control_sets.enforce_maximums := tmv$dispatching_control_sets.enforce_maximums +
                $jmt$dispatching_priority_set [jmc$dp_conversion - dp];
        IFEND;
      FOREND;
      tmv$dispatching_control_sets.minimums_to_satisfy := tmv$dispatching_controls.minimums_to_satisfy;
      tmv$dispatching_control_time := tmv$dispatching_controls.controls;
    IFEND;

  PROCEND controls_command;

?? TITLE := 'quit_command', EJECT ??

  PROCEDURE quit_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{   PDT quit_pdt (
{     STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^quit_pdt_names, ^quit_pdt_params];

  VAR
    quit_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
      clt$parameter_name_descriptor := [['STATUS', 1]];

  VAR
    quit_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1] of clt$parameter_descriptor := [

{ STATUS }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
      clc$array_not_allowed, clc$status_value]]];

?? POP ??
    status.normal := TRUE;
    clp$scan_parameter_list (parameter_list, quit_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_include (utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
  PROCEND quit_command;


  PROGRAM tmp$invoke_test_harness
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ table command_table t=c sn=oss$job_paged_literal s=local
{ command (create_task                    ,cret) create_command cm=local
{ command (delete_task                    ,delt) delete_command cm=local
{ command (ready_task                     ,reat) ready_command cm=local
{ command (display_dct                    ,disd) display_command cm=local
{ command (idle_task                      ,idet) idle_command cm=local
{ command (switch_task                    ,swit) switch_command cm=local
{ command (create_controls                ,crec) controls_command cm=local
{ command (quit                           ,end)  quit_command cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??
VAR
  command_table: [STATIC, READ, oss$job_paged_literal] ^clt$command_table := ^command_table_entries,

  command_table_entries: [STATIC, READ, oss$job_paged_literal] array [1 .. 16] of
      clt$command_table_entry := [
  {} ['CREATE_CONTROLS                ', clc$nominal_entry, clc$advertised_entry, 7,
        clc$automatically_log, clc$linked_call, ^controls_command],
  {} ['CREATE_TASK                    ', clc$nominal_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^create_command],
  {} ['CREC                           ', clc$abbreviation_entry, clc$advertised_entry, 7,
        clc$automatically_log, clc$linked_call, ^controls_command],
  {} ['CRET                           ', clc$abbreviation_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^create_command],
  {} ['DELETE_TASK                    ', clc$nominal_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^delete_command],
  {} ['DELT                           ', clc$abbreviation_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^delete_command],
  {} ['DISD                           ', clc$abbreviation_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^display_command],
  {} ['DISPLAY_DCT                    ', clc$nominal_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^display_command],
  {} ['END                            ', clc$abbreviation_entry, clc$advertised_entry, 8,
        clc$automatically_log, clc$linked_call, ^quit_command],
  {} ['IDET                           ', clc$abbreviation_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^idle_command],
  {} ['IDLE_TASK                      ', clc$nominal_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^idle_command],
  {} ['QUIT                           ', clc$nominal_entry, clc$advertised_entry, 8,
        clc$automatically_log, clc$linked_call, ^quit_command],
  {} ['READY_TASK                     ', clc$nominal_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^ready_command],
  {} ['REAT                           ', clc$abbreviation_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^ready_command],
  {} ['SWIT                           ', clc$abbreviation_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^switch_command],
  {} ['SWITCH_TASK                    ', clc$nominal_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^switch_command]];

?? POP ??


    VAR
      file_attachment: array [1 .. 3] of fst$attachment_option,
      i: integer,
      input_file: amt$local_file_name,
      local_status: ost$status,
      max_ptlo: ost$task_index,
      segment_pointer: amt$segment_pointer,
      unique_name: ost$unique_name,
      utility_attributes: array [1 .. 4] of clt$utility_attribute;

    status.normal := TRUE;
    osv$cpus_logically_on := 1;

    ALLOCATE jmv$ijl_p.block_p: [0 .. 3];
    ALLOCATE jmv$ijl_p.block_p^ [0].index_p;
    pmp$zero_out_table (#LOC (jmv$ijl_p.block_p^ [0].index_p^),
           #SIZE (jmv$ijl_p.block_p^ [0].index_p^));

    ALLOCATE tmv$ptl_p: [0 .. 49];
    pmp$zero_out_table (#LOC (tmv$ptl_p^), #SIZE (tmv$ptl_p^));

    max_ptlo := UPPERBOUND (tmv$ptl_p^);
    FOR i := 1 TO max_ptlo DO
      tmv$ptl_p^ [i].ptl_thread := i + 1;
      tmv$ptl_p^ [i].index := i MOD 256;
    FOREND;
    tmv$ptl_p^ [max_ptlo].ptl_thread := 0;

{ Initialize the free queue control block.

    tmv$dct [jmc$null_dispatching_priority].queue_head := 1;
    tmv$dct [jmc$null_dispatching_priority].queue_tail := max_ptlo;
    tmv$tables_initialized := TRUE;

    utility_attributes [1].key := clc$utility_command_search_mode;
    utility_attributes [1].command_search_mode := clc$global_command_search;
    utility_attributes [2].key := clc$utility_command_table;
    utility_attributes [2].command_table := command_table;
    utility_attributes [3].key := clc$utility_termination_command;
    utility_attributes [3].termination_command := 'quit';
    utility_attributes [4].key := clc$utility_prompt;
    utility_attributes [4].prompt.value := prompt_string;
    utility_attributes [4].prompt.size := prompt_string_size;

    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$include_file (clc$current_command_input, '', utility_name, status);

    clp$end_utility (utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND tmp$invoke_test_harness;

MODEND tmm$dispatcher_test_harness;
