?? RIGHT := 110 ??
?? TITLE := 'NOS/VE File Server: Manage Image' ??
MODULE dfm$manage_image;

{
{   This module includes the processes involved with the server image file.
{  The server image file is the permanent file that is used to retain pages
{  on the client mainframe belonging to a server mainframe.
{  On the client mainframe this includes:
{  - Continuation deadstart:
{    Referencing the old system file table from the image.
{    For each server file copy the server pages to the server image.
{ -  Timeout processing
{    Using the system file table from memory move
{    pages from real memory to the server image file.
{  This module also includes the process involved with flushing the image
{    file to the server mainframe on activation from the awaiting_recovery
{    state.
{
{ The general flow within this module is as follows.
{   DEFINE_SERVER
{      dfp$create_image_file
{
{   Continuation deadstart
{     dfp$save_server_image
{        get_image_file
{        recover_server_files
{          for all server files
{             save_server_file_image
{                move pages from old image to server image file
{        return_image_file
{
{   activation of file server
{     dfp$flush_image_file
{       get_image_file
{       dfp$begin_ch_remote_proc_call
{       dfp$send_client_rpc_segment
{       dfp$send_remote_procedure_call
{                                             dfp$server_flush_image_file
{                                               dfp$receive_client_rpc_segment
{                                               recover_served_file
{                                                  update_served_file_image
{                                                    allocate_file_space
{                                                    open the disk file and
{                                                    move the pages
{                                                    free the pages from the recovery job's working set
{                                                  dmp$set_eoi
{       terminate_unrecovered_files
{       dfp$end_ch_remote_proc_call
{


?? NEWTITLE := '  Global Declarations Reference by this Module', EJECT ??
*copyc dft$image_file
?? SKIP := 6 ??
*copyc dft$image_file_id
*copyc osc$volume_unavailable_cond
?? SKIP := 6 ??
*copyc dfp$initialize_block_header
?? SKIP := 6 ??
*copyc dfp$expand_image_file
?? SKIP := 6 ??
*copyc dfp$get_next_image_block
?? PUSH (LISTEXT := ON) ??
*copyc amp$close
*copyc amp$get_file_attributes
*copyc amp$get_segment_pointer
*copyc amp$open
*copyc amp$return
*copyc clp$get_value
*copyc clp$operator_intervention
*copyc clp$scan_parameter_list
*copyc dfc$partially_rebuilt_fde_eoi
*copyc dfc$server_mainframes_catalog
*copyc dfc$test_jr_constants
*copyc dfi$display
*copyc dfi$log_display
*copyc dfp$build_image_file_name
*copyc dfp$complement_gfn
*copyc dfp$crack_mainframe_id
*copyc dfp$delete_client_rpc_segment
*copyc dfp$find_mainframe_id
*copyc dfp$get_served_file_desc_p
*copyc dfp$r1_timeout_server_files
*copyc dfp$receive_client_rpc_segment
*copyc dfp$send_client_rpc_segment
*copyc dfp$send_message_to_operator
*copyc dfp$send_remote_procedure_call
*copyc dfp$uncomplement_gfn
*copyc dfp$verify_system_administrator
*copyc dfv$file_server_debug_enabled
*copyc dfv$recovery_task
*copyc dmp$allocate_file_space_r1
*copyc dmp$change_overflow_allowed
*copyc dmp$close_file
*copyc dmp$generate_gfn_hash
*copyc dmp$get_disk_file_descriptor_p
*copyc dmp$get_old_image_pointers
*copyc dmp$get_total_allocated_length
*copyc dmp$open_file
*copyc dmp$search_fdt_by_gfn
*copyc dmp$set_eoi
*copyc dmp$terminate_server_file_list
*copyc dmt$error_condition_codes
*copyc dsp$system_committed
*copyc fsp$close_file
*copyc fsp$open_file
*copyc gfp$get_fde_p
*copyc gfp$scan_all_fdes_in_image
*copyc i#build_adaptable_seq_pointer
*copyc i#current_sequence_position
*copyc i#move
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc mmp$fetch_image_page_count
*copyc mmp$fetch_pvas_of_image_pages
*copyc mmp$free_pages
*copyc mmp$get_allocated_addresses
*copyc mmp$os_preallocate_file_space
*copyc mmp$set_segment_length
*copyc mmp$write_modified_pages
*copyc osp$append_status_parameter
*copyc osp$establish_condition_handler
*copyc osp$get_condition_status
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$set_status_from_condition
*copyc osp$verify_system_privilege
*copyc osv$page_size
*copyc pfp$attach
*copyc pfp$define
*copyc pfp$find_directory_array
*copyc pfp$find_next_info_record
*copyc pfp$get_multi_item_info
*copyc pfp$purge
*copyc pfp$restricted_attach
*copyc pmp$continue_to_cause
*copyc pmp$convert_mainframe_to_binary
*copyc pmp$convert_binary_mainframe_id
*copyc pmp$convert_binary_unique_name
*copyc pmp$delay
*copyc pmp$exit
*copyc pmp$get_mainframe_id
*copyc syp$hang_if_system_jrt_set
?? POP ??
?? TITLE := 'Client: [XDCL] dfp$create_image_file ', EJECT ??

{
{   This procedure creates the image file for the specified server mainframe.
{ If preallocated_size is greater than zero,  space is preallocated for the
{ file.  If the file already exists but the specified preallocated_size is
{ greater than the current allocated length for the file, the file will be
{ extended.  During this time the file is allowed to overflow devices, but
{ when written by timeout or continuation deadstart it is not allowed to
{ overflow.

  PROCEDURE [XDCL] dfp$create_image_file
    (    server_mainframe_id: pmt$binary_mainframe_id;
         preallocated_size: ost$segment_length;
     VAR image_file_already_exists: boolean;
     VAR status: ost$status);

    VAR
      cycle_selector: pft$cycle_selector,
      file_id: amt$file_identifier,
      local_status: ost$status,
      mainframe_file_path: array [1 .. 4] of pft$name,
      p_seq: ^SEQ ( * ),
      p_server_image_header: ^dft$image_header,
      segment_pointer: amt$segment_pointer,
      server_image_file_name: ost$name;

    dfp$build_image_file_name (server_mainframe_id, server_image_file_name);
    IF dfv$file_server_debug_enabled THEN
      display (server_image_file_name);
    IFEND;

    mainframe_file_path [1] := ' ';
    mainframe_file_path [2] := ' ';
    mainframe_file_path [3] := dfc$server_mainframes_catalog;
    mainframe_file_path [4] := server_image_file_name;
    cycle_selector.cycle_option := pfc$specific_cycle;
    cycle_selector.cycle_number := 1;
    pfp$define (server_image_file_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
        image_file_already_exists := TRUE;
        status.normal := TRUE;
        IF preallocated_size > 0 THEN
          increase_preallocated_size (server_mainframe_id, preallocated_size, status);
        IFEND;
      IFEND;
      RETURN;
    IFEND;

    image_file_already_exists := FALSE;
    amp$open (server_image_file_name, amc$segment, NIL, file_id, status);
    IF NOT status.normal THEN
      amp$return (server_image_file_name, local_status);
      RETURN;
    IFEND;
    amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      amp$close (file_id, local_status);
      amp$return (server_image_file_name, local_status);
      RETURN;
    IFEND;
    p_seq := segment_pointer.sequence_pointer;

    IF preallocated_size > 0 THEN
      mmp$os_preallocate_file_space (p_seq, preallocated_size, { wait secs } 60, status);
      IF status.normal THEN
        mmp$set_segment_length (p_seq, { ring } 2, preallocated_size, status);
      IFEND;
      IF NOT status.normal THEN
        { Despite this abnormal status continue.  The image file write
        { process during continuation deadstart or timeout will attempt to
        { preallocate space as it goes.
        display_integer (' Unable to preallocate server image space: ', preallocated_size);
        log_display_integer ($pmt$ascii_logset [pmc$system_log],
              ' Unable to preallocate server image space: ', preallocated_size);
        display_status (status);
        log_display_status ($pmt$ascii_logset [pmc$system_log], { format } TRUE, status);
      IFEND;
    IFEND;

    initialize_image_file (server_mainframe_id, preallocated_size, p_seq);

    RESET p_seq;
    NEXT p_server_image_header IN p_seq;
    p_server_image_header^.file_update_flag := dfc$image_file_valid;
    amp$close (file_id, status);

    change_overflow_allowed (server_image_file_name, FALSE, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

    amp$return (server_image_file_name, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;
  PROCEND dfp$create_image_file;
?? TITLE := 'Client: [XDCL, #GATE] dfp$display_image_file ', EJECT ??

{ This procedure is provided for debugging file server.
{  display_image_file (mainframe_name: name 17  = $optional
{    image_file, if: file = $optional
{    display_pages, dp: boolean = FALSE
{    status)
{ This command processor displays the image file to the $response
{ file.  This includes display of all headers in the image file.
{ If the image_file parameter is specified the image file is displayed from the
{   specified file.  This may be used to look at an image file from a dump
{   by using a copy_memory command to command memory from the dump to a
{   file that would be specified as this parameter.
{ If the image file is not specified, then the mainframe_name parameter
{   must be specified and the image file for that server mainframe is
{   displayed and is attached from the $system.$df$client_mainframes catalog.
{   This option is only allowed from the console.
{ The display_pages parameter indicates whether the actual page data for
{   each file is to be displayed.
{

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


{   pdt display_image_file (mainframe_name: name 17  = $optional
{    image_file, if: file = $optional
{    display_pages, dp: boolean = FALSE
{    status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    display_image_file: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^display_image_file_names,
  ^display_image_file_params];

  VAR
    display_image_file_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of
  clt$parameter_name_descriptor := [['MAINFRAME_NAME', 1], ['IMAGE_FILE', 2], ['IF', 2], ['DISPLAY_PAGES', 3]
  , ['DP', 3], ['STATUS', 4]];

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

{ MAINFRAME_NAME }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$name_value, 17, 17]],

{ IMAGE_FILE IF }
    [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ DISPLAY_PAGES DP }
    [[clc$optional_with_default, ^display_image_file_dv3], 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
    display_image_file_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (5) := 'FALSE';

?? FMT (FORMAT := ON) ??
?? POP ??

    VAR
      block_advanced: boolean,
      display_pages: boolean,
      file_count: gft$file_descriptor_index,
      image_file_id: dft$image_file_id,
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_name: pmt$mainframe_id,
      p_data: ^cell,
      p_file_header: ^dft$image_file_header,
      p_page_header: ^dft$image_page_header,
      page_count: 0 .. osc$max_page_frames,
      value: clt$value;

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

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

    clp$get_value ('DISPLAY_PAGES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display_pages := value.bool.value;

    clp$get_value ('IMAGE_FILE', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF value.kind = clc$unknown_value THEN
      dfp$crack_mainframe_id ('MAINFRAME_NAME', mainframe_name, mainframe_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      get_image_file (mainframe_id, dfc$read_image_file, image_file_id, status);
    ELSE
      open_file_as_image (value.file.local_file_name, image_file_id, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    display_pva (' Current eoi ', image_file_id.p_current_eoi);
    display_integer (' Current allocated_length', image_file_id.allocated_size);
    display_image_header (image_file_id.p_image_header^);
    block_advanced := FALSE;

  /for_all_blocks_in_image/
    WHILE image_file_id.p_current_block_header <> NIL DO
      IF NOT block_advanced THEN
        display_block_header (image_file_id.p_current_block_header);
      IFEND;
      block_advanced := FALSE;

    /for_all_files_starting_in_block/
      FOR file_count := 1 TO image_file_id.p_current_block_header^.file_count DO
        NEXT p_file_header IN image_file_id.p_current_block_seq;
        display_file_header (p_file_header);

      /for_all_pages_of_file/
        FOR page_count := 1 TO p_file_header^.page_count DO
          NEXT p_page_header IN image_file_id.p_current_block_seq;
          IF p_page_header = NIL THEN
            display (' --- Pages for a file crossing block boundary ');
            advance_to_next_block (image_file_id);
            block_advanced := TRUE;
            display_block_header (image_file_id.p_current_block_header);
            NEXT p_page_header IN image_file_id.p_current_block_seq;
          IFEND;
          display_pva ('  - dft$image_page_header ', p_page_header);
          display_integer ('    <page count > ', page_count);
          display_integer ('    file_offset', p_page_header^.file_offset);
          display_integer ('    image_offset', p_page_header^.image_offset);
          IF display_pages THEN
            p_data := #ADDRESS (#RING (image_file_id.p_current_block_header),
                  #SEGMENT (image_file_id.p_current_block_header), p_page_header^.image_offset);
            display_bytes (p_data, image_file_id.p_image_header^.page_size);
          IFEND;
        FOREND /for_all_pages_of_file/;
      FOREND /for_all_files_starting_in_block/;
      IF block_advanced THEN

{ The block header is all set up

      ELSEIF image_file_id.p_current_block_header^.next_block_header_offset = 0 THEN
        image_file_id.p_current_block_header := NIL;
      ELSE
        advance_to_next_block (image_file_id);
      IFEND;

    WHILEND /for_all_blocks_in_image/;

    return_image_file (image_file_id, status);

  PROCEND dfp$display_image_file;
?? TITLE := 'Client: [XDCL, #GATE] dfp$flush_image_file_command', EJECT ??

{ This procedure is provided for debugging file server.

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

{  pdt flush_image_file (mainframe_name: name 17  = $required
{  status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    flush_image_file: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
[^flush_image_file_names,
  ^flush_image_file_params];

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

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

{ MAINFRAME_NAME }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
clc$name_value, 17, 17]],

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

?? FMT (FORMAT := ON) ??
?? POP ??

    VAR
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_name: pmt$mainframe_id;

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

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

    dfp$crack_mainframe_id ('MAINFRAME_NAME', mainframe_name, mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$flush_image_file (mainframe_id, mainframe_name, status);
  PROCEND dfp$flush_image_file_command;
?? TITLE := 'Client [XDCL] dfp$flush_image_file', EJECT ??

{   The purpose of this procedure (which executes on the client) is to
{ transfer the image file that exists on the client mainframe to the server
{ mainframe. This uses the RPC mechanism of sending a segment to the
{ server.  The companion RPC procedure on the server is
{ dfp$server_flush_image_file.   The server procedure returns the list
{ of files that did not recover.

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

?? NEWTITLE := 'dfp$remote_procedure_call_ch', EJECT ??

{ PURPOSE:
{   This procedure is a condition handler established to call a routine to clear the assignment of a task
{   services queue_entry if a task aborts with a queue_entry assigned to it.  The queue_entry must be clear
{   before the task can safely exit.

    PROCEDURE dfp$remote_procedure_call_ch
      (    condition: pmt$condition;
           cond_desc: ^pmt$condition_information;
           save: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      dfp$ch_cleanup;
      osp$set_status_from_condition (dfc$file_server_id, condition, save, status, handler_status);
      EXIT dfp$flush_image_file;

    PROCEND dfp$remote_procedure_call_ch;
*block
*copyc dfp$begin_ch_remote_proc_call
*copyc dfp$end_ch_remote_proc_call
*blockend
?? OLDTITLE, EJECT ??
    VAR
      image_file_id: dft$image_file_id,
      local_status: ost$status,
      msg_string: string (80),
      msg_string_length: integer,
      p_receive_data: dft$p_receive_data,
      p_receive_from_server_params: dft$p_receive_parameters,
      p_send_data: dft$p_send_data,
      p_send_to_server_params: dft$p_send_parameters,
      queue_entry_location: dft$rpc_queue_entry_location,
      server_location: dft$server_location;

    get_image_file (mainframe_id, dfc$read_image_file, image_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF (image_file_id.p_current_block_header = NIL) OR (image_file_id.p_current_block_header^.file_count = 0)
          THEN
      STRINGREP (msg_string, msg_string_length, ' Empty server image ', mainframe_name);
      log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
      display (msg_string (1, msg_string_length));
      return_image_file (image_file_id, status);
      RETURN;
    IFEND;
    dfv$recovery_task := TRUE;
    server_location.server_location_selector := dfc$mainframe_id;
    server_location.server_mainframe := mainframe_name;
    dfp$begin_ch_remote_proc_call (server_location, {allowed_when_server_deactivated } FALSE,
          queue_entry_location, p_send_to_server_params, p_send_data, status);

    IF status.normal THEN
      IF dfv$file_server_debug_enabled THEN
        display_integer (' Sending image to server ', #OFFSET (image_file_id.p_current_eoi));
      IFEND;
      dfp$send_client_rpc_segment (queue_entry_location, image_file_id.p_image_file, { offset = } 0, { size }
            #OFFSET (image_file_id.p_current_eoi), status);
      IF status.normal THEN
        dfp$send_remote_procedure_call (queue_entry_location, dfc$flush_image_file, {parameter_size } 0,
              {data size} 0, p_receive_from_server_params, p_receive_data, status);
        IF status.normal THEN
          terminate_unrecovered_files (mainframe_name, p_receive_data);
        IFEND;
      IFEND;
      dfp$end_ch_remote_proc_call (queue_entry_location, local_status);
    IFEND;

    return_image_file (image_file_id, local_status);

  PROCEND dfp$flush_image_file;
?? TITLE := 'Client: [XDCL, #GATE] dfp$free_image_file_command ', EJECT ??

{  This procedure is provided for testing file server.

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

{  pdt free_image_file (mainframe_name: name 17  = $required
{  status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    free_image_file: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
[^free_image_file_names,
  ^free_image_file_params];

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

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

{ MAINFRAME_NAME }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
clc$name_value, 17, 17]],

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

?? FMT (FORMAT := ON) ??
?? POP ??

    VAR
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_name: pmt$mainframe_id;

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

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

    dfp$crack_mainframe_id ('MAINFRAME_NAME', mainframe_name, mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    dfp$free_image_file (mainframe_id, status);
  PROCEND dfp$free_image_file_command;
?? TITLE := 'Client: [XDCL] dfp$free_image_file', EJECT ??

{  This procedure removes all pages from the image file. The allocated
{ length for the file is NOT changed.
{

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

    VAR
      image_file_id: dft$image_file_id;

    get_image_file (mainframe_id, dfc$reset_image_file, image_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    initialize_image_file (mainframe_id, image_file_id.p_image_header^.requested_preallocation_size,
          image_file_id.p_image_file);

    return_image_file (image_file_id, status);

  PROCEND dfp$free_image_file;

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

{
{ Purpose:
{   This procedure purges all the image files contained in the catalog of
{   server mainframes.  This is done when we are not recovering server
{   mainframes.
{

  PROCEDURE [XDCL] dfp$purge_all_image_files;

    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 server 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$server_mainframes_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$server_mainframes_catalog;
            cycle_selector.cycle_option := pfc$specific_cycle;
            cycle_selector.cycle_number := 1;

          /delete_all_images/
            FOR index := LOWERBOUND (p_directory_array^) TO UPPERBOUND (p_directory_array^) DO
              IF (p_directory_array^ [index].name_type = pfc$file_name) AND
                    (p_directory_array^ [index].name (1, 4) = 'DFF$') AND
                    (p_directory_array^ [index].name (22, 5) = 'IMAGE') THEN
                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);
              IFEND;
            FOREND /delete_all_images/;
          IFEND;
        IFEND;
      IFEND;
      mmp$delete_scratch_segment (catalog_content_info, status);
    IFEND;
  PROCEND dfp$purge_all_image_files;
?? TITLE := 'Client:  [XDCL] dfp$purge_image_file', EJECT ??

{  This procedure deletes the image file for the specified server mainframe.

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

    VAR
      cycle_selector: pft$cycle_selector,
      mainframe_file_path: array [1 .. 4] of pft$name,
      server_image_file_name: pft$name;

    dfp$build_image_file_name (mainframe_id, server_image_file_name);

    mainframe_file_path [1] := ' ';
    mainframe_file_path [2] := ' ';
    mainframe_file_path [3] := dfc$server_mainframes_catalog;
    mainframe_file_path [4] := server_image_file_name;
    cycle_selector.cycle_option := pfc$specific_cycle;
    cycle_selector.cycle_number := 1;
    pfp$purge (mainframe_file_path, cycle_selector, osc$null_name, status);
  PROCEND dfp$purge_image_file;

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

{
{    This procedure copies all pages for a single server mainframe from
{ the memory image to the server image file. This procedure is executed
{ during continuation deadstart.
{

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

    VAR
      image_available: boolean,
      image_page_count: 0 .. osc$max_page_frames,
      image_file_id: dft$image_file_id,
      local_status: ost$status,
      mainframe_id: pmt$binary_mainframe_id,
      msg_string: string (75),
      msg_string_length: integer,
      old_image_pointers: dmt$old_image_pointers;

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

    pmp$convert_mainframe_to_binary (mainframe_name, mainframe_id, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$improper_mainframe_id, mainframe_name, status);
      RETURN;
    IFEND;

    IF mainframe_id.model_number = osc$cyber_180_model_unknown THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$unknown_model_number,
         mainframe_name (9, pmc$processor_model_number_size), status);
      osp$append_status_parameter (osc$status_parameter_delimiter, mainframe_name, status);
      RETURN;
    IFEND;

    STRINGREP (msg_string, msg_string_length, ' Recovering server ', mainframe_name, ' image.');
    log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
    display (msg_string (1, msg_string_length));

    dmp$get_old_image_pointers (old_image_pointers, image_available);
    mmp$fetch_image_page_count (image_page_count);
    IF (NOT image_available) OR (image_page_count = 0) THEN
      STRINGREP (msg_string, msg_string_length, '  Server Image unavailable ', mainframe_name, ' image.');
      log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
      display (msg_string (1, msg_string_length));
      RETURN;
    IFEND;

    get_image_file (mainframe_id, dfc$image_source_deadstart, image_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    recover_server_files (mainframe_id, mainframe_name, image_page_count, old_image_pointers, image_file_id,
          status);

    return_image_file (image_file_id, local_status);

  PROCEND dfp$save_server_image;
?? TITLE := 'Server: [XDCL, #GATE] dfp$server_flush_image_file', EJECT ??

{ This procedure is the server side of the RPC request started by
{ dfp$flush_image_file.  This procedure receives the segment containing the
{ image from the client mainframe.  This then cycles through the image file
{ and writes the pages to the actual permanent file. The p_send_to_client_data
{ area is used to return the list of files that did not recover to the client.
{

  PROCEDURE [XDCL, #GATE] dfp$server_flush_image_file
    (VAR p_param_received_from_client {Input} : dft$p_receive_parameters;
     VAR p_data_from_client {Input} : dft$p_receive_data;
     VAR p_send_to_client_params {^Output} : dft$p_send_parameters;
     VAR p_send_to_client_data {^Output} : dft$p_send_data;
     VAR send_parameters_size: dft$send_parameter_size;
     VAR send_data_size: dft$send_data_size;
     VAR status: ost$status);

    VAR
      block_advanced: boolean,
      file_count: ost$non_negative_integers,
      files_not_recovered: ost$non_negative_integers,
      files_recovered: ost$non_negative_integers,
      gfn_name: ost$name,
      image_file_id: dft$image_file_id,
      local_status: ost$status,
      mainframe_found: boolean,
      msg_string: string (80),
      msg_string_length: integer,
      p_cpu_queue: ^dft$cpu_queue,
      p_file_header: ^dft$image_file_header,
      p_gfn: ^dmt$global_file_name,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: ^dft$queue_interface_table,
      pages_recovered_for_file: 0 .. osc$max_page_frames,
      queue_index: dft$queue_index,
      total_pages: ost$non_negative_integers;

    osp$verify_system_privilege;
    status.normal := TRUE;
    send_parameters_size := 0;
    send_data_size := 0;
    files_recovered := 0;
    files_not_recovered := 0;
    total_pages := 0;

    dfp$receive_client_rpc_segment (image_file_id.p_image_file, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    NEXT image_file_id.p_image_header IN image_file_id.p_image_file;
    IF dfv$file_server_debug_enabled THEN
      display_image_header (image_file_id.p_image_header^);
    IFEND;
    dfp$find_mainframe_id (image_file_id.p_image_header^.client_mainframe_name, { server_to_client } TRUE,
          mainframe_found, p_queue_interface_table, p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN

{ Server was probably terminated and deleted

      RETURN;
    IFEND;

    i#build_adaptable_seq_pointer (#RING (image_file_id.p_image_file), #SEGMENT (image_file_id.p_image_file),
          image_file_id.p_image_header^.page_size, { Size } image_file_id.p_image_header^.page_size,
          { next } 0, image_file_id.p_current_block_seq);
    NEXT image_file_id.p_current_block_header IN image_file_id.p_current_block_seq;
    image_file_id.client := FALSE;
    image_file_id.operation := dfc$read_image_file;

    block_advanced := FALSE;

  /for_all_blocks_in_image/
    WHILE image_file_id.p_current_block_header <> NIL DO
      IF dfv$file_server_debug_enabled THEN
        display_block_header (image_file_id.p_current_block_header);
      IFEND;
      block_advanced := FALSE;

    /recover_files_starting_in_block/
      FOR file_count := 1 TO image_file_id.p_current_block_header^.file_count DO
        #SPOIL (p_cpu_queue^.queue_header.partner_status.server_state);
        IF p_cpu_queue^.queue_header.partner_status.server_state <> dfc$recovering THEN
          osp$set_status_condition (dfe$server_has_terminated, status);
          RETURN;
        IFEND;

        NEXT p_file_header IN image_file_id.p_current_block_seq;
        IF dfv$file_server_debug_enabled THEN
          display_file_header (p_file_header);
        IFEND;
        recover_served_file (p_file_header^, p_cpu_queue^.queue_header.partner_status.server_state,
              image_file_id, block_advanced, pages_recovered_for_file, status);
        IF status.normal THEN
          files_recovered := files_recovered + 1;
          total_pages := total_pages + pages_recovered_for_file;
        ELSEIF status.condition = dfe$server_has_terminated THEN
          RETURN;
        ELSE
          pmp$convert_binary_unique_name (p_file_header^.global_file_name, gfn_name, local_status);
          STRINGREP (msg_string, msg_string_length, ' Client ',
                image_file_id.p_image_header^.client_mainframe_name, ' unrecovered file ',
                gfn_name);
          log_display ($pmt$ascii_logset [pmc$system_log, pmc$job_log], msg_string (1, msg_string_length));
          display_status (status);
          files_not_recovered := files_not_recovered + 1;
          NEXT p_gfn IN p_send_to_client_data;
          IF p_gfn = NIL THEN

{ Too many files - terminate the server

            p_cpu_queue^.queue_header.partner_status.terminate_partner := TRUE;
            osp$set_status_condition (dfe$server_has_terminated, status);
            RETURN;
          IFEND;

{ The gfn must be complemented because that is how the client
{ must terminate it.

          dfp$complement_gfn (p_file_header^.global_file_name, p_gfn^);
        IFEND;
      FOREND /recover_files_starting_in_block/;

      IF block_advanced THEN

      ELSEIF image_file_id.p_current_block_header^.next_block_header_offset = 0 THEN
        image_file_id.p_current_block_header := NIL;
      ELSE
        advance_to_next_block (image_file_id);
      IFEND;
    WHILEND /for_all_blocks_in_image/;

    STRINGREP (msg_string, msg_string_length, files_recovered, ' file(s) recovered');
    dfp$send_message_to_operator (msg_string (1, msg_string_length),
        {server_to_client} TRUE, image_file_id.p_image_header^.client_mainframe_name);

    STRINGREP (msg_string, msg_string_length, total_pages, ' page(s) recovered');
    dfp$send_message_to_operator (msg_string (1, msg_string_length),
          {server_to_client} TRUE, image_file_id.p_image_header^.client_mainframe_name);

    STRINGREP (msg_string, msg_string_length, files_not_recovered, ' file(s) not recovered');
    dfp$send_message_to_operator (msg_string (1, msg_string_length),
          {server_to_client} TRUE, image_file_id.p_image_header^.client_mainframe_name);
    send_data_size := i#current_sequence_position (p_send_to_client_data);

    dfp$delete_client_rpc_segment;

  PROCEND dfp$server_flush_image_file;
?? TITLE := 'Client: [XDCL, #GATE] dfp$timeout_server_files_cmnd', EJECT ??

{ FOR TEST PURPOSES ONLY !!!
{ DONT EVEN THINK ABOUT USING UNLESS THE SERVER IS AWAITING RECOVERY

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

{  pdt timeout_server_files (mainframe_name: name 17  = $required
{  status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    timeout_server_files: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
[^timeout_server_files_names,
  ^timeout_server_files_params];

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

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

{ MAINFRAME_NAME }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
clc$name_value, 17, 17]],

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

?? FMT (FORMAT := ON) ??
?? POP ??

    VAR
      local_status: ost$status,
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_name: pmt$mainframe_id;

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

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

    dfp$crack_mainframe_id ('MAINFRAME_NAME', mainframe_name, mainframe_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$timeout_server_files (mainframe_id, status);
  PROCEND dfp$timeout_server_files_cmnd;

?? TITLE := 'Client: dfp$timeout_server_files ', EJECT ??

  PROCEDURE [XDCL] dfp$timeout_server_files
    (    server_mainframe_id: pmt$binary_mainframe_id;
     VAR status: ost$status);

    VAR
      image_file_id: dft$image_file_id,
      local_status: ost$status,
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: ^dft$queue_interface_table,
      p_server_state : ^dft$server_state,
      queue_index: dft$queue_index,
      server_mainframe_name: pmt$mainframe_id;

    display (' Saving pages belonging to server ');
    log_display ($pmt$ascii_logset [pmc$system_log], ' Saving pages belonging to server ');
    pmp$convert_binary_mainframe_id (server_mainframe_id, server_mainframe_name,
          status);
    dfp$find_mainframe_id (server_mainframe_name, { server_to_client } FALSE,
          mainframe_found, p_queue_interface_table, p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN

{ Server was probably terminated and deleted

      RETURN;
    IFEND;
    p_server_state :=  ^p_cpu_queue^.queue_header.partner_status.server_state;

    get_image_file (server_mainframe_id, dfc$image_source_timeout, image_file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    dfp$r1_timeout_server_files (server_mainframe_id, p_server_state, image_file_id, status);

    return_image_file (image_file_id, local_status);

    display (' Saving server pages complete ');
    log_display ($pmt$ascii_logset [pmc$system_log], ' Saving server pages complete ');
  PROCEND dfp$timeout_server_files;

?? TITLE := 'Server: allocate_file_space', EJECT ??

{  This procedure increases the size of the disk file on the server mainframe
{ if it is required. This procedure waits one minute before giving up with
{ the status of  dme$unable_to_alloc_all_space.

  PROCEDURE allocate_file_space
    (    sfid: gft$system_file_identifier;
         file_header: dft$image_file_header;
     VAR server_state: dft$server_state;
     VAR status: ost$status);

    VAR
      allocate_attempt: 1 .. 5,
      allocated_length: amt$file_byte_address,
      fde_p: gft$file_desc_entry_p;

    gfp$get_fde_p (sfid, fde_p);
    dmp$get_total_allocated_length (fde_p, allocated_length);

    IF (file_header.page_count > 0) AND (allocated_length < (file_header.highest_file_offset + osv$page_size))
          THEN

    /attempt_allocate_file_space/
      FOR allocate_attempt := 1 TO 5 DO
        IF dfv$file_server_debug_enabled THEN
          display_integer (' Extending file to ', file_header.highest_file_offset);
        IFEND;
        #SPOIL (server_state);
        IF server_state <> dfc$recovering THEN
          osp$set_status_condition (dfe$server_has_terminated, status);
          RETURN;
        IFEND;
        dmp$allocate_file_space_r1 (sfid, { byte address} file_header.highest_file_offset,
              { size } osv$page_size, {chapter } 0, osc$nowait, sfc$no_limit, status);
        IF dfv$file_server_debug_enabled THEN
          display_status (status);
        IFEND;
        IF status.normal OR (status.condition <> dme$unable_to_alloc_all_space) THEN
          EXIT /attempt_allocate_file_space/;
        IFEND;
        pmp$delay (12000 { 12 seconds} , status);
      FOREND /attempt_allocate_file_space/;
    IFEND;
  PROCEND allocate_file_space;

?? TITLE := ' advance_to_next_block ', EJECT ??

  PROCEDURE advance_to_next_block
    (VAR image_file_id: dft$image_file_id);

    i#build_adaptable_seq_pointer (#RING (image_file_id.p_image_file), #SEGMENT (image_file_id.p_image_file),
          image_file_id.p_current_block_header^.next_block_header_offset,
          { Size } image_file_id.p_image_header^.page_size, { next } 0, image_file_id.p_current_block_seq);
    NEXT image_file_id.p_current_block_header IN image_file_id.p_current_block_seq;

  PROCEND advance_to_next_block;
?? TITLE := 'Client: change_overflow_allowed ', EJECT ??

  PROCEDURE change_overflow_allowed
    (    lfn: amt$local_file_name;
         overflow_allowed: boolean;
     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$global_file_name;
    amp$get_file_attributes (lfn, p_file_attributes^, local_file, existing_file, contains_data, status);
    IF status.normal THEN
      dmp$change_overflow_allowed (p_file_attributes^ [1].global_file_name, overflow_allowed, status);
      IF dfv$file_server_debug_enabled THEN
        display_boolean (' dmp$change_overflow_allowed ', overflow_allowed);
        display_status (status);
      IFEND;
    IFEND;
  PROCEND change_overflow_allowed;
?? TITLE := ' display_block_header ', EJECT ??

  PROCEDURE display_block_header
    (    p_block_header: ^dft$image_block_header);

    display_pva (' ****************  dft$image_block_header ', p_block_header);
    IF p_block_header = NIL THEN
      RETURN;
    IFEND;
    display (p_block_header^.block_header_string);
    display_integer ('   file_count', p_block_header^.file_count);
    display_integer ('   page_count', p_block_header^.page_count);
    CASE p_block_header^.page_source OF
    = dfc$image_source_timeout =
      display ('    dfc$image_source_timeout');
    = dfc$image_source_deadstart =
      display ('    dfc$image_source_deadstart');
    ELSE
      display_integer (' Unknown image source ', $INTEGER (p_block_header^.page_source));
    CASEND;
    display_integer ('   next_block_header_offset', p_block_header^.next_block_header_offset);

  PROCEND display_block_header;
?? TITLE := ' display_file_header ', EJECT ??

  PROCEDURE display_file_header
    (    p_file_header: ^dft$image_file_header);

    VAR
      gfn_name: ost$name,
      status: ost$status;

    display_pva ('   -- dft$image_file_header ', p_file_header);
    display_boolean (' file_completed', p_file_header^.file_completed);
    pmp$convert_binary_unique_name (p_file_header^.global_file_name, gfn_name, status);
    display (gfn_name);
    display_integer (' eoi_byte_address', p_file_header^.eoi_byte_address);
    display_integer (' highest_file_offset', p_file_header^.highest_file_offset);
    display_integer (' page_count ', p_file_header^.page_count);
  PROCEND display_file_header;
?? TITLE := ' display_image_header ', EJECT ??

  PROCEDURE display_image_header
    (    image_header: dft$image_header);

    display (' -------  dft$image_header ');
    display (image_header.file_update_flag);
    display (image_header.version);
    display ('  Server / Client ');
    display (image_header.server_mainframe_name);
    display (image_header.client_mainframe_name);
    display_integer (' current_eoi ', image_header.current_eoi);
    display_integer (' requested_preallocation_size ', image_header.requested_preallocation_size);
    display_integer (' page_size ', image_header.page_size);
  PROCEND display_image_header;

?? TITLE := 'Client: get_image_file ', EJECT ??

{ This procedure gains access to the image file for the specified server
{ mainframe. The image file must exist for this request to work.
{ This procedure sets up the image_file_id which is used to reference
{ the image file.
{ This procedure will attempt to repair the image file if the system crashed
{ previously while the image file was being written.
{ The operation parameter controls what is done to the image file and how
{ the image file is positioned:
{ = dfc$read_image_file =
{   Image file position at first block.
{ = dfc$reset_image_file =
{   Previous pages discarded.
{   Image file re-initialized and positioned at new first block.
{ = dfc$image_source_timeout, dfc$image_source_deadstart =
{   New block created at the end of the image file.

  PROCEDURE get_image_file
    (    server_mainframe_id: pmt$binary_mainframe_id;
         operation: dft$image_file_operation;
     VAR image_file_id: dft$image_file_id;
     VAR status: ost$status);

    VAR
      address_pairs_returned: integer,
      allocated_length_list: array [1 .. 1] of dmt$addr_length_pair,
      cycle_number: fst$cycle_number,
      cycle_selector: pft$cycle_selector,
      list_overflow: boolean,
      local_status: ost$status,
      mainframe_file_path: array [1 .. 4] of pft$name,
      p_last_block: ^dft$image_block_header,
      p_next_to_last_block: ^dft$image_block_header,
      segment_pointer: amt$segment_pointer,
      server_image_file_name: ost$name,
      server_mainframe_name: pmt$mainframe_id;

    image_file_id.client := TRUE;
    dfp$build_image_file_name (server_mainframe_id, server_image_file_name);
    IF dfv$file_server_debug_enabled THEN
      display (server_image_file_name);
    IFEND;

    mainframe_file_path [1] := ' ';
    mainframe_file_path [2] := ' ';
    mainframe_file_path [3] := dfc$server_mainframes_catalog;
    mainframe_file_path [4] := server_image_file_name;
    cycle_selector.cycle_option := pfc$specific_cycle;
    cycle_selector.cycle_number := 1;
    IF dsp$system_committed () THEN
      pfp$attach (server_image_file_name, mainframe_file_path, cycle_selector, osc$null_name,
            -$pft$usage_selections [], $pft$share_selections [pfc$read], pfc$wait, status);
    ELSE { Prior to the point of commitment
      pfp$restricted_attach (server_image_file_name, mainframe_file_path, cycle_selector, osc$null_name,
            -$pft$usage_selections [], $pft$share_selections [pfc$read], cycle_number, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$open (server_image_file_name, amc$segment, NIL, image_file_id.file_id, status);
    IF NOT status.normal THEN
      amp$return (server_image_file_name, local_status);
      RETURN;
    IFEND;
    amp$get_segment_pointer (image_file_id.file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      amp$close (image_file_id.file_id, local_status);
      amp$return (server_image_file_name, local_status);
      RETURN;
    IFEND;

    image_file_id.p_image_file := segment_pointer.sequence_pointer;
    NEXT image_file_id.p_image_header IN segment_pointer.sequence_pointer;
    mmp$get_allocated_addresses (image_file_id.p_image_file, { Starting address } 0, allocated_length_list,
          address_pairs_returned, list_overflow, status);
    image_file_id.allocated_size := allocated_length_list [1].length;
    IF dfv$file_server_debug_enabled THEN
      display_integer (' mmp$get_allocated_addresses ', image_file_id.allocated_size);
      IF NOT status.normal THEN
        display_status (status);
      IFEND;
      display_integer (' current eoi ', image_file_id.p_image_header^.current_eoi);
    IFEND;
    image_file_id.local_file_name := server_image_file_name;
    image_file_id.operation := operation;
    image_file_id.p_current_eoi := #ADDRESS (#RING (image_file_id.p_image_file),
          #SEGMENT (image_file_id.p_image_file), { Offset } image_file_id.p_image_header^.current_eoi);
    IF (image_file_id.p_image_header^.current_eoi = osv$page_size) OR
          (image_file_id.p_image_header^.current_eoi = image_file_id.p_image_header^.page_size) THEN
      image_file_id.p_current_block_header := NIL;
      image_file_id.p_current_block_seq := NIL;
    ELSE
      i#build_adaptable_seq_pointer (#RING (image_file_id.p_image_file),
            #SEGMENT (image_file_id.p_image_file), osv$page_size, { Size } osv$page_size, { next } 0,
            image_file_id.p_current_block_seq);
      NEXT image_file_id.p_current_block_header IN image_file_id.p_current_block_seq;
    IFEND;

    IF (operation <> dfc$reset_image_file) THEN
      repair_image_file (server_mainframe_id, image_file_id, status);
    IFEND;

    IF (operation = dfc$reset_image_file) THEN
      initialize_image_file (server_mainframe_id, image_file_id.p_image_header^.requested_preallocation_size,
            image_file_id.p_image_file);
    ELSEIF (operation = dfc$read_image_file) THEN
      image_file_id.p_current_eoi := #ADDRESS (#RING (image_file_id.p_image_file),
            #SEGMENT (image_file_id.p_image_file), { Offset } image_file_id.p_image_header^.current_eoi);
    ELSEIF (#OFFSET (image_file_id.p_current_eoi) = osv$page_size) THEN
      initialize_image_file (server_mainframe_id, image_file_id.p_image_header^.requested_preallocation_size,
            image_file_id.p_image_file);

{ Create the first block_sequence and header

      i#build_adaptable_seq_pointer (#RING (image_file_id.p_image_file),
            #SEGMENT (image_file_id.p_image_file), osv$page_size, { Size } osv$page_size, { next } 0,
            image_file_id.p_current_block_seq);
      NEXT image_file_id.p_current_block_header IN image_file_id.p_current_block_seq;
      dfp$initialize_block_header (image_file_id.operation, image_file_id.p_current_block_header^);
      image_file_id.p_current_eoi := #ADDRESS (#RING (image_file_id.p_image_file),
            #SEGMENT (image_file_id.p_image_file), { Offset- One page header, One page block} 2 *
            osv$page_size);
      image_file_id.p_image_header^.current_eoi := #OFFSET (image_file_id.p_current_eoi);
    ELSEIF operation IN $dft$image_file_operations [dfc$image_source_timeout, dfc$image_source_deadstart] THEN
      dfp$expand_image_file (image_file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      locate_last_block (image_file_id, p_next_to_last_block, p_last_block);

{ Create the next block_sequence and header

      i#build_adaptable_seq_pointer (#RING (image_file_id.p_image_file),
            #SEGMENT (image_file_id.p_image_file), #OFFSET (image_file_id.p_current_eoi),
            { Size } osv$page_size, { next } 0, image_file_id.p_current_block_seq);
      NEXT image_file_id.p_current_block_header IN image_file_id.p_current_block_seq;
      dfp$initialize_block_header (operation, image_file_id.p_current_block_header^);
      p_last_block^.next_block_header_offset := #OFFSET (image_file_id.p_current_block_header);

      image_file_id.p_current_eoi := #ADDRESS (#RING (image_file_id.p_image_file),
            #SEGMENT (image_file_id.p_image_file), { Offset } #OFFSET (image_file_id.p_current_eoi) +
            osv$page_size);
      image_file_id.p_image_header^.current_eoi := #OFFSET (image_file_id.p_current_eoi);
    IFEND;

  PROCEND get_image_file;
?? TITLE := 'Client: increase_preallocated_size ', EJECT ??

  PROCEDURE increase_preallocated_size
    (    mainframe_id: pmt$binary_mainframe_id;
         requested_preallocated_size: ost$segment_length;
     VAR status: ost$status);

    VAR
      image_file_id: dft$image_file_id,
      local_status: ost$status;

    get_image_file (mainframe_id, dfc$read_image_file, image_file_id, status);
    IF status.normal THEN
      IF requested_preallocated_size > image_file_id.allocated_size THEN

{ need to increase the size of the file

        change_overflow_allowed (image_file_id.local_file_name, TRUE, local_status);
        mmp$os_preallocate_file_space (image_file_id.p_image_file, requested_preallocated_size,
             { wait secs } 60, status);
        IF status.normal THEN
          mmp$set_segment_length (image_file_id.p_image_file, { ring } 2, requested_preallocated_size,
                status);
        IFEND;
        IF NOT status.normal THEN
          display_integer (' Unable to preallocate server image space: ', requested_preallocated_size);
          log_display_integer ($pmt$ascii_logset [pmc$system_log],
                ' Unable to preallocate server image space: ', requested_preallocated_size);
          display_status (status);
          log_display_status ($pmt$ascii_logset [pmc$system_log], { format } TRUE, status);
        IFEND;
        change_overflow_allowed (image_file_id.local_file_name, FALSE, local_status);
      IFEND;
      return_image_file (image_file_id, local_status);
    IFEND;
  PROCEND increase_preallocated_size;
?? TITLE := 'Client: initialize_image_file ', EJECT ??

  PROCEDURE initialize_image_file
    (    server_mainframe_id: pmt$binary_mainframe_id;
         preallocation_size: ost$segment_length;
     VAR p_image_file: ^SEQ ( * ));

    VAR
      p_server_image_header: ^dft$image_header,
      status: ost$status;

    NEXT p_server_image_header IN p_image_file;
    p_server_image_header^.server_mainframe_id := server_mainframe_id;
    pmp$convert_binary_mainframe_id (server_mainframe_id, p_server_image_header^.server_mainframe_name,
          status);
    pmp$get_mainframe_id (p_server_image_header^.client_mainframe_name, status);
    p_server_image_header^.page_size := osv$page_size;

{ The segment length is used to determine the starting point to write
{ the first block header at.

    RESET p_image_file;
    p_server_image_header^.current_eoi := osv$page_size;
    p_server_image_header^.requested_preallocation_size := preallocation_size;
    p_server_image_header^.file_update_flag := dfc$image_file_writing;
    p_server_image_header^.version := dfc$current_image_file_version;

  PROCEND initialize_image_file;
?? TITLE := ' locate_last_block ', EJECT ??

{ If there is only one block this procedure returns NIL for
{ p_next_to_last_block.

  PROCEDURE locate_last_block
    (    image_file_id: dft$image_file_id;
     VAR p_next_to_last_block: ^dft$image_block_header;
     VAR p_block_header: ^dft$image_block_header);

    p_block_header := image_file_id.p_current_block_header;
    p_next_to_last_block := NIL;
    IF p_block_header = NIL THEN
      RETURN;
    IFEND;

  /while_still_blocks/
    WHILE p_block_header^.next_block_header_offset <> 0 DO
      p_next_to_last_block := p_block_header;
      p_block_header := #ADDRESS (#RING (p_block_header), #SEGMENT (p_block_header),
            p_block_header^.next_block_header_offset);
    WHILEND /while_still_blocks/;

  PROCEND locate_last_block;
?? TITLE := ' open_file_as_image', EJECT ??

{  This procedure is provided testing so that an image_file from a different
{ system or a dump (copy_memory)  may be displayed using the dfp$display_image_file
{ procedure.

  PROCEDURE open_file_as_image
    (    local_file_name: amt$local_file_name;
     VAR image_file_id: dft$image_file_id;
     VAR status: ost$status);

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

    image_file_id.local_file_name := local_file_name;
    fsp$open_file (local_file_name, amc$segment, NIL, NIL, NIL, NIL, NIL, image_file_id.file_id, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amp$get_segment_pointer (image_file_id.file_id, amc$sequence_pointer, segment_pointer, status);
    IF NOT status.normal THEN
      fsp$close_file (image_file_id.file_id, local_status);
      RETURN;
    IFEND;
    image_file_id.p_image_file := segment_pointer.sequence_pointer;
    NEXT image_file_id.p_image_header IN image_file_id.p_image_file;
    i#build_adaptable_seq_pointer (#RING (image_file_id.p_image_file), #SEGMENT (image_file_id.p_image_file),
          image_file_id.p_image_header^.page_size, { Size } image_file_id.p_image_header^.page_size,
          { next } 0, image_file_id.p_current_block_seq);
    NEXT image_file_id.p_current_block_header IN image_file_id.p_current_block_seq;
    image_file_id.client := TRUE;
    image_file_id.operation := dfc$read_image_file;
  PROCEND open_file_as_image;
?? TITLE := 'Server: recover_served_file', EJECT ??

{  This server side procedure takes the eoi, and pages for a file and
{  writes them to the disk file.
{  Unlike normal recovery we will allow extending the users permanent file.
{  should the sft be locked - -even WHILE allocating??
{  We need TO  ALLOCATE because file may have been trimmed by recovery.
{  This does not yet deal with file damage.  Is it required?
{  The caller of this procedure assumes that the image file will be
{  be positioned after the last page for the file even if status is abnormal.
{

  PROCEDURE recover_served_file
    (    file_header: dft$image_file_header;
     VAR server_state: dft$server_state;
     VAR image_file_id: dft$image_file_id;
     VAR block_advanced: boolean;
     VAR pages_recovered: 0 .. osc$max_page_frames;
     VAR status: ost$status);

    VAR
      dfd_p: ^dmt$disk_file_descriptor,
      fde_found: boolean,
      file_entry_index: gft$file_descriptor_index,
      gfn_name: ost$name,
      local_status: ost$status,
      p_fde: gft$file_desc_entry_p,
      sfid: gft$system_file_identifier;

    status.normal := TRUE;
    block_advanced := FALSE;
    pages_recovered := 0;

    #SPOIL (server_state);
    IF server_state <> dfc$recovering THEN
      osp$set_status_condition (dfe$server_has_terminated, status);
      RETURN;
    IFEND;
    dmp$search_fdt_by_gfn (gfc$tr_system, file_header.global_file_name, file_entry_index, fde_found);
    IF fde_found THEN
      sfid.residence := gfc$tr_system;
      sfid.file_entry_index := file_entry_index;
      dmp$generate_gfn_hash (file_header.global_file_name, sfid.file_hash);
      gfp$get_fde_p (sfid, p_fde);
      dmp$get_disk_file_descriptor_p (p_fde, dfd_p);
    IFEND;

    IF (NOT file_header.file_completed) OR (NOT fde_found) OR (dfd_p^.purged) OR
          (p_fde^.attached_in_write_count = 0) THEN
      skip_pages_for_file (file_header, image_file_id, block_advanced);
      osp$set_status_abnormal (dmc$device_manager_ident, dme$unknown_file, ' Not recoverable on server',
            status);
      IF dfv$file_server_debug_enabled THEN
        display (' Could not recover file ');
        display_boolean ('file_header.file_completed ', file_header.file_completed);
        display_boolean (' fde_found  ', fde_found);
        IF fde_found THEN
          display_boolean (' purged ', dfd_p^.purged);
          display_integer (' attached_in_write_count ', p_fde^.attached_in_write_count);
        IFEND;
      IFEND;
      RETURN;
    IFEND;

    IF (file_header.page_count > 0) THEN
      update_served_file_image (sfid, file_header, server_state, image_file_id, block_advanced,
            pages_recovered, status);
    IFEND;

    IF status.normal AND (file_header.eoi_byte_address <> p_fde^.eoi_byte_address) THEN
      IF dfv$file_server_debug_enabled THEN
        display_integer (' Setting eoi (current)', p_fde^.eoi_byte_address);
      IFEND;
      #SPOIL (server_state);
      IF server_state <> dfc$recovering THEN
        osp$set_status_condition (dfe$server_has_terminated, status);
        RETURN;
      IFEND;
      dmp$set_eoi (sfid, file_header.eoi_byte_address, status);
    IFEND;

  PROCEND recover_served_file;
?? TITLE := 'Client: recover_server_files', EJECT ??

{ Copy all pages for a particular server to the server image file.

  PROCEDURE recover_server_files
    (    server_mainframe_id: pmt$binary_mainframe_id;
         server_mainframe: pmt$mainframe_id;
         total_image_page_count: 0 .. osc$max_page_frames;
         old_image_pointers: dmt$old_image_pointers;
     VAR image_file_id: dft$image_file_id;
     VAR status: ost$status);

    VAR
      entry_index: gft$file_descriptor_index,
      image_segment_number: ost$segment,
      local_status: ost$status,
      msg_string: string (75),
      msg_string_length: integer,
      p_old_fde: gft$file_desc_entry_p,
      p_server_descriptor: dft$server_descriptor_p,
      pages_saved_for_file: 0 .. osc$max_page_frames,
      scan_control: gft$scan_all_fdes_state,
      server_files_not_recovered: gft$file_descriptor_index,
      server_files_recovered: gft$file_descriptor_index,
      server_pages_recovered: 0 .. osc$max_page_frames,
      sfid: gft$system_file_identifier;

    status.normal := TRUE;
    server_files_recovered := 0;
    server_files_not_recovered := 0;
    server_pages_recovered := 0;
    image_segment_number := old_image_pointers.old_wired_segment;

    gfp$scan_all_fdes_in_image (image_segment_number, scan_control, p_old_fde);

    WHILE p_old_fde <> NIL DO

    /recover_server_file_block/
      BEGIN

{ It is not necessary to lock the FDE in the image file: nobody else is using it at this point anyway.

        IF p_old_fde^.media <> gfc$fm_served_file THEN
          EXIT /recover_server_file_block/;
        IFEND;

        IF p_old_fde^.attached_in_write_count = 0 THEN
          EXIT /recover_server_file_block/;
        IFEND;

        IF p_old_fde^.eoi_byte_address = dfc$partially_rebuilt_fde_eoi THEN
          EXIT /recover_server_file_block/;
        IFEND;

        dfp$get_served_file_desc_p (p_old_fde, p_server_descriptor);
        IF p_server_descriptor^.header.server_mainframe_id <> server_mainframe_id THEN
          EXIT /recover_server_file_block/;
        IFEND;

        IF p_server_descriptor^.header.purged THEN
          EXIT /recover_server_file_block/;
        IFEND;

        IF p_server_descriptor^.header.file_state = dfc$terminated THEN
          EXIT /recover_server_file_block/;
        IFEND;

        save_server_file_image (p_old_fde, total_image_page_count, image_file_id, pages_saved_for_file,
              status);
        IF NOT status.normal THEN
          display_status (status);
          IF status.condition = dfe$no_space_for_server_pages THEN
            RETURN;
          ELSE
            server_files_not_recovered := server_files_not_recovered + 1;
            status.normal := TRUE;
            EXIT /recover_server_file_block/;
          IFEND;
        IFEND;

        server_files_recovered := server_files_recovered + 1;
        server_pages_recovered := server_pages_recovered + pages_saved_for_file;
      END /recover_server_file_block/;

      gfp$scan_all_fdes_in_image (0 {forces continuation of scan}, scan_control, p_old_fde);
    WHILEND;

    STRINGREP (msg_string, msg_string_length, ' Server ', server_mainframe, ' ', server_files_recovered,
          ' file(s) recovered');
    log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
    display (msg_string (1, msg_string_length));

    STRINGREP (msg_string, msg_string_length, ' Server ', server_mainframe, ' ', server_pages_recovered,
          ' page(s) recovered');
    log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
    display (msg_string (1, msg_string_length));

    STRINGREP (msg_string, msg_string_length, ' Server ', server_mainframe, ' ', server_files_not_recovered,
          ' file(s) not recovered');
    log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
    display (msg_string (1, msg_string_length));

    STRINGREP (msg_string, msg_string_length, ' Server ', server_mainframe, ' image size ',
          #OFFSET (image_file_id.p_current_eoi), ' bytes');
    log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
    display (msg_string (1, msg_string_length));
  PROCEND recover_server_files;
?? TITLE := 'Client: repair_image_file', EJECT ??

{ This  handles a failure when writing the server image file.

  PROCEDURE repair_image_file
    (    server_mainframe_id: pmt$binary_mainframe_id;
     VAR image_file_id: dft$image_file_id;
     VAR status: ost$status);

    VAR
      p_last_block_header: ^dft$image_block_header,
      p_next_to_last_block: ^dft$image_block_header;

    status.normal := TRUE;
    IF image_file_id.p_image_header^.version <> dfc$current_image_file_version THEN
      display (' No recovery of server image possible. Unexpected image version:');
      log_display ($pmt$ascii_logset [pmc$system_log],
            ' No recovery of server image possible. Unexpected image version:');
      display (image_file_id.p_image_header^.version);
      log_display ($pmt$ascii_logset [pmc$system_log], image_file_id.p_image_header^.version);
      initialize_image_file (server_mainframe_id, { Preallocation } 0, image_file_id.p_image_file);
      RETURN;
    IFEND;

    IF image_file_id.p_image_header^.file_update_flag = dfc$image_file_valid THEN

{ Everything is fine.

    ELSEIF image_file_id.p_image_header^.file_update_flag = dfc$image_file_writing THEN
      display (' Recovery of server image file required.');
      log_display ($pmt$ascii_logset [pmc$system_log], ' Recovering of server image file required.');
      locate_last_block (image_file_id, p_next_to_last_block, p_last_block_header);
      display (' --- last block header ');
      display_block_header (p_last_block_header);
      display (' ---next to last block header ');
      display_block_header (p_next_to_last_block);
      IF p_last_block_header^.block_header_string <> dfc$block_header_string THEN
        display (' Previous failure - left unexpected image block string.');
        log_display ($pmt$ascii_logset [pmc$system_log],
              ' Previous failure - left unexpected image block string.');
        display (p_last_block_header^.block_header_string);
        log_display ($pmt$ascii_logset [pmc$system_log], p_last_block_header^.block_header_string);
        IF p_next_to_last_block = NIL THEN
          initialize_image_file (server_mainframe_id, { Preallocation } 0, image_file_id.p_image_file);
        ELSE
          p_next_to_last_block^.next_block_header_offset := 0;
          image_file_id.p_image_header^.current_eoi := #OFFSET (p_last_block_header);
          image_file_id.p_current_eoi := #ADDRESS (#RING (image_file_id.p_image_file),
                #SEGMENT (image_file_id.p_image_file), image_file_id.p_image_header^.current_eoi);
        IFEND;
      ELSE { Block header should be consistant
        CASE p_last_block_header^.page_source OF
        = dfc$image_source_deadstart =
          display (' Previous failure during continuation deadstart.');
          log_display ($pmt$ascii_logset [pmc$system_log], ' Previous failure during continuation deadstart.')
                ;

{       The failure occurred during continuation deadstart.
{       Al the pages will still be in the image.
{       Re-use the block.

          IF p_next_to_last_block = NIL THEN
            initialize_image_file (server_mainframe_id, { Preallocation } 0, image_file_id.p_image_file);
          ELSE
            p_next_to_last_block^.next_block_header_offset := 0;
            image_file_id.p_image_header^.current_eoi := #OFFSET (p_last_block_header);
            image_file_id.p_current_eoi := #ADDRESS (#RING (image_file_id.p_image_file),
                  #SEGMENT (image_file_id.p_image_file), image_file_id.p_image_header^.current_eoi);
          IFEND;

        = dfc$image_source_timeout =
          display (' Previous failure during timeout processing.');
          log_display ($pmt$ascii_logset [pmc$system_log], ' previous failure during timeout processing');

{ The server side flush process knows how to handle incomplete files so no need
{ to do anything.

        ELSE
          display (' Previous failure - left unexpected image block.');
          log_display ($pmt$ascii_logset [pmc$system_log], ' Previous failure - left unexpected image block.')
                ;
          IF p_next_to_last_block = NIL THEN
            initialize_image_file (server_mainframe_id, { Preallocation } 0, image_file_id.p_image_file);
          ELSE
            p_next_to_last_block^.next_block_header_offset := 0;
            image_file_id.p_image_header^.current_eoi := #OFFSET (p_last_block_header);
            image_file_id.p_current_eoi := #ADDRESS (#RING (image_file_id.p_image_file),
                  #SEGMENT (image_file_id.p_image_file), image_file_id.p_image_header^.current_eoi);
          IFEND;
        CASEND;
      IFEND;
    ELSE
      display (' No recovery of server image possible. Image file damaged');
      log_display ($pmt$ascii_logset [pmc$system_log],
            ' No recovery of server image possible. Image file damaged');
      display (image_file_id.p_image_header^.file_update_flag);
      initialize_image_file (server_mainframe_id, { Preallocation } 0, image_file_id.p_image_file);
    IFEND;
  PROCEND repair_image_file;
?? TITLE := 'Client: return_image_file', EJECT ??

  PROCEDURE return_image_file
    (VAR image_file_id: dft$image_file_id;
     VAR status: ost$status);

    image_file_id.p_image_header^.file_update_flag := dfc$image_file_valid;
    amp$close (image_file_id.file_id, status);
    amp$return (image_file_id.local_file_name, status);

  PROCEND return_image_file;

?? TITLE := 'Client: save_server_file_image', EJECT ??

  PROCEDURE save_server_file_image
    (    p_old_fde: gft$file_desc_entry_p;
         total_image_page_count: 0 .. osc$max_page_frames;
     VAR image_file_id: dft$image_file_id;
     VAR page_count: 0 .. osc$max_page_frames;
     VAR status: ost$status);

    VAR
      allocated_length: amt$file_byte_address,
      descriptor_list_index: 0 .. 7ffffffff(16),
      gfn_name: ost$name,
      image_page_description_p: ^mmt$image_page_description,
      message: string (80),
      message_length: integer,
      p_file_header: ^dft$image_file_header,
      p_page_header: ^dft$image_page_header;


    page_count := 0;
    NEXT p_file_header IN image_file_id.p_current_block_seq;
    IF p_file_header = NIL THEN
      dfp$get_next_image_block (image_file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      NEXT p_file_header IN image_file_id.p_current_block_seq;
    IFEND;

    p_file_header^.file_completed := FALSE;
    dfp$uncomplement_gfn (p_old_fde^.global_file_name, p_file_header^.global_file_name);
    p_file_header^.eoi_byte_address := p_old_fde^.eoi_byte_address;
    p_file_header^.page_count := 0;
    p_file_header^.highest_file_offset := 0;
    image_file_id.p_current_block_header^.file_count := image_file_id.p_current_block_header^.file_count + 1;
    status.normal := TRUE;

    IF (p_old_fde^.asti = 0) THEN
{ Still need to send eoi over despite this.
      p_file_header^.file_completed := TRUE;
      RETURN;
    IFEND;

    PUSH image_page_description_p: [1 .. total_image_page_count];
    mmp$fetch_pvas_of_image_pages (p_old_fde, image_page_description_p, status);
    IF NOT status.normal OR (image_page_description_p^.valid_desc_count = 0) THEN
      p_file_header^.file_completed := TRUE;
      RETURN;
    IFEND;

  /copy_all_pages/
    FOR descriptor_list_index := 1 TO image_page_description_p^.valid_desc_count DO

      NEXT p_page_header IN image_file_id.p_current_block_seq;
      IF p_page_header = NIL THEN
        dfp$get_next_image_block (image_file_id, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        NEXT p_page_header IN image_file_id.p_current_block_seq;
      IFEND;

      dfp$expand_image_file (image_file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      syp$hang_if_system_jrt_set (dfc$tjr_halt_save_server_image);

      i#move (image_page_description_p^.page_desc [descriptor_list_index].image_pva,
            image_file_id.p_current_eoi, image_page_description_p^. PAGESIZE);
      p_page_header^.image_offset := #OFFSET (image_file_id.p_current_eoi);
      p_page_header^.file_offset := image_page_description_p^.page_desc [descriptor_list_index].file_offset;
      image_file_id.p_current_block_header^.page_count := image_file_id.p_current_block_header^.page_count +
            1;
      p_file_header^.page_count := p_file_header^.page_count + 1;
      IF p_page_header^.file_offset > p_file_header^.highest_file_offset THEN
        p_file_header^.highest_file_offset := p_page_header^.file_offset;
      IFEND;
      image_file_id.p_current_eoi := #ADDRESS (#RING (image_file_id.p_current_eoi),
            #SEGMENT (image_file_id.p_current_eoi), #OFFSET (image_file_id.p_current_eoi) +
            image_page_description_p^. PAGESIZE);
      image_file_id.p_image_header^.current_eoi := #OFFSET (image_file_id.p_current_eoi);
      page_count := page_count + 1;
    FOREND /copy_all_pages/;

    p_file_header^.file_completed := TRUE;
  PROCEND save_server_file_image;
?? TITLE := ' skip_pages_for_file ', EJECT ??

  PROCEDURE skip_pages_for_file
    (    file_header: dft$image_file_header;
     VAR image_file_id: dft$image_file_id;
     VAR block_advanced: boolean);

    VAR
      p_page_header: ^dft$image_page_header,
      page: 0 .. osc$max_page_frames;

    block_advanced := FALSE;

  /for_all_pages_of_file/
    FOR page := 1 TO file_header.page_count DO
      NEXT p_page_header IN image_file_id.p_current_block_seq;
      IF p_page_header = NIL THEN
        block_advanced := TRUE;
        advance_to_next_block (image_file_id);
        NEXT p_page_header IN image_file_id.p_current_block_seq;
      IFEND;
    FOREND /for_all_pages_of_file/;

  PROCEND skip_pages_for_file;
?? TITLE := 'Client: terminate_unrecovered_files', EJECT ??

  PROCEDURE terminate_unrecovered_files
    (    server_mainframe: pmt$mainframe_id;
     VAR p_receive_data: dft$p_receive_data);

    VAR
      list_size: integer,
      msg_string: string (80),
      msg_string_length: integer,
      number_not_terminated: ost$non_negative_integers,
      number_terminated: ost$non_negative_integers,
      p_gfn_list: ^array [1 .. * ] of dmt$global_file_name;

    IF p_receive_data <> NIL THEN
      list_size := #SIZE (p_receive_data^) DIV #SIZE (dmt$global_file_name);
      NEXT p_gfn_list: [1 .. list_size] IN p_receive_data;
      dmp$terminate_server_file_list (p_gfn_list^, number_terminated, number_not_terminated);
      STRINGREP (msg_string, msg_string_length, ' Server ', server_mainframe, ' ', number_terminated,
            ' file(s) terminated');
      log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
      display (msg_string (1, msg_string_length));
      IF number_not_terminated > 0 THEN
        STRINGREP (msg_string, msg_string_length, ' Server ', server_mainframe, ' ', number_not_terminated,
              ' file(s) not found to terminate');
        log_display ($pmt$ascii_logset [pmc$system_log], msg_string (1, msg_string_length));
        display (msg_string (1, msg_string_length));
      IFEND;
    IFEND;
  PROCEND terminate_unrecovered_files;
?? TITLE := 'Server: update_served_file_image', EJECT ??

{  The caller of this assumes that the image file is positioned AFTER the
{ last page for the file even is status is abnormal.

  PROCEDURE update_served_file_image
    (    sfid: gft$system_file_identifier;
         file_header: dft$image_file_header;
     VAR server_state: dft$server_state;
     VAR image_file_id: dft$image_file_id;
     VAR block_advanced: boolean;
     VAR pages_recovered: 0 .. osc$max_page_frames;
     VAR status: ost$status);

?? NEWTITLE := 'abort_handler', EJECT ??

{
{  This procedure is intended to catch aborts in writing to the users
{ permanent file.  Possible conditions include write errors or an
{ unavailable volume.
{

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

      display (' --- update_served_file_image abort_handler ');
      CASE condition.selector OF
      = mmc$segment_access_condition =
        osp$set_status_from_condition (dfc$file_server_id, condition, save_area, status, handler_status);
        display_status (status);
        EXIT update_served_file_image;
      = pmc$user_defined_condition =
        IF condition.user_condition_name = osc$volume_unavailable_cond THEN
          osp$get_condition_status (condition_information, status);
          display_status (status);
          EXIT update_served_file_image;
        IFEND;
      ELSE
        ;
      CASEND;

      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

    PROCEND abort_handler;
?? OLDTITLE ??
?? SKIP := 6 ??

    VAR
      cell_pointer: mmt$segment_pointer,
      free_pages_status: ost$status,
      local_status: ost$status,
      p_data: ^cell,
      p_file: ^cell,
      p_page_header: ^dft$image_page_header,
      page: 0 .. osc$max_page_frames;

    osp$establish_condition_handler (^abort_handler, FALSE);

    allocate_file_space (sfid, file_header, server_state, status);
    IF NOT status.normal THEN
      skip_pages_for_file (file_header, image_file_id, block_advanced);
      RETURN;
    IFEND;

    cell_pointer.kind := mmc$cell_pointer;
    dmp$open_file (sfid, osc$tsrv_ring, osc$tsrv_ring, mmc$sar_write_extend, mmc$as_sequential,
          cell_pointer, status);
    IF NOT status.normal THEN
      skip_pages_for_file (file_header, image_file_id, block_advanced);
      RETURN;
    IFEND;

    p_file := cell_pointer.cell_pointer;

  /write_all_pages_of_file/
    FOR page := 1 TO file_header.page_count DO
      #SPOIL (server_state);
      IF server_state <> dfc$recovering THEN
        osp$set_status_condition (dfe$server_has_terminated, status);
        RETURN;
      IFEND;
      NEXT p_page_header IN image_file_id.p_current_block_seq;
      IF p_page_header = NIL THEN
        IF dfv$file_server_debug_enabled THEN
          display (' --- Pages for a file crossing block boundary ');
        IFEND;
        block_advanced := TRUE;
        advance_to_next_block (image_file_id);
        NEXT p_page_header IN image_file_id.p_current_block_seq;
      IFEND;
      p_data := #ADDRESS (#RING (image_file_id.p_current_block_header),
            #SEGMENT (image_file_id.p_current_block_header), p_page_header^.image_offset);
      p_file := #ADDRESS (#RING (p_file), #SEGMENT (p_file), p_page_header^.file_offset);
      IF dfv$file_server_debug_enabled THEN
        display_pva (' Source ', p_data);
        display_pva (' Destination ', p_file);
        display_integer (' page size ', image_file_id.p_image_header^.page_size);
      IFEND;
      i#move (p_data, p_file, image_file_id.p_image_header^.page_size);
    FOREND /write_all_pages_of_file/;

    pages_recovered := file_header.page_count;

    IF file_header.page_count > 0 THEN
{
{ Write out and free ALL pages which were updated from the image file.  Use the largest size possible, in case
{ there has been some streaming of pages.  (
{
      mmp$write_modified_pages (cell_pointer.cell_pointer, 7fffffff(16), osc$wait, status);
      mmp$free_pages (cell_pointer.cell_pointer, 7fffffff(16), {not used:} osc$nowait, free_pages_status);
      IF status.normal AND NOT free_pages_status.normal THEN
        status := free_pages_status;
      IFEND;
    IFEND;

    dmp$close_file (p_file, local_status);
  PROCEND update_served_file_image;
?? OLDTITLE ??
MODEND dfm$manage_image;

