?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE File Server: Client Mainframe Manager' ??
MODULE dfm$client_mainframe_manager;

{ PURPOSE:
{   This server module contains those processes responsible for initially defining a client mainframe on the
{   server.  This is command driven: all information about the client mainframe must be entered via the
{   DEFINE_CLIENT command.  As a result of this command, a queue will be created on the server, for the
{   specified client mainframe.  Also, a permanent file will be created for the client mainframe.  This
{   permanent file contains information about the the client mainframe, and also contains an 'environment'
{   for each client job, that is using the server.  A job is submitted that services the client mainframe.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfc$iou_names
*copyc dfc$test_jr_constants
*copyc dfe$error_condition_codes
*copyc dfi$console_display
*copyc dfi$display
*copyc dfi$log_display
*copyc dft$client_mainframe_file
*copyc dft$display_identifier
*copyc dft$server_lifetime
*copyc dft$server_state
*copyc dpt$window_id
*copyc osd$virtual_address
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc oss$task_shared
*copyc ost$caller_identifier
*copyc pfe$internal_error_conditions
*copyc pmt$binary_mainframe_id
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$return
*copyc amp$set_segment_eoi
*copyc clp$evaluate_parameters
*copyc dfp$build_client_mf_file_name
*copyc dfp$check_if_valid
*copyc dfp$crack_client_mf_file_name
*copyc dfp$create_queue
*copyc dfp$display
*copyc dfp$display_client_jobs
*copyc dfp$find_mainframe_id
*copyc dfp$locate_esm_definition
*copyc dfp$new_crack_mainframe_id
*copyc dfp$register_client_job
*copyc dfp$start_cdcnet_server
*copyc dfp$verify_stornet_channel
*copyc dfp$verify_system_administrator
*copyc fmp$ln_open_chapter
*copyc fsp$change_segment_number
*copyc fsp$close_file
*copyc fsp$open_file
*copyc i#move
*copyc mmp$change_segment_number
*copyc mmp$close_segment
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc mmp$get_segment_length
*copyc mmp$set_segment_length
*copyc mmp$write_modified_pages
*copyc osp$append_status_integer
*copyc osp$clear_job_signature_lock
*copyc osp$initialize_signature_lock
*copyc osp$reset_heap
*copyc osp$set_job_signature_lock
*copyc osp$set_status_abnormal
*copyc osp$system_error
*copyc osp$test_sig_lock
*copyc pfp$attach
*copyc pfp$define
*copyc pfp$define_catalog
*copyc pfp$find_directory_array
*copyc pfp$find_next_info_record
*copyc pfp$get_multi_item_info
*copyc pfp$process_job_end
*copyc pfp$purge
*copyc pfp$reattach_files_for_client
*copyc pfp$reset_task_environment
*copyc pfp$set_task_environment
*copyc pmp$convert_binary_mainframe_id
*copyc pmp$execute
*copyc pmp$wait
*copyc pmp$get_unique_name
*copyc syp$advised_move_bytes
*copyc syp$hang_if_system_jrt_set
?? EJECT ??
*copyc dfv$client_mainframe_file_lock
*copyc dfv$file_server_debug_enabled
*copyc dfv$maximum_client_job_lists
*copyc dfv$rebuild_client_tasks_stat_p
*copyc dfv$server_state_string
*copyc dfv$server_wired_heap
*copyc osv$page_size
?? TITLE := 'Global Variables Declared by This Module', EJECT ??

  VAR
    dfv$p_client_mainframe_file: [XDCL, oss$task_private] ^dft$client_mainframe_file := NIL,
    segment_attribute: [READ, oss$job_paged_literal] ARRAY [1 .. 1] OF mmt$attribute_descriptor :=
          [[mmc$kw_segment_number, dfc$client_mainframe_segnum]];

?? TITLE := '[XDCL] dfp$acquire_client_mf_file', EJECT ??

  PROCEDURE [XDCL] dfp$acquire_client_mf_file
    (    client_mainframe_name: pmt$mainframe_id;
         read_only: boolean;
     VAR lfn: ost$name;
     VAR client_segment_pointer: mmt$segment_pointer;
     VAR p_file: dft$p_mainframe_file;
     VAR status: ost$status);


    VAR
      amt_segment_pointer: amt$segment_pointer,
      caller_identifier: ost$caller_identifier,
      client_mainframe_file_name: ost$name,
      cycle_selector: pft$cycle_selector,
      local_status: ost$status,
      path: array [1 .. 4] of pft$name,
      p_segment_attribute: ^array [ * ] of mmt$attribute_descriptor,
      repeat_count: 0 .. 15,
      share: pft$share_selections,
      usage: pft$usage_selections;


    #CALLER_ID (caller_identifier);
    dfp$build_client_mf_file_name (client_mainframe_name, client_mainframe_file_name);
    path [1] := '';
    path [2] := '';
    path [3] := dfc$client_mainframe_catalog;
    path [4] := client_mainframe_file_name;
    cycle_selector.cycle_option := pfc$specific_cycle;
    cycle_selector.cycle_number := 1;
    pmp$get_unique_name (lfn, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF read_only THEN
      usage := $pft$usage_selections [pfc$read];
    ELSE
      usage := $pft$usage_selections [pfc$read, pfc$shorten, pfc$append, pfc$modify];
    IFEND;
    share := $pft$share_selections [pfc$read, pfc$shorten, pfc$append, pfc$modify];


    repeat_count := 5;
    REPEAT
      IF repeat_count <> 5 THEN
        pmp$wait (100, 100);
      IFEND;
      pfp$attach (lfn, path, cycle_selector, osc$null_name, usage, share, pfc$no_wait, status);
      repeat_count := repeat_count - 1;
    UNTIL status.normal OR (status.condition <> pfe$cycle_busy) OR (repeat_count <= 0);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Open the file (segment)

    p_segment_attribute := ^segment_attribute;

    fmp$ln_open_chapter (lfn, 0, caller_identifier.ring, p_segment_attribute, mmc$cell_pointer,
          client_segment_pointer, status);
    IF NOT status.normal THEN
      amp$return (lfn, local_status);

{??   dfp$purge_client_mainframe_file (client_mainframe_name, local_status);

      RETURN;
    IFEND;

    p_file := client_segment_pointer.cell_pointer;
    IF p_file^.mainframe_header.segment_number <> dfc$client_mainframe_segnum THEN
      amt_segment_pointer.kind := amc$cell_pointer;
      amt_segment_pointer.cell_pointer := client_segment_pointer.cell_pointer;
      mmp$change_segment_number (amt_segment_pointer, p_file^.mainframe_header.segment_number,
            caller_identifier.ring, amt_segment_pointer, status);
      IF NOT status.normal THEN
        display_abnormal_status (' dfp$acquire_client_mf_file calling mmp$change_seg..', status);
        mmp$close_segment (client_segment_pointer, caller_identifier.ring, local_status);
        amp$return (lfn, local_status);

{??!!   dfp$purge_client_mainframe_file (client_mainframe_name, local_status);

        RETURN;
      IFEND;
      client_segment_pointer.cell_pointer := amt_segment_pointer.cell_pointer;
      p_file := client_segment_pointer.cell_pointer;
    IFEND;


  PROCEND dfp$acquire_client_mf_file;

?? TITLE := '[XDCL] dfp$display_client_mainframes ', EJECT ??
{ PURPOSE:
{   The purpose of this request is to display the attached mainframes
{   at the operator display and the "Display_Client_Mainframes"
{   subcommand for the MANAGE_FILE_SERVER utility.
{
{ NOTES:
{   Upon entry to this procedure the 'message_written' parameter has been
{   set to FALSE by the calling procedure.  It is set to TRUE if a line is
{   displayed by this procedure.

  PROCEDURE [XDCL] dfp$display_client_mainframes
    (VAR display_identifier: dft$display_identifier;
     VAR message_written {input, output} : boolean;
     VAR status: ost$status);

    VAR
      catalog_content_info: amt$segment_pointer,
      catalog_path: array [1 .. 3] of pft$name,
      group: pft$group,
      ignore_status: ost$status,
      index: pft$array_index,
      lock_status: ost$signature_lock_status,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, catalog_content_info, status);
    IF status.normal THEN
      RESET catalog_content_info.sequence_pointer;
      group.group_type := pfc$public;
      catalog_path [1] := ' ';
      catalog_path [2] := ' ';
      catalog_path [3] := dfc$client_mainframe_catalog;

      pfp$get_multi_item_info (catalog_path, group, $pft$catalog_info_selections [],
            $pft$file_info_selections [pfc$file_directory], catalog_content_info.sequence_pointer, status);
      osp$test_sig_lock (dfv$client_mainframe_file_lock, lock_status);
      IF lock_status <> osc$sls_not_locked THEN
        { If a new client is created after this time we won't know about it since
        { the catalog_content_info will not contain it.
        status.normal := TRUE;
        dfp$display (' Client mainframes being defined ', display_identifier, status);
        mmp$delete_scratch_segment (catalog_content_info, ignore_status);
        RETURN;
      IFEND;
      IF status.normal THEN
        RESET catalog_content_info.sequence_pointer;
        pfp$find_next_info_record (catalog_content_info.sequence_pointer, p_info_record, status);
        IF status.normal THEN
          pfp$find_directory_array (p_info_record, p_directory_array, status);
          IF status.normal AND (p_directory_array <> NIL) THEN
            dfp$display ('--SYSTEM SUPPLIED NAME----USER JOB NAME-------------TRANSACTIONS--ACCESS-------',
                  display_identifier, ignore_status);
            message_written := TRUE;

          /display_all_mainframes/
            FOR index := LOWERBOUND (p_directory_array^) TO UPPERBOUND (p_directory_array^) DO
              CASE p_directory_array^ [index].name_type OF
              = pfc$file_name =
                IF p_directory_array^ [index].name (1, 4) = 'DFF$' THEN
                  display_mainframe (p_directory_array^ [index].name, display_identifier, status);
                IFEND;
              ELSE
              CASEND;
            FOREND /display_all_mainframes/;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (catalog_content_info, ignore_status);
    IFEND;
  PROCEND dfp$display_client_mainframes;

?? TITLE := '[XDCL, #GATE] dfp$define_client_command ', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$define_client_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    VAR
      client_active: boolean,
      client_mainframe: pmt$mainframe_id,
      client_mainframe_id: pmt$binary_mainframe_id,
      connection_parameters: dft$connection_parameters;

    status.normal := TRUE;
    dfp$verify_system_administrator ('DEFINE_CLIENT', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    crack_define_client (parameter_list, client_mainframe, client_mainframe_id, connection_parameters,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF connection_parameters.connection_type = dfc$esm_connection THEN
      dfp$check_if_valid (connection_parameters, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    define_client_request (client_mainframe, client_mainframe_id, connection_parameters, status);

  PROCEND dfp$define_client_command;
?? TITLE := 'define_client_request ', EJECT ??

  PROCEDURE define_client_request
    (    client_mainframe: pmt$mainframe_id;
         client_mainframe_id: pmt$binary_mainframe_id;
         connection_parameters: dft$connection_parameters;
     VAR status: ost$status);

    VAR
      client_found: boolean,
      cpu_queue_p: ^dft$cpu_queue,
      ignore_directory_entry_p: ^dft$q_interface_directory_entry,
      queue_index: dft$queue_index,
      queue_interface_table_p: dft$p_queue_interface_table,
      server_birthdate: integer,
      server_lifetime: dft$server_lifetime,
      server_state: dft$server_state,
      server_to_client: boolean;

    status.normal := TRUE;
    server_to_client := TRUE;
    dfp$find_mainframe_id (client_mainframe, server_to_client, client_found, queue_interface_table_p,
          cpu_queue_p, queue_index, ignore_directory_entry_p);
    IF client_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$client_already_configured, client_mainframe, status);
      RETURN;
    IFEND;

    dfp$create_queue (connection_parameters, client_mainframe, client_mainframe_id, server_to_client,
          queue_interface_table_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    cpu_queue_p := queue_interface_table_p^.queue_directory.cpu_queue_pva_directory
         [connection_parameters.server_queue_index].p_cpu_queue;
    dfp$get_client_mf_file_info (client_mainframe_id, client_found, server_state, server_lifetime,
          server_birthdate);
    IF client_found THEN
      CASE server_state OF
      = dfc$active, dfc$deactivated, dfc$inactive, dfc$awaiting_recovery, dfc$recovering =

        { Recover the lifetime and the birthdate from the client mainframe file.

        cpu_queue_p^.queue_header.partner_status.server_state := dfc$awaiting_recovery;
        cpu_queue_p^.queue_header.server_lifetime := server_lifetime;
        cpu_queue_p^.queue_header.server_birthdate := server_birthdate;
      ELSE

        { The client was terminated - do not recover the lifetime, start new.

      CASEND;
    ELSE
      osp$set_job_signature_lock (dfv$client_mainframe_file_lock);
      create_client_mainframe_file (client_mainframe, client_mainframe_id, status);
      osp$clear_job_signature_lock (dfv$client_mainframe_file_lock);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      dfp$set_client_mf_file_info (client_mainframe_id, cpu_queue_p^.queue_header.
            partner_status.server_state, cpu_queue_p^.queue_header.server_lifetime,
            cpu_queue_p^.queue_header.server_birthdate, client_found);
    IFEND;

    IF #RING (queue_interface_table_p) = osc$user_ring THEN

      { Running in a test harness environment

      set_queue_entries_active (queue_interface_table_p, queue_index);
    ELSE

      { In the real environment the entries are set as active by the activate_client process.

    IFEND;

    IF connection_parameters.connection_type = dfc$cdcnet_connection THEN
      dfp$start_cdcnet_server (queue_interface_table_p, connection_parameters.driver_name, client_mainframe,
            queue_index, status);
    IFEND;

  PROCEND define_client_request;
?? TITLE := ' [XDCL]   dfp$delete_client_mainframes ', EJECT ??

{
{ Purpose:
{   This procedure deletes all the files contained in the catalog of
{   client mainframes.  This is done when recovery is not enabled.
{

  PROCEDURE [XDCL] dfp$delete_client_mainframes;

    VAR
      catalog_content_info: amt$segment_pointer,
      catalog_path: array [1 .. 3] of pft$name,
      cycle_selector: pft$cycle_selector,
      file_path: array [1 .. 4] of pft$name,
      group: pft$group,
      index: pft$array_index,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record,
      status: ost$status;

    IF dfv$file_server_debug_enabled THEN
      display ('Not recovering client mainframes ');
    IFEND;
    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, catalog_content_info, status);
    IF status.normal THEN
      RESET catalog_content_info.sequence_pointer;
      group.group_type := pfc$public;
      catalog_path [1] := ' ';
      catalog_path [2] := ' ';
      catalog_path [3] := dfc$client_mainframe_catalog;
      pfp$get_multi_item_info (catalog_path, group, $pft$catalog_info_selections [],
            $pft$file_info_selections [pfc$file_directory], catalog_content_info.sequence_pointer, status);
      IF status.normal THEN
        RESET catalog_content_info.sequence_pointer;
        pfp$find_next_info_record (catalog_content_info.sequence_pointer, p_info_record, status);
        IF status.normal THEN
          pfp$find_directory_array (p_info_record, p_directory_array, status);
          IF status.normal AND (p_directory_array <> NIL) THEN
            file_path [1] := ' ';
            file_path [2] := ' ';
            file_path [3] := dfc$client_mainframe_catalog;
            cycle_selector.cycle_option := pfc$highest_cycle;

          /delete_all_mainframes/
            FOR index := LOWERBOUND (p_directory_array^) TO UPPERBOUND (p_directory_array^) DO
              CASE p_directory_array^ [index].name_type OF
              = pfc$file_name =
                file_path [4] := p_directory_array^ [index].name;
                IF dfv$file_server_debug_enabled THEN
                  display (p_directory_array^ [index].name);
                IFEND;
                pfp$purge (file_path, cycle_selector, osc$null_name, status);

{ Make sure any extra cycles get deleted also

                pfp$purge (file_path, cycle_selector, osc$null_name, status);
                pfp$purge (file_path, cycle_selector, osc$null_name, status);
              ELSE
              CASEND;
            FOREND /delete_all_mainframes/;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (catalog_content_info, status);
    IFEND;
  PROCEND dfp$delete_client_mainframes;

?? TITLE := '[XDCL] dfp$discard_client_jobs ', EJECT ??

{ Remove all jobs from the client mainframe file, and update the state of
{ in the client mainframe file.

  PROCEDURE [XDCL] dfp$discard_client_jobs
    (    mainframe_id: pmt$mainframe_id;
         new_state: dft$server_state;
     VAR status: ost$status);

    VAR
      caller_id: ost$caller_identifier,
      client_mainframe_lfn: ost$name,
      client_mainframe_name: pmt$mainframe_id,
      client_segment_pointer: mmt$segment_pointer,
      p_client_mainframe_file: dft$p_mainframe_file;

    #CALLER_ID (caller_id);
    dfp$acquire_client_mf_file (mainframe_id, {read_only} FALSE, client_mainframe_lfn,
          client_segment_pointer, p_client_mainframe_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    p_client_mainframe_file^.mainframe_header.server_state := new_state;

    remove_client_jobs (p_client_mainframe_file, status);

    mmp$close_segment (client_segment_pointer, caller_id.ring, status);
    amp$return (client_mainframe_lfn, status);

  PROCEND dfp$discard_client_jobs;
?? TITLE := '[XDCL] dfp$get_client_mf_file_info ', EJECT ??

  PROCEDURE [XDCL] dfp$get_client_mf_file_info
    (    client_mainframe_id: pmt$binary_mainframe_id;
     VAR client_found: boolean;
     VAR server_state: dft$server_state;
     VAR server_lifetime: dft$server_lifetime;
     VAR server_birthdate: integer);

    VAR
      caller_id: ost$caller_identifier,
      client_mainframe_lfn: ost$name,
      client_mainframe_name: pmt$mainframe_id,
      client_segment_pointer: mmt$segment_pointer,
      p_client_mainframe_file: dft$p_mainframe_file,
      status: ost$status;

    #CALLER_ID (caller_id);
    client_found := FALSE;
    pmp$convert_binary_mainframe_id (client_mainframe_id, client_mainframe_name, status);
    IF NOT status.normal THEN
      display_abnormal_status (' dfp$get_client_mf_file_info calling pmp$convert_binary..', status);
      RETURN;
    IFEND;
    dfp$acquire_client_mf_file (client_mainframe_name, {read_only} TRUE, client_mainframe_lfn,
          client_segment_pointer, p_client_mainframe_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF p_client_mainframe_file^.mainframe_header.file_update_flag = dfc$client_file_valid THEN
      server_state := p_client_mainframe_file^.mainframe_header.server_state;
      server_lifetime := p_client_mainframe_file^.mainframe_header.server_lifetime;
      server_birthdate := p_client_mainframe_file^.mainframe_header.server_birthdate;
      client_found := TRUE;
    ELSE

{ Note - if file damaged is set in the header then delete the file
{  and return client_found = false

    IFEND;
    mmp$close_segment (client_segment_pointer, caller_id.ring, status);
    amp$return (client_mainframe_lfn, status);
  PROCEND dfp$get_client_mf_file_info;

?? TITLE := '[XDCL, #GATE] dfp$get_client_mainframe_file ', EJECT ??

{ PURPOSE:
{   This procedure is provided for debugging, and returns the client mainframe file for the specified client
{   mainframe.  The file returned is an exact copy of the client mainframe file, and is in binary format.

  PROCEDURE [XDCL, #GATE] dfp$get_client_mainframe_file
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE get_client_mainframe_file, getcmf (
{   client_mainframe_id, cmid: name pmc$mainframe_id_size = $required
{   output, o: file = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 9, 4, 12, 34, 46, 703],
    clc$command, 5, 3, 2, 0, 0, 0, 3, ''], [
    ['CLIENT_MAINFRAME_ID            ',clc$nominal_entry, 1],
    ['CMID                           ',clc$abbreviation_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [pmc$mainframe_id_size, pmc$mainframe_id_size]],
{ PARAMETER 2
    [[1, 0, clc$file_type]],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$client_mainframe_id = 1,
      p$output = 2,
      p$status = 3;

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

    VAR
      caller_id: ost$caller_identifier,
      cell_array_p: ^ARRAY [1 .. * ] OF cell,
      client_mainframe: pmt$mainframe_id,
      client_mainframe_id: pmt$binary_mainframe_id,
      client_mainframe_lfn: ost$name,
      client_mainframe_segment_length: ost$segment_length,
      client_segment_pointer: mmt$segment_pointer,
      file_creation: ARRAY [1 .. 1] OF fst$file_cycle_attribute,
      ignore_p_file: dft$p_mainframe_file,
      local_status: ost$status,
      output_file_id: amt$file_identifier,
      output_segment_pointer: amt$segment_pointer;

    #CALLER_ID (caller_id);

    status.normal := TRUE;
    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$verify_system_administrator ('GET_CLIENT_MAINFRAME_FILE', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    client_mainframe := pvt [p$client_mainframe_id].value^.name_value;
    dfp$new_crack_mainframe_id (client_mainframe, client_mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    file_creation [1].selector := fsc$ring_attributes;
    file_creation [1].ring_attributes.r1 := 11;
    file_creation [1].ring_attributes.r2 := 11;
    file_creation [1].ring_attributes.r3 := 11;
    fsp$open_file (pvt [p$output].value^.file_value^, amc$segment, NIL, ^file_creation, NIL, NIL, NIL,
          output_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (output_file_id, amc$sequence_pointer, output_segment_pointer, status);
    IF NOT status.normal THEN
      fsp$close_file (output_file_id, local_status);
      RETURN;
    IFEND;

    dfp$acquire_client_mf_file (client_mainframe, {read_only} TRUE, client_mainframe_lfn,
          client_segment_pointer, ignore_p_file, status);
    IF NOT status.normal THEN
      fsp$close_file (output_file_id, local_status);
      RETURN;
    IFEND;

    mmp$get_segment_length (client_segment_pointer.cell_pointer, caller_id.ring,
          client_mainframe_segment_length, status);
    IF status.normal THEN
      RESET output_segment_pointer.sequence_pointer;
      NEXT cell_array_p: [1 .. client_mainframe_segment_length] IN output_segment_pointer.sequence_pointer;
      IF cell_array_p = NIL THEN
        osp$set_status_abnormal (dfc$file_server_id, pfe$info_full, 'get_client_mainframe_file', status);
      ELSE
        i#move (client_segment_pointer.cell_pointer, output_segment_pointer.sequence_pointer,
              client_mainframe_segment_length);
        amp$set_segment_eoi (output_file_id, output_segment_pointer, status);
      IFEND;
    IFEND;
    mmp$close_segment (client_segment_pointer, caller_id.ring, local_status);

    amp$return (client_mainframe_lfn, local_status);
    fsp$close_file (output_file_id, local_status);

  PROCEND dfp$get_client_mainframe_file;

?? TITLE := '[XDCL] dfp$purge_client_mainframe_file', EJECT ??

  PROCEDURE [XDCL] dfp$purge_client_mainframe_file
    (    mainframe_id: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      client_mainframe_file_name: ost$name,
      cycle_selector: pft$cycle_selector,
      path: array [1 .. 4] of pft$name;

    status.normal := TRUE;
    dfp$build_client_mf_file_name (mainframe_id, client_mainframe_file_name);

    path [1] := '';
    path [2] := '';
    path [3] := dfc$client_mainframe_catalog;
    path [4] := client_mainframe_file_name;
    cycle_selector.cycle_option := pfc$highest_cycle;
    pfp$purge (path, cycle_selector, osc$null_name, status);

  PROCEND dfp$purge_client_mainframe_file;
?? TITLE := '[XDCL, #GATE] dfp$rebuild_client_mainframe', EJECT ??

  PROCEDURE [XDCL, #GATE] dfp$rebuild_client_mainframe
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE dfp$rebuild_client_mainframe (
{   mainframe_name: name pmc$mainframe_id_size = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 2] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 9, 4, 12, 43, 19, 974],
    clc$command, 2, 2, 1, 0, 0, 0, 2, ''], [
    ['MAINFRAME_NAME                 ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [pmc$mainframe_id_size, pmc$mainframe_id_size]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$mainframe_name = 1,
      p$status = 2;

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

    PROCEDURE remove_old_client_mf_file;

      display (display_string);
      log_display ($pmt$ascii_logset[pmc$system_log], display_string);
      display_status (status);
      log_display_status ($pmt$ascii_logset[pmc$system_log], TRUE, status);
      mmp$close_segment (old_client_segment_pointer, caller_identifier.ring, local_status);
      amp$return (old_client_mainframe_lfn, local_status);
      dfp$purge_client_mainframe_file (client_mainframe_name, local_status);

    PROCEND remove_old_client_mf_file;

    PROCEDURE remove_new_client_mf_file;

      fsp$close_file (new_client_fid, local_status);
      amp$return (new_client_mainframe_lfn, status);

    PROCEND remove_new_client_mf_file;

    VAR
      caller_identifier: ost$caller_identifier,
      client_mainframe_id: pmt$binary_mainframe_id,
      client_mainframe_name: pmt$mainframe_id,
      display_string: string (80),
      display_string_length: integer,
      local_status: ost$status,
      new_client_mainframe_lfn: ost$name,
      new_client_mainframe_file_p: dft$p_mainframe_file,
      new_client_fid: amt$file_identifier,
      old_client_file_id: amt$file_identifier,
      old_client_mainframe_file_p: dft$p_mainframe_file,
      old_client_mainframe_lfn: ost$name,
      old_client_segment_pointer: mmt$segment_pointer;

    #CALLER_ID (caller_identifier);
    status.normal := TRUE;
    dfp$verify_system_administrator ('dfp$rebuild_client_mainframe', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      display_status (status);
      log_display_status ($pmt$ascii_logset[pmc$system_log], {format} TRUE, status);
      RETURN;
    IFEND;

    client_mainframe_name := pvt [p$mainframe_name].value^.name_value;
    dfp$new_crack_mainframe_id (client_mainframe_name, client_mainframe_id, status);
    IF NOT status.normal THEN
      log_display_status ($pmt$ascii_logset[pmc$system_log], {format} TRUE, status);
      display_status (status);
      RETURN;
    IFEND;

    display_string := ' Rebuild client mainframe ';
    display_string (27, * ) := client_mainframe_name;
    display (display_string);
    log_display ($pmt$ascii_logset[pmc$system_log], display_string);
    dfp$acquire_client_mf_file (client_mainframe_name, {read_only} FALSE, old_client_mainframe_lfn,
          old_client_segment_pointer, old_client_mainframe_file_p, status);

    IF NOT status.normal THEN
      log_display ($pmt$ascii_logset[pmc$system_log], display_string);
      display (display_string);
      display_status (status);
      log_display_status ($pmt$ascii_logset[pmc$system_log], TRUE,
           status);
      dfp$purge_client_mainframe_file (client_mainframe_name, local_status);
      RETURN;
    IFEND;

    verify_client_file_recoverable (old_client_mainframe_file_p, status);
    IF NOT status.normal THEN
      remove_old_client_mf_file;
      IF status.condition = dfe$client_already_terminated THEN
        display (' Client already terminated: no recovery possible ');
        log_display ($pmt$ascii_logset [pmc$system_log],
              ' Client already terminated: no recovery possible ');
        display (client_mainframe_name);
        log_display ($pmt$ascii_logset [pmc$system_log], client_mainframe_name);
        status.normal := TRUE;
      IFEND;
      RETURN;
    IFEND;

    create_rebuild_segment (old_client_mainframe_file_p, client_mainframe_name, client_mainframe_id,
          new_client_fid, new_client_mainframe_file_p, new_client_mainframe_lfn, status);
    IF NOT status.normal THEN
      remove_old_client_mf_file;
      remove_new_client_mf_file;
      RETURN;
    IFEND;

    rebuild_client_jobs (old_client_mainframe_file_p, new_client_mainframe_file_p, status);
    IF NOT status.normal THEN
      remove_old_client_mf_file;
      remove_new_client_mf_file;
      RETURN;
    IFEND;

    copy_rebuilt_segment (old_client_mainframe_file_p, new_client_mainframe_file_p, status);

    fsp$close_file (new_client_fid, local_status);
    mmp$close_segment (old_client_segment_pointer, caller_identifier.ring, local_status);
    amp$return (new_client_mainframe_lfn, status);
    amp$return (old_client_mainframe_lfn, status);
    display_string := ' Rebuild client mainframe ';
    display_string (27, * ) := client_mainframe_name;
    display_string (45, * ) := 'completed';
    display (display_string);
    log_display ($pmt$ascii_logset[pmc$system_log], display_string);

  PROCEND dfp$rebuild_client_mainframe;
?? TITLE := ' [XDCL] dfp$rebuild_client_mainframes ', EJECT ??

{
{ Purpose:
{   This procedure rebuilds all the files contained in the catalog of
{   client mainframes. An asynchronous task is started for each client mainframe.
{   This task then waits for all of the tasks to complete.

  PROCEDURE [XDCL] dfp$rebuild_client_mainframes;

    VAR
      catalog_content_info: amt$segment_pointer,
      catalog_path: array [1 .. 3] of pft$name,
      group: pft$group,
      index: pft$array_index,
      local_status: ost$status,
      mainframe_id: pmt$mainframe_id,
      p_directory_array: pft$p_directory_array,
      p_info_record: pft$p_info_record,
      status: ost$status;

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_random, catalog_content_info, status);
    IF status.normal THEN
      RESET catalog_content_info.sequence_pointer;
      group.group_type := pfc$public;
      catalog_path [1] := ' ';
      catalog_path [2] := ' ';
      catalog_path [3] := dfc$client_mainframe_catalog;
      pfp$get_multi_item_info (catalog_path, group, $pft$catalog_info_selections [],
            $pft$file_info_selections [pfc$file_directory], catalog_content_info.sequence_pointer, status);
      IF status.normal THEN
        RESET catalog_content_info.sequence_pointer;
        pfp$find_next_info_record (catalog_content_info.sequence_pointer, p_info_record, status);
        IF status.normal THEN
          pfp$find_directory_array (p_info_record, p_directory_array, status);
          IF status.normal AND (p_directory_array <> NIL) THEN
            ALLOCATE dfv$rebuild_client_tasks_stat_p: [1 .. UPPERBOUND (p_directory_array^)] IN
                  dfv$server_wired_heap^;

          /rebuild_all_mainframes/
            FOR index := LOWERBOUND (p_directory_array^) TO UPPERBOUND (p_directory_array^) DO
              CASE p_directory_array^ [index].name_type OF
              = pfc$file_name =
                IF p_directory_array^ [index].name (1, 4) = 'DFF$' THEN
                  dfp$crack_client_mf_file_name (p_directory_array^ [index].name, mainframe_id);
                  dfv$rebuild_client_tasks_stat_p^ [index].mainframe_id := mainframe_id;
                  start_rebuild_client_task (mainframe_id, dfv$rebuild_client_tasks_stat_p^ [index].
                        task_status, status);
                ELSE
                  dfv$rebuild_client_tasks_stat_p^ [index].mainframe_id := ' ';
                  dfv$rebuild_client_tasks_stat_p^ [index].task_status.status.normal := TRUE;
                  dfv$rebuild_client_tasks_stat_p^ [index].task_status.complete := TRUE;
                IFEND;
              ELSE
                dfv$rebuild_client_tasks_stat_p^ [index].mainframe_id := ' ';
                dfv$rebuild_client_tasks_stat_p^ [index].task_status.status.normal := TRUE;
                dfv$rebuild_client_tasks_stat_p^ [index].task_status.complete := TRUE;
              CASEND;
            FOREND /rebuild_all_mainframes/;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (catalog_content_info, local_status);
    IFEND;

    await_rebuild_tasks_completion (dfv$rebuild_client_tasks_stat_p);
    IF dfv$rebuild_client_tasks_stat_p <> NIL THEN
      FREE dfv$rebuild_client_tasks_stat_p IN dfv$server_wired_heap^;
    IFEND;

  PROCEND dfp$rebuild_client_mainframes;
?? TITLE := '[XDCL] dfp$remove_client_jobs ', EJECT ??

  PROCEDURE [XDCL] dfp$remove_client_jobs
    (    mainframe_name: pmt$mainframe_id;
     VAR status: ost$status);

    VAR
      amt_segment_pointer: amt$segment_pointer,
      caller_identifier: ost$caller_identifier,
      client_mainframe_name: ost$name,
      p_client_mainframe_file: ^dft$client_mainframe_file,
      segment_attribute: array [1 .. 1] of mmt$attribute_descriptor,
      segment_pointer: mmt$segment_pointer;

    dfp$build_client_mf_file_name (mainframe_name, client_mainframe_name);
    segment_attribute [1].keyword := mmc$kw_segment_number;
    segment_attribute [1].segnum := dfc$client_mainframe_segnum;

    #CALLER_ID (caller_identifier);
    fmp$ln_open_chapter (client_mainframe_name, 0, caller_identifier.ring, ^segment_attribute,
          mmc$cell_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    p_client_mainframe_file := segment_pointer.cell_pointer;
    IF p_client_mainframe_file^.mainframe_header.segment_number <> dfc$client_mainframe_segnum THEN
      amt_segment_pointer.kind := amc$cell_pointer;
      amt_segment_pointer.cell_pointer := segment_pointer.cell_pointer;
      mmp$change_segment_number (amt_segment_pointer, p_client_mainframe_file^.mainframe_header.
            segment_number, 3, amt_segment_pointer, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      segment_pointer.cell_pointer := amt_segment_pointer.cell_pointer;
      p_client_mainframe_file := segment_pointer.cell_pointer;
    IFEND;
    remove_client_jobs (p_client_mainframe_file, status);

    mmp$close_segment (segment_pointer, caller_identifier.ring, status);
  PROCEND dfp$remove_client_jobs;
?? TITLE := '[XDCL] dfp$set_client_mf_file_info', EJECT ??

  PROCEDURE [XDCL] dfp$set_client_mf_file_info
    (    client_mainframe_id: pmt$binary_mainframe_id;
         server_state: dft$server_state;
         server_lifetime: dft$server_lifetime;
         server_birthdate: integer;
     VAR client_found: boolean);

    VAR
      caller_id: ost$caller_identifier,
      client_mainframe_lfn: ost$name,
      client_mainframe_name: pmt$mainframe_id,
      client_segment_pointer: mmt$segment_pointer,
      log_string: string (80),
      log_string_length: integer,
      p_client_mainframe_file: dft$p_mainframe_file,
      status: ost$status;

    #CALLER_ID (caller_id);
    client_found := FALSE;
    pmp$convert_binary_mainframe_id (client_mainframe_id, client_mainframe_name, status);
    IF NOT status.normal THEN
      display_abnormal_status (' dfp$Set_client_mf_file_info calling pmp$convert_binary..', status);
      RETURN;
    IFEND;
    STRINGREP (log_string, log_string_length, ' Client ', client_mainframe_name,
     ' ', dfv$server_state_string [server_state],
     ' Life/Birth ', server_lifetime, server_birthdate);
    log_display ($pmt$ascii_logset [pmc$system_log, pmc$job_log], log_string (1, log_string_length));
    IF dfv$file_server_debug_enabled THEN
      display_to_console (log_string (1, log_string_length));
    IFEND;
    dfp$acquire_client_mf_file (client_mainframe_name, {read_only} FALSE, client_mainframe_lfn,
          client_segment_pointer, p_client_mainframe_file, status);

    IF NOT status.normal THEN
      display_abnormal_status (' dfp$set_client_mf_file_info calling dfp$acquire..', status);
      RETURN;
    IFEND;
    IF p_client_mainframe_file^.mainframe_header.file_update_flag = dfc$client_file_valid THEN
      p_client_mainframe_file^.mainframe_header.server_state := server_state;
      p_client_mainframe_file^.mainframe_header.server_lifetime := server_lifetime;
      p_client_mainframe_file^.mainframe_header.server_birthdate := server_birthdate;
      client_found := TRUE;
    ELSE
      { Note - if file damaged is set in the header then delete the file  } {??}

{  and return client_found = false

    IFEND;
    mmp$close_segment (client_segment_pointer, caller_id.ring, status);
    amp$return (client_mainframe_lfn, status);
  PROCEND dfp$set_client_mf_file_info;
?? TITLE := 'await_rebuild_task_completion', EJECT ??
{
{    This procedure waits for all of the tasks rebuilding client mainframes to
{ complete.  This is done by checking the task status of each of the
{ rebuild tasks.  A 'deadman' timeout is provided in the event of a hung task.
{
  PROCEDURE await_rebuild_tasks_completion
    (    rebuild_client_tasks_stat_p: ^array [ * ] of dft$mainframe_task_status);

    CONST
      check_wait_time = 30000 { 30 seconds } ,
      maximum_wait_time = 5 {minutes } * 60000 { milliseconds per minute } ;

    VAR
      all_tasks_complete: boolean,
      index: integer,
      local_status: ost$status,
      wait_count: 0 .. 50;

    wait_count := 0;
    all_tasks_complete := TRUE;

    IF rebuild_client_tasks_stat_p <> NIL THEN
      display (' Waiting for rebuild of client mainframes to complete ');

    /await_rebuild_complete/
      REPEAT
        all_tasks_complete := TRUE;
        pmp$wait (check_wait_time, check_wait_time);
        wait_count := wait_count + 1;

      /check_all_tasks/
        FOR index := LOWERBOUND (rebuild_client_tasks_stat_p^)
              TO UPPERBOUND (rebuild_client_tasks_stat_p^) DO
          all_tasks_complete := all_tasks_complete AND rebuild_client_tasks_stat_p^ [index].task_status.
                complete;
          IF rebuild_client_tasks_stat_p^ [index].task_status.complete AND
                NOT rebuild_client_tasks_stat_p^ [index].task_status.status.normal THEN
            display ('Rebuild client_mainframe task failed ');
            log_display ($pmt$ascii_logset[pmc$system_log],
                  'Rebuild client_mainframe task failed ');
            display (rebuild_client_tasks_stat_p^ [index].mainframe_id);
            log_display ($pmt$ascii_logset[pmc$system_log],
                  rebuild_client_tasks_stat_p^ [index].mainframe_id);
            display_status (rebuild_client_tasks_stat_p^ [index].task_status.status);
            log_display_status ($pmt$ascii_logset[pmc$system_log], {format} TRUE,
                 rebuild_client_tasks_stat_p^ [index].task_status.status);
            display (' -- Deadstart required to bring up client - no job recovery possible ');
            log_display ($pmt$ascii_logset[pmc$system_log],
                  ' -- Deadstart required to bring up client - no job recovery possible ');
            rebuild_client_tasks_stat_p^ [index].task_status.status.normal := TRUE;
            dfp$purge_client_mainframe_file (rebuild_client_tasks_stat_p^ [index].mainframe_id,
                  local_status);
          IFEND;
        FOREND /check_all_tasks/;
      UNTIL all_tasks_complete OR ((wait_count * check_wait_time) > maximum_wait_time);

      IF all_tasks_complete THEN
        display (' All rebuild client mainframe tasks have completed ');
        log_display ($pmt$ascii_logset[pmc$system_log],
             ' All rebuild client mainframe tasks have completed ');
      ELSE
        display (' All rebuild client mainframe tasks have not yet completed - proceeding with deadstart ');
        log_display ($pmt$ascii_logset[pmc$system_log],
              ' All rebuild client mainframe tasks have not completed successfully');
      IFEND;
    IFEND;
  PROCEND await_rebuild_tasks_completion;

?? TITLE := 'copy_rebuilt_segment ', EJECT ??

  PROCEDURE copy_rebuilt_segment
    (    old_client_mainframe_p: ^dft$client_mainframe_file;
         new_client_mainframe_p: ^dft$client_mainframe_file;
     VAR status: ost$status);

    VAR
      new_segment_length: ost$segment_length;

    status.normal := TRUE;
    mmp$get_segment_length (new_client_mainframe_p, #RING (new_client_mainframe_p), new_segment_length,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    new_client_mainframe_p^.mainframe_header.file_update_flag := dfc$client_file_damaged;
    old_client_mainframe_p^.mainframe_header.file_update_flag := dfc$client_file_damaged;
    mmp$write_modified_pages (old_client_mainframe_p, 1000, osc$wait, status);

    syp$advised_move_bytes (new_client_mainframe_p, old_client_mainframe_p, new_segment_length, status);
    mmp$write_modified_pages (old_client_mainframe_p, new_segment_length, osc$wait, status);

    old_client_mainframe_p^.mainframe_header.file_update_flag := dfc$client_file_valid;
    mmp$write_modified_pages (old_client_mainframe_p, 1000, osc$wait, status);
    mmp$set_segment_length (old_client_mainframe_p, #RING (new_client_mainframe_p), new_segment_length,
          status);

  PROCEND copy_rebuilt_segment;
?? TITLE := 'crack_define_client', EJECT ??

  PROCEDURE crack_define_client
    (    parameter_list: clt$parameter_list;
     VAR client_mainframe: pmt$mainframe_id;
     VAR client_mainframe_id: pmt$binary_mainframe_id;
     VAR connection_parameters: dft$connection_parameters;
     VAR status: ost$status);

{ PROCEDURE define_client, defc (
{   client_mainframe_identifier, cmi: name pmc$mainframe_id_size = $required
{   client_id_number, cidn, cin: integer 1 .. dfc$max_number_of_mainframes  = $required
{   server_id_number, sidn, sin: integer 1 .. dfc$max_number_of_mainframes = $required
{   number_of_monitor_queue_entries, nomqe: integer 0 .. dfc$max_queue_entries-2 = 50
{   number_of_task_queue_entries, notqe: integer 1 .. dfc$max_queue_entries-2 = 4
{   connection_type, ct: any of key stornet keyend, name, anyend = stornet
{   element_name, en: name = $required
{   send_channel, sc: list 1 .. 2 of name = $required
{   receive_channel, rc: list 1 .. 2 of name
{   dma_available, da: boolean = true
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??
  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 23] of clt$pdt_parameter_name,
      parameters: array [1 .. 11] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (2),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (1),
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
        default_value: string (7),
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type8: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type9: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$name_type_qualifier,
        recend,
      recend,
      type10: record
        header: clt$type_specification_header,
        default_value: string (4),
      recend,
      type11: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [91, 9, 6, 7, 30, 35, 924],
    clc$command, 23, 11, 5, 0, 0, 0, 11, ''], [
    ['CIDN                           ',clc$alias_entry, 2],
    ['CIN                            ',clc$abbreviation_entry, 2],
    ['CLIENT_ID_NUMBER               ',clc$nominal_entry, 2],
    ['CLIENT_MAINFRAME_IDENTIFIER    ',clc$nominal_entry, 1],
    ['CMI                            ',clc$abbreviation_entry, 1],
    ['CONNECTION_TYPE                ',clc$nominal_entry, 6],
    ['CT                             ',clc$abbreviation_entry, 6],
    ['DA                             ',clc$abbreviation_entry, 10],
    ['DMA_AVAILABLE                  ',clc$nominal_entry, 10],
    ['ELEMENT_NAME                   ',clc$nominal_entry, 7],
    ['EN                             ',clc$abbreviation_entry, 7],
    ['NOMQE                          ',clc$abbreviation_entry, 4],
    ['NOTQE                          ',clc$abbreviation_entry, 5],
    ['NUMBER_OF_MONITOR_QUEUE_ENTRIES',clc$nominal_entry, 4],
    ['NUMBER_OF_TASK_QUEUE_ENTRIES   ',clc$nominal_entry, 5],
    ['RC                             ',clc$abbreviation_entry, 9],
    ['RECEIVE_CHANNEL                ',clc$nominal_entry, 9],
    ['SC                             ',clc$abbreviation_entry, 8],
    ['SEND_CHANNEL                   ',clc$nominal_entry, 8],
    ['SERVER_ID_NUMBER               ',clc$nominal_entry, 3],
    ['SIDN                           ',clc$alias_entry, 3],
    ['SIN                            ',clc$abbreviation_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 11]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [20, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$required_parameter,
  0, 0],
{ PARAMETER 4
    [14, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 2],
{ PARAMETER 5
    [15, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 6
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 69,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 7
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$required_parameter, 0
  , 0],
{ PARAMETER 8
    [19, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 21, clc$required_parameter,
  0, 0],
{ PARAMETER 9
    [17, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 21, clc$optional_parameter,
  0, 0],
{ PARAMETER 10
    [9, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 11
    [23, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$name_type], [pmc$mainframe_id_size, pmc$mainframe_id_size]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [1, dfc$max_number_of_mainframes, 10]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [1, dfc$max_number_of_mainframes, 10]],
{ PARAMETER 4
    [[1, 0, clc$integer_type], [0, dfc$max_queue_entries-2, 10],
    '50'],
{ PARAMETER 5
    [[1, 0, clc$integer_type], [1, dfc$max_queue_entries-2, 10],
    '4'],
{ PARAMETER 6
    [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['STORNET                        ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ,
    'stornet'],
{ PARAMETER 7
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 8
    [[1, 0, clc$list_type], [5, 1, 2, 0, FALSE, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 9
    [[1, 0, clc$list_type], [5, 1, 2, 0, FALSE, FALSE],
      [[1, 0, clc$name_type], [1, osc$max_name_size]]
    ],
{ PARAMETER 10
    [[1, 0, clc$boolean_type],
    'true'],
{ PARAMETER 11
    [[1, 0, clc$status_type]]];
?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$client_mainframe_identifier = 1,
      p$client_id_number = 2,
      p$server_id_number = 3,
      p$number_of_monitor_queue_entri = 4 {NUMBER_OF_MONITOR_QUEUE_ENTRIES} ,
      p$number_of_task_queue_entries = 5,
      p$connection_type = 6,
      p$element_name = 7,
      p$send_channel = 8,
      p$receive_channel = 9,
      p$dma_available = 10,
      p$status = 11;

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

    VAR
      computed_queue_size: ost$non_negative_integers,
      data_value: clt$data_value,
      esm_table_entry_p: ^dft$esm_definition_table_entry;

    status.normal := TRUE;
    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    { Crack the mainframe id.

    client_mainframe := pvt [p$client_mainframe_identifier].value^.name_value;
    dfp$new_crack_mainframe_id (client_mainframe, client_mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    connection_parameters.server_queue_index := pvt [p$client_id_number].value^.integer_value.value;
    connection_parameters.client_queue_index :=
          pvt [p$server_id_number].value^.integer_value.value + dfc$max_number_of_mainframes;
    connection_parameters.number_of_monitor_queue_entries :=
          pvt [p$number_of_monitor_queue_entri].value^.integer_value.value;
    connection_parameters.number_of_task_queue_entries :=
          pvt [p$number_of_task_queue_entries].value^.integer_value.value;

    { Add 1 to the sum of queue entries to account for the Poll Task.

    computed_queue_size := ((connection_parameters.number_of_monitor_queue_entries +
          connection_parameters.number_of_task_queue_entries + 1) * #SIZE (dft$driver_queue_entry)) +
          #SIZE (dft$driver_queue_header);
    IF computed_queue_size > osv$page_size THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$too_many_queue_entries, '', status);
      osp$append_status_integer (osc$status_parameter_delimiter, computed_queue_size, 10, FALSE, status);
      osp$append_status_integer (osc$status_parameter_delimiter, osv$page_size, 10, FALSE, status);
      RETURN;
    IFEND;

    connection_parameters.client_to_server.client_to_server := FALSE;
    connection_parameters.client_to_server.users_wait_on_terminated := TRUE;
    connection_parameters.client_to_server.preallocate_image_size := 0;
    connection_parameters.client_to_server.timeout_interval := 1;
    connection_parameters.client_to_server.maximum_request_timeout_count := 1;
    connection_parameters.client_to_server.maximum_retransmission_count := 1;

    IF (pvt [p$connection_type].value^.kind = clc$keyword) AND
          (pvt [p$connection_type].value^.keyword_value = 'STORNET') THEN
      connection_parameters.connection_type := dfc$esm_connection;
      connection_parameters.esm_parameters.element_name := pvt [p$element_name].value^.name_value;

      data_value := pvt [p$send_channel].value^;
      connection_parameters.esm_parameters.send_channel.channel_name := data_value.element_value^.name_value;
      IF data_value.link = NIL THEN
        connection_parameters.esm_parameters.send_channel.iou_name := dfc$iou_name0;
      ELSE
        data_value := data_value.link^;
        IF (data_value.element_value^.name_value <> dfc$iou_name0) AND
              (data_value.element_value^.name_value <> dfc$iou_name1) THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$send_channel_invalid_iou,
                data_value.element_value^.name_value, status);
          RETURN;
        IFEND;
        connection_parameters.esm_parameters.send_channel.iou_name :=
              data_value.element_value^.name_value;
      IFEND;
      dfp$verify_stornet_channel (connection_parameters.esm_parameters.element_name,
            connection_parameters.esm_parameters.send_channel, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF NOT pvt [p$receive_channel].specified THEN
        connection_parameters.esm_parameters.receive_channel :=
              connection_parameters.esm_parameters.send_channel;
      ELSE
        data_value := pvt [p$receive_channel].value^;
        connection_parameters.esm_parameters.receive_channel.channel_name :=
              data_value.element_value^.name_value;
        IF data_value.link = NIL THEN
          connection_parameters.esm_parameters.receive_channel.iou_name :=
                connection_parameters.esm_parameters.send_channel.iou_name;
        ELSE
          data_value := data_value.link^;
          IF (data_value.element_value^.name_value <> dfc$iou_name0) AND
                (data_value.element_value^.name_value <> dfc$iou_name1) THEN
            osp$set_status_abnormal (dfc$file_server_id, dfe$receive_channel_invalid_iou,
                  data_value.element_value^.name_value, status);
            RETURN;
          IFEND;
          connection_parameters.esm_parameters.receive_channel.iou_name :=
                data_value.element_value^.name_value;
        IFEND;
        dfp$verify_stornet_channel (connection_parameters.esm_parameters.element_name,
              connection_parameters.esm_parameters.receive_channel, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      connection_parameters.esm_parameters.destination_id_number :=
            pvt [p$client_id_number].value^.integer_value.value;
      connection_parameters.esm_parameters.source_id_number :=
            pvt [p$server_id_number].value^.integer_value.value;
      connection_parameters.esm_parameters.dma_available := pvt [p$dma_available].value^.boolean_value.value;

      dfp$locate_esm_definition (connection_parameters.esm_parameters.element_name, esm_table_entry_p);
      IF esm_table_entry_p = NIL THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$stornet_not_defined,
             connection_parameters.esm_parameters.element_name, status);
        RETURN;
      IFEND;
      connection_parameters.esm_parameters.esm_memory_size := esm_table_entry_p^.memory_size;
      connection_parameters.esm_parameters.esm_base_addresses := esm_table_entry_p^.esm_base_addresses;
      connection_parameters.client_to_server.maximum_data_bytes := esm_table_entry_p^.maximum_data_bytes;

      connection_parameters.driver_name := connection_parameters.esm_parameters.send_channel.channel_name;

      IF pvt [p$client_id_number].value^.integer_value.value >
            connection_parameters.esm_parameters.esm_base_addresses.number_of_mainframes THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$id_number_exceeds_nomf, 'Client', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              pvt [p$client_id_number].value^.integer_value.value, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              connection_parameters.esm_parameters.esm_base_addresses.number_of_mainframes, 10, FALSE,
              status);
        RETURN;
      IFEND;
      IF pvt [p$server_id_number].value^.integer_value.value >
            connection_parameters.esm_parameters.esm_base_addresses.number_of_mainframes THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$id_number_exceeds_nomf, 'Server', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              pvt [p$server_id_number].value^.integer_value.value, 10, FALSE, status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              connection_parameters.esm_parameters.esm_base_addresses.number_of_mainframes, 10, FALSE,
              status);
        RETURN;
      IFEND;

    ELSEIF pvt [p$connection_type].value^.name_value = 'CDCNET' THEN
      connection_parameters.connection_type := dfc$cdcnet_connection;
      connection_parameters.driver_name := pvt [p$element_name].value^.name_value;
    ELSEIF pvt [p$connection_type].value^.name_value = 'MOCK' THEN
      connection_parameters.connection_type := dfc$mock_connection;
      connection_parameters.driver_name := pvt [p$element_name].value^.name_value;
    ELSE
      connection_parameters.driver_name := pvt [p$element_name].value^.name_value;
    IFEND;

  PROCEND crack_define_client;
?? TITLE := 'create_client_mainframe_file ', EJECT ??

  PROCEDURE create_client_mainframe_file
    (    client_mainframe: pmt$mainframe_id;
         client_mainframe_id: pmt$binary_mainframe_id;
     VAR status: ost$status);

    VAR
      caller_identifier: ost$caller_identifier,
      catalog_path: array [1 .. 3] of pft$name,
      client_mainframe_name: ost$name,
      cycle_selector: pft$cycle_selector,
      local_status: ost$status,
      mainframe_file_path: array [1 .. 4] of pft$name,
      segment_pointer: mmt$segment_pointer;

    status.normal := TRUE;
    catalog_path [1] := ' ';
    catalog_path [2] := ' ';
    catalog_path [3] := dfc$client_mainframe_catalog;
    pfp$define_catalog (catalog_path, status);
    IF (NOT status.normal) AND (status.condition <> pfe$name_already_subcatalog) THEN
      RETURN;
    IFEND;
    dfp$build_client_mf_file_name (client_mainframe, client_mainframe_name);
    mainframe_file_path [1] := ' ';
    mainframe_file_path [2] := ' ';
    mainframe_file_path [3] := dfc$client_mainframe_catalog;
    mainframe_file_path [4] := client_mainframe_name;
    cycle_selector.cycle_option := pfc$specific_cycle;
    cycle_selector.cycle_number := 1;
    pfp$define (client_mainframe_name, mainframe_file_path, cycle_selector, osc$null_name,
          pfc$maximum_retention, pfc$log, status);
    IF NOT status.normal THEN
      IF (status.condition = pfe$name_already_permanent_file) OR (status.condition = pfe$duplicate_cycle) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$client_already_configured, client_mainframe, status);
      IFEND;
      RETURN;
    IFEND;

    #CALLER_ID (caller_identifier);
    fmp$ln_open_chapter (client_mainframe_name, 0, caller_identifier.ring, ^segment_attribute,
          mmc$cell_pointer, segment_pointer, status);
    IF status.normal THEN
      dfv$p_client_mainframe_file := segment_pointer.cell_pointer;
      initializ_client_mainframe_file (dfv$p_client_mainframe_file, client_mainframe, client_mainframe_id,
            dfc$client_mainframe_segnum);
      mmp$close_segment (segment_pointer, caller_identifier.ring, status);
    IFEND;

    amp$return (client_mainframe_name, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;
  PROCEND create_client_mainframe_file;
?? TITLE := 'create_rebuild_segment', EJECT ??

  PROCEDURE create_rebuild_segment
    (    old_client_mainframe_p: ^dft$client_mainframe_file;
         client_mainframe_name: pmt$mainframe_id;
         client_mainframe_id: pmt$binary_mainframe_id;
     VAR new_client_fid: amt$file_identifier;
     VAR new_client_mainframe_p: ^dft$client_mainframe_file;
     VAR new_client_mainframe_lfn: ost$name;
     VAR status: ost$status);

    VAR
      amt_segment_pointer: amt$segment_pointer,
      local_status: ost$status,
      segment: ost$segment;

    pmp$get_unique_name (new_client_mainframe_lfn, status);
    fsp$open_file (new_client_mainframe_lfn, amc$segment, NIL, NIL, NIL, NIL, NIL, new_client_fid, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (new_client_fid, amc$cell_pointer, amt_segment_pointer, status);
    IF NOT status.normal THEN
      fsp$close_file (new_client_fid, local_status);
      RETURN;
    IFEND;

    IF old_client_mainframe_p^.mainframe_header.segment_number = dfc$client_mainframe_segnum THEN
      segment := dfc$client_mainframe_segnum_b;
    ELSE
      segment := dfc$client_mainframe_segnum;
    IFEND;
    fsp$change_segment_number (new_client_fid, segment, { validation_ring } 3, amc$cell_pointer,
          amt_segment_pointer, status);
    IF NOT status.normal THEN
      display_status (status);
      fsp$close_file (new_client_fid, local_status);
      amp$return (new_client_mainframe_lfn, local_status);
      RETURN;
    IFEND;

    new_client_mainframe_p := amt_segment_pointer.cell_pointer;
    dfv$p_client_mainframe_file := amt_segment_pointer.cell_pointer;
    initializ_client_mainframe_file (dfv$p_client_mainframe_file, client_mainframe_name, client_mainframe_id,
          segment);

    new_client_mainframe_p^.mainframe_header.server_state := dfc$awaiting_recovery;
    new_client_mainframe_p^.mainframe_header.server_lifetime :=
          old_client_mainframe_p^.mainframe_header.server_lifetime;
    new_client_mainframe_p^.mainframe_header.server_birthdate :=
          old_client_mainframe_p^.mainframe_header.server_birthdate;

  PROCEND create_rebuild_segment;

?? TITLE := 'display_abnormal_status', EJECT ??

  PROCEDURE display_abnormal_status
    (    comment: string ( * <= 255);
         abnormal_status: ost$status);

    display ('  ******************ABNORMAL STATUS *********');
    display (comment);
    display_status (abnormal_status);
    log_display ($pmt$ascii_logset[pmc$system_log], comment);
    log_display_status ($pmt$ascii_logset[pmc$system_log], {format} TRUE,
       abnormal_status);
    display ('  ********************');

  PROCEND display_abnormal_status;

?? TITLE := 'display_mainframe ', EJECT ??

  PROCEDURE display_mainframe
    (    client_mainframe_pf_name: ost$name;
     VAR display_identifier: dft$display_identifier;
     VAR status: ost$status);

    VAR
      caller_identifier: ost$caller_identifier,
      client_mainframe_lfn: ost$name,
      local_status: ost$status,
      mainframe_id: pmt$mainframe_id,
      mainframe_title: string (60),
      mainframe_title_size: integer,
      p_client_mainframe_file: dft$p_mainframe_file,
      segment_pointer: mmt$segment_pointer;

    status.normal := TRUE;
    #CALLER_ID (caller_identifier);
    dfp$crack_client_mf_file_name (client_mainframe_pf_name, mainframe_id);
    mainframe_title := ' CLIENT   ';
    mainframe_title (14, * ) := mainframe_id;
    dfp$acquire_client_mf_file (mainframe_id, {read_only} TRUE, client_mainframe_lfn, segment_pointer,
          p_client_mainframe_file, status);
    IF NOT status.normal THEN
      STRINGREP (mainframe_title, mainframe_title_size, mainframe_title (1, 32),
          ' - Error ', status.condition);
      dfp$display (mainframe_title, display_identifier, local_status);
      RETURN;
    IFEND;
    IF (p_client_mainframe_file^.mainframe_header.file_update_flag <> dfc$client_file_valid) THEN
      mainframe_title (40, * ) := ' file being updated or damaged';
      dfp$display (mainframe_title, display_identifier, local_status);
      mmp$close_segment (segment_pointer, caller_identifier.ring, local_status);
      amp$return (client_mainframe_lfn, local_status);
      RETURN;
    IFEND;

    mainframe_title (40, * ) := dfv$server_state_string [p_client_mainframe_file^.mainframe_header.
          server_state];
    dfp$display (mainframe_title, display_identifier, status);

    dfp$display_client_jobs (p_client_mainframe_file, display_identifier, status);

    mmp$close_segment (segment_pointer, caller_identifier.ring, status);
    IF NOT status.normal THEN
      amp$return (client_mainframe_lfn, local_status);
      RETURN;
    IFEND;

    amp$return (client_mainframe_lfn, status);

  PROCEND display_mainframe;

?? TITLE := 'initializ_client_mainframe_file', EJECT ??

  PROCEDURE initializ_client_mainframe_file
    (    p_mainframe_file: dft$p_mainframe_file;
         client_mainframe_name: pmt$mainframe_id;
         client_mainframe_id: pmt$binary_mainframe_id;
         segment_number: ost$segment);

    VAR
      job_list: dft$job_list_ptr_array_index,
      status: ost$status;

    osp$reset_heap (^p_mainframe_file^.mainframe_heap, #SIZE (p_mainframe_file^.mainframe_heap),
          {lock = } TRUE, 1);
    ALLOCATE p_mainframe_file^.mainframe_header.client_job_list_root.p_job_list_pointer_array:
          [1 .. dfv$maximum_client_job_lists] IN p_mainframe_file^.mainframe_heap;
    IF p_mainframe_file^.mainframe_header.client_job_list_root.p_job_list_pointer_array = NIL THEN
      osp$system_error (' NIL JOB_LIST_POINTER_ARRAY', NIL);
    IFEND;
    p_mainframe_file^.mainframe_header.version := dfc$current_mf_file_version;
    p_mainframe_file^.mainframe_header.client_mainframe_id := client_mainframe_id;
    p_mainframe_file^.mainframe_header.client_mainframe_name := client_mainframe_name;
    osp$initialize_signature_lock (p_mainframe_file^.mainframe_header.client_job_list_lock, status);
    p_mainframe_file^.mainframe_header.client_job_list_root.number_of_active_pointers := 0;

  /initialize_job_lists/
    FOR job_list := 1 TO dfv$maximum_client_job_lists DO
      p_mainframe_file^.mainframe_header.client_job_list_root.p_job_list_pointer_array^ [job_list].
            assignment := ' ';
      p_mainframe_file^.mainframe_header.client_job_list_root.p_job_list_pointer_array^ [job_list].
            p_client_job_list := NIL;
    FOREND /initialize_job_lists/;

    #SPOIL (p_mainframe_file^.mainframe_header);
    p_mainframe_file^.mainframe_header.file_update_flag := dfc$client_file_valid;
    p_mainframe_file^.mainframe_header.segment_number := segment_number;
    #SPOIL (p_mainframe_file^.mainframe_header);
  PROCEND initializ_client_mainframe_file;
?? EJECT ??

  PROCEDURE rebuild_client_jobs
    (    p_old_client_mainframe_file: ^dft$client_mainframe_file;
         p_new_client_mainframe_file: ^dft$client_mainframe_file;
     VAR status: ost$status);

    VAR
      client_mainframe_id: pmt$binary_mainframe_id,
      display_string: string (80),
      display_string_length: integer,
      files_reattached: ost$non_negative_integers,
      files_not_reattached: ost$non_negative_integers,
      job_list_index: dft$client_job_list_index,
      job_list_pointer_index: dft$job_list_ptr_array_index,
      new_client_job_id: dft$client_job_id,
      new_job_list_entry: dft$client_job_list_entry,
      new_p_job_list_pointer: ^dft$job_list_pointer_array,
      old_job_list_entry: dft$client_job_list_entry,
      old_p_job_list_pointer: ^dft$job_list_pointer_array,
      p_client_job_space: ^dft$client_job_space,
      p_client_mainframe_file: ^dft$client_mainframe_file,
      p_job_list_pointer: ^dft$job_list_pointer_array,
      p_old_attached_pf_table: ^pft$attached_pf_table,
      recoverable_job_count: ost$non_negative_integers,
      total_files_reattached: ost$non_negative_integers,
      total_files_not_reattached: ost$non_negative_integers,
      unrecoverable_job_count: ost$non_negative_integers,
      user_id: ost$user_identification;

    unrecoverable_job_count := 0;
    recoverable_job_count := 0;
    total_files_reattached := 0;
    total_files_not_reattached := 0;

    client_mainframe_id :=  p_old_client_mainframe_file^.mainframe_header.client_mainframe_id;
    old_p_job_list_pointer := p_old_client_mainframe_file^.mainframe_header.client_job_list_root.
          p_job_list_pointer_array;
    new_p_job_list_pointer := p_new_client_mainframe_file^.mainframe_header.client_job_list_root.
          p_job_list_pointer_array;

  /search_mainframe_file/
    FOR job_list_pointer_index := 1 TO p_old_client_mainframe_file^.mainframe_header.client_job_list_root.
          number_of_active_pointers DO

    /find_active_jobs/
      FOR job_list_index := 1 TO dfc$client_job_list_size DO
        IF old_p_job_list_pointer^ [job_list_pointer_index].assignment (job_list_index) =
              dfc$free_entry_char THEN
          CYCLE /find_active_jobs/;
        IFEND;
        old_job_list_entry := old_p_job_list_pointer^ [job_list_pointer_index].
              p_client_job_list^ [job_list_index];
        IF dfv$file_server_debug_enabled THEN
          display (old_job_list_entry.system_supplied_job_name);
        IFEND;

{ Do some verification of the client job environment (but not the heap).
{  Verify request is not processing unrecoverable request.

        IF old_job_list_entry.inhibit_job_recovery <> 0 THEN
          unrecoverable_job_count := unrecoverable_job_count + 1;
          IF dfv$file_server_debug_enabled THEN
            display_integer (' Unrecoverable job - inhibit_job_recovery ',
                  old_job_list_entry.inhibit_job_recovery);
          IFEND;
          STRINGREP (display_string, display_string_length,
                ' Unrecoverable client job ',
                 old_job_list_entry.system_supplied_job_name);
          display (display_string( 1, display_string_length));
          log_display ($pmt$ascii_logset[pmc$system_log], display_string( 1, display_string_length));
          CYCLE /find_active_jobs/;
        IFEND;

        syp$hang_if_system_jrt_set (dfc$tjr_hang_rebuild_clientjobs);
        p_client_job_space := old_job_list_entry.p_client_job_space;
        user_id.user := p_client_job_space^.user;
        user_id.family := p_client_job_space^.family;
        dfp$register_client_job (user_id, p_client_job_space^.account, p_client_job_space^.project,
              old_job_list_entry.system_supplied_job_name, old_job_list_entry.user_supplied_job_name,
              old_job_list_entry.job_mode,
              p_client_job_space^.family_access_kind, old_job_list_entry.job_lifetime,
              p_new_client_mainframe_file, new_client_job_id, status);
        IF NOT status.normal THEN
          unrecoverable_job_count := unrecoverable_job_count + 1;
          display_status (status);
          display (' Unrecoverable job - dfp$register_client_job');
          log_display ($pmt$ascii_logset [pmc$system_log],
                 ' Unrecoverable job - dfp$register_client_job');
          CYCLE /find_active_jobs/;
        IFEND;

        new_job_list_entry := new_p_job_list_pointer^ [new_client_job_id.job_list_pointer_index].
              p_client_job_list^ [new_client_job_id.job_list_index];
        pfp$set_task_environment (new_job_list_entry.p_client_job_space, TRUE, TRUE);
        p_old_attached_pf_table := p_client_job_space^.p_attached_pf_table.table_p;
        pfp$reattach_files_for_client (client_mainframe_id, p_old_attached_pf_table, files_reattached,
              files_not_reattached, status);
        total_files_reattached := total_files_reattached + files_reattached;
        total_files_not_reattached := total_files_not_reattached + files_not_reattached;
        IF dfv$file_server_debug_enabled THEN
          display_integer (' Files reattached ', files_reattached);
          display_integer (' Files NOT reattached ', files_not_reattached);
        IFEND;
        IF status.normal THEN
          recoverable_job_count := recoverable_job_count + 1;
        ELSE
          unrecoverable_job_count := unrecoverable_job_count + 1;
          IF dfv$file_server_debug_enabled THEN
            display (' Unrecoverable job - pfp$reatttach_files_for_client');
            display_status (status);
          IFEND;

{ Remove the job from the new client mainframe file.

          new_p_job_list_pointer^ [new_client_job_id.job_list_pointer_index].
                assignment (new_client_job_id.job_list_index) := dfc$free_entry_char;
          FREE new_job_list_entry.p_client_job_space IN p_new_client_mainframe_file^.mainframe_heap;
          new_p_job_list_pointer^ [new_client_job_id.job_list_pointer_index].
                p_client_job_list^ [new_client_job_id.job_list_index].system_supplied_job_name := 'deleted';
        IFEND;

      FOREND /find_active_jobs/;
    FOREND /search_mainframe_file/;

    pfp$reset_task_environment;

    display (p_old_client_mainframe_file^.mainframe_header.client_mainframe_name);
    display_integer (' - Files reattached ', total_files_reattached);
    display_integer (' - Files NOT reattached ', total_files_not_reattached);
    display_integer (' - Recoverable client jobs ', recoverable_job_count);
    display_integer (' - Unrecoverable client jobs ', unrecoverable_job_count);
    log_display ($pmt$ascii_logset[pmc$system_log],
         p_old_client_mainframe_file^.mainframe_header.client_mainframe_name);
    log_display_integer ($pmt$ascii_logset[pmc$system_log],
          ' - Files reattached ', total_files_reattached);
    log_display_integer ($pmt$ascii_logset[pmc$system_log],
          ' - Files NOT reattached ', total_files_not_reattached);
    log_display_integer ($pmt$ascii_logset[pmc$system_log],
           ' - Recoverable client jobs ', recoverable_job_count);
    log_display_integer ($pmt$ascii_logset[pmc$system_log],
          ' - Unrecoverable client jobs ', unrecoverable_job_count);
  PROCEND rebuild_client_jobs;
?? TITLE := 'remove_client_jobs ', EJECT ??

  PROCEDURE remove_client_jobs
    (    p_client_mainframe_file: ^dft$client_mainframe_file;
     VAR status: ost$status);

    VAR
      job_list_entry: dft$client_job_list_entry,
      job_list_index: dft$client_job_list_index,
      job_list_pointer_index: dft$job_list_ptr_array_index,
      p_job_list_pointer: ^dft$job_list_pointer_array,
      pass: 1 .. 2,
      return_files_option: pft$return_files_option;

    p_job_list_pointer := p_client_mainframe_file^.mainframe_header.client_job_list_root.
          p_job_list_pointer_array;

  /two_pass/
    FOR pass := 1 TO 2 DO

    /search_mainframe_file/
      FOR job_list_pointer_index := 1 TO p_client_mainframe_file^.mainframe_header.client_job_list_root.
            number_of_active_pointers DO

      /find_active_jobs/
        FOR job_list_index := 1 TO dfc$client_job_list_size DO
          IF p_job_list_pointer^ [job_list_pointer_index].assignment (job_list_index) =
                dfc$free_entry_char THEN
            CYCLE /find_active_jobs/;
          IFEND;
          job_list_entry := p_job_list_pointer^ [job_list_pointer_index].p_client_job_list^ [job_list_index];
          IF dfv$file_server_debug_enabled THEN
            display (job_list_entry.system_supplied_job_name);
          IFEND;
          pfp$set_task_environment (job_list_entry.p_client_job_space, { System Administrator } TRUE,
                { Family Administrator } TRUE);
          return_files_option.return_files := TRUE;
          return_files_option.log_returned_files := TRUE;
          return_files_option.wait_for_down_volume := FALSE;
          pfp$process_job_end (p_client_mainframe_file^.mainframe_header.client_mainframe_id,
                return_files_option);
          IF dfv$file_server_debug_enabled THEN
            display_integer ('Files Returned :', return_files_option.files_returned);
          IFEND;
          IF pass = 2 THEN
            IF return_files_option.files_on_down_device > 0 THEN
              return_files_option.wait_for_down_volume := TRUE;
              display_integer ('Waiting for return of files on down device:',
                    return_files_option.files_on_down_device);
              pfp$process_job_end (p_client_mainframe_file^.mainframe_header.client_mainframe_id,
                    return_files_option);
              IF dfv$file_server_debug_enabled THEN
                display_integer ('Files Returned :', return_files_option.files_returned);
              IFEND;
            IFEND;
          IFEND;

          IF ((pass = 1) AND (return_files_option.files_on_down_device = 0)) OR (pass = 2) THEN

{ Remove the job.

            p_job_list_pointer^ [job_list_pointer_index].assignment (job_list_index) := dfc$free_entry_char;
            FREE job_list_entry.p_client_job_space IN p_client_mainframe_file^.mainframe_heap;
            p_job_list_pointer^ [job_list_pointer_index].p_client_job_list^ [job_list_index].
                  system_supplied_job_name := 'deleted';
          IFEND;
        FOREND /find_active_jobs/;
      FOREND /search_mainframe_file/;
    FOREND /two_pass/;

    pfp$reset_task_environment;
  PROCEND remove_client_jobs;
?? TITLE := 'set_queue_entries_active ', EJECT ??

  PROCEDURE set_queue_entries_active
    (    p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index);

    VAR
      queue_entry: dft$queue_entry_index;

  /initialize_each_entry/
    FOR queue_entry := 1 TO UPPERBOUND (p_queue_interface_table^.queue_directory.
          driver_queue_pva_directory [queue_index].p_driver_queue^.queue_entries) DO
      p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].p_driver_queue^.
            queue_entries [queue_entry].flags.active_entry := TRUE;
    FOREND /initialize_each_entry/;
  PROCEND set_queue_entries_active;

?? TITLE := 'start_rebuild_client_task ', EJECT ??

  PROCEDURE start_rebuild_client_task
    (    mainframe_id: pmt$mainframe_id;
     VAR task_status: pmt$task_status;
     VAR status: ost$status);

    VAR
      p_parameter_sequence: ^pmt$program_parameters,
      p_parameter_string: ^ost$string,
      p_program_attributes: ^pmt$program_attributes,
      p_program_description: ^pmt$program_description,
      taskid: pmt$task_id;

    PUSH p_program_description: [[REP 1 OF pmt$program_attributes]];
    RESET p_program_description;
    NEXT p_program_attributes IN p_program_description;
    p_program_attributes^.contents := $pmt$prog_description_contents
          [pmc$starting_proc_specified, pmc$load_map_options_specified, pmc$term_error_level_specified];
    p_program_attributes^.starting_procedure := 'DFP$REBUILD_CLIENT_MAINFRAME';
    p_program_attributes^.load_map_options := $pmt$load_map_options [pmc$no_load_map];
    p_program_attributes^.termination_error_level := pmc$warning_load_errors;

    PUSH p_parameter_sequence: [[REP 1 OF ost$string]];
    RESET p_parameter_sequence;
    NEXT p_parameter_string IN p_parameter_sequence;
    p_parameter_string^.size := #SIZE (mainframe_id);
    p_parameter_string^.value := mainframe_id;

    pmp$execute (p_program_description^, p_parameter_sequence^, osc$nowait, taskid, task_status, status);
  PROCEND start_rebuild_client_task;
?? TITLE := 'verify_client_file_recoverable', EJECT ??

  PROCEDURE verify_client_file_recoverable
    (    p_client_mainframe_file: ^dft$client_mainframe_file;
     VAR status: ost$status);

    status.normal := TRUE;
    IF (p_client_mainframe_file^.mainframe_header.file_update_flag <> dfc$client_file_valid) THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$client_mf_file_unrecovered,
            ' SYSTEM FAILURE IN THE MIDDLE OF UPDATE ', status);
      RETURN;
    IFEND;

    IF (p_client_mainframe_file^.mainframe_header.server_state = dfc$terminated) OR
          (p_client_mainframe_file^.mainframe_header.server_state = dfc$deleted) THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$client_already_terminated,
            p_client_mainframe_file^.mainframe_header.client_mainframe_name, status);
      RETURN;
    IFEND;

    IF dfv$file_server_debug_enabled THEN
      IF p_client_mainframe_file^.mainframe_header.client_job_list_lock.lock_id <> 0 THEN
        display (p_client_mainframe_file^.mainframe_header.client_mainframe_name);
        display ('     Previous failure while client job list locked.');
       log_display ($pmt$ascii_logset[pmc$system_log],
              '     Previous failure while client job list locked.');
      IFEND;
    IFEND;
  PROCEND verify_client_file_recoverable;
?? OLDTITLE ??
?? OLDTITLE ??
MODEND dfm$client_mainframe_manager;

