?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE File Server: Server: clone_task_manager', EJECT ??
MODULE dfm$clone_task_process;
{
{  This module contains those processes concerned with the clone tasks.
{  This includes initiating the clone tasks, checking on the status
{  of the clone tasks and finally the processing within the clone tasks
{  themselves.
{    The purpose of the clone tasks is to process requests from the client
{  mainframe.  For permanent file requests, this means that the clone task
{  will act on behalf of the client job, and it must appear to  the permanent file manager
{  that the task is the user on the client requesting access to the permanent file.
{  For monitor requests the clone task is responsible for processing rejects
{  from monitor mode.  Normal monitor requests are processed directly by
{  monitor normally, and the monitor clone task is only activated when needed.
{
?? NEWTITLE := '  Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amp$get_segment_pointer
*copyc amt$local_file_name
*copyc clp$get_value
*copyc clp$include_command
*copyc clp$scan_parameter_list
*copyc dfd$driver_queue_types
*copyc dfd$request_package
*copyc dfe$error_condition_codes
*copyc dfi$display
*copyc dfi$console_display
*copyc dfi$log_display
*copyc dfk$keypoints
*copyc dft$application_support_limits
*copyc dft$app_support_limits_af
*copyc dft$rb_file_server_request
*copyc dfp$build_client_mf_file_name
*copyc dfp$clear_server_driver_flags
*copyc dfp$crack_client_mf_job_name
*copyc dfp$crack_mainframe_id
*copyc dfp$free_entry_assignment
*copyc dfp$get_qit_p_from_direct_index
*copyc dfp$load_application_procedure
*copyc dfp$send_message_to_operator
*copyc dfp$set_message_content_error
*copyc dfp$verify_system_administrator
*copyc dfp$word_boundary
*copyc dft$remote_request
*copyc dfp$fetch_queue_entry
*copyc dfp$find_mainframe_id
*copyc dfp$queue_task_request
*copyc dfp$receive_remote_call
*copyc dft$entry_type
*copyc dft$rpc_procedure_address_list
*copyc dfv$active_queue_entry_flags
*copyc dfv$file_server_debug_enabled
*copyc dfv$null_global_task_id
*copyc dfv$procedure_address_list
*copyc dfv$send_command_flags
*copyc dmp$allocate_file_space_r1
*copyc dpp$put_next_line
*copyc dpv$system_core_display
*copyc fmp$ln_open_chapter
*copyc fsp$change_segment_number
*copyc fsp$open_file
*copyc ioe$st_errors
*copyc i#call_monitor
*copyc i#current_sequence_position
*copyc mme$condition_codes
*copyc mmp$change_segment_number
*copyc mmp$reserve_segment_number
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$begin_system_activity
*copyc osp$end_system_activity
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$system_error
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc osv$task_private_heap
*copyc oss$task_shared
*copyc ost$caller_identifier
*copyc osv$task_shared_heap
*copyc pmp$convert_binary_unique_name
*copyc pmp$exit
*copyc pmp$execute
*copyc pmp$generate_unique_name
*copyc pmp$get_executing_task_gtid
*copyc pmp$wait
*copyc pmt$program_name
?? POP ??

?? TITLE := '   INLINE IN DECKS ', EJECT ??
*copyc dfp$determine_action_for_server
?? EJECT ??
?? TITLE := '  Global variables', EJECT ??

  VAR
    dfv$p_clone_tasks_status: [XDCL, oss$task_shared] ^array [ * ] of pmt$task_status := NIL;
*copyc dfv$p_client_mainframe_file

  VAR
    dfv$p_attached_file_pointers: [XDCL, oss$task_private] ^array [*] of ^cell := NIL,
    dfv$p_proc_addresses: [XDCL, oss$task_private] ^array [*] of dft$rpc_procedure_address := NIL;

?? TITLE := '    all_monitor_queues_waiting', EJECT  ??
  FUNCTION all_monitor_queues_waiting
    (    p_queue_interface_table: ^dft$queue_interface_table;
         queue_index: dft$queue_index): boolean;

     VAR
       p_cpu_queue_entry: ^dft$cpu_queue_entry,
       queue_entry_index: dft$queue_entry_index;

      FOR queue_entry_index := 1 to p_queue_interface_table^.queue_directory.driver_queue_pva_directory
           [queue_index].p_driver_queue^.queue_header.number_of_queue_entries  do
        p_cpu_queue_entry := ^p_queue_interface_table^.queue_directory.
            cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_entries [queue_entry_index];
        IF p_cpu_queue_entry^.processor_type = dfc$monitor THEN
          IF p_cpu_queue_entry^.p_server_iocb^.server_state <> mmc$ss_waiting THEN
            all_monitor_queues_waiting := FALSE;
            RETURN;
          IFEND;
        IFEND;
      FOREND;

      all_monitor_queues_waiting := TRUE;

   FUNCEND all_monitor_queues_waiting;

?? TITLE := '  [XDCL] dfp$establish_clone_task_stable', EJECT ??
  PROCEDURE [XDCL] dfp$establish_clone_task_stable
    (    mainframe_name: pmt$mainframe_id;
         number_of_monitor_queue_entries: 0 .. dfc$max_queue_entries;
         number_of_task_queue_entries: dft$queue_entry_index;
     VAR status: ost$status);

    VAR
      first_index: dft$queue_entry_index,
      length: integer,
      parameters: string (50),
      queue_entry_index: dft$queue_entry_index;

{  It is assumed that the queue entries are ordered as follows:
{     Polling Task, Monitor Entries, Task Services entries.
{
{   The clone task status array is to be generated such that an index into it
{   corresponds to the queue entry index of the associated task. Since there is
{   only one task for all monitor queue entries, the index of the highest monitor
{   queue entry is chosen as the lower bound of the tasks status array. There
{   is no task status for the Polling Task.
{
{   The upper bound is the highest queue entry index of the task services entries.
{

    IF number_of_monitor_queue_entries > 0 THEN
      first_index := dfc$poll_queue_index + number_of_monitor_queue_entries;
    ELSE
      {No monitor entries but the Poll Task and at least one Task Services Task always exist.
      first_index := dfc$poll_queue_index + 1;
    IFEND;

    ALLOCATE dfv$p_clone_tasks_status: [first_index .. (dfc$poll_queue_index +
          number_of_monitor_queue_entries + number_of_task_queue_entries)] IN osv$task_shared_heap^;

    IF number_of_monitor_queue_entries > 0 THEN
      STRINGREP (parameters, length, mainframe_name, ' ', number_of_monitor_queue_entries);
      execute_clone_task ('DFP$MONITOR_CLONE_TASK', parameters (1, length),
            dfv$p_clone_tasks_status^ [number_of_monitor_queue_entries+1], status);
      IF NOT status.normal THEN
        display_status (status);
      RETURN;
      IFEND;
    IFEND;

  /initiate_task_services_clones/
    FOR queue_entry_index := (dfc$poll_queue_index + number_of_monitor_queue_entries + 1) TO
          UPPERBOUND (dfv$p_clone_tasks_status^) DO
      STRINGREP (parameters, length, mainframe_name, ' ', queue_entry_index);
      execute_clone_task ('DFP$TASK_SERVICES_CLONE_TASK', parameters (1, length),
            dfv$p_clone_tasks_status^ [queue_entry_index], status);
      IF NOT status.normal THEN
        display_status (status);
        RETURN;
      IFEND;
    FOREND /initiate_task_services_clones/;

    wait_for_tasks_active (mainframe_name, number_of_monitor_queue_entries,
          number_of_task_queue_entries, status);

  PROCEND dfp$establish_clone_task_stable;

?? TITLE := ' [XDCL, #GATE] dfp$get_rpc_attached_files', EJECT ??
*copyc dfh$get_rpc_attached_files

  PROCEDURE [XDCL, #GATE] dfp$get_rpc_attached_files
    (    application_name: ost$name;
     VAR attached_file_pointers: array [1 .. *] of ^cell;
     VAR attached_file_names: array [1 .. *] of ost$string;
     VAR number_of_attached_files: dft$number_of_attached_files;
     VAR status: ost$status);

    VAR
      application_found: boolean,
      attached_file_index: dft$number_of_attached_files,
      client_mainframe: pmt$mainframe_id,
      ignore_p_q_interf_dir_entry: ^dft$q_interface_directory_entry,
      ignore_p_q_interf_table: ^dft$queue_interface_table,
      ignore_queue_index: dft$queue_index,
      mainframe_found: boolean,
      p_cpu_queue: ^dft$cpu_queue,
      p_host_application_info: ^dft$host_application_info,
      previous_attached_files: dft$number_of_attached_files;

    status.normal := TRUE;
    number_of_attached_files := 0;
    application_found := FALSE;

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

{
{ Final implementation of this request is currently DEFERRED.
{

    RETURN;

{  Find client mainframe id, etc.
    dfp$crack_client_mf_job_name (client_mainframe, status);
    IF status.normal THEN
      dfp$find_mainframe_id (client_mainframe, {host_is_server} TRUE, mainframe_found,
            ignore_p_q_interf_table, p_cpu_queue, ignore_queue_index, ignore_p_q_interf_dir_entry);
      IF NOT mainframe_found THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, client_mainframe,
              status);
        RETURN;
      IFEND;
    ELSE
      RETURN;
    IFEND;

    IF p_cpu_queue^.queue_header.p_host_application_info = NIL THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$application_not_known, application_name, status);
      RETURN;
    IFEND;

    previous_attached_files := 0;
    p_host_application_info := p_cpu_queue^.queue_header.p_host_application_info;

  /find_application/
    WHILE p_host_application_info <> NIL DO
      IF p_host_application_info^.application_name = application_name THEN
        application_found := TRUE;
        EXIT /find_application/;
      IFEND;
      IF p_host_application_info^.p_attached_file_info <> NIL THEN
        previous_attached_files := previous_attached_files +
              UPPERBOUND (p_host_application_info^.p_attached_file_info^);
      IFEND;
      p_host_application_info := p_host_application_info^.next_p_application_info;
    WHILEND /find_application/;
    IF NOT application_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$application_not_known, application_name, status);
      RETURN;
    IFEND;

    IF (p_host_application_info^.p_attached_file_info = NIL) OR
          (dfv$p_attached_file_pointers = NIL) THEN
       RETURN;
    IFEND;

    number_of_attached_files := UPPERBOUND (p_host_application_info^.p_attached_file_info^);

    { Return attached file info
      IF (number_of_attached_files <= UPPERBOUND (attached_file_names)) AND
            (number_of_attached_files <= UPPERBOUND (attached_file_pointers))THEN
        FOR attached_file_index := 1 TO number_of_attached_files DO
          previous_attached_files := previous_attached_files + 1;
          attached_file_pointers [attached_file_index] :=
                dfv$p_attached_file_pointers^ [previous_attached_files];
          attached_file_names [attached_file_index].size := #size (
            p_host_application_info^.p_attached_file_info^ [previous_attached_files]^);
          attached_file_names [attached_file_index].value :=
            p_host_application_info^.p_attached_file_info^ [previous_attached_files]^;
        FOREND;
      ELSE
        osp$set_status_abnormal (dfc$file_server_id, dfe$callers_variable_too_small,
              'DFP$GET_RPC_ATTACHED_FILES', status);
        osp$append_status_parameter (osc$status_parameter_delimiter, 'ATTACHED_FILE_POINTERS', status);
        osp$append_status_integer (osc$status_parameter_delimiter,
              number_of_attached_files , 10, FALSE, status);
        RETURN;
      IFEND;

  PROCEND dfp$get_rpc_attached_files;
?? TITLE := '  [XDCL, #GATE] dfp$monitor_clone_task', EJECT ??
  PROCEDURE [XDCL, #GATE] dfp$monitor_clone_task
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{      pdt create_monitor_clone_pdt (
{       mainframe_name: name pmc$mainframe_id_size = $required
{       number_of_monitor_queue_entries, nomqe: integer 0 .. dfc$max_queue_entries-2=$required
{       status)

?? PUSH (LISTEXT := ON) ??

  VAR
    create_monitor_clone_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
      ^create_monitor_clone_pdt_names, ^create_monitor_clone_pdt_params];

  VAR
    create_monitor_clone_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
      clt$parameter_name_descriptor := [['MAINFRAME_NAME', 1], ['NUMBER_OF_MONITOR_QUEUE_ENTRIES', 2], [
      'NOMQE', 2], ['STATUS', 3]];

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

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

{ NUMBER_OF_MONITOR_QUEUE_ENTRIES NOMQE }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 0,
      dfc$max_queue_entries-2]],

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

?? POP ??

    VAR
      global_task_id: ost$global_task_id,
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_name: pmt$mainframe_id,
      number_of_monitor_queue_entries: 0 .. dfc$max_queue_entries,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: ^dft$queue_interface_table,
      queue_entry_index: dft$queue_entry_index,
      queue_index: dft$queue_index,
      server_to_client: boolean,
      value: clt$value;

    dfp$verify_system_administrator ('DFP$MONITOR_CLONE_TASK', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$scan_parameter_list (parameter_list, create_monitor_clone_pdt, status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;

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

    clp$get_value ('NUMBER_OF_MONITOR_QUEUE_ENTRIES', 1, 1, clc$low, value, status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;
    number_of_monitor_queue_entries := value.int.value;
    IF number_of_monitor_queue_entries = 0 THEN
      {In this case, this procedure should have never be called.
      display (' DFP$MONITOR_CLONE_TASK called with zero monitor queue entries.');
      RETURN;
    IFEND;

    pmp$get_executing_task_gtid (global_task_id);
    IF dfv$file_server_debug_enabled THEN
      display_integer (' monitor clone task gtid.index ', global_task_id.index);
      display_integer (' monitor clone task gtid.seqno ', global_task_id.seqno);
    IFEND;
    server_to_client := TRUE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
         p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN
      osp$system_error ('INTERNAL ERROR: MAINFRAME NOT FOUND IN MONITOR CLONE TASK.', NIL);
    IFEND;

  /store_task_ids/
{   1ST task is the Poll Task.
    FOR queue_entry_index := 2 TO (number_of_monitor_queue_entries + 1) DO
      p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue_index].
            p_cpu_queue^.queue_entries [queue_entry_index].global_task_id := global_task_id;
      p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
            p_driver_queue^.queue_entries [queue_entry_index].flags.active_entry := TRUE;

    FOREND /store_task_ids/;

    receive_monitor_requests (p_queue_interface_table, queue_index, number_of_monitor_queue_entries, status);
    display_status (status);
  PROCEND dfp$monitor_clone_task;

?? TITLE := '  [XDCL] dfp$process_task_request', EJECT ??
  PROCEDURE [XDCL] dfp$process_task_request
    (    p_queue_interface_table: dft$p_queue_interface_table;
         queue_index: dft$queue_index;
         queue_entry_index: dft$queue_entry_index;
         p_driver_queue_entry: ^dft$driver_queue_entry;
         p_cpu_queue_entry: ^dft$cpu_queue_entry;
     VAR status: ost$status);


    VAR
      action_for_server: dft$action_for_server,
      p_buffer_header: ^dft$buffer_header;

    #KEYPOINT (osk$entry, osk$m * queue_entry_index, dfk$process_task_entry);
    status.normal := TRUE;

{   Determine cause of PP response.
    dfp$determine_action_for_server (p_cpu_queue_entry, p_driver_queue_entry, action_for_server);

    RESET p_cpu_queue_entry^.p_receive_buffer;
    NEXT p_buffer_header IN p_cpu_queue_entry^.p_receive_buffer;
    CASE action_for_server OF
    = dfc$transaction_out_of_sequence =
      display (' ENTRY SEQUENCE ERROR ');
      display_integer (' Expecting ', p_cpu_queue_entry^.transaction_count);
      display_integer (' Received from client: ', p_buffer_header^.transaction_count);
      display_integer_to_console (' DF - SERVER - ERROR SEQUENCE ERROR ',
              p_cpu_queue_entry^.transaction_count);
      dfp$set_message_content_error (p_cpu_queue_entry, p_driver_queue_entry);
      RETURN;

    = dfc$complete_request_on_error =
      display (' COMPLETE REQUEST ON ERROR ');
      display_integer_to_console (' DF - SERVER - COMPLETE REQUEST ON ERROR ',
              p_cpu_queue_entry^.transaction_count);
      IF dfv$file_server_debug_enabled THEN
        display_integer (' DRIVER ERROR ALERT - INDEX', queue_entry_index);
        display_integer_to_console (' DRIVER ERROR ALERT - INDEX', queue_entry_index);
        display_integer (' DRIVER ERROR CONDITION ', p_driver_queue_entry^.error_condition);
        display_integer_to_console (' DF - SERVER - DRIVER ERROR CONDITION ',
                p_driver_queue_entry^.error_condition);
        IF p_driver_queue_entry^.flags.send_ready_for_data THEN
          display (' SERVER ATTEMPTED TO READ PAGE DATA.');
          display_to_console (' DF - SERVER ATTEMPTED TO READ PAGE DATA.');
        ELSEIF p_driver_queue_entry^.flags.send_data THEN
          display (' SERVER ATTEMPTED TO SEND PAGE DATA.');
          display_to_console (' DF - SERVER ATTEMPTED TO SEND PAGE DATA.');
        IFEND;
      IFEND;
      dfp$clear_server_driver_flags (p_driver_queue_entry);
      RETURN;
    ELSE
      ;
    CASEND;

    IF dfv$file_server_debug_enabled THEN
      IF (p_buffer_header^.remote_processor > LOWERVALUE (dft$procedure_address_ordinal)) AND
         (p_buffer_header^.remote_processor < UPPERVALUE (dft$procedure_address_ordinal)) THEN
        IF p_buffer_header^.remote_processor <= dfc$last_system_procedure THEN
          display (dfv$procedure_address_list [p_buffer_header^.remote_processor].debug_display);
        ELSE
          display_integer (' Extended procedure ordinal ', $integer (
                p_buffer_header^.remote_processor));
        IFEND;
      ELSE
       display_integer (' Unexpected procedure ordinal', $integer
             (p_buffer_header^.remote_processor));
       dfp$set_message_content_error (p_cpu_queue_entry, p_driver_queue_entry);
       RETURN;
      IFEND;
    IFEND;

    IF p_buffer_header^.version = dfc$rpc_request_buffer_version THEN
      dfp$receive_remote_call (p_queue_interface_table, queue_index,
          queue_entry_index, p_driver_queue_entry, p_cpu_queue_entry,
          action_for_server, status);
    ELSE
      display_integer (' Unexpected request - queue entry:', queue_entry_index);
      display (p_buffer_header^.version);
      dfp$set_message_content_error (p_cpu_queue_entry, p_driver_queue_entry);
    IFEND;
    #KEYPOINT (osk$exit, 0, dfk$process_task_entry);
  PROCEND dfp$process_task_request;
?? TITLE := '  [XDCL, #GATE] dfp$task_services_clone_task', EJECT ??
  PROCEDURE [XDCL, #GATE] dfp$task_services_clone_task
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{    pdt create_task_clone_pdt (
{      mainframe_name: name pmc$mainframe_id_size = $required
{      queue_entry_index, qei: integer 2 .. dfc$max_queue_entries = $required
{      status)

?? PUSH (LISTEXT := ON) ??

  VAR
    create_task_clone_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [
      ^create_task_clone_pdt_names, ^create_task_clone_pdt_params];

  VAR
    create_task_clone_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 4] of
      clt$parameter_name_descriptor := [['MAINFRAME_NAME', 1], ['QUEUE_ENTRY_INDEX', 2], ['QEI', 2], ['STATUS'
      , 3]];

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

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

{ QUEUE_ENTRY_INDEX QEI }
    [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$integer_value, 2,
      dfc$max_queue_entries]],

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

?? POP ??

    VAR
      caller_id: ost$caller_identifier,
      client_mainframe_name: ost$name,
      display_string: string (80),
      display_string_length: integer,
      global_task_id: ost$global_task_id,
      mainframe_found: boolean,
      mainframe_id: pmt$binary_mainframe_id,
      mainframe_name: pmt$mainframe_id,
      p_cpu_queue: ^dft$cpu_queue,
      p_q_interface_directory_entry: ^dft$q_interface_directory_entry,
      p_queue_interface_table: ^dft$queue_interface_table,
      queue_index: dft$queue_index,
      queue_entry_index: dft$queue_entry_index,
      scratch_pointer: amt$segment_pointer,
      segment_attribute: array [1 .. 1] of mmt$attribute_descriptor,
      segment_pointer: mmt$segment_pointer,
      server_to_client: boolean,
      value: clt$value;

    dfp$verify_system_administrator ('DFP$TASK_SERVICES_CLONE_TASK', status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$scan_parameter_list (parameter_list, create_task_clone_pdt, status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;

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

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

    queue_entry_index := value.int.value;
    pmp$get_executing_task_gtid (global_task_id);
    STRINGREP (display_string, display_string_length, ' task queue_entry_index:', queue_entry_index,
          '-- gtid.index:', global_task_id.index);
    IF dfv$file_server_debug_enabled THEN
      display_integer (' task clone task gtid.seqno ', global_task_id.seqno);
      display (display_string (1, display_string_length));
    IFEND;
    server_to_client := TRUE;
    dfp$find_mainframe_id (mainframe_name, server_to_client, mainframe_found, p_queue_interface_table,
         p_cpu_queue, queue_index, p_q_interface_directory_entry);
    IF NOT mainframe_found THEN
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
      RETURN;
    IFEND;
    p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue_index].
          p_cpu_queue^.queue_entries [queue_entry_index].global_task_id := global_task_id;
    p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue_index].
          p_driver_queue^.queue_entries [queue_entry_index].flags.active_entry := TRUE;

    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_id);
    fmp$ln_open_chapter (client_mainframe_name, 0, caller_id.ring, ^segment_attribute, mmc$cell_pointer,
          segment_pointer, status);
    IF NOT status.normal THEN
      display_status (status);
      RETURN;
    IFEND;
    dfv$p_client_mainframe_file := segment_pointer.cell_pointer;
      IF dfv$p_client_mainframe_file^.mainframe_header.segment_number <> dfc$client_mainframe_segnum THEN
        scratch_pointer.kind := amc$cell_pointer;
        scratch_pointer.cell_pointer := segment_pointer.cell_pointer;
        mmp$change_segment_number (scratch_pointer, dfv$p_client_mainframe_file^.mainframe_header.
              segment_number, 3, scratch_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        dfv$p_client_mainframe_file := scratch_pointer.cell_pointer;
      IFEND;

    generate_task_info (^p_cpu_queue^.queue_header, dfv$p_proc_addresses,
          dfv$p_attached_file_pointers, status);
    IF NOT status.normal THEN
      log_display_status ($pmt$ascii_logset [pmc$job_log, pmc$system_log], FALSE, status);
      display_status (status);
      status.normal := TRUE;
    IFEND;

    receive_task_requests (p_queue_interface_table, queue_index, queue_entry_index, status);
    display_status (status);

  PROCEND dfp$task_services_clone_task;
?? TITLE := '  display_condition', EJECT ??
{ This code was stolen from dfm$driver_test_utility

  PROCEDURE display_condition
    (    condition: dft$server_iocb_error_condition);

    CASE condition OF
    = dfc$null_server_condition =
      display (' Condition: null_server_condition');
    = dfc$reissued_rq_no_memory =
      display (' Condition: reissued_rq_no_memory');
    = dfc$reissued_rq_low_on_memory =
      display (' Condition: reissued_rq_low_on_memory');
    = dfc$reissued_rq_pt_full =
      display (' Condition: reissued_rq_pt_full');
    = dfc$reissued_rq_io_temp_reject =
      display (' Condition: reissued_rq_io_temp_reject');
    = dfc$reissu_rq_temp_rej_fde_lock =
      display (' Condition: reissued_rq_temp_reject_fde_locked');
    = dfc$reissued_rq_temp_rej_q_full =
      display (' Condition: reissued_rq_temp_reject_queue_full');
    = dfc$reissued_rq_io_still_active =
      display (' Condition: reissued_rq_io_still_active');
    = dfc$reissued_rq_task_queued =
      display (' Condition: reissued_rq_task_queued');
    = dfc$reissue_rq_client_locked_pg =
      display (' Condition: reissue_rq_client_locked_pg');
    = dfc$server_page_locked =
      display (' Condition: server_page_locked');
    = dfc$server_read_beyond_eoi =
      display (' Condition: server_read_beyond_eoi');
    = dfc$server_beyond_file_limit =
      display (' Condition: server_beyond_file_limit');
    = dfc$server_no_extend_permission =
      display (' Condition: server_no_extend_permission');
    = dfc$server_signal_select_on_pf =
      display (' Condition: server_signal_select_on_pf');
    = dfc$server_beyond_tape_window =
      display (' Condition: server_beyond_tape_window');
    = dfc$server_io_already_active =
      display (' Condition: server_io_already_active');
    = dfc$server_io_not_active =
      display (' Condition: server_io_not_active');
    = dfc$server_pages_not_available =
      display (' Condition: server_pages_not_available');
    = dfc$server_write_client_error =
      display (' Condition: server_write_client_error');
    = dfc$unrecovered_disk_error =
      display (' Condition: unrecovered_disk_error');
    = dfc$pp_not_configured =
      display (' Condition: pp_not_configured');
    = dfc$pp_interlock_set =
      display (' Condition: pp_interlock_set');
    = dfc$no_space_to_allocate =
      display (' Condition: no_space_to_allocate');
    = dfc$invalid_image_request =
      display (' Condition: invalid_image_request');
    = dfc$invalid_disk_type =
      display (' Condition: invalid_disk_type');
    = dfc$disk_media_error =
      display (' Condition: disk_media_error');
    = dfc$requests_full =
      display (' Condition: requests_full');
    = dfc$unable_to_build_io_request =
      display (' Condition: unable_to_build_io_request');
    = dfc$free_failure =
      display (' Condition: free_failure');
    = dfc$address_error =
      display (' Condition: address_error');
    = dfc$unable_to_unlock_rma_list =
      display (' Condition: unable_to_unlock_rma_list');
    = dfc$unable_to_set_system_flag =
      display (' Condition: unable_to_set_system_flag');
    = dfc$allocation_failure =
      display (' Condition: allocation_failure');
    = dfc$unable_to_queue_io_request =
      display (' Condition: unable_to_queue_io_request');
    = dfc$unable_to_destroy_io_req =
      display (' Condition: unable_to_destroy_io_req');
    = dfc$io_completion_table_error =
      display (' Condition: io_completion_table_error');
    = dfc$unsupported_monitor_request =
      display (' Condition: unsupported_monitor_request');
    = dfc$request_id_mismatch =
      display (' Condition: request_id_mismatch');
    = dfc$io_request_error =
      display (' Condition: io_request_error');
    = dfc$ssiot_recovery_required =
      display (' Condition: ssiot_recovery_required');
    ELSE
      display_integer ('UNKNOWN CONDITION ', $INTEGER (condition));
    CASEND;
  PROCEND display_condition;
?? TITLE := '  display_state', EJECT ??
  PROCEDURE display_state
    (    state: mmt$server_state);

    CASE state OF
    = mmc$ss_queue_initialized =
      display (' State: queue_initialized');
    = mmc$ss_waiting =
      display (' State: waiting');
    = mmc$ss_reading_from_disk =
      display (' State: reading_from_disk');
    = mmc$ss_read_disk_error =
      display (' State: read_disk_error');
    = mmc$ss_writing_to_esm =
      display (' State: writing_to_esm');
    = mmc$ss_write_esm_error =
      display (' State: write_esm_error');
    = mmc$ss_reading_from_esm =
      display (' State: reading_from_esm');
    = mmc$ss_read_esm_error =
      display (' State: read_esm_error');
    = mmc$ss_writing_to_disk =
      display (' State: writing_to_disk');
    = mmc$ss_write_disk_error =
      display (' State: write_disk_error');
    = mmc$ss_sending_write_response =
      display (' State: sending_response');
    = mmc$ss_sending_write_resp_error =
      display (' State: send_write_response_error');
    = mmc$ss_allocating_space =
      display (' State: allocating_space');
    = mmc$ss_allocate_space_error =
      display (' State: allocate_space_error');
    = mmc$ss_send_allocate_response =
      display (' State: send_allocate_response');
    = mmc$ss_send_allocate_resp_error =
      display (' State: send_allocate_resp_error');
    = mmc$ss_reading_pages_ahead =
      display (' State: reading_pages_ahead');
    ELSE
      display_integer (' unknown server state', $INTEGER (state));
    CASEND;
  PROCEND display_state;
?? TITLE := '  execute_clone_task', EJECT ??
  PROCEDURE execute_clone_task
    (    starting_procedure: string ( * <= osc$max_name_size);
         parameters: string ( * <= osc$max_string_size);
     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 := starting_procedure;
    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 (parameters);
    p_parameter_string^.value := parameters;

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

{ PURPOSE:
{   The purpose of this request is to generate task-dependent application
{   information.
{ NOTES:
{   No checking is made for allocation in system heaps since the system heap
{   manager never returns NIL (AHSE Cybil Coding Standards).
{   An error encountered in loading a remote procedure will result in the
{   pointer to that procedure remaining NIL. At time of calling a remote
{   application, a check must be made to see if the pointer is NIL.

  PROCEDURE generate_task_info
    (    p_cpu_queue_header: ^dft$cpu_queue_header;
     VAR p_proc_addresses: ^array [ * ] of dft$rpc_procedure_address;
     VAR p_attached_file_cells: ^array [ * ] of ^cell;
     VAR status: ost$status);

    VAR
      application_index: dft$number_of_applications,
      application_proc_index: dft$number_of_procs_per_app,
      attached_file_count: dft$number_of_attached_files,
      attached_file_index: dft$number_of_attached_files,
      file_attachment: array [1 .. 1] of fst$attachment_option,
      file_id: amt$file_identifier,
      global_attached_file_index: dft$number_of_attached_files,
      library_lfn: amt$local_file_name,
      line: string (120),
      line_size: integer,
      loaded_address: pmt$loaded_address,
      number_of_applications: dft$number_of_applications,
      p_reserved_file_segment_numbers: ^array [ * ] of ost$segment,
      p_host_application_info: ^dft$host_application_info,
      p_remote_application_info: ^dft$remote_application_info,
      segment_pointer: amt$segment_pointer,
      total_file_index: dft$number_of_attached_files,
      total_number_of_attached_files: dft$number_of_attached_files,
      total_number_of_procs: dft$total_number_of_app_procs,
      total_proc_index: dft$total_number_of_app_procs;

    status.normal := TRUE;
    p_proc_addresses := NIL;
    p_attached_file_cells := NIL;

    IF p_cpu_queue_header^.p_host_application_info = NIL THEN
      RETURN;
    IFEND;

    IF p_cpu_queue_header^.p_application_rpc_list <> NIL THEN
      total_number_of_procs := UPPERBOUND (p_cpu_queue_header^.p_application_rpc_list^);
    ELSE
      stringrep (line, line_size, ' **** Application ',
           p_cpu_queue_header^.p_host_application_info^.application_name,
           ' with no remote procedure info.');
      log_display ($pmt$ascii_logset [pmc$job_log, pmc$system_log], line (1, line_size));
      RETURN;
    IFEND;

    IF dfv$file_server_debug_enabled THEN
      STRINGREP (line, line_size, '    Total number of application procedures = ', total_number_of_procs);
      display (line (1, line_size));
    IFEND;

    ALLOCATE p_proc_addresses: [1 .. total_number_of_procs] IN osv$task_private_heap^;

    FOR total_proc_index := 1 TO total_number_of_procs DO
      p_proc_addresses^ [total_proc_index] := NIL;
    FOREND;

    total_proc_index := 0;
    total_number_of_attached_files := 0;

    p_remote_application_info := p_cpu_queue_header^.p_remote_application_info;
    p_host_application_info := p_cpu_queue_header^.p_host_application_info;
    WHILE p_host_application_info <> NIL DO
      library_lfn := p_host_application_info^.attached_library_lfn;

      IF p_remote_application_info <> NIL THEN

      /load_procedures/
        FOR application_proc_index := 1 TO p_remote_application_info^.number_of_procedures DO
          total_proc_index := total_proc_index + 1;
          IF dfv$file_server_debug_enabled THEN
            STRINGREP (line, line_size, ' Ready to load application procedure: ',
                  p_cpu_queue_header^.p_application_rpc_list^ [total_proc_index].debug_display);
            display (line (1, line_size));
          IFEND;
          dfp$load_application_procedure (p_cpu_queue_header^.p_application_rpc_list^ [total_proc_index].
                debug_display, library_lfn, loaded_address, status);
          IF status.normal THEN
            #CONVERT_POINTER_TO_PROCEDURE (loaded_address.pointer_to_procedure,
                  p_proc_addresses^ [total_proc_index]);
          ELSE
            stringrep (line, line_size, ' Error while trying to load application procedure: ',
                  p_cpu_queue_header^.p_application_rpc_list^ [total_proc_index].debug_display);
            dfp$send_message_to_operator (line (1, line_size), {host_is_server} TRUE,
                  p_cpu_queue_header^.destination_mainframe_name);
            log_display_status ($pmt$ascii_logset [pmc$system_log], TRUE, status);
            display_status (status);
            status.normal := TRUE;
          IFEND;

        FOREND /load_procedures/;
        p_remote_application_info := p_remote_application_info^.next_p_application_info;
      IFEND;

      IF p_host_application_info^.p_attached_file_info <> NIL THEN
        total_number_of_attached_files := total_number_of_attached_files +
              UPPERBOUND (p_host_application_info^.p_attached_file_info^);
      IFEND;

      p_host_application_info := p_host_application_info^.next_p_application_info;
    WHILEND;

    IF total_number_of_attached_files = 0 THEN
      RETURN;
    IFEND;

{ Open attached files

    ALLOCATE p_attached_file_cells: [1 .. total_number_of_attached_files] IN osv$task_private_heap^;
    FOR attached_file_index := 1 TO total_number_of_attached_files DO
      p_attached_file_cells^ [attached_file_index] := NIL;
    FOREND;
    IF dfv$file_server_debug_enabled THEN
      STRINGREP (line, line_size, '    Number of attached files = ', total_number_of_attached_files);
      display (line (1, line_size));
    IFEND;

    PUSH p_reserved_file_segment_numbers: [1 .. total_number_of_attached_files];
    mmp$reserve_segment_number ({shared_stack_flag} FALSE, p_reserved_file_segment_numbers, status);
    IF NOT status.normal THEN
      log_display ($pmt$ascii_logset [pmc$job_log, pmc$system_log],
             ' Bad status from mmp$reserve_segment_number');
      log_display_status ($pmt$ascii_logset [pmc$job_log, pmc$system_log], TRUE, status);
      RETURN;
    IFEND;
{!!! ??? How to ensure all tasks have the same reserved segment numbers ?????

    file_attachment [1].selector := fsc$access_and_share_modes;
    file_attachment [1].access_modes.selector := fsc$specific_access_modes;
    file_attachment [1].access_modes.value := -$fst$file_access_options [];
    file_attachment [1].share_modes.selector := fsc$specific_share_modes;
    file_attachment [1].share_modes.value := -$fst$file_access_options [];

    p_host_application_info := p_cpu_queue_header^.p_host_application_info;
    WHILE p_host_application_info <> NIL DO

      IF p_host_application_info^.p_attached_file_info <> NIL THEN

      /attach_files/
        FOR attached_file_index := 1 TO UPPERBOUND (p_host_application_info^.p_attached_file_info^) DO

          fsp$open_file (p_host_application_info^.p_attached_file_info^ [attached_file_index]^, amc$segment,
                ^file_attachment, {default_creation_attributes} NIL, {manadated_creation_attributes} NIL,
                {attribute_validation} NIL, {attribute_override} NIL, file_id, status);
          IF NOT status.normal THEN
            log_display_status ($pmt$ascii_logset [pmc$job_log, pmc$system_log], FALSE, status);
            display_status (status);
            status.normal := TRUE;
            CYCLE /attach_files/;
          IFEND;
          amp$get_segment_pointer (file_id, amc$cell_pointer, segment_pointer, status);
          IF NOT status.normal THEN
            log_display ($pmt$ascii_logset [pmc$job_log, pmc$system_log],
                  ' Bad status from amp$get_segment_pointer');
            log_display_status ($pmt$ascii_logset [pmc$job_log, pmc$system_log], TRUE, status);
            status.normal := TRUE;
            CYCLE /attach_files/;
          IFEND;
          IF #SEGMENT (segment_pointer.cell_pointer) <> p_reserved_file_segment_numbers^
                [attached_file_index] THEN
            fsp$change_segment_number (file_id, p_reserved_file_segment_numbers^
                  [attached_file_index], {validation_ring} 3 {??} , amc$cell_pointer,
                  segment_pointer, status);
            IF NOT status.normal THEN
              log_display ($pmt$ascii_logset [pmc$job_log, pmc$system_log],
                   ' Bad status from fsp$change_segment_number');
              log_display_status ($pmt$ascii_logset [pmc$job_log, pmc$system_log], TRUE, status);
              display_status (status);
              status.normal := TRUE;
              CYCLE /attach_files/;
            IFEND;
          IFEND;
          p_attached_file_cells^ [attached_file_index] := segment_pointer.cell_pointer;
        FOREND /attach_files/;
      IFEND;

      p_host_application_info := p_host_application_info^.next_p_application_info;
    WHILEND;

  PROCEND generate_task_info;
?? TITLE := '  process_monitor_entry', EJECT ??
  PROCEDURE process_monitor_entry
    (    p_cpu_queue: ^dft$cpu_queue;
         p_cpu_queue_entry: ^dft$cpu_queue_entry;
     VAR status: ost$status);

    VAR
      display_string: string (80),
      display_string_length: integer,
      file_name: ost$name,
      ignored_status: ost$status,
      p_driver_queue_entry: ^dft$driver_queue_entry,
      p_queue_interface_table: ^dft$queue_interface_table,
      p_server_iocb: ^mmt$server_iocb_entry,
      remote_request: dft$remote_request,
      request_block:  dft$rb_file_server_request,
      allocation_status: ost$status;

    CONST
     { Time in milliseconds.
     restart_delay = 15,          {Delay time before re-starting request}
     maximum_wait_time = 600000,  {10 minutes}
     maximum_restart_count = (maximum_wait_time DIV restart_delay);

    p_server_iocb := p_cpu_queue_entry^.p_server_iocb;

    IF dfv$file_server_debug_enabled THEN
      display_condition (p_server_iocb^.condition);
      display_state (p_server_iocb^.server_state);
      display_integer (' SERVER IOCB ACTIVE IO COUNT ',
            p_server_iocb^.active_io_count);
      display_bytes (p_server_iocb, #size(p_server_iocb^));
    IFEND;

    CASE p_server_iocb^.server_state OF
    = mmc$ss_read_disk_error, mmc$ss_write_esm_error =
      CASE p_server_iocb^.condition OF
      = dfc$bad_sfid =
        send_error_status_response (p_cpu_queue_entry, dfe$sfid_gfn_mismatch, status);
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;
      = dfc$server_terminated =
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;
      = dfc$volume_unavailable, dfc$unit_disabled =
        send_error_status_response (p_cpu_queue_entry, mme$volume_unavailable, status);
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;
      = dfc$disk_media_error, dfc$unrecovered_disk_error =
        send_error_status_response (p_cpu_queue_entry, ioc$disk_media_error, status);
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;
      ELSE
      CASEND;
      p_server_iocb^.server_state := mmc$ss_waiting;
      remote_request := dfc$read_for_client;
      p_server_iocb^.active_io_count := 0;
{     Reset the server_iocb condition.
      p_server_iocb^.condition := dfc$null_server_condition;

    = mmc$ss_read_esm_error =
      CASE p_server_iocb^.condition OF
      = dfc$bad_sfid =
        log_display ($pmt$ascii_logset [pmc$system_log], ' DF - BAD SFID RECEIVED ');
        log_display_integer ($pmt$ascii_logset [pmc$system_log], '      QUEUE INDEX = ',
              p_cpu_queue_entry^.io_id.queue_entry_location.queue_index);
        IF dfv$file_server_debug_enabled THEN
          osp$system_error (' BAD SFID. PROCESS_MONITOR_REQUEST', NIL);
        IFEND;
        send_error_status_response (p_cpu_queue_entry, dfe$sfid_gfn_mismatch, status);
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;
      = dfc$server_terminated =
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;
      = dfc$disk_media_error =
{       FS PP driver detected ESM failure while reading page data.
{       Clean up queue entry and wait for Client to retransmit the request.
        p_server_iocb^.server_state := mmc$ss_waiting;
        p_server_iocb^.active_io_count := 0;
{       Reset the server_iocb condition.
        p_server_iocb^.condition := dfc$null_server_condition;
        dfp$get_qit_p_from_direct_index (p_cpu_queue_entry^.io_id.queue_entry_location.directory_index,
              p_queue_interface_table);
        p_driver_queue_entry := ^p_queue_interface_table^.queue_directory.
           driver_queue_pva_directory [p_cpu_queue_entry^.io_id.queue_entry_location.queue_index].
           p_driver_queue^.queue_entries [p_cpu_queue_entry^.io_id.queue_entry_location.queue_entry_index];
        p_driver_queue_entry^.flags := dfv$active_queue_entry_flags;
        RETURN;

      ELSE
      CASEND;
      p_server_iocb^.server_state := mmc$ss_waiting;
      remote_request := dfc$write_for_client;
      p_server_iocb^.active_io_count := 0;
{     Reset the server_iocb condition.
      p_server_iocb^.condition := dfc$null_server_condition;

    = mmc$ss_sending_write_resp_error =
      IF p_server_iocb^.condition = dfc$server_terminated THEN
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;
      IFEND;
      p_server_iocb^.server_state := mmc$ss_writing_to_disk;
      remote_request := dfc$completing_previous_request;
      p_server_iocb^.active_io_count := 1;
{     Reset the server_iocb condition.
      p_server_iocb^.condition := dfc$null_server_condition;

    = mmc$ss_write_disk_error =
      p_server_iocb^.server_state := mmc$ss_reading_from_esm;
      remote_request := dfc$completing_previous_request;
      p_server_iocb^.active_io_count := 1;
      CASE p_server_iocb^.condition OF
      = dfc$bad_sfid =
        p_server_iocb^.server_state := mmc$ss_waiting;
        send_error_status_response (p_cpu_queue_entry, dfe$sfid_gfn_mismatch, status);
        RETURN;
      = dfc$disk_media_error, dfc$unrecovered_disk_error =
        p_server_iocb^.server_state := mmc$ss_waiting;
        send_error_status_response (p_cpu_queue_entry, ioc$disk_media_error, status);
        RETURN;
      = dfc$volume_unavailable, dfc$unit_disabled =
        p_server_iocb^.server_state := mmc$ss_waiting;
        send_error_status_response (p_cpu_queue_entry, mme$volume_unavailable, status);
        RETURN;
      ELSE
      CASEND;
{     Reset the server_iocb condition.
      p_server_iocb^.condition := dfc$null_server_condition;

    = mmc$ss_allocate_space_error =
      CASE p_server_iocb^.condition OF
      = dfc$reissued_rq_io_temp_reject =
        dmp$allocate_file_space_r1 (p_server_iocb^.sfid, p_server_iocb^.offset, p_server_iocb^.length -
               p_server_iocb^.offset, 0, osc$nowait, sfc$no_limit, allocation_status);
        IF allocation_status.normal THEN
{         Set up a server response indicating a successful allocation and reset the server_iocb condition.
          p_server_iocb^.server_state := mmc$ss_allocating_space;
          remote_request := dfc$completing_previous_request;
          p_server_iocb^.active_io_count := 1;
          p_server_iocb^.condition := dfc$null_server_condition;
        ELSE
{         Set up a server response indicating a failed allocation.
{         DO NOT reset the server_iocb condition to zero (dfc$null_server_condition)!
{         DO NOT reset the server_iocb state either (mmc$ss_allocate_space_error)!
          remote_request := dfc$completing_previous_request;
          p_server_iocb^.active_io_count := 1;
          p_server_iocb^.condition := dfc$allocation_failure;
        IFEND;

      = dfc$volume_unavailable, dfc$unit_disabled =
        p_server_iocb^.server_state := mmc$ss_waiting;
        send_error_status_response (p_cpu_queue_entry, mme$volume_unavailable, status);
        RETURN;
      = dfc$disk_media_error, dfc$unrecovered_disk_error =
        send_error_status_response (p_cpu_queue_entry, ioc$disk_media_error, status);
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;

      ELSE
{ The server_condition, DFC$SERVER_TERMINATED, cannot happen on the mainframe which is executing this code.
        osp$system_error ('Unexpected server_condition in PROCESS_MONITOR_ENTRY', NIL);
      CASEND;

    = mmc$ss_send_allocate_resp_error =
      IF p_server_iocb^.condition = dfc$server_terminated THEN
        p_server_iocb^.server_state := mmc$ss_waiting;
        RETURN;
      IFEND;
      p_server_iocb^.server_state := mmc$ss_allocating_space;
      remote_request := dfc$completing_previous_request;
      p_server_iocb^.active_io_count := 1;
{     Reset the server_iocb condition.
      p_server_iocb^.condition := dfc$null_server_condition;

    ELSE

{ We don't care about the particular server request states here - they all are unexpected.  However, we may be
{ able to react to individual server conditions regardless of the server request state...

      IF p_server_iocb^.condition = dfc$volume_unavailable THEN
        p_server_iocb^.server_state := mmc$ss_waiting;
        send_error_status_response (p_cpu_queue_entry, mme$volume_unavailable, status);
        RETURN;
      ELSE
        log_display ($pmt$ascii_logset[pmc$job_log, pmc$system_log],
              ' Unable to handle DF state/condition combo:');
        log_display_integer ($pmt$ascii_logset[pmc$job_log, pmc$system_log], '    Queue Index = ',
             p_cpu_queue_entry^.io_id.queue_entry_location.queue_index);
        log_display_integer ($pmt$ascii_logset[pmc$job_log, pmc$system_log], '    Queue Entry Index = ',
             p_cpu_queue_entry^.io_id.queue_entry_location.queue_entry_index);
        log_display_integer ($pmt$ascii_logset[pmc$job_log, pmc$system_log], '    DF IOCB state = ',
             $INTEGER (p_server_iocb^.server_state));
        log_display_integer ($pmt$ascii_logset[pmc$job_log, pmc$system_log], '    DF IOCB condition = ',
             $INTEGER (p_server_iocb^.condition));
        osp$system_error (' UNEXPECTED SERVER STATE ', NIL);
      IFEND;
    CASEND;

    IF (p_cpu_queue^.queue_header.partner_status.server_state = dfc$terminated) OR
        (p_cpu_queue^.queue_header.partner_status.server_state = dfc$awaiting_recovery) THEN
       { There is no reason to attempt to restart the request if the server is terminated.
        p_server_iocb^.server_state := mmc$ss_waiting;
       RETURN;
    IFEND;

{   For some reason (most likely the page is locked by another task)
{   File Server cannot complete the request. The following code provides a
{   delay between attempts to complete the request, and also imposes a time
{   limit on completion of the request. If the request cannot be completed
{   after the maximum number of attempts (approx. 10 minutes, 40000 attempts)
{   it is assumed that something is terribly wrong and the File Server
{   connection will be "timed out".
{
{   The iocb field "restart_count" is initialized to zero when a new or
{   retransmitted request is detected in dfp$process_server_response_a.

    IF p_server_iocb^.restart_count >= maximum_restart_count THEN
      pmp$convert_binary_unique_name (p_server_iocb^.global_file_name, file_name, ignored_status);
      STRINGREP (display_string, display_string_length, '    Global File Name - ', file_name);
      display (' DF - Timing out File Server - inaccessible page encountered.');
      display_to_console (' DF - Timing out File Server - inaccessible page encountered.');
      log_display ($pmt$ascii_logset[pmc$system_log],
           ' DF - Timing out File Server - inaccessible page encountered.');
      log_display ($pmt$ascii_logset[pmc$system_log], display_string(1, display_string_length));
      IF dfv$file_server_debug_enabled THEN
        log_display_integer ($pmt$ascii_logset[pmc$system_log], '    Queue Index = ',
             p_cpu_queue_entry^.io_id.queue_entry_location.queue_index);
        log_display_integer ($pmt$ascii_logset[pmc$system_log], '    Queue Entry Index = ',
             p_cpu_queue_entry^.io_id.queue_entry_location.queue_entry_index);
        display (display_string(1, display_string_length));
        display_integer ('    Queue Index = ', p_cpu_queue_entry^.io_id.queue_entry_location
             .queue_index);
        display_integer ('    Queue Entry Index = ', p_cpu_queue_entry^.io_id.queue_entry_location
             .queue_entry_index);
      IFEND;
      p_server_iocb^.server_state := mmc$ss_waiting;
      p_cpu_queue^.queue_header.partner_status.timeout_partner := TRUE;
      RETURN;

    ELSEIF p_server_iocb^.restart_count <> 0 THEN
{     Do not delay before first re-start attempt.
{     This delay is to allow the task, which has the page in question locked,
{     an opportunity to release the locked page.
      pmp$wait (restart_delay, restart_delay);
    IFEND;
    p_server_iocb^.restart_count := p_server_iocb^.restart_count + 1;

    request_block.reqcode := syc$rc_file_server_request;
    request_block.status.normal := TRUE;
    request_block.request := dfc$fsr_restart_server_request;
    request_block.remote_request := remote_request;
    request_block.p_cpu_queue_entry := p_cpu_queue_entry;
    IF dfv$file_server_debug_enabled THEN
      display (' i#call_monitor - RESTART_SERVER_REQUEST ');
      display_integer ('    Re-start count = ', p_server_iocb^.restart_count);
    IFEND;
    i#call_monitor (#LOC(request_block), #SIZE (request_block));
    IF request_block.status.normal THEN
      IF dfv$file_server_debug_enabled THEN
        display (' RETURN FROM MONITOR - NORMAL ');
      IFEND;
    ELSE
      display_integer (' ABNORMAL STATUS FROM MONITOR ',
            request_block.status.condition);
    IFEND;
    status.normal := TRUE;
  PROCEND process_monitor_entry;

?? TITLE := '  receive_monitor_requests', EJECT ??
  PROCEDURE receive_monitor_requests
    (    p_queue_interface_table: ^dft$queue_interface_table;
         queue_index: dft$queue_index;
         number_of_monitor_queue_entries: 0 .. dfc$max_queue_entries;
     VAR status: ost$status);

     CONST
      { Time in milliseconds
      requested_time = 5000,
      expected_time =  5000;

    TYPE
      char_set = set of char;

    VAR
      active_entry_found: boolean,
      active_queue_entry: dft$queue_entry_index,
      assigned_char_set: char_set,
      p_cpu_queue: ^dft$cpu_queue,
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_server_state: ^dft$server_state;

    status.normal := TRUE;
    IF number_of_monitor_queue_entries = 0 THEN
      {In this case, this procedure should have never be called.
      display (' RECEIVE_MONITOR_REQUESTS called with zero monitor queue entries.');
      RETURN;
    IFEND;

    assigned_char_set := $char_set [dfc$assigned_entry_char];
    p_cpu_queue := p_queue_interface_table^.queue_directory.
      cpu_queue_pva_directory [queue_index].p_cpu_queue;
    p_server_state := ^p_cpu_queue^.queue_header.
      partner_status.server_state;

  /loop_until_terminated/
    WHILE TRUE DO
      #SPOIL (p_server_state^);
      IF (p_server_state^ = dfc$terminated) OR (p_server_state^ = dfc$awaiting_recovery) THEN
        IF all_monitor_queues_waiting (p_queue_interface_table, queue_index) THEN
          osp$set_status_condition (dfe$client_not_active, status);
          pmp$exit (status);
        IFEND;
      IFEND;
      pmp$wait (requested_time, expected_time);
      #KEYPOINT (osk$debug, 0, dfk$monitor_task_activated);
      REPEAT
        #SPOIL(p_cpu_queue^.queue_header.
              queue_entry_assignment_table);
{       Provide for 1 st entry assigned to Poll Task.
        #SCAN (assigned_char_set, p_cpu_queue^.queue_header.
              queue_entry_assignment_table (2, number_of_monitor_queue_entries), active_queue_entry,
              active_entry_found);
        IF active_entry_found THEN
          active_queue_entry := active_queue_entry + 1;
          IF dfv$file_server_debug_enabled THEN
            display_integer (' MONITOR ACTIVE - ENTRY ', active_queue_entry);
          IFEND;
          dfp$free_entry_assignment (active_queue_entry,
              p_cpu_queue^.queue_header.
              queue_entry_assignment_table);
          p_cpu_queue_entry :=
              ^p_cpu_queue^.queue_entries [active_queue_entry];
          process_monitor_entry (p_cpu_queue, p_cpu_queue_entry, status);
          IF NOT status.normal THEN
            display_status (status);
          IFEND;
        ELSEIF (p_server_state^ = dfc$terminated) OR (p_server_state^ = dfc$awaiting_recovery) THEN
          IF all_monitor_queues_waiting (p_queue_interface_table, queue_index) THEN
            osp$set_status_condition (dfe$client_not_active, status);
            pmp$exit (status);
          IFEND;
        IFEND;
      UNTIL (NOT active_entry_found) OR (NOT status.normal);
    WHILEND /loop_until_terminated/;

  PROCEND receive_monitor_requests;

?? TITLE := '  receive_task_requests', EJECT ??
  PROCEDURE receive_task_requests
    (    p_queue_interface_table: ^dft$queue_interface_table;
         queue_index: dft$queue_index;
         queue_entry_index: dft$queue_entry_index;
     VAR status: ost$status);

    CONST
      { Time in milliseconds
      requested_time = 2000,
      expected_time =  1000;

    VAR
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_driver_queue_entry: ^dft$driver_queue_entry,
      p_server_state: ^dft$server_state;

    dfp$fetch_queue_entry (p_queue_interface_table, queue_index, queue_entry_index,
          p_driver_queue_entry, p_cpu_queue_entry);

 { Probably should be in above procedure, or somewhere
    p_server_state := ^p_queue_interface_table^.queue_directory.
      cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_header.
      partner_status.server_state;

    status.normal := TRUE;

  /await_task_activation/
    REPEAT
      #SPOIL (p_server_state^);
      IF NOT ((p_server_state^ = dfc$terminated) OR (p_server_state^ = dfc$awaiting_recovery)) THEN
        REPEAT
          pmp$wait (requested_time, expected_time);
        UNTIL p_driver_queue_entry^.flags.subsystem_action;
      IFEND;
      IF ((p_server_state^ = dfc$terminated) OR (p_server_state^ = dfc$awaiting_recovery)) THEN
        osp$set_status_abnormal (dfc$file_server_id, dfe$client_not_active, '', status);
        pmp$exit (status);
      ELSE
        dfp$process_task_request (p_queue_interface_table, queue_index, queue_entry_index,
              p_driver_queue_entry, p_cpu_queue_entry, status);
      IFEND;
    UNTIL NOT status.normal;
    display_status (status);
  PROCEND receive_task_requests;
?? TITLE := '  send_bad_status_response', EJECT ??

  PROCEDURE send_error_status_response
    (    p_cpu_queue_entry: ^dft$cpu_queue_entry;
         error_condition: ost$status_condition;
     VAR status: ost$status);

    VAR
      p_driver_queue_entry: ^dft$driver_queue_entry,
      p_queue_interface_table: dft$p_queue_interface_table,
      p_req_buffer_header: ^dft$buffer_header,
      p_status_response: ^dft$status_response,
      queue_request_status: dft$queue_request_status;

    IF dfv$file_server_debug_enabled THEN
      display_integer (' send_error_status_response ', $integer (error_condition));
      display_integer_to_console (' send_error_status_response ', $integer (error_condition));
    IFEND;

    RESET p_cpu_queue_entry^.p_send_buffer;
    NEXT p_status_response IN p_cpu_queue_entry^.p_send_buffer;

    p_status_response^.buffer_header.version := dfc$status_buffer_version;

    RESET p_cpu_queue_entry^.p_receive_buffer;
    NEXT p_req_buffer_header IN p_cpu_queue_entry^.p_receive_buffer;

    p_status_response^.buffer_header.remote_processor := p_req_buffer_header^.remote_processor;
    p_status_response^.buffer_header.transaction_count :=
          p_cpu_queue_entry^.transaction_count;
    p_status_response^.buffer_header.retransmission_count :=
          p_cpu_queue_entry^.retransmission_count;
    p_status_response^.buffer_header.data_length_sent := 0;

    p_status_response^.status.normal := FALSE;
    p_status_response^.status.condition := error_condition;

    dfp$get_qit_p_from_direct_index (p_cpu_queue_entry^.io_id.queue_entry_location.directory_index,
          p_queue_interface_table);

    p_driver_queue_entry := ^p_queue_interface_table^.queue_directory.
          driver_queue_pva_directory [p_cpu_queue_entry^.io_id.queue_entry_location.queue_index].
          p_driver_queue^.queue_entries [p_cpu_queue_entry^.io_id.queue_entry_location.queue_entry_index];

    { Set send buffer length in buffer header.
    p_status_response^.buffer_header.buffer_length_sent :=
          dfp$word_boundary (i#current_sequence_position (p_cpu_queue_entry^.p_send_buffer));

    { Setup driver_queue_entry flags for send buffer and data.
    p_driver_queue_entry^.flags := dfv$send_command_flags;

    { Set send buffer length in driver queue entry.
    p_driver_queue_entry^.send_buffer_descriptor.actual_length :=
          p_status_response^.buffer_header.buffer_length_sent;

    { Queue request for driver.
    osp$begin_system_activity;
    dfp$queue_request (p_queue_interface_table,
          p_cpu_queue_entry^.io_id.queue_entry_location.queue_index, p_cpu_queue_entry^.
          io_id.queue_entry_location.queue_entry_index, queue_request_status);
    osp$end_system_activity;
  PROCEND send_error_status_response;

?? TITLE :=  'wait_for_tasks_active', EJECT ??
  PROCEDURE wait_for_tasks_active
    (    mainframe_name: pmt$mainframe_id;
         number_of_monitor_queue_entries: 0 .. dfc$max_queue_entries;
         number_of_task_queue_entries: dft$queue_entry_index;
     VAR status: ost$status);

    VAR
      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,
      queue_entry_index: dft$queue_entry_index,
      queue_index: dft$queue_index,
      wait_count: 0 .. 255;

    dfp$find_mainframe_id (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
      osp$set_status_abnormal (dfc$file_server_id, dfe$mainframe_not_client, mainframe_name, status);
      RETURN;
    IFEND;

    IF number_of_monitor_queue_entries > 0 THEN
      wait_count := 0;
    /wait_for_monitor_task/
      WHILE p_cpu_queue^.queue_entries [dfc$poll_queue_index + 1].global_task_id =
            dfv$null_global_task_id DO
        IF wait_count > 50 THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$task_not_established, 'MONITOR',
                status);
          RETURN;
        IFEND;
        pmp$wait (100, 100);
        IF (wait_count = 10) AND dfv$file_server_debug_enabled THEN
          display (' Waiting for monitor task to become active.');
        IFEND;
        wait_count := wait_count + 1;
      WHILEND /wait_for_monitor_task/;
    IFEND;

    FOR queue_entry_index := (dfc$poll_queue_index + number_of_monitor_queue_entries + 1) TO
          UPPERBOUND (dfv$p_clone_tasks_status^) DO
      wait_count := 0;
    /wait_for_services_task/
      WHILE p_cpu_queue^.queue_entries [queue_entry_index].global_task_id =
            dfv$null_global_task_id DO
        IF wait_count > 50 THEN
          osp$set_status_abnormal (dfc$file_server_id, dfe$task_not_established,
                'TASK SERVICES', status);
          RETURN;
          EXIT /wait_for_services_task/;
        IFEND;
        pmp$wait (100, 100);
        IF (wait_count = 10) AND dfv$file_server_debug_enabled THEN
          display (' Waiting for services task to become active.');
        IFEND;
        wait_count := wait_count + 1;
      WHILEND /wait_for_services_task/;
    FOREND;

  PROCEND wait_for_tasks_active;

?? OLDTITLE ??
MODEND dfm$clone_task_process;
