?? RIGHT := 110 ??
*copyc osd$default_pragmats
?? NEWTITLE := 'FS test harness support' ??
MODULE fsm$test_harness_fs_support;

{
{ This module contains support code for the FS test harness
{ in the following groups:
{   1. variables,
{   2. loader,
{   3. os,
{   4. device manager,
{   5. memory manager,
{   6. conversion to real bam,
{   7. miscellaneous,
{   8. accounting/validation,
{   9. set manager,
{  10. interactive,
{  11. logging,
{  12. tape (required and non-essential),
{  13. command language,
{  14. commands and functions.
{


*copyc clc$compiling_for_test_harness
*copyc fsc$compiling_for_test_harness

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc lgc$default_preallocation_size
*copyc amt$local_file_name
*copyc avt$password
*copyc dmt$chapter_number
*copyc dmt$error_condition_codes
*copyc dmt$file_type
*copyc dmt$file_share_history
*copyc dmt$locked_file
*copyc dmt$new_file_attribute
*copyc dmt$reconcile_locator
*copyc dmt$segment_file_information
*copyc dmt$stored_fmd
*copyc dmt$stored_fmd_size
*copyc dpt$window_id
*copyc fsc$local
*copyc fst$attachment_options
*copyc ift$terminal_attributes
*copyc iit$connection_description
*copyc jme$queued_file_conditions
*copyc jmt$job_class_set
*copyc jmt$job_count_range
*copyc jmt$job_status_count
*copyc jmt$job_status_options
*copyc jmt$job_status_results
*copyc mmt$attribute_keyword
*copyc mmt$lus_declarations
*copyc oss$job_pageable
*copyc oss$job_paged_literal
*copyc oss$mainframe_pageable
*copyc ost$heap
*copyc osv$mainframe_pageable_heap
*copyc pmt$initialization_value
*copyc pud$cycle_reference
*copyc pue$error_condition_codes
*copyc pus$literals
*copyc ste$error_condition_codes
*copyc amt$display_tft_options
*copyc iot$io_id
*copyc iot$tape_io_status
*copyc iot$tape_block_count
*copyc iot$tape_block_count
*copyc iot$io_id
*copyc iot$write_tape_description
*copyc cmt$element_name
*copyc cmt$logical_pp_table
*copyc cmt$logical_unit_table
*copyc dmt$mainframe_allocation_table
*copyc dmt$file_descriptor_entry
*copyc ost$cpu_state_table
*copyc syt$value_kinds
{copyc ttt$states
*copyc iot$read_tape_description
*copyc dmt$active_volume_table
*copyc oss$mainframe_wired
?? POP ??
*copyc amp$#copy_file
*copyc amp$close
*copyc amp$get_file_attributes
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$set_segment_eoi
*copyc i#move
*copyc amp$#close
*copyc amp$#get_file_attributes
*copyc amp$#get_partial
*copyc amp$#get_segment_pointer
*copyc amp$#open
*copyc amp$#set_segment_eoi
*copyc bap$task_termination_cleanup
*copyc bap$validate_file_identifier
*copyc clp$convert_cyc_ref_to_cyc_sel
*copyc clp$end_scan_command_file
{copyc clp$get_fs_path_elements
*copyc clp$get_value
*copyc clp$pop_parameters
*copyc clp$push_parameters
*copyc clp$scan_argument_list
*copyc clp$scan_parameter_list
*copyc fmp$get_system_file_id
*copyc fmp$job_exit
*copyc fmp$recover_job_files
*copyc fsp$convert_fs_structure_to_pf
*copyc ifp$fap_control_ring_3
*copyc osp$append_status_parameter
*copyc osp$get_set_name
*copyc osp$set_status_abnormal
*copyc pfp$change_family_name
*copyc pfp$define_master_catalog
*copyc pfp$overhaul_catalog
*copyc pfp$overhaul_set
*copyc pfp$process_job_end
*copyc pfp$purge_master_catalog
*copyc pmp$load

{
{ Clp$get_fs_path_elements assumes that the path_handle_name it receives
{ as input represents a path_handle, i.e. it can be converted to an
{ fmt$path_handle.
{

  PROCEDURE [INLINE] clp$get_fs_path_elements
    (    path_handle_name: amt$local_file_name;
     VAR evaluated_file_reference: fst$evaluated_file_reference;
     VAR status: ost$status);

?? PUSH (LISTEXT := ON) ??

    VAR
      cl_path_handle: clt$path_handle,
      ignore_status: ost$status;

    status.normal := TRUE;

    clp$check_name_for_path_handle (path_handle_name, cl_path_handle);
    IF cl_path_handle.kind = clc$command_file_handle THEN
      osp$set_status_abnormal ('CL', cle$inappropriate_cmnd_file_ref, '',
            status);
      RETURN;
    IFEND;

    bap$get_path_elements (cl_path_handle.regular_handle,
          evaluated_file_reference, status);
    IF NOT status.normal THEN
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status,
            ignore_status);
      osp$set_status_abnormal ('CL', cle$system_error, '', status);
    IFEND;

  PROCEND clp$get_fs_path_elements;

*copyc amt$local_file_name
*copyc cle$ecc_command_processing
*copyc cle$ecc_file_reference
*copyc fst$evaluated_file_reference
*copyc pmd$system_log_interface
?? POP ??
*copyc bap$get_path_elements
*copyc clp$check_name_for_path_handle
*copyc osp$set_status_abnormal
  PROCEDURE [XREF] display
    (    display_line: string ( * <= 256));


  PROCEDURE [XREF] display_integer
    (    descriptor: string ( * <= 128);
         number: integer);


  PROCEDURE [XREF] display_integer_to_log
    (    descriptor: string ( * <= 128);
         number: integer);


  PROCEDURE [XREF] display_job_information
    (    display_current_job: boolean;
         display_current_task: boolean);


  PROCEDURE [XREF] display_status
    (    status: ost$status);


  PROCEDURE [XREF] display_status_to_log
    (    status: ost$status);


  PROCEDURE [XREF] display_to_log
    (    display_line: string ( * <= 256));


  PROCEDURE [XREF] set_job_terminated
    (    job_id: integer);


  PROCEDURE [XREF] set_task_terminated
    (    task_id: pmt$task_id);


  PROCEDURE [XREF] switch_jobs
    (    next_job_id: integer;
     VAR next_job_active: boolean);


  PROCEDURE [XREF] switch_tasks
    (    next_task_id: pmt$task_id;
     VAR next_task_active: boolean);



  VAR
    pfv$p_catalog_alarm_table: [XREF] pft$p_catalog_alarm_table;

  VAR
    pfv$p_newest_queued_catalog: [XREF] pft$p_queued_catalog;

  VAR
    pfv$p_queued_catalog_table: [XREF] pft$p_queued_catalog_table;

  VAR
    max_number_of_jobs: [XREF] integer,
    max_number_of_tasks: [XREF] pmt$task_id;

  ?IF NOT clc$compiling_for_test_harness THEN
    VAR
      userbam_utility_name: [XREF] ost$name;
  ?IFEND

?? TITLE := 'Stubbed variables', EJECT ??

  VAR
    lgv$global_log_ctl: [XDCL, #GATE, oss$mainframe_pageable] array [pmt$global_logs] of
          lgt$log_control_descriptor := [
          [*, pmc$account_log,       0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE],
          [*, pmc$engineering_log,   0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE],
          [*, pmc$history_log,       0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE],
          [*, pmc$security_log,      0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE],
          [*, pmc$statistic_log,     0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE],
          [*, pmc$system_log,        0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE]];

  VAR
    lgv$local_log_ctl: [XDCL, #GATE, oss$job_pageable] array [pmt$logs] of ^lgt$log_control_descriptor := [
          ^lgv$job_account_log_lcd, ^lgv$job_statistic_log_lcd, NIL, NIL, NIL, NIL, NIL, NIL,
          ^lgv$job_log_lcd],

    lgv$job_account_log_lcd: [STATIC, oss$job_pageable] lgt$log_control_descriptor :=
          [*, pmc$job_account_log,   0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE],

    lgv$job_statistic_log_lcd: [STATIC, oss$job_pageable] lgt$log_control_descriptor :=
          [*, pmc$job_statistic_log, 0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE],

    lgv$job_log_lcd: [STATIC, oss$job_pageable] lgt$log_control_descriptor :=
          [*, pmc$job_log,           0, NIL, NIL, lgc$maximum_log_size,
                lgc$default_preallocation_size, FALSE, 0, FALSE];

  VAR
    mmv$max_segment_length: [XDCL] integer := 99999744;

  VAR
    syv$inhibit_job_recovery: integer := 0;

  VAR
    syv$test_jr_job: [XDCL] syt$test_jr_set := $syt$test_jr_set [];

  TYPE
    syt$test_jr_set = set of 0 .. 255;

  VAR
    syv$test_jr_system: [XDCL] syt$test_jr_set := $syt$test_jr_set [];

  VAR
    fmv$system_path_table_size: [XDCL] integer := 40,
    fmv$system_cycle_table_size: [XDCL] integer := 12;

  VAR
    dfv$file_server_info_enabled: [XDCL] boolean := FALSE;

  VAR
    osv$system_family_name: [XDCL] ost$name := '$SYSTEM                        ';

  VAR
    mmv$preset_conversion_table: [XDCL] array [pmt$initialization_value]
        of integer;

  VAR
    iiv$connection_desc_ptr: [XDCL,#GATE] ^iit$connection_description := NIL;

  VAR
    iiv$network_identifier: [XDCL, #GATE] iit$network_identifier := iic$dsiaf_network;

  VAR
    dump_to_pf: [XDCL] boolean := FALSE,
    syv$job_template_ptr_array: [XDCL, #GATE] ^array [1 .. * ] of ^cell := NIL;

  VAR
    dmv$p_active_volume_table: [XDCL, STATIC, #GATE, oss$mainframe_wired] ^dmt$active_volume_table;

  ?IF NOT clc$compiling_for_test_harness THEN

    VAR
      clv$value_descriptors: [XDCL, READ, oss$job_paged_literal] array
            [clc$variable_reference .. clc$status_value] of string (8) := ['VARIABLE', 'FILE', 'NAME',
            'STRING', 'REAL', 'INTEGER', 'BOOLEAN', 'STATUS'];

  ?IFEND

  CONST
    fmd_header = 'PF_CATALOG_STORED_FMD          ';

  TYPE
    zzzz = (job, system);

  VAR
    current_user_id: ost$user_identification := ['GLS', 'NVE3'];

  VAR
    global_system_administrator: [XDCL] boolean := FALSE,
    global_family_administrator: [XDCL] boolean := TRUE;

  VAR
    global_file_entry_index: integer := 1;

  VAR
    pf_root_created: boolean := FALSE;

  VAR
    p_pf_root: ^pft$root := NIL;

  VAR
    real_terminal_connected: [STATIC] boolean := FALSE,
    real_terminal_input_file_id: [STATIC] amt$file_identifier,
    real_terminal_output_file_id: [STATIC] amt$file_identifier,
    real_terminal_command_file_id: [STATIC] amt$file_identifier;

  VAR
    segment_to_real_file_table: [STATIC] array [1 .. 100] of record
      segment_number: ost$segment,
      eoi: amt$file_byte_address,
      sfid: gft$system_file_identifier,
      real_file_id: amt$file_identifier,
    recend := [REP 100 of [0, 0, [1, gfc$tr_system, 12], [2, 2]]];

  VAR
    file_usage_table: [STATIC] array [1 .. 100] of record
      eoi: amt$file_byte_address,
      file_usage: dmt$usage_count,
    recend := [REP 100 of [0, 0]];

  VAR
    last_real_file_name: [XDCL] amt$local_file_name;

?? TITLE := 'Loader stubs ', EJECT ??

  PROCEDURE [XDCL] lop$load_entry_point
    (    name: pmt$program_name;
         reference_ring: ost$valid_ring;
         reference_global_key: ost$key_lock_value;
         kind: pmt$loaded_address_kind;
     VAR address: pmt$loaded_address;
     VAR status {control} : ost$status);

    display (' lop$load_entry_point  LOADING');
    pmp$load (name, kind, address, status);
  PROCEND lop$load_entry_point;
?? TITLE := 'Os stubs ', EJECT ??

  PROCEDURE [XDCL] osp$generate_unique_binary_name
    (VAR name: ost$binary_unique_name;
     VAR status: ost$status);

    VAR
      sequence_number: [STATIC] integer := 1;

    {display (' osp$generate_unique_binary_name stub');
    status.normal := TRUE;
    name.serial_number := 101;
    name.model_number := osc$cyber_2000_model_20u1;
    name.year := 1984;
    name.month := 6;
    name.day := 7;
    name.hour := 1;
    name.minute := 1;
    name.second := 1;
    name.sequence_number := sequence_number;
    sequence_number := sequence_number + 1;
  PROCEND osp$generate_unique_binary_name;
?? SKIP := 5 ??

  PROCEDURE [XDCL] osp$initialize_signature_lock
    (VAR lock: ost$signature_lock;
     VAR status: ost$status);
  PROCEND osp$initialize_signature_lock;
?? SKIP := 5 ??

  PROCEDURE [XDCL] osp$test_signature_lock
    (VAR lock: ost$signature_lock;
     VAR lock_status: ost$signature_lock_status;
     VAR status: ost$status);

    status.normal := TRUE;
    IF lock.lock_id = 0 THEN
      lock_status := osc$sls_not_locked;
    ELSE
      lock_status := osc$sls_locked_by_current_task;
    IFEND;
    {display (' osp$test_signature_lock stub');
  PROCEND osp$test_signature_lock;
?? SKIP := 5 ??

  PROCEDURE [XDCL] osp$clear_signature_lock
    (VAR lock: ost$signature_lock;
     VAR status: ost$status);

    status.normal := TRUE;
    IF lock.lock_id <> 12 THEN
      display (' lock not set ');
      osp$set_status_abnormal ('GS', 333000, 'LOCK NOT SET', status);
    IFEND;
    lock.lock_id := 0;
    {display (' osp$clear_signature_lock stub');
  PROCEND osp$clear_signature_lock;
?? SKIP := 5 ??

  PROCEDURE [XDCL] osp$recoverable_system_error
    (    error_message: string ( * );
         p_status: ^ost$status);

    display (' osp$recoverable_system_error');
    display (error_message);
    IF p_status <> NIL THEN
      display_status (p_status^);
    IFEND;
  PROCEND osp$recoverable_system_error;
?? SKIP := 5 ??


  PROCEDURE [XDCL] pmp$log_ascii
    (    text: pmt$log_msg_text;
         log: pmt$ascii_logset;
         origin: pmt$log_msg_origin;
     VAR status: ost$status);

    display (' pmp$log_ascii');
    display (text);
    status.normal := TRUE;
  PROCEND pmp$log_ascii;

?? SKIP := 5 ??


  PROCEDURE [XDCL] pmp$get_user_identification
    (VAR user_identification: ost$user_identification;
     VAR status: ost$status);

    status.normal := TRUE;
    user_identification := current_user_id;
  PROCEND pmp$get_user_identification;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dpp$put_critical_message
    (    text: string ( * );
     VAR status: ost$status);

    display (' dpp$put_critical_message');
    display (text);
    status.normal := TRUE;
  PROCEND dpp$put_critical_message;
?? SKIP := 5 ??

  PROCEDURE [XDCL] syp$cycle;

    display ('syp$cycle');
  PROCEND syp$cycle;
?? TITLE := 'Device manager stubs', EJECT ??

  PROCEDURE [XDCL] dmp$close_segment_access_file
    (    pva: ^cell;
     VAR status: ost$status);

    VAR
      file_id: amt$file_identifier;

    remove_segment_number (#SEGMENT (pva), file_id);
    amp$#close (file_id, status);
  PROCEND dmp$close_segment_access_file;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$fetch_segment_file_info
    (    sfid: gft$system_file_identifier;
         chapter: dmt$chapter_number;
     VAR file_info: dmt$segment_file_info;
     VAR status: ost$status);

    file_info.usage_count := file_usage_table [sfid.file_entry_index].file_usage;
    status.normal := TRUE;
  PROCEND dmp$fetch_segment_file_info;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$open_file_for_segment_acces
    (    sfid: gft$system_file_identifier;
         p_seg_attributes: ^array [ * ] OF mmt$attribute_descriptor;
     VAR segment_pointer: mmt$segment_pointer;
     VAR status: ost$status);

    open_segment (sfid, file_usage_table [sfid.file_entry_index].eoi, segment_pointer, status);
  PROCEND dmp$open_file_for_segment_acces;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$create_file_entry
    (    file_type: dmt$file_type;
         file_usage: pft$usage_selections;
         file_share_selections: pft$share_selections;
         file_share_history: dmt$file_share_history;
         p_file_attribute: ^array [ * ] OF dmt$new_file_attribute;
         byte_address: amt$file_byte_address;
         assign_volume: boolean;
     VAR global_file_name: dmt$global_file_name;
     VAR system_file_id: gft$system_file_identifier;
     VAR status: ost$status);

    osp$generate_unique_binary_name (global_file_name, status);
    system_file_id.file_entry_index := global_file_entry_index;
    display_integer (' dmp$create_file_entry jjj', system_file_id.file_entry_index);
    global_file_entry_index := global_file_entry_index + 1;
    system_file_id.residence := gfc$tr_system;
    system_file_id.file_hash := 12;
    file_usage_table [system_file_id.file_entry_index].file_usage := 1;

  PROCEND dmp$create_file_entry;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$destroy_file
    (VAR system_file_id: gft$system_file_identifier;
     VAR status: ost$status);

    VAR
      command_string: ost$name;

    status.normal := TRUE;
    display_integer (' dmp$destroy_file jjj', system_file_id.file_entry_index);
{    build_name ('$system.detach_file,jjj', system_file_id.file_entry_index, command_string); display ('
    {dmp$destroy_file stub');
{    {display (command_string);
{    clp$scan_command_line (command_string, status);
{    display_status (status);
{    global_file_entry_index := global_file_entry_index - 1;

  PROCEND dmp$destroy_file;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$fetch_eoi
    (    sfid: gft$system_file_identifier;
     VAR eoi: amt$file_byte_address;
     VAR status: ost$status);

    display (' dmp$fetch_eoi stub');
    eoi := file_usage_table [sfid.file_entry_index].eoi;
    status.normal := TRUE;
  PROCEND dmp$fetch_eoi;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$set_eoi
    (    sfid: gft$system_file_identifier;
         eoi: amt$file_byte_address;
     VAR status: ost$status);

    display (' dmp$set_eoi stub');
    file_usage_table [sfid.file_entry_index].eoi := eoi;
    status.normal := TRUE;
    {display (' exit dmp$set_eoi');
  PROCEND dmp$set_eoi;
?? SKIP := 5 ??
{ DEVICE MANAGEMENT STUBS
{   FMD FORMAT:
{      FMD_HEADER: SFID


  PROCEDURE [XDCL] dmp$attach_file
    (    global_file_name: dmt$global_file_name;
         file_type: dmt$file_type;
         stored_fmd: dmt$stored_fmd;
         file_usage: pft$usage_selections;
         file_share_selections: pft$share_selections;
         file_history: dmt$file_share_history;
         file_limit: amt$file_limit;
         locked_file: dmt$locked_file;
     VAR system_file_id: gft$system_file_identifier;
     VAR status: ost$status);

    VAR
      p_fmd: ^dmt$stored_fmd,
      p_fmd_header: ^ost$name,
      p_sfid: ^gft$system_file_identifier;

    p_fmd := ^stored_fmd;

    RESET p_fmd;
    NEXT p_fmd_header IN p_fmd;
    IF p_fmd_header = NIL THEN
      display (' NIL p_fmd_header IN dmp$attach_file');
    ELSEIF p_fmd_header^ <> fmd_header THEN
      display (' Unexpected fmd header');
      display (p_fmd_header^);
    IFEND;
    NEXT p_sfid IN p_fmd;
    system_file_id := p_sfid^;
    display_integer (' dmp$attach_file jjj', system_file_id.file_entry_index);
    file_usage_table [system_file_id.file_entry_index].file_usage :=
          file_usage_table [system_file_id.file_entry_index].file_usage + 1;

    status.normal := TRUE;
  PROCEND dmp$attach_file;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$destroy_permanent_file
    (    global_file_name: dmt$global_file_name;
         stored_fmd: dmt$stored_fmd;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND dmp$destroy_permanent_file;
?? SKIP := 4 ??


  PROCEDURE [XDCL] dmp$detach_file
    (    system_file_id: gft$system_file_identifier;
         flush_pages: boolean;
     VAR file_modified: boolean;
     VAR fmd_modified: boolean;
     VAR status: ost$status);

    display_integer (' dmp$detach_file jjj', system_file_id.file_entry_index);
    file_usage_table [system_file_id.file_entry_index].file_usage :=
          file_usage_table [system_file_id.file_entry_index].file_usage - 1;
    fmd_modified := FALSE;
    file_modified := FALSE;
    status.normal := TRUE;
  PROCEND dmp$detach_file;
?? SKIP := 4 ??

  PROCEDURE [XDCL] dmp$delete_file_descriptor
    (    system_file_id: gft$system_file_identifier;
     VAR status: ost$status);


    IF file_usage_table [system_file_id.file_entry_index].file_usage > 0 THEN
      display_integer (' dmp$delete_file_descriptor did not delete  jjj', system_file_id.file_entry_index);
      osp$set_status_abnormal ('DM', dme$file_descriptor_not_deleted, ' file in use', status);
    ELSE
      display_integer (' dmp$delete_file_descriptor deleted  jjj', system_file_id.file_entry_index);
      status.normal := TRUE;
    IFEND;


  PROCEND dmp$delete_file_descriptor;
?? SKIP := 4 ??


  PROCEDURE [XDCL] dmp$get_stored_fmd
    (    system_file_id: gft$system_file_identifier;
     VAR stored_fmd: dmt$stored_fmd;
     VAR status: ost$status);

    VAR
      p_fmd: ^dmt$stored_fmd,
      p_fmd_header: ^ost$name,
      p_sfid: ^gft$system_file_identifier;

    p_fmd := ^stored_fmd;
    RESET p_fmd;
    NEXT p_fmd_header IN p_fmd;
    p_fmd_header^ := fmd_header;
    NEXT p_sfid IN p_fmd;
    p_sfid^ := system_file_id;

    status.normal := TRUE;
  PROCEND dmp$get_stored_fmd;
?? SKIP := 4 ??

  PROCEDURE [XDCL] dmp$get_stored_fmd_size
    (    system_file_id: gft$system_file_identifier;
     VAR size_of_stored_fmd: dmt$stored_fmd_size;
     VAR status: ost$status);

    status.normal := TRUE;
    size_of_stored_fmd := 31 {#SIZE (ost$name)CY BUG} + #SIZE (gft$system_file_identifier);
  PROCEND dmp$get_stored_fmd_size;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$build_sorted_dfl
    (    set_name: stt$set_name;
     VAR reconcile_locator: dmt$reconcile_locator;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND dmp$build_sorted_dfl;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$reconcile_fmd
    (    reconcile_locator: dmt$reconcile_locator;
         global_file_name: dmt$global_file_name;
         stored_fmd: dmt$stored_fmd;
         purge_file: boolean;
     VAR stored_fmd_size: dmt$stored_fmd_size;
     VAR status: ost$status);

    VAR
      reconcile_count: [STATIC] integer := 0;

    reconcile_count := reconcile_count + 1;
    IF (reconcile_count = 3) OR (reconcile_count = 7) THEN
      osp$set_status_abnormal ('GS', 333000, 'unable to reconcile', status);
    ELSE
      IF reconcile_count > 10 THEN
        reconcile_count := 0;
      IFEND;
    IFEND;
    status.normal := TRUE;
  PROCEND dmp$reconcile_fmd;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$get_reconciled_fmd
    (    reconcile_locator: dmt$reconcile_locator;
         global_file_name: dmt$global_file_name;
         old_stored_fmd: dmt$stored_fmd;
     VAR new_stored_fmd: dmt$stored_fmd;
     VAR status: ost$status);

    new_stored_fmd := old_stored_fmd;
    status.normal := TRUE;
  PROCEND dmp$get_reconciled_fmd;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$release_sorted_dfl
    (    reconcile_locator: dmt$reconcile_locator;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND dmp$release_sorted_dfl;
?? SKIP := 4 ??

  PROCEDURE [XDCL] dmp$device_file_list_update
    (    reconcile_locator: dmt$reconcile_locator;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND dmp$device_file_list_update;


?? TITLE := 'Memory manager stubs', EJECT ??

  PROCEDURE [XDCL] mmp$open_file_segment
    (    sfid: gft$system_file_identifier;
         seg_attributes_p: ^array [ * ] OF mmt$attribute_descriptor;
         pointer_kind: mmt$segment_pointer_kind;
         validation_ring_number: ost$valid_ring;
         chapter_number: dmt$chapter_number;
     VAR pointer: mmt$segment_pointer;
     VAR status: ost$status);



    VAR
      bam_pointer: amt$segment_pointer,
      file_name: ost$name,
      eoi: amt$file_length,
      display_string: string (31);

    {display (' mmp$open_file_segment stub');
    build_name ('jjj', sfid.file_entry_index, file_name);
{   get_file_length (file_name, eoi, status);
    last_real_file_name := file_name;

    open_segment (sfid, file_usage_table [sfid.file_entry_index].eoi, pointer, status);

  PROCEND mmp$open_file_segment;

  PROCEDURE get_file_length
    (    lfn: amt$local_file_name;
     VAR file_length: amt$file_length;
     VAR status: ost$status);

    VAR
      contains_data: boolean,
      existing_file: boolean,
      local_file: boolean,
      p_file_attributes: ^amt$get_attributes;

    PUSH p_file_attributes: [1 .. 1];
    p_file_attributes^ [1].key := amc$file_length;
    amp$#get_file_attributes (lfn, p_file_attributes^, local_file, existing_file, contains_data, status);
    IF status.normal THEN
      IF (NOT existing_file) OR (NOT contains_data) THEN
        file_length := 0;
      ELSE
        file_length := p_file_attributes^ [1].file_length;
      IFEND;
      display_integer (' user file length :', file_length);
    IFEND;
  PROCEND get_file_length;
?? SKIP := 5 ??

  PROCEDURE [XDCL] mmp$close_segment
    (VAR pointer: mmt$segment_pointer;
         validation_ring_number: ost$valid_ring;
     VAR status: ost$status);

    {display (' mmp$close_segment stub');

    VAR
      file_id: amt$file_identifier;

{  map segment number into REAL file identifier and real amp$#close
    display (' close segment');
    remove_segment_number (#SEGMENT (pointer.cell_pointer), file_id);
    amp$#close (file_id, status);
  PROCEND mmp$close_segment;
?? SKIP := 5 ??

  PROCEDURE [XDCL] mmp$set_segment_length
    (    pva: ^cell;
         validation_ring_number: ost$valid_ring;
         segment_length: ost$segment_length;
     VAR status: ost$status);

    {display (' mmp$set_segment_length stub');
    {map segment number into REAL           file id, and real amp$set_segment_eoi

    VAR
      j: integer,
      i: integer;

    status.normal := TRUE;
    FOR i := 1 TO 100 DO
      IF #SEGMENT (pva) = segment_to_real_file_table [i].segment_number THEN
        segment_to_real_file_table [i].eoi := segment_length;
        j := segment_to_real_file_table [i].sfid.file_entry_index;
        file_usage_table [j].eoi := segment_length;
{       store_eoi (pva, segment_length, segment_to_real_file_table [i].real_file_id);
        RETURN;
      IFEND;
    FOREND;
    display (' unable to find segment');
  PROCEND mmp$set_segment_length;

  PROCEDURE store_eoi
    (    pva: ^cell;
         segment_length: ost$segment_length;
         file_id: amt$file_identifier);

    VAR
      status: ost$status,
      bam_pointer: amt$segment_pointer;

    bam_pointer.kind := amc$cell_pointer;
    bam_pointer.cell_pointer := #ADDRESS (#RING (pva), #SEGMENT (pva), segment_length);
    amp$#set_segment_eoi (file_id, bam_pointer, status);
    IF NOT status.normal THEN
      display_status (status);
    IFEND;
  PROCEND store_eoi;
?? SKIP := 5 ??

  PROCEDURE [XDCL] mmp$get_segment_length
    (    pva: ^cell;
         validation_ring_number: ost$valid_ring;
     VAR segment_length: ost$segment_length;
     VAR status: ost$status);

    VAR
      i: integer;

    status.normal := TRUE;
    display (' mmp$get_segment_length');
    segment_length := 0;

    status.normal := TRUE;
    FOR i := 1 TO 100 DO
      IF #SEGMENT (pva) = segment_to_real_file_table [i].segment_number THEN
        segment_length := segment_to_real_file_table [i].eoi;
        RETURN;
      IFEND;
    FOREND;
    display (' unable to find segment');
  PROCEND mmp$get_segment_length;
?? SKIP := 5 ??

  PROCEDURE [XDCL] mmp$write_modified_pages
    (    pva: ^cell;
         length: ost$byte_count;
         waitopt: ost$wait;
     VAR status: ost$status);

    status.normal := TRUE; {no need to really do this }
    {display (' mmp$write_modified           pages stub');
  PROCEND mmp$write_modified_pages;
?? SKIP := 5 ??

  PROCEDURE [XDCL] mmp$lock_segment
    (    p: ^cell;
         access: mmt$lus_lock_type;
         wait: ost$wait;
     VAR status: ost$status);

    IF access = mmc$lus_lock_for_read THEN
      display (' mmp$lock_segment mmc$lus_lock_for_read');
    ELSE
      display (' mmp$lock_segment mmc$lus_lock_for_write');
    IFEND;

    status.normal := TRUE;
  PROCEND mmp$lock_segment;
?? SKIP := 5 ??



  PROCEDURE [XDCL] mmp$unlock_segment
    (    p: ^cell;
         page_disposition: mmt$lus_page_disposition;
         wait: ost$wait;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND mmp$unlock_segment;
?? TITLE := 'Conversion to real bam routines. ', EJECT ??

  PROCEDURE open_segment
    (    sfid: gft$system_file_identifier;
         eoi: amt$file_byte_address;
     VAR pointer: mmt$segment_pointer;
     VAR status: ost$status);

    VAR
      bam_pointer: amt$segment_pointer,
      file_name: ost$name,
      file_id: amt$file_identifier,
      display_string: string (31);

    build_name ('jjj', sfid.file_entry_index, file_name);
    display_string := ' Open real file name :';
    display_string (22, * ) := file_name;
    display (display_string);
{    clp$put_job_command_response (display_string, status); display (' amp$#open users file');
    amp$#open (file_name, amc$segment, NIL, file_id, status);
    IF status.normal THEN
      {display (' amp$#get_segment_pointer');
      amp$#get_segment_pointer (file_id, amc$cell_pointer, bam_pointer, status);
      IF status.normal THEN
        pointer.kind := mmc$cell_pointer;
        pointer.cell_pointer := bam_pointer.cell_pointer;
        store_segment_number (#SEGMENT (bam_pointer.cell_pointer), sfid, eoi, file_id);
      ELSE
        {display_status (status);
      IFEND;
    IFEND;
  PROCEND open_segment;
?? SKIP := 5 ??

  PROCEDURE build_name
    (    name_start: string ( * ),
         name_end: integer;
     VAR name: ost$name);

    VAR
      number_length: integer,
      working_string: string (29);

    name := '';
    working_string := '';
    STRINGREP (working_string, number_length, name_end);
    name := name_start;
    name ((STRLENGTH (name_start) + 1), * ) := working_string (2, number_length);
{    display (name);
  PROCEND build_name;

?? SKIP := 5 ??

  PROCEDURE store_segment_number
    (    segment_number: ost$segment;
         sfid: gft$system_file_identifier;
         eoi: amt$file_byte_address;
         file_id: amt$file_identifier);

    VAR
      i: integer;

    FOR i := 1 TO 100 DO
      IF segment_to_real_file_table [i].segment_number = 0 THEN
        segment_to_real_file_table [i].segment_number := segment_number;
        segment_to_real_file_table [i].real_file_id := file_id;
        segment_to_real_file_table [i].sfid := sfid;
        segment_to_real_file_table [i].eoi := eoi;
        RETURN;
      IFEND;
    FOREND;
    display (' No file id slots !!!!!!!!!!!!!!!!');
  PROCEND store_segment_number;
?? SKIP := 5 ??

  PROCEDURE remove_segment_number
    (    segment_number: ost$segment;
     VAR file_id: amt$file_identifier);

    VAR
      i: integer;

    FOR i := 1 TO 100 DO
      IF segment_number = segment_to_real_file_table [i].segment_number THEN
        file_id := segment_to_real_file_table [i].real_file_id;
        segment_to_real_file_table [i].segment_number := 0;
        RETURN;
      IFEND;
    FOREND;
    display (' unable to find segment');
  PROCEND remove_segment_number;

?? TITLE := 'Miscellaneous stubs', EJECT ??


  PROCEDURE [XDCL] syp$push_inhibit_job_recovery;

    {display (' syp$push_inhibit_job_recovery');
    syv$inhibit_job_recovery := syv$inhibit_job_recovery + 1;

  PROCEND syp$push_inhibit_job_recovery;

?? SKIP := 5 ??

  PROCEDURE [XDCL] syp$pop_inhibit_job_recovery;

    {display ('syp$pop_inhibit_job_recovery');
    IF syv$inhibit_job_recovery <= 0 THEN
      display ('*** BUG pop called without push');
    ELSE
      syv$inhibit_job_recovery := syv$inhibit_job_recovery - 1;
    IFEND;
  PROCEND syp$pop_inhibit_job_recovery;
?? SKIP := 5 ??

  PROCEDURE [XDCL] syp$invalidate_open_sfid
    (    sfid: gft$system_file_identifier;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND syp$invalidate_open_sfid;

?? SKIP := 5 ??

  PROCEDURE [XDCL] syp$clear_job_recovery_test
    (    t: zzzz;
         option: 0 .. 255);

    IF t = job THEN
      syv$test_jr_job := syv$test_jr_job - $syt$test_jr_set [option];
    ELSE
      syv$test_jr_system := syv$test_jr_system - $syt$test_jr_set [option];
    IFEND;
  PROCEND syp$clear_job_recovery_test;


?? SKIP := 5 ??

  PROCEDURE [XDCL] syp$replace_sfid
    (    old_sfid: gft$system_file_identifier;
         new_sfid: gft$system_file_identifier;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND syp$replace_sfid;
?? SKIP := 5 ??

  FUNCTION [XDCL] jmp$job_file_fap
    (    local_file_name: amt$local_file_name): amt$fap_pointer;

    { display (' jmp$job_file_fap ');
    jmp$job_file_fap := NIL;
  FUNCEND jmp$job_file_fap;
?? SKIP := 5 ??
?? TITLE := 'Accounting / validation stubs ', EJECT ??

  PROCEDURE [XDCL] avp$get_user_set
    (    user_id: ost$user_identification;
     VAR set_name: stt$set_name;
     VAR status: ost$status);

    osp$get_set_name (user_id.family, set_name, status);
  PROCEND avp$get_user_set;
?? SKIP := 5 ??

  FUNCTION [XDCL] avp$ring_min: ost$ring;

    avp$ring_min := 11;
  FUNCEND avp$ring_min;
?? SKIP := 5 ??
?? TITLE := 'Set manager stubs ', EJECT ??

?? SKIP := 5 ??

  PROCEDURE [XDCL] stp$recover_jobs_sets
    (VAR status: ost$status);

    status.normal := TRUE;
  PROCEND stp$recover_jobs_sets;
?? SKIP := 5 ??

  PROCEDURE [XDCL] stp$get_set_owner
    (    set_name: stt$set_name;
     VAR set_owner: ost$user_identification;
     VAR status: ost$status);

    set_owner.family := '$SYSTEM';
    set_owner.user := '$SYSTEM';
    status.normal := TRUE;
  PROCEND stp$get_set_owner;
?? SKIP := 5 ??

  PROCEDURE [XDCL] stp$get_pf_root
    (    set_name: stt$set_name;
     VAR pf_root_size: pft$root_size;
     VAR pf_root: pft$root;
     VAR status: ost$status);

    VAR
      p_root_container: ^pft$root,
      p_local_pf_root: ^pft$root;

    IF pf_root_created THEN
      pf_root_size := #SIZE (p_pf_root^);
      p_root_container := ^pf_root;
      RESET p_root_container;
      NEXT p_local_pf_root: [[REP pf_root_size OF cell]] IN p_root_container;
      p_local_pf_root^ := p_pf_root^;
    ELSE
      osp$set_status_abnormal ('ST', ste$pf_root_not_stored, 'NVESET', status);
    IFEND;
  PROCEND stp$get_pf_root;
?? SKIP := 5 ??

  PROCEDURE [XDCL] stp$get_pf_root_size
    (    set_name: stt$set_name;
     VAR pf_root_size: pft$root_size;
     VAR status: ost$status);

    IF pf_root_created THEN
      pf_root_size := #SIZE (p_pf_root^);
    ELSE
      osp$set_status_abnormal ('ST', ste$pf_root_not_stored, 'NVESET', status);
    IFEND;
  PROCEND stp$get_pf_root_size;
?? SKIP := 5 ??

  PROCEDURE [XDCL] stp$store_pf_root
    (    set_name: stt$set_name;
         pf_root: pft$root;
     VAR status: ost$status);

    pf_root_created := TRUE;
    ALLOCATE p_pf_root: [[REP #SIZE (pf_root) OF cell]] IN osv$mainframe_pageable_heap^;
    p_pf_root^ := pf_root;
    status.normal := TRUE;
  PROCEND stp$store_pf_root;
?? SKIP := 5 ??

  PROCEDURE [XDCL] avp$login_user
    (    user_name: ost$user_name;
         family_name: ost$family_name;
         password: avt$password;
         job_class: jmt$job_class;
     VAR account: avt$account_name;
     VAR project: avt$project_name;
     VAR status: ost$status);

    account := 'DUM_ACCOUNT';
    project := 'DUMMY_PROJECT';
    status.normal := TRUE;
  PROCEND avp$login_user;

  PROCEDURE [XDCL] ofp$enable_stop_key;

  PROCEND ofp$enable_stop_key;


  PROCEDURE [XDCL] jmp$set_job_class_limits
    (    job_class_set: jmt$job_class_set;
         class_limit_value: jmt$job_count_range;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND jmp$set_job_class_limits;


  PROCEDURE [XDCL] jmp$get_job_status
    (    job_status_options: ^jmt$job_status_options;
         job_status_results: ^jmt$job_status_results;
     VAR number_of_jobs_found: jmt$job_status_count;
     VAR status: ost$status);

    number_of_jobs_found := 0;
    osp$set_status_abnormal ('JM', jme$no_jobs_were_found, '', status);
  PROCEND jmp$get_job_status;

?? TITLE := 'Interactive stubs', EJECT ??

  PROCEDURE [XDCL] ifp$mark_attributes_change
    (    change_source: ift$connection_attribute_source;
     VAR status: ost$status);

    status.normal := TRUE;
  PROCEND ifp$mark_attributes_change;
?? SKIP := 5 ??

  PROCEDURE [XDCL] ifp$fap_control
    (    file_id: amt$file_identifier;
         call_block: amt$call_block;
         layer_number: amt$fap_layer_number;
     VAR status: ost$status);

    VAR
      converted_call_block: amt$call_block,
      converted_operation: amt$fap_operation,
      file_id_valid: boolean,
      real_file_id: amt$file_identifier,
      real_terminal_output_file: amt$local_file_name,
      real_terminal_input_file: amt$local_file_name,
      real_terminal_command_file: amt$local_file_name;

    IF NOT real_terminal_connected THEN
      real_terminal_input_file := 'GARYS_INPUT_TERMINAL';
      display_to_log ('opening GARYS_INPUT_TERMINAL');
      amp$#open (real_terminal_input_file, amc$record, NIL, real_terminal_input_file_id, status);

      real_terminal_output_file := 'GARYS_OUTPUT_TERMINAL';
      display_to_log ('opening GARYS_OUTPUT_TERMINAL');
      amp$#open (real_terminal_output_file, amc$record, NIL, real_terminal_output_file_id, status);

      real_terminal_input_file := 'GARYS_COMMAND_TERMINAL';
      display_to_log ('opening GARYS_COMMAND_TERMINAL');
      amp$#open (real_terminal_input_file, amc$record, NIL, real_terminal_command_file_id, status);
      real_terminal_connected := TRUE;
    IFEND;

    display_to_log (' ifp$fap_control');
    convert_fake_to_real_fid (file_id, real_file_id, file_id_valid);
    display_integer_to_log (' original operation', call_block.operation);
    converted_operation := call_block.operation;
    converted_call_block := call_block;
    converted_call_block.operation := converted_operation;
    display_integer_to_log (' converted operation', converted_operation);

    CASE converted_operation OF
    = amc$open_req =
      display_to_log (' open request - NOT calling interactive');
    = amc$close_req =
      display_to_log (' close request - NOT calling interactive');
    ELSE
      display_to_log (' ifp$fap_control_ring_3');
      ifp$fap_control_ring_3 (real_file_id, converted_call_block, layer_number, status);
      display_status (status);
    CASEND;
  PROCEND ifp$fap_control;

?? SKIP := 5 ??

  PROCEDURE convert_fake_to_real_fid
    (    fake_file_id: amt$file_identifier;
     VAR real_file_id: amt$file_identifier;
     VAR file_id_valid: boolean);

    VAR
      lfn: amt$local_file_name,
      file_instance: ^bat$task_file_entry;

    bap$validate_file_identifier (fake_file_id, file_instance, file_id_valid);
    IF file_id_valid THEN
      lfn := file_instance^.local_file_name;
      display_to_log (lfn);
      IF lfn = 'INPUT' THEN
        real_file_id := real_terminal_input_file_id;
      ELSEIF lfn = 'COMMAND' THEN
        real_file_id := real_terminal_command_file_id;
      ELSEIF lfn = 'OUTPUT' THEN
        real_file_id := real_terminal_output_file_id;
      ELSE
        display_to_log (' unexpected lfn ');
        real_file_id := real_terminal_output_file_id;
      IFEND;
    ELSE
      real_file_id := real_terminal_output_file_id;
      display_to_log (' invalid file identifier');
    IFEND;
  PROCEND convert_fake_to_real_fid;
?? SKIP := 10 ??

  PROCEDURE [XDCL] ifp$get_page_length_width
    (    terminal_file_name: amt$local_file_name;
     VAR page_length_width: array [1 .. 2] of ift$terminal_attribute;
     VAR status: ost$status);

    page_length_width [1].key := ifc$page_length;
    page_length_width [1].page_length := 80;
    page_length_width [2].key := ifc$page_width;
    page_length_width [2].page_width := 24;

  PROCEND ifp$get_page_length_width;

?? SKIP := 3 ??

  PROCEDURE [XDCL, #GATE] ifp$store_term_conn_attributes
    (    file_identifier: amt$file_identifier;
         terminal_attributes: ift$connection_attributes;
     VAR status: ost$status);

    VAR
      i: integer,
      file_id_is_valid: boolean,
      call_block: amt$call_block,
      real_file_id: amt$file_identifier,
      store_attributes: ^ift$connection_attributes;

    call_block.operation := ifc$store_terminal_req;

    PUSH store_attributes: [LOWERBOUND (terminal_attributes) .. UPPERBOUND
          (terminal_attributes)];
    FOR i := 1 TO UPPERBOUND (terminal_attributes) DO
      CASE terminal_attributes [i].key OF
      = ifc$prompt_file_identifier =
        convert_fake_to_real_fid (terminal_attributes [i].prompt_file_identifier,
              real_file_id, file_id_is_valid);
        store_attributes^ [i].key := ifc$prompt_file_identifier;
        store_attributes^ [i].prompt_file_identifier := real_file_id;

      = ifc$prompt_string =
        store_attributes^ [i] := terminal_attributes [i];
      ELSE
        display_to_log (' unsupported terminal key');
        store_attributes^ [i].key := ifc$null_connection_attribute;
      CASEND;
    FOREND;
    call_block.store_terminal.terminal_attributes := store_attributes;
    convert_fake_to_real_fid (file_identifier, real_file_id, file_id_is_valid);
    display_to_log (' ifp$fap_control_ring_3 store');
    ifp$fap_control_ring_3 (real_file_id, call_block, {layer_number =} 0, status);
    display_status_to_log (status);
    display_to_log (' fake ifp$store_term_conn_attributes');
    status.normal := TRUE;
  PROCEND ifp$store_term_conn_attributes;

?? TITLE := 'Logging stubs', EJECT ??

  PROCEDURE [XDCL, #GATE] lgp$get_global_log_description
    (    global_log: pmt$global_logs;
     VAR log_cycle: lgt$log_cycle;
     VAR previous_length: lgt$log_entry_size;
     VAR base_offset: ^SEQ ( * );
     VAR write_offset: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      global_log_lcd_p: ^lgt$log_control_descriptor,
      old_te: 0 .. 3;

    status.normal := TRUE;

    global_log_lcd_p := ^lgv$global_log_ctl [global_log];

    log_cycle := global_log_lcd_p^.log_cycle;
    previous_length := global_log_lcd_p^.previous_length;
    base_offset := global_log_lcd_p^.base_offset;
    write_offset := global_log_lcd_p^.write_offset;

  PROCEND lgp$get_global_log_description;
?? SKIP := 3 ??

  PROCEDURE [XDCL, #GATE] lgp$get_local_log_description
    (    local_log: pmt$logs;
     VAR log_cycle: lgt$log_cycle;
     VAR previous_length: lgt$log_entry_size;
     VAR base_offset: ^SEQ ( * );
     VAR write_offset: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      local_log_lcd_p: ^lgt$log_control_descriptor,
      old_te: 0 .. 3;

    status.normal := TRUE;

    local_log_lcd_p := ^lgv$local_log_ctl [local_log];

    log_cycle := local_log_lcd_p^.log_cycle;
    previous_length := local_log_lcd_p^.previous_length;
    base_offset := local_log_lcd_p^.base_offset;
    write_offset := local_log_lcd_p^.write_offset;

  PROCEND lgp$get_local_log_description;
?? SKIP := 3 ??



  PROCEDURE [XDCL] lgp$get_entry_from_global_log
    (    global_log: pmt$global_logs;
         log_cycle: lgt$log_cycle;
     VAR log_address: ^SEQ ( * );
     VAR previous_length: lgt$log_entry_size;
     VAR current_length: lgt$log_entry_size;
     VAR entry: string ( * );
     VAR status: ost$status);

    osp$set_status_abnormal ('GS', 333000, ' unable to read log', status);

  PROCEND lgp$get_entry_from_global_log;



?? SKIP := 3 ??

  PROCEDURE [XDCL] lgp$get_entry_from_local_log
    (    local_log: pmt$logs;
         log_cycle: lgt$log_cycle;
     VAR log_address: ^SEQ ( * );
     VAR previous_length: lgt$log_entry_size;
     VAR current_length: lgt$log_entry_size;
     VAR entry: string ( * );
     VAR status: ost$status);


    osp$set_status_abnormal ('GS', 333000, ' unable to read log', status);

  PROCEND lgp$get_entry_from_local_log;
?? TITLE := 'Tape stubs ' ??
?? NEWTITLE := 'Required', EJECT ??

  PROCEDURE [XDCL] dmp$job_tape_table_recovery
    (VAR any_tapes: boolean;
     VAR status: ost$status);

    {display (' dmp$job_tape_table_recovery stub');
    any_tapes := FALSE;
    status.normal := TRUE;
  PROCEND dmp$job_tape_table_recovery;
?? SKIP := 5 ??
  PROCEDURE [XDCL] dmp$assign_tape_volume (sfid: gft$system_file_identifier;
        path_handle_name: fst$path_handle_name;
        label_type: amt$label_type;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

?? TITLE := 'Non essential', EJECT ??

  PROCEDURE [XDCL] dmp$release_tape
    (    rel_req: rmt$release_tape_request;
     VAR status: ost$status);

    {display (' dmp$release_tape stub');
    status.normal := TRUE;
  PROCEND dmp$release_tape;
?? SKIP := 5 ??

  PROCEDURE [XDCL] dmp$close_tape_volume
    (    sfid: gft$system_file_identifier;
     VAR status: ost$status);

    osp$set_status_abnormal ('GS', 330000, 'unsupported tape request', status);
  PROCEND dmp$close_tape_volume;

  PROCEDURE [XDCL] dmp$create_tape_file_sfid
    (    p_removable_media_req_info: ^fmt$removable_media_req_info;
         p_volume_list: ^rmt$volume_list;
     VAR system_file_id: gft$system_file_identifier;
     VAR status: ost$status);

    osp$set_status_abnormal ('GS', 330000, 'unsupported tape request', status);
  PROCEND dmp$create_tape_file_sfid;

  PROCEDURE [XDCL] dmp$reset_tape_volume
    (    sfid: gft$system_file_identifier;
     VAR status: ost$status);

    osp$set_status_abnormal ('GS', 330000, 'unsupported tape request', status);
  PROCEND dmp$reset_tape_volume;

  PROCEDURE [XDCL] fmp$logically_position_tape
    (    local_file_name: amt$local_file_name;
     VAR status: ost$status);

    osp$set_status_abnormal ('GS', 330000, 'unsupported tape request', status);
  PROCEND fmp$logically_position_tape;

  PROCEDURE [XDCL] fmp$release_resource
    (    release_request: rmt$release_tape_request;
     VAR status: ost$status);

    osp$set_status_abnormal ('GS', 330000, 'unsupported tape request', status);
  PROCEND fmp$release_resource;

  PROCEDURE [XDCL] fmp$reserve_resource
    (    reserve_request: rmt$reserve_tape_request;
     VAR status: ost$status);

    osp$set_status_abnormal ('GS', 330000, 'unsupported tape request', status);
  PROCEND fmp$reserve_resource;

?? OLDTITLE ??
?? TITLE := 'Command language stubs', EJECT ??

  ?IF NOT clc$compiling_for_test_harness THEN

    PROCEDURE [XDCL] clp$convert_cycle_to_string
      (    cycle_selector: clt$cycle_selector;
       VAR cycle_string: ost$string);

      cycle_string.size := 22;
      cycle_string.value := 'gls lazy in bam$stubs';
    PROCEND clp$convert_cycle_to_string;
?? SKIP := 5 ??

    PROCEDURE [XDCL] clp$get_ultimate_connection
      (    lfn: amt$local_file_name;
       VAR ultimate_lfn: amt$local_file_name;
       VAR status: ost$status);

      display (' clp$get_ultimiate_connection stub');
      status.normal := TRUE;
      ultimate_lfn := lfn;
    PROCEND clp$get_ultimate_connection;
?? SKIP := 5 ??

    PROCEDURE [XDCL] clp$return_connected_file
      (    local_file_name: amt$local_file_name);

    PROCEND clp$return_connected_file;
?? SKIP := 5 ??

    PROCEDURE [XDCL] clp$return_local_file
      (    local_file_name: amt$local_file_name);

    PROCEND clp$return_local_file;
?? SKIP := 5 ??

    PROCEDURE [XDCL] osp$generate_log_message
      (    logs: pmt$ascii_logset;
           message_status: ost$status;
       VAR status: ost$status);

      display ('osp$generate_log_message');
      display_status (message_status);
      status.normal := TRUE;
    PROCEND osp$generate_log_message;
  ?IFEND
?? TITLE := 'Commands and functions' ??
?? NEWTITLE := 'fsp$th_set_job_number', EJECT ??

  PROCEDURE [XDCL] fsp$th_set_job_number
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    ?IF NOT clc$compiling_for_test_harness THEN

{  pdt set_job_number (job, j: integer  = 2
{     status)

?? PUSH (LISTEXT := ON) ??

      VAR
        set_job_number: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
              [^set_job_number_names, ^set_job_number_params];

      VAR
        set_job_number_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
              clt$parameter_name_descriptor := [['JOB', 1], ['J', 1], ['STATUS', 2]];

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

{ JOB J }
        [[clc$optional_with_default, ^set_job_number_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
              [NIL, clc$integer_value, -9223372036854775806, 9223372036854775807]],

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

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

?? POP ??

      VAR
        value: clt$value,
        next_job_active: boolean,
        next_job: integer;


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

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

      IF (next_job < 1) OR (next_job > max_number_of_jobs) THEN
        display ('*** WARNING - THE SELECTED JOB IS AN INCORRECT JOB NUMBER ****');
      ELSE
        switch_jobs (next_job, next_job_active);
        IF NOT next_job_active THEN
          display ('*** WARNING - THE SELECTED JOB HAS BEEN TERMINATED ALREADY ****');
        IFEND;
      IFEND;

      display_job_information (TRUE, TRUE);

    ?IFEND

  PROCEND fsp$th_set_job_number;
?? TITLE := 'fsp$th_set_task_number', EJECT ??

  PROCEDURE [XDCL] fsp$th_set_task_number
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    ?IF NOT clc$compiling_for_test_harness THEN

{  pdt set_task_number (task, j: integer = 2
{     status)

?? PUSH (LISTEXT := ON) ??

      VAR
        set_task_number: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
              [^set_task_number_names, ^set_task_number_params];

      VAR
        set_task_number_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
              clt$parameter_name_descriptor := [['TASK', 1], ['J', 1], ['STATUS', 2]];

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

{ TASK J }
        [[clc$optional_with_default, ^set_task_number_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
              [NIL, clc$integer_value, -9223372036854775806, 9223372036854775807]],

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

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

?? POP ??

      VAR
        value: clt$value,
        next_task_active: boolean,
        next_task: integer;


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

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

      IF (next_task < 1) OR (next_task > max_number_of_tasks) THEN
        display (' **** WARNING - SELECTED TASK NUMBER IS INCORRECT ***');
      ELSE
        switch_tasks (next_task, next_task_active);
        IF NOT next_task_active THEN
          display (' **** WARNING - SELECTED TASK ALREADY TERMINATED ***');
        IFEND;
      IFEND;

      display_job_information (FALSE, TRUE);

    ?IFEND

  PROCEND fsp$th_set_task_number;
?? TITLE := 'fsp$th_set_user_id', EJECT ??

  PROCEDURE [XDCL] fsp$th_set_user_id
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      p_user_path: ^pft$path,
      path_container: clt$path_container;


    crack_user_path (parameter_list, path_container, p_user_path, status);

    IF NOT status.normal THEN
      RETURN;
    IFEND;
    current_user_id.family := p_user_path^ [1];
    current_user_id.user := p_user_path^ [2];

  PROCEND fsp$th_set_user_id;
?? TITLE := 'fsp$th_known_point', EJECT ??

  PROCEDURE [XDCL] fsp$th_known_point
    (    pl: clt$parameter_list;
     VAR status: ost$status);

    { setb kp m=bam$stubs p=known_point bo=78(16)

    VAR
      i: integer;

    i := 77;
    i := 123;
    i := 444;
    i := 5678;
  PROCEND fsp$th_known_point;
?? TITLE := 'fsp$th_set_job_recovery_test', EJECT ??

  PROCEDURE [XDCL] fsp$th_set_job_recovery_test
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{  PDT setjrt_pdt (environment,e: key job, system, clear_job, clear_system =
{job
{      option: integer 0 .. 255 = $required)

?? PUSH (LISTEXT := ON) ??

    VAR
      setjrt_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^setjrt_pdt_names, ^setjrt_pdt_params];

    VAR
      setjrt_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['ENVIRONMENT', 1], ['E', 1], ['OPTION', 2]];

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

{ ENVIRONMENT E }
      [[clc$optional_with_default, ^setjrt_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
            [^setjrt_pdt_kv1, clc$keyword_value]],

{ OPTION }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0, 255]]];

    VAR
      setjrt_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['JOB',
            'SYSTEM', 'CLEAR_JOB', 'CLEAR_SYSTEM'];

    VAR
      setjrt_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (3) := 'job';

?? POP ??

    VAR
      clear: boolean,
      t: (job, system),
      value: clt$value;

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

    clp$get_value ('ENVIRONMENT', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.name.value = 'JOB' THEN
      t := job;
      clear := FALSE;
    ELSEIF value.name.value = 'CLEAR_JOB' THEN
      t := job;
      clear := TRUE;
    ELSEIF value.name.value = 'CLEAR_SYSTEM' THEN
      t := system;
      clear := TRUE;
    ELSE
      t := system;
      clear := FALSE;
    IFEND;

    clp$get_value ('OPTION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF clear THEN
      IF t = job THEN
        syv$test_jr_job := syv$test_jr_job - $syt$test_jr_set [value.int.value];
      ELSE
        syv$test_jr_system := syv$test_jr_system - $syt$test_jr_set [value.int.value];
      IFEND;
    ELSE
      IF t = job THEN
        syv$test_jr_job := syv$test_jr_job + $syt$test_jr_set [value.int.value];
      ELSE
        syv$test_jr_system := syv$test_jr_system + $syt$test_jr_set [value.int.value];
      IFEND;

    IFEND;

  PROCEND fsp$th_set_job_recovery_test;
?? TITLE := 'fsp$th_change_family_command', EJECT ??

  PROCEDURE [XDCL] fsp$th_change_family_command
    (    pl: clt$parameter_list;
     VAR status: ost$status);

    VAR
      new_value: clt$value,
      set_name: stt$set_name,
      value: clt$value;

{ pdt chafn_pdt (family_name, fn: name = $required
{   new_family_name, nfn: name = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      chafn_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^chafn_pdt_names, ^chafn_pdt_params];

    VAR
      chafn_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
            clt$parameter_name_descriptor := [['FAMILY_NAME', 1], ['FN', 1], ['NEW_FAMILY_NAME', 2],
            ['NFN', 2], ['STATUS', 3]];

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

{ FAMILY_NAME FN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ NEW_FAMILY_NAME NFN }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

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

?? POP ??
    clp$scan_parameter_list (pl, chafn_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('FAMILY_NAME', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('NEW_FAMILY_NAME', 1, 1, clc$low, new_value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$get_set_name (value.name.value, set_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pfp$change_family_name (set_name, value.name.value, new_value.name.value, status);

  PROCEND fsp$th_change_family_command;

?? TITLE := 'fsp$th_set_admin_status_command', EJECT ??

  PROCEDURE [XDCL] fsp$th_set_admin_status_command
    (    pl: clt$parameter_list;
     VAR status: ost$status);

{ PDT chadn_pdt (admin, a: key of system, family, none = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      chadn_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^chadn_pdt_names, ^chadn_pdt_params];

    VAR
      chadn_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['ADMIN', 1], ['A', 1], ['STATUS', 2]];

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

{ ADMIN A }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [^chadn_pdt_kv1, clc$keyword_value]],

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

    VAR
      chadn_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of ost$name := ['OF', 'SYSTEM',
            'FAMILY', 'NONE'];

?? POP ??

    VAR
      value: clt$value;

    clp$scan_parameter_list (pl, chadn_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$get_value ('ADMIN', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.name.value = 'SYSTEM' THEN
      global_system_administrator := TRUE;
      global_family_administrator := FALSE;
    ELSEIF value.name.value = 'FAMILY' THEN
      global_system_administrator := FALSE;
      global_family_administrator := TRUE;
    ELSE
      global_system_administrator := FALSE;
      global_family_administrator := FALSE;
    IFEND;

  PROCEND fsp$th_set_admin_status_command;

?? TITLE := 'fsp$th_recover_files_command', EJECT ??

  PROCEDURE [XDCL] fsp$th_recover_files_command
    (    pl: clt$parameter_list;
     VAR status: ost$status);



{    PDT recover_files (initialization, i: boolean
{      all_catalogs, ac: boolean = true
{      recover_purged_files, rpf: boolean = false
{      validate, v: boolean = true
{      reorganize: boolean = true
{      reconciliation: boolean = true
{      status)

?? PUSH (LISTEXT := ON) ??

    VAR
      recover_files: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^recover_files_names, ^recover_files_params];

    VAR
      recover_files_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 11] of
            clt$parameter_name_descriptor := [['INITIALIZATION', 1], ['I', 1], ['ALL_CATALOGS', 2], ['AC', 2],
            ['RECOVER_PURGED_FILES', 3], ['RPF', 3], ['VALIDATE', 4], ['V', 4], ['REORGANIZE', 5],
            ['RECONCILIATION', 6], ['STATUS', 7]];

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

{ INITIALIZATION I }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$boolean_value]],

{ ALL_CATALOGS AC }
      [[clc$optional_with_default, ^recover_files_dv2], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_value]],

{ RECOVER_PURGED_FILES RPF }
      [[clc$optional_with_default, ^recover_files_dv3], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_value]],

{ VALIDATE V }
      [[clc$optional_with_default, ^recover_files_dv4], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_value]],

{ REORGANIZE }
      [[clc$optional_with_default, ^recover_files_dv5], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_value]],

{ RECONCILIATION }
      [[clc$optional_with_default, ^recover_files_dv6], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_value]],

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

    VAR
      recover_files_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

    VAR
      recover_files_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'false';

    VAR
      recover_files_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

    VAR
      recover_files_dv5: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

    VAR
      recover_files_dv6: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'true';

?? POP ??

    VAR
      dm_file: integer,
      ignored_status: ost$status,
      initialization: boolean,
      user_id: ost$user_identification,
      recovery_count: [STATIC] integer := 0,
      reorganization_selections: pft$set_overhaul_choices,
      set_name: stt$set_name,
      value: clt$value;

    clp$scan_parameter_list (pl, recover_files, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('INITIALIZATION', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind = clc$unknown_value THEN
      { default based on recovery number
      initialization := (recovery_count = 0);
    ELSE
      initialization := value.bool.value;
    IFEND;

    recovery_count := recovery_count + 1;
    IF initialization THEN
      display (' Initialization recovery');
      reorganization_selections := $pft$set_overhaul_choices [];
    ELSE
      clp$get_value ('ALL_CATALOGS', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.bool.value THEN
        reorganization_selections := reorganization_selections + $pft$set_overhaul_choices [pfc$all_catalogs];
      IFEND;

      clp$get_value ('RECOVER_PURGED_FILES', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.bool.value THEN
        reorganization_selections := reorganization_selections +
              $pft$set_overhaul_choices [pfc$recover_purged_files];
      IFEND;

      clp$get_value ('VALIDATE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.bool.value THEN
        reorganization_selections := reorganization_selections + $pft$set_overhaul_choices
              [pfc$validate_files];
      IFEND;

      clp$get_value ('REORGANIZE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.bool.value THEN
        reorganization_selections := reorganization_selections +
              $pft$set_overhaul_choices [pfc$reorganize_catalogs];
      IFEND;

      clp$get_value ('RECONCILIATION', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      IF value.bool.value THEN
        reorganization_selections := reorganization_selections +
              $pft$set_overhaul_choices [pfc$reconcile_files];
      IFEND;
    IFEND;

    FOR dm_file := 1 TO 100 DO
      file_usage_table [dm_file].file_usage := 0;
    FOREND;
    setup_job_pointers;
    global_system_administrator := TRUE;
    global_family_administrator := FALSE;
    pmp$get_user_identification (user_id, status);
    osp$get_set_name (user_id.family, set_name, status);
    pfp$overhaul_set (set_name, reorganization_selections, status);
    global_system_administrator := FALSE;
    global_family_administrator := FALSE;
  PROCEND fsp$th_recover_files_command;
?? TITLE := 'fsp$th_recover_job_file_command', EJECT ??

  PROCEDURE [XDCL] fsp$th_recover_job_file_command
    (    pl: clt$parameter_list;
     VAR status: ost$status);

{ THIS ONLY RECOVERS THE CURRENT JOB
{ A Prior call to recover files should have been made to go through the system pf recovery

{  PDT recover_job_files (status)

?? PUSH (LISTEXT := ON) ??

    VAR
      recover_job_files: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^recover_job_files_names, ^recover_job_files_params];

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

    VAR
      recover_job_files_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 ??

    clp$scan_parameter_list (pl, recover_job_files, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display (' fmp$recover_job_files');
    fmp$recover_job_files (status);
  PROCEND fsp$th_recover_job_file_command;
?? TITLE := 'fsp$th_defmc_command', EJECT ??

  PROCEDURE [XDCL] fsp$th_defmc_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


    VAR
      path_container: clt$path_container,
      p_path: ^pft$path,
      user_id: ost$user_identification,
      set_name: stt$set_name,
      local_status: ost$status,
      charge_id: pft$charge_id;

    crack_user_path (parameter_list, path_container, p_path, status);
    IF status.normal THEN
      charge_id.account := '  ';
      charge_id.project := ' ';
      global_system_administrator := TRUE;
      global_family_administrator := FALSE;
      pmp$get_user_identification (user_id, status);
      osp$get_set_name (user_id.family, set_name, status);
      IF status.normal THEN
        pfp$define_master_catalog (set_name, p_path^ [pfc$family_name_index],
              p_path^ [pfc$master_catalog_name_index], charge_id, status);
      IFEND;
    IFEND;
    global_system_administrator := FALSE;
    global_family_administrator := FALSE;
  PROCEND fsp$th_defmc_command;
?? TITLE := 'fsp$th_purmc_command', EJECT ??

  PROCEDURE [XDCL] fsp$th_purmc_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


    VAR
      path_container: clt$path_container,
      p_path: ^pft$path,
      user_id: ost$user_identification,
      set_name: stt$set_name,
      local_status: ost$status,
      charge_id: pft$charge_id;

    crack_user_path (parameter_list, path_container, p_path, status);
    IF status.normal THEN
      charge_id.account := '  ';
      charge_id.project := ' ';
      global_system_administrator := TRUE;
      global_family_administrator := FALSE;
      pmp$get_user_identification (user_id, status);
      osp$get_set_name (user_id.family, set_name, status);
      IF status.normal THEN
        pfp$purge_master_catalog (set_name, p_path^ [pfc$family_name_index],
              p_path^ [pfc$master_catalog_name_index], status);
      IFEND;
    IFEND;
    global_system_administrator := FALSE;
    global_family_administrator := FALSE;
  PROCEND fsp$th_purmc_command;

?? TITLE := 'fsp$th_validate_catalog', EJECT ??

  PROCEDURE [XDCL] fsp$th_validate_catalog
    (    params: pmt$program_parameters;
     VAR status: ost$status);

{ PDT VALIDATE_CATALOG_PDT (
{     CATALOG, C: FILE = $REQUIRED
{     VALIDATE_SUBCATALOGS, VALIDATE_SUBCATALOG, VS: BOOLEAN = FALSE
{     STATUS: VAR OF STATUS)

?? PUSH (LISTEXT := ON) ??

    VAR
      validate_catalog_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^validate_catalog_pdt_names, ^validate_catalog_pdt_params];

    VAR
      validate_catalog_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
            clt$parameter_name_descriptor := [['CATALOG', 1], ['C', 1], ['VALIDATE_SUBCATALOGS', 2],
            ['VALIDATE_SUBCATALOG', 2], ['VS', 2], ['STATUS', 3]];

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

{ CATALOG C }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ VALIDATE_SUBCATALOGS VALIDATE_SUBCATALOG VS }
      [[clc$optional_with_default, ^validate_catalog_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$boolean_value]],

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

    VAR
      validate_catalog_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'FALSE';

?? POP ??

    VAR
      overhaul_selections: pft$catalog_overhaul_choices,
      p_path: ^pft$path,
      path_container: clt$path_container,
      value: clt$value;

    clp$scan_parameter_list (params, validate_catalog_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pup$crack_catalog ('CATALOG', path_container, p_path, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('VALIDATE_SUBCATALOGS', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF value.bool.value THEN
      overhaul_selections := $pft$catalog_overhaul_choices [pfc$all_catalogs, pfc$validate_files];
      pfp$overhaul_catalog (p_path^, overhaul_selections, status);
    ELSE
      overhaul_selections := $pft$catalog_overhaul_choices [pfc$validate_files];
      pfp$overhaul_catalog (p_path^, overhaul_selections, status);
    IFEND;
  PROCEND fsp$th_validate_catalog;
?? TITLE := 'fsp$th_task_cleanup', EJECT ??

  PROCEDURE [XDCL] fsp$th_task_cleanup
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    ?IF NOT clc$compiling_for_test_harness THEN

{ pdt task_termination_pdt ()

?? PUSH (LISTEXT := ON) ??

      VAR
        task_termination_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??

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

      bap$task_termination_cleanup;
      set_task_terminated (0);

    ?IFEND

  PROCEND fsp$th_task_cleanup;
?? TITLE := 'fsp$th_job_cleanup', EJECT ??

  PROCEDURE [XDCL] fsp$th_job_cleanup
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    ?IF NOT clc$compiling_for_test_harness THEN

{ pdt job_termination_pdt ()

?? PUSH (LISTEXT := ON) ??

      VAR
        job_termination_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??


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

      display (' fmp$job_exit ');
      fmp$job_exit;

      display (' pfp$process_job_end ');
      pfp$process_job_end;
      set_job_terminated (0)

    ?IFEND

  PROCEND fsp$th_job_cleanup;
?? TITLE := 'fsp$th_quit_command', EJECT ??

  PROCEDURE [XDCL] fsp$th_quit_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    ?IF NOT clc$compiling_for_test_harness THEN

{ pdt task_termination_pdt ()

?? PUSH (LISTEXT := ON) ??

      VAR
        task_termination_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??

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

      clp$end_scan_command_file (userbam_utility_name, status);

    ?IFEND

  PROCEND fsp$th_quit_command;
?? TITLE := 'fsp$$th_real_file_name', EJECT ??

  PROCEDURE [XDCL] fsp$$th_real_file_name
    (    function_name: clt$name;
         argument_list: string ( * );
     VAR returned_value: clt$value;
     VAR status: ost$status);

    VAR
      rfn_adt: [STATIC, READ, cls$adt] array [1 .. 1] of clt$argument_descriptor := [
            {1} [[clc$required], [^keywords_rfn, clc$name_value, 1, 31]]],

      keywords_rfn: [STATIC, READ, cls$adt_names_and_defaults] array [1 .. 1] of ost$name := ['LFN'],

      rfn_avt: array [1 .. 1] of clt$value,

      ws: string (30),
      scr: integer,
      sfid: gft$system_file_identifier,
      lfn: amt$local_file_name,
      file_name: ost$name,
      value: clt$value;

    clp$scan_argument_list (function_name, argument_list, ^rfn_adt, ^rfn_avt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    value := rfn_avt [1];

    lfn := value.name.value;
    fmp$get_system_file_id (lfn, sfid, status);
    IF NOT status.normal THEN
{         display ('unable to fetch sfid: $RFN');
{         display_status (status);
      RETURN;
    IFEND;

    file_name := 'jjj';
    STRINGREP (ws, scr, sfid.file_entry_index);
    file_name (4, * ) := ws (2, scr - 1);

    returned_value.descriptor := 'NAME';
    returned_value.kind := clc$name_value;
    returned_value.name.value := file_name;
    returned_value.name.size := STRLENGTH (returned_value.name.value);

  PROCEND fsp$$th_real_file_name;
?? OLDTITLE ??
?? TITLE := 'crack_user_path', EJECT ??

  PROCEDURE crack_user_path
    (    parameter_list: clt$parameter_list;
     VAR path_container: clt$path_container;
     VAR p_path: ^pft$path;
     VAR status: ost$status);

{ pdt user_path_pdt (
{ user,u:file=$required
{ status)

?? PUSH (LISTEXT := ON) ??

    VAR
      user_path_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^user_path_pdt_names, ^user_path_pdt_params];

    VAR
      user_path_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['USER', 1], ['U', 1], ['STATUS', 2]];

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

{ USER U }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

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

?? POP ??

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

    pup$crack_catalog ('USER', path_container, p_path, status);
    IF status.normal AND (p_path <> NIL) AND (UPPERBOUND (p_path^) > pfc$master_catalog_name_index) THEN
      osp$set_status_abnormal ('UB', 333000, ' Path to long for user', status);
    IFEND;
  PROCEND crack_user_path;
?? TITLE := 'setup_job_pointers', EJECT ??

  PROCEDURE [XDCL] setup_job_pointers;

    ?IF fsc$compiling_for_test_harness THEN
      pfv$p_catalog_alarm_table := NIL;
      pfv$p_newest_queued_catalog := NIL;
      pfv$p_queued_catalog_table := NIL;
    ?IFEND

  PROCEND setup_job_pointers;
?? TITLE := 'set_current_user_id', EJECT ??

  PROCEDURE [XDCL] set_current_user_id;

    VAR
      rec_length: amt$max_record_length,
      fid: amt$file_identifier,
      fpos: amt$file_position,
      tc: amt$transfer_count,
      wsa: ^cell,
      wsl: amt$working_storage_length,
      ba: amt$file_byte_address,
      user_name: ost$name,

      p_user_string: ^ost$string,
      path_container: clt$path_container,
      p_user_path: ^pft$path,
      status: ost$status,
      parameter_list: ^clt$parameter_list;


    amp$#open ('USER_NAME                      ', amc$record, NIL, fid, status);
    IF status.normal THEN
      wsa := ^user_name;
      user_name := ' ';
      amp$#get_partial (fid, wsa, 31, rec_length, tc, ba, fpos, amc$no_skip, status);
      IF status.normal THEN
        current_user_id.family := 'NVE3';
        current_user_id.user := user_name;
        RETURN;
      IFEND;
    IFEND;

    PUSH parameter_list: [[REP 1 OF ost$string]];
    RESET parameter_list;
    NEXT p_user_string IN parameter_list;
    p_user_string^.size := 10;
    p_user_string^.value := ' $USER';
    clp$push_parameters (status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;
    crack_user_path (parameter_list^, path_container, p_user_path, status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;
    clp$pop_parameters (status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;
    current_user_id.family := p_user_path^ [1];
    current_user_id.user := p_user_path^ [2];
  PROCEND set_current_user_id;

?? TITLE := 'clp$get_file_command', EJECT ??
{ The exporting and importing of files between the FS test harness environment
{ and the real file system is available.

{ Only V record, SS blocking can be ported.
{ This combination supports text output from displays and also
{ backup_file format.
{ Attributes are not transferred, so if you need the attributes (for example
{ command_libraries) backup the file first, use get_file, and then restore.
{ Only files named with a lfn (on both sides) can be ported.
{
{ Both the from and to parameters are required.
{ GET_FILE
{   Brings a file from the real file system into the userbam world.
{   FROM - lfn of real file
{     If you need to bring over a permanent file, just attach it before entering
{     userbam and specify an lfn on the attach_file command.
{   TO -lfn of userbam file to create
{

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


{ PDT get_file_pdt (
{   from, f : NAME = $required
{   to, t : name = $REQUIRED
{   STATUS)

?? PUSH (LISTEXT := ON) ??

  VAR
    get_file_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^get_file_pdt_names,
      ^get_file_pdt_params];

  VAR
    get_file_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
      clt$parameter_name_descriptor := [['FROM', 1], ['F', 1], ['TO', 2], ['T', 2], ['STATUS', 3]];

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

{ FROM F }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ TO T }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 1, osc$max_name_size]],

{ 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
      fid: amt$file_identifier,
      file_length: amt$file_length,
      from_real_lfn: amt$local_file_name,
      to_real_lfn: amt$local_file_name,
      to_userbam_lfn: amt$local_file_name,
      value: clt$value;

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

    clp$get_value ('TO', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display (' get_file stub');
    to_userbam_lfn := value.name.value;
    { open the userbam file so it looks like a V record access file, and
    {so that the 'real' file name   is assigned.
    display (' open to_userbam_lfn');
    display (to_userbam_lfn);
    amp$open (to_userbam_lfn, amc$record, NIL, fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    amp$close (fid, status);
    fetch_real_file_name (to_userbam_lfn, to_real_lfn, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('FROM', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    from_real_lfn := value.name.value;

    get_real_file_length (from_real_lfn, file_length, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { copy the data into the file
    display (' copy_bytes');
    copy_bytes (from_real_lfn, to_real_lfn, file_length, status);
    display_status (status);

    set_userbam_eoi (to_userbam_lfn, file_length, status);


  PROCEND clp$get_file_command;

?? TITLE := 'clp$replace_file_command', EJECT ??
{ REPLACE_FILE
{   Replace a file from the userbam world to the real file system, for later use.
{   FROM - lfn of userbam file to replace
{   TO - lfn of real file
{
{ No verification is made if the file exists or not, so be careful with
{ replace_file not to overwrite an existing file.

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


{ PDT replace_file_pdt (
{   from, f : name = $REQUIRED
{   to, t : NAME  = $REQUIRED
{   STATUS)

?? PUSH (LISTEXT := ON) ??

    VAR
      replace_file_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table
        := [^replace_file_pdt_names, ^replace_file_pdt_params];

    VAR
      replace_file_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array
        [1 .. 5] of clt$parameter_name_descriptor := [['FROM', 1], ['F', 1],
        ['TO', 2], ['T', 2], ['STATUS', 3]];

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

{ FROM F }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$name_value, 1, osc$max_name_size]],

{ TO T }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$name_value, 1, osc$max_name_size]],

{ 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
      fid: amt$file_identifier,
      file_length: amt$file_length,
      from_real_lfn: amt$local_file_name,
      from_userbam_lfn: amt$local_file_name,
      to_real_lfn: amt$local_file_name,
      value: clt$value;

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

    clp$get_value ('FROM', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    from_userbam_lfn := value.name.value;
    display (' replace_file ');
    display (from_userbam_lfn);
    fetch_real_file_name (from_userbam_lfn, from_real_lfn, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display (from_real_lfn);

    clp$get_value ('TO', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    to_real_lfn := value.name.value;
    display (' TO :');
    display (to_real_lfn);

    { open the real file so it looks like a V  record access file
    display (' open to  real lfn ');
    amp$#open (to_real_lfn, amc$record, NIL, fid, status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;
    amp$#close (fid, status);

    display (' get userbam file length');
    get_userbam_file_length (from_userbam_lfn, file_length, status);
    display_integer (' from userbam lfn length: ', file_length);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;

    { copy the data into the file
    copy_bytes (from_real_lfn, to_real_lfn, file_length, status);

    display (' replace_file completed');
    display_status (status);

  PROCEND clp$replace_file_command;

?? TITLE := 'copy_bytes', EJECT ??
  PROCEDURE copy_bytes (from_real_lfn: amt$local_file_name;
        to_real_lfn: amt$local_file_name;
        length: amt$file_length;
    VAR status: ost$status);

    VAR
      from_fid: amt$file_identifier,
      from_segment_pointer: amt$segment_pointer,
      to_fid: amt$file_identifier,
      to_segment_pointer: amt$segment_pointer;


    display (' copy bytes');
    display (' open from ');
    amp$#open (from_real_lfn, amc$segment, NIL, from_fid, status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;
    amp$#get_segment_pointer (from_fid, amc$cell_pointer, from_segment_pointer,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display (' open to ');
    amp$#open (to_real_lfn, amc$segment, NIL, to_fid, status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;
    amp$#get_segment_pointer (to_fid, amc$cell_pointer, to_segment_pointer,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display_integer (' i#move ', length);
    i#move (from_segment_pointer.cell_pointer, to_segment_pointer.cell_pointer,
          length);

    to_segment_pointer.cell_pointer := #address (#ring (to_segment_pointer.
          cell_pointer), #segment (to_segment_pointer.cell_pointer),
          length);
    display (' set to segment eoi');
    amp$#set_segment_eoi (to_fid, to_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display (' closing files ');
    amp$#close (to_fid, status);
    amp$#close (from_fid, status);
  PROCEND copy_bytes;
?? TITLE := 'fetch_real_file_name', EJECT ??

  PROCEDURE fetch_real_file_name (userbam_lfn: amt$local_file_name;
    VAR real_lfn: amt$local_file_name;
    VAR status: ost$status);

    VAR
      sfid: gft$system_file_identifier;

    fmp$get_system_file_id (userbam_lfn, sfid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    build_name ('jjj', sfid.file_entry_index, real_lfn);
  PROCEND fetch_real_file_name;

?? TITLE := 'get_real_file_length', EJECT ??

  PROCEDURE get_real_file_length (lfn: amt$local_file_name;
    VAR file_length: amt$file_length;
    VAR status: ost$status);

    VAR
      contains_data: boolean,
      existing_file: boolean,
      local_file: boolean,
      p_file_attributes: ^amt$get_attributes;

    PUSH p_file_attributes: [1 .. 1];
    p_file_attributes^ [1].key := amc$file_length;
    amp$#get_file_attributes (lfn, p_file_attributes^, local_file,
          existing_file, contains_data, status);
    IF status.normal THEN
      IF existing_file AND contains_data THEN
        file_length := p_file_attributes^ [1].file_length;
      ELSE
        file_length := 0;
      IFEND;
      display_integer (' real file length :', file_length);
    IFEND;
  PROCEND get_real_file_length;

?? TITLE := 'get_userbam_file_length', EJECT ??

  PROCEDURE get_userbam_file_length (lfn: amt$local_file_name;
    VAR file_length: amt$file_length;
    VAR status: ost$status);

    VAR
      contains_data: boolean,
      existing_file: boolean,
      local_file: boolean,
      p_file_attributes: ^amt$get_attributes;

    PUSH p_file_attributes: [1 .. 1];
    p_file_attributes^ [1].key := amc$file_length;
    display (' amp$get_file_attributes ');
    amp$get_file_attributes (lfn, p_file_attributes^, local_file,
          existing_file, contains_data, status);
    IF status.normal THEN
      IF existing_file AND contains_data THEN
        file_length := p_file_attributes^ [1].file_length;
      ELSE
        file_length := 0;
      IFEND;
      display_integer (' userbam file length :', file_length);
    IFEND;
    display_status (status);
  PROCEND get_userbam_file_length;

?? TITLE := 'set_real_eoi', EJECT ??

  PROCEDURE set_real_eoi (real_lfn: amt$local_file_name;
    VAR file_length: amt$file_length;
    VAR status: ost$status);

    VAR
      fid: amt$file_identifier,
      segment_pointer: amt$segment_pointer;

    display (' set real eoi');
    amp$#open (real_lfn, amc$segment, NIL, fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$#get_segment_pointer (fid, amc$cell_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    segment_pointer.cell_pointer := #address (#ring (segment_pointer.
          cell_pointer), #segment (segment_pointer.cell_pointer), file_length);
    amp$#set_segment_eoi (fid, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    amp$#close (fid, status);

  PROCEND set_real_eoi;

?? TITLE := 'set_userbam_eoi', EJECT ??

  PROCEDURE set_userbam_eoi (userbam_lfn: amt$local_file_name;
    VAR file_length: amt$file_length;
    VAR status: ost$status);

    VAR
      fid: amt$file_identifier,
      segment_pointer: amt$segment_pointer;

    display (' set userbam eoi');
    amp$open (userbam_lfn, amc$segment, NIL, fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (fid, amc$cell_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    segment_pointer.cell_pointer := #address (#ring (segment_pointer.
          cell_pointer), #segment (segment_pointer.cell_pointer), file_length);
    amp$set_segment_eoi (fid, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    amp$close (fid, status);

  PROCEND set_userbam_eoi;

?? TITLE := 'nap$se_return_file', EJECT ??

  PROCEDURE [XDCL] nap$se_return_file (connection_id: nat$connection_id;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND nap$se_return_file;

?? TITLE :='nlp$cancel_switch_offer', EJECT ??

  PROCEDURE [XDCL] nlp$cancel_switch_offer (connection_id: nat$connection_id;
    VAR switch_complete: boolean;
    VAR status: ost$status);

    switch_complete := TRUE;
    status.normal := TRUE;

  PROCEND nlp$cancel_switch_offer;

?? TITLE := 'rfp$delete_connection', EJECT ??

  PROCEDURE [XDCL] rfp$delete_connection (local_file_name: amt$local_file_name;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND rfp$delete_connection;

?? TITLE := 'dmp$dev_mgmt_table_update', EJECT ??

  PROCEDURE [XDCL] dmp$dev_mgmt_table_update;

  PROCEND dmp$dev_mgmt_table_update;

?? TITLE := 'syp$invoke_system_debugger', EJECT ??

  PROCEDURE [XDCL] syp$invoke_system_debugger
    (    text: string (*);
         id: dpt$window_id;
     VAR status: ost$status);

    status.normal := TRUE;

  PROCEND syp$invoke_system_debugger;

?? TITLE := 'fmp$fetch_tape_label_attributes', EJECT ??

  PROCEDURE [XDCL] fmp$fetch_tape_label_attributes (local_file_name: amt$local_file_name;
    VAR tape_attachments: fst$tape_attachment_information;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND fmp$fetch_tape_label_attributes;

?? TITLE := 'fmp$store_tape_attachment', EJECT ??

  PROCEDURE [XDCL] fmp$store_tape_attachment (tape_attachments: fst$attachment_options;
      tape_attachment_info_source: fst$tape_attach_info_source;
      tape_attachment_info: ^fst$tape_attachment_information;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND fmp$store_tape_attachment;

?? TITLE := 'iip$search_connection_desc', EJECT ??

  PROCEDURE [XDCL] iip$search_connection_desc (session_file: amt$local_file_name;
    VAR connection_desc_ptr: ^iit$connection_description);

  PROCEND iip$search_connection_desc;

?? TITLE := 'iip$st_initialize_connection', EJECT ??

  PROCEDURE [XDCL] iip$st_initialize_connection (terminal_file_name:
    amt$local_file_name;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND iip$st_initialize_connection;

?? TITLE := 'iip$st_get_terminal_attributes', EJECT ??

  PROCEDURE [XDCL] iip$st_get_terminal_attributes (file_name: amt$local_file_name;
    VAR terminal_attributes: ift$terminal_attributes;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND iip$st_get_terminal_attributes;

?? TITLE := 'pup$crack_catalog ', EJECT ??

  PROCEDURE [XDCL] pup$crack_catalog (parameter_name: string ( * );
    VAR path_container: clt$path_container;
    VAR p_path: ^pft$path;
    VAR status: ost$status);

{ The purpose of this routine is to crack a reference of the type
{     < catalog>
{ Callers are responsible for validating the length of the path returned.
{ No file position or cycle selector may be specified.
{

    VAR
      cycle_selector: pft$cycle_selector,
      cycle_selector_specified: boolean,
      value: clt$value;

    clp$get_value (parameter_name, 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind = clc$unknown_value THEN
      p_path := NIL;
      RETURN;
    IFEND;
    crack_path (value, parameter_name, pfc$family_name_index, $put$cycle_reference_selections
          [puc$cycle_omitted], path_container, p_path, cycle_selector_specified, cycle_selector, status);
  PROCEND pup$crack_catalog;

?? TITLE := '    crack_path ', EJECT ??

  PROCEDURE crack_path (value: clt$value;
        parameter_name: string ( * );
        minimum_path_length: pft$array_index;
        allowed_cycle_references: put$cycle_reference_selections;
    VAR path_container: clt$path_container;
    VAR p_path: ^pft$path;
    VAR cycle_selector_specified: boolean;
    VAR cycle_selector: pft$cycle_selector;
    VAR status: ost$status);


    VAR
      cl_cycle_selector: clt$cycle_selector,
      evaluated_file_reference: fst$evaluated_file_reference,
      path_handle: fmt$path_handle,
      p_path_container: ^clt$path_container;

    status.normal := TRUE;
    clp$get_fs_path_elements (value.file.local_file_name, evaluated_file_reference, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_path_container := ^path_container;
    RESET p_path_container;
    NEXT p_path: [1 .. evaluated_file_reference.number_of_path_elements] IN p_path_container;
    fsp$convert_fs_structure_to_pf (evaluated_file_reference, p_path);

    IF p_path^ [1] = fsc$local THEN
      osp$set_status_abnormal (puc$pf_utility_id, cle$not_permitted_on_loc_file, 'backup or restore', status);
    ELSE
      IF (UPPERBOUND (p_path^)) < minimum_path_length THEN
        osp$set_status_abnormal (puc$pf_utility_id, pue$path_too_short, parameter_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, p_path^ [1], status);
      ELSEIF evaluated_file_reference.path_handle_info.path_handle.open_position.specified THEN
        osp$set_status_abnormal (puc$pf_utility_id, pue$unexpected_file_position, parameter_name, status);
      ELSE
        clp$convert_cyc_ref_to_cyc_sel (evaluated_file_reference.cycle_reference, cl_cycle_selector);
        verify_cycle_selection (parameter_name, allowed_cycle_references, cl_cycle_selector, status);
        IF status.normal THEN
          cycle_selector_specified := cl_cycle_selector.specification <> clc$cycle_omitted;
          IF cycle_selector_specified THEN
            cycle_selector := cl_cycle_selector.value;
          IFEND;
        IFEND;
      IFEND;
    IFEND;
  PROCEND crack_path;

?? TITLE := '    verify_cycle_selection ', EJECT ??

  PROCEDURE verify_cycle_selection (parameter_name: string ( * );
        allowed_cycle_selections: put$cycle_reference_selections;
        specified_cycle_selection: clt$cycle_selector;
    VAR status: ost$status);

    VAR
      cycle_selector: put$cycle_reference_options,
      cycle_selector_name_table: [STATIC, READ, pus$literals] array [put$cycle_reference_options] of ost$name
        := [' NO CYCLE REFERENCE', ' $LOW', ' $HIGH', ' A SPECIFIC CYCLE NUMBER', ' $NEXT', ' $NEXT_LOW'],
      check_set: put$cycle_reference_selections,
      delimiter: char,
      first_element: boolean,
      pu_cycle_selector: put$cycle_reference_options;

    status.normal := TRUE;
    IF allowed_cycle_selections = $put$cycle_reference_selections [] THEN
      osp$set_status_abnormal (puc$pf_utility_id, pue$bad_cycle_selections, parameter_name, status);
      RETURN;
    IFEND;
    convert_cycle_selector (specified_cycle_selection, pu_cycle_selector);
    IF NOT (pu_cycle_selector IN allowed_cycle_selections) THEN
      osp$set_status_abnormal (puc$pf_utility_id, pue$incorrect_cycle_reference, cycle_selector_name_table
            [pu_cycle_selector], status);
      delimiter := osc$status_parameter_delimiter;
      osp$append_status_parameter (delimiter, parameter_name, status);
      check_set := $put$cycle_reference_selections [];
      first_element := TRUE;
      FOR cycle_selector := LOWERVALUE (put$cycle_reference_options) TO UPPERVALUE
            (put$cycle_reference_options) DO
        IF cycle_selector IN allowed_cycle_selections THEN
          check_set := check_set + $put$cycle_reference_selections [cycle_selector];
          IF (check_set = allowed_cycle_selections) AND (NOT first_element) THEN
            delimiter := osc$status_parameter_delimiter;
            osp$append_status_parameter (delimiter, ' or ', status);
          IFEND;
          first_element := FALSE;
          osp$append_status_parameter (delimiter, cycle_selector_name_table [cycle_selector], status);
          delimiter := ',';
        IFEND;
      FOREND;
    IFEND;
  PROCEND verify_cycle_selection;

?? TITLE := '    convert_cycle_selector ', EJECT ??

  PROCEDURE convert_cycle_selector (cl_cycle_selector: clt$cycle_selector;
    VAR pu_cycle_selector: put$cycle_reference_options);

    CASE cl_cycle_selector.specification OF
    = clc$cycle_omitted =
      pu_cycle_selector := puc$cycle_omitted;
    = clc$cycle_specified =
      CASE cl_cycle_selector.value.cycle_option OF
      = pfc$lowest_cycle =
        pu_cycle_selector := puc$lowest_cycle;
      = pfc$highest_cycle =
        pu_cycle_selector := puc$highest_cycle;
      = pfc$specific_cycle =
        pu_cycle_selector := puc$specific_cycle;
      ELSE
      CASEND;
    = clc$cycle_next_highest =
      pu_cycle_selector := puc$next_highest_cycle;
    = clc$cycle_next_lowest =
      pu_cycle_selector := puc$next_lowest_cycle;
    ELSE
    CASEND;
  PROCEND convert_cycle_selector;

  PROCEDURE [XDCL] amp$crack_display_tft_options (parameter_name: string ( * );
    VAR display_options: amt$display_tft_option_list;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] amp$display_file_id_list (file_id_list: array [1 .. * ] OF
    amt$file_identifier;
        display_options: amt$display_tft_option_list;
        list_file: amt$local_file_name;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] amp$display_full_tft (display_options:
    amt$display_tft_option_list;
        list_file: amt$local_file_name;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] amp$display_jft_command (parameter_list:
    clt$parameter_list;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] amp$display_lnt_command (parameter_list:
    clt$parameter_list;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] amp$display_local_files_command (parameter_list:
    clt$parameter_list;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] amp$display_tft_command (parameter_list:
    clt$parameter_list;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$advance_tape_volume (sfid: gft$system_file_identifier;
        extend_volume_list: boolean;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$assign_tape_volume (sfid: gft$system_file_identifier;
        path_handle_name: fst$path_handle_name;
        label_type: amt$label_type;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$await_tape_io_completion (sfid: gft$system_file_identifier;
        io_id: iot$io_id;
        data_wait: boolean;
        last_buffer_pva: ^cell;
    VAR tape_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$backspace_tape (sfid: gft$system_file_identifier;
        count: iot$tape_block_count;
    VAR tape_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

 PROCEDURE [XDCL] bap$erase_tape (sfid: gft$system_file_identifier;
        block_length: amt$max_block_length;
        number_of_erases: integer;
    VAR io_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

 PROCEDURE [XDCL] bap$fetch_tape_capabilities (sfid: gft$system_file_identifier;
    VAR maximum_block_length: amt$max_block_length;
    VAR max_blocks_per_physical_call: iot$tape_block_count;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$forspace_tape (sfid: gft$system_file_identifier;
        count: iot$tape_block_count;
    VAR tape_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$read_tape (sfid: gft$system_file_identifier;
        max_block_size: iot$tape_block_length;
        block_description: ^iot$read_tape_description;
        block_count: iot$tape_block_count;
        perform_media_error_recovery: boolean;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$reset_tape_volume (sfid: gft$system_file_identifier;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$rewind_tape (sfid: gft$system_file_identifier;
    VAR tape_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$skip_tapemark_backward (sfid: gft$system_file_identifier;
        count: iot$tape_block_count;
    VAR tape_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$skip_tapemark_forward (sfid: gft$system_file_identifier;
        count: iot$tape_block_count;
    VAR tape_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$tape_request_status (sfid: gft$system_file_identifier;
        io_id: iot$io_id;
    VAR tape_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$write_tape (sfid: gft$system_file_identifier;
        block_description: ^iot$write_tape_description;
        block_count: iot$tape_block_count;
        perform_media_error_recovery: boolean;
    VAR io_id: iot$io_id;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  PROCEDURE [XDCL] bap$write_tapemark (sfid: gft$system_file_identifier;
    VAR tape_status: iot$tape_io_status;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

  VAR
    bav$force_direct_tape_io: [XDCL] boolean;

  VAR
    bav$max_allowed_tape_block_size: [XDCL] integer;
  VAR
    bav$max_bytes_per_tape_io: [XDCL] integer;
  VAR
    bav$max_indirect_tape_block: [XDCL] integer;
  VAR
    bav$use_assign_pages_for_tape: [XDCL] boolean;

  PROCEDURE [XDCL] cmp$get_element_name_via_lun (logical_unit_number: iot$logical_unit;
    VAR element_name: cmt$element_name;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;


{ COMMON DECK CMXLPPT }

  VAR
    cmv$logical_pp_table_p: [XDCL] ^cmt$logical_pp_table;


{ COMMON DECK CMXLUT }

  VAR
    cmv$logical_unit_table: [XDCL] ^cmt$logical_unit_table;

{dmxcsl}
{        convert sfid to lun xref

  PROCEDURE [XDCL] dmp$convert_sfid_to_lun ALIAS 'dmxcsl' (sfid:
    gft$system_file_identifier;
    VAR lun: iot$logical_unit;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

 PROCEDURE [XDCL] dmp$get_mat_pointer (avt_index: dmt$active_volume_table_index;
    VAR p_mat: ^dmt$mainframe_allocation_table);

  PROCEND;

  PROCEDURE [XDCL] dmp$unconditional_get_fde ALIAS 'dmxugfd' (p_fdt_root:
    ^dmt$file_table_root;
        system_file_id: gft$system_file_identifier;
    VAR p_file_descriptor_entry: ^dmt$file_descriptor_entry;
    VAR able_to_locate_fde: boolean);

  PROCEND;

  VAR
    mtv$cst0: [XDCL] ost$state_tables;


  PROCEDURE [XDCL] syp$crack_command (pdt: array [1 .. * ] OF syt$parameter_descriptor;
        text: string ( * );
    VAR pvt: array [1 .. * ] OF syt$parameter_value;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;

*if false
  PROCEDURE [XDCL] ttp$set_test_state (state: ttt$states;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND;
*ifend
  PROCEDURE [XDCL] verify_access (access_type: (syc$readable, syc$writeable);
        cell_pp: ^^cell;
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND verify_access;

  PROCEDURE [XDCL] write_output_line (s: string ( * );
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND write_output_line;

  PROCEDURE [XDCL] convert_bytes (p: ^packed array [1 .. 1000] OF 0 .. 0f(16);
        length: integer;
    VAR msg: string ( * );
        add_to_eol: boolean);

  PROCEND convert_bytes;

  PROCEDURE [XDCL, #GATE] osp$output_debug_text (s: ^string ( * );
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND osp$output_debug_text;

  PROCEDURE [XDCL] ttp$attach_or_create_file_req (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$attach_or_create_file_req;

  PROCEDURE [XDCL] ttp$attach_request (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$attach_request;

  PROCEDURE [XDCL] ttp$close_volume (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$close_volume;

  PROCEDURE [XDCL] ttp$compare_legible_files (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$compare_legible_files;

  PROCEDURE [XDCL] ttp$define_request (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$define_request;

  PROCEDURE [XDCL] ttp$erase_tape_block (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$erase_tape_block;

  PROCEDURE [XDCL] ttp$get_label (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$get_label;

  PROCEDURE [XDCL] ttp$process_change_term_conn (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$process_change_term_conn;

  PROCEDURE [XDCL] ttp$process_display_term_conn (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$process_display_term_conn;

  PROCEDURE [XDCL] ttp$purge_request (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$purge_request;

  PROCEDURE [XDCL] ttp$request_terminal (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$request_terminal;

  PROCEDURE [XDCL] ttp$verify_fsp_attrs (parameter_list: clt$parameter_list;
    VAR status: ost$status);

  PROCEND ttp$verify_fsp_attrs;

  PROCEDURE [XDCL, #GATE] osp$output_debug_heading (s: ^string ( * );
    VAR status: ost$status);

    status.normal := TRUE;

  PROCEND osp$output_debug_heading;

MODEND fsm$test_harness_fs_support;

