?? RIGHT := 110 ??
?? TITLE := 'NOS/VE File Server: client allocation interface to server' ??
MODULE dfm$file_server_allocation;
{
{
{ This module is the module containing procedures to set up client allocation on the server.
{
{
?? NEWTITLE := '  Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfd$driver_queue_types
*copyc dfd$request_package
*copyc dfe$error_condition_codes
*copyc dft$allocate_space_request
*copyc dmt$error_condition_codes
*copyc dft$server_descriptor
*copyc gft$system_file_identifier
*copyc ioe$st_errors
*copyc jmt$initiated_job_list_entry

*copyc dfp$assign_queue_entry
*copyc dfp$convert_list_pointer
*copyc dfp$fetch_queue_entry
*copyc dfp$fetch_served_family_info
*copyc dfp$queue_request
*copyc dfp$release_queue_entry
*copyc dfp$set_terminated_mtr_status
*copyc dfp$uncomplement_gfn
*copyc dfp$word_boundary
*copyc dfp$get_served_file_desc_p
*copyc gfp$mtr_get_locked_fde_p
*copyc gfp$mtr_unlock_fde_p
*copyc i#current_sequence_position
*copyc mmp$build_lock_rma_list
*copyc mmp$unlock_rma_list
*copyc mtp$error_stop
*copyc mtp$set_status_abnormal
*copyc sfp$mtr_accumulate_file_space
*copyc sfv$dynamic_file_space_limits
*copyc osv$page_size
?? POP ??
?? OLDTITLE, NEWTITLE := '  [XDCL] dfp$file_server_allocation', EJECT ??

{
{   This procedure executes on the client mainframe and performs the allocation function called in
{ MMP$PAGE_PULL. It sets up the queue_entry (specified via IO_ID) so that the allocation length
{ requested by the client is input to the link device by the link driver.  It is patterned after
{ DFP$SERVER_IO.
{
  PROCEDURE [XDCL] dfp$file_server_allocation
    (    sfid: gft$system_file_identifier;
         segment_offset: ost$segment_offset;
         segment_length: ost$segment_length;
         io_id: mmt$io_identifier;
         buffer_descriptor: mmt$buffer_descriptor;
         file_space_limit: sft$file_space_limit_kind;
     VAR spio_status: syt$monitor_status);

    VAR
      assign_status: dft$assign_queue_entry_status,
      family_name: ost$family_name,
      index_valid: boolean,
      io_error: iot$io_error,
      list_length: mmt$rma_list_length,
      m_status: syt$monitor_status,
      p_buffer_header: ^dft$buffer_header,
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_driver_queue_entry: ^dft$driver_queue_entry,
      p_fde: gft$file_desc_entry_p,
      p_allocate_space_request: ^dft$allocate_space_request,
      p_queue_interface_table: dft$p_queue_interface_table,
      p_rma_list: ^mmt$rma_list,
      p_server_descriptor: dft$server_descriptor_p,
      p_status_response: ^dft$status_response,
      queue_index: dft$queue_index,
      queue_entry_index: dft$queue_entry_index,
      queue_request_status: dft$queue_request_status,
      release_queue_entry_status: dft$release_queue_entry_status,
      served_mainframe_id: pmt$binary_mainframe_id,
      space_limit_exceeded: boolean;

    gfp$mtr_get_locked_fde_p (sfid, NIL, p_fde);

{ Locate server descriptor for file.

    dfp$get_served_file_desc_p (p_fde, p_server_descriptor);
    IF p_server_descriptor = NIL THEN
      mtp$error_stop ('DF - p_server_descriptor = NIL: DFP$FILE_SERVER_ALLOCATION');
    IFEND;

    dfp$fetch_served_family_info (p_server_descriptor^.header.served_family_table_index, family_name,
          served_mainframe_id, p_queue_interface_table, queue_index, index_valid);

    IF NOT index_valid THEN
      spio_status.normal := FALSE;
      spio_status.condition := dfe$server_has_terminated;
      gfp$mtr_unlock_fde_p (p_fde);
      RETURN;
    IFEND; { index_valid }

    IF (p_server_descriptor^.header.file_state = dfc$awaiting_recovery) THEN
      { Force a wait
      spio_status.normal := FALSE;
      spio_status.condition := ioe$unit_disabled;
      gfp$mtr_unlock_fde_p (p_fde);
      RETURN;
    IFEND;

    dfp$assign_queue_entry ( p_queue_interface_table, queue_index, dfc$monitor, queue_entry_index,
          assign_status);

    IF assign_status <> dfc$aqes_entry_assigned THEN
      spio_status.normal := FALSE;
      IF assign_status = dfc$aqes_server_terminated THEN
        dfp$set_terminated_mtr_status (p_queue_interface_table, queue_index,
          spio_status);
      ELSE
        spio_status.condition := dme$transient_error;
      IFEND;
      gfp$mtr_unlock_fde_p (p_fde);
      RETURN;
    IFEND; { assign queue entry }


{   Locate driver and cpu queue entries.

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

{   Build request package in send_buffer.

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

{   Fill in request header.

    p_buffer_header^.version := dfc$allocate_request_version;
{   Increment in Q entry when request queued.
    p_buffer_header^.transaction_count := p_cpu_queue_entry^.transaction_count + 1;
    p_buffer_header^.retransmission_count := 0;
    p_cpu_queue_entry^.retransmission_count := 0;

    p_buffer_header^.remote_processor := dfc$allocate;
    p_buffer_header^.data_length_sent := 0;
    p_driver_queue_entry^.flags.send_data := FALSE;

    NEXT p_allocate_space_request IN p_cpu_queue_entry^.p_send_buffer;

{   Fill in page I/O request

    p_allocate_space_request^.segment_offset := segment_offset;
    p_allocate_space_request^.segment_length := segment_length;
    dfp$uncomplement_gfn (p_fde^.global_file_name, p_allocate_space_request^.global_file_name);
    p_allocate_space_request^.eoi_byte_address := p_fde^.eoi_byte_address;
    p_allocate_space_request^.remote_sfid := p_server_descriptor^.header.remote_sfid;

{   Set send buffer length in buffer header.

    p_buffer_header^.buffer_length_sent := dfp$word_boundary (i#current_sequence_position
          (p_cpu_queue_entry^.p_send_buffer));

{   Set fields in cpu queue entry.

    p_cpu_queue_entry^.io_id := io_id;
    p_cpu_queue_entry^.io_type := ioc$allocate;
    p_cpu_queue_entry^.sfid := sfid;

{   Set up driver_queue_entry flags for send buffer and data.
    p_driver_queue_entry^.flags.subsystem_action := FALSE;
    p_driver_queue_entry^.flags.driver_action := TRUE;
    p_driver_queue_entry^.flags.send_command := TRUE;
    p_driver_queue_entry^.flags.send_ready_for_data := FALSE;
    p_driver_queue_entry^.flags.buffer_sent := FALSE;
    p_driver_queue_entry^.flags.data_sent := FALSE;

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

{   Lock data pages.
{   Set list length in CM words.
    list_length := buffer_descriptor.page_count;

    dfp$convert_list_pointer (p_cpu_queue_entry^.p_data_rma_list, p_rma_list);

    mmp$build_lock_rma_list (buffer_descriptor, buffer_descriptor.page_count * osv$page_size, ioc$allocate,
          p_rma_list, list_length, m_status);

    IF m_status.normal THEN

      p_cpu_queue_entry^.data_pages_locked := TRUE;

{     Set indirect list length in bytes for driver.

      p_driver_queue_entry^.data_descriptor.actual_length := list_length * 8;

{     Queue request for driver.

      dfp$queue_request (p_queue_interface_table, queue_index, queue_entry_index, queue_request_status);
      IF queue_request_status = dfc$qrs_entry_queued THEN

{       Increment read write count, and transaction_count.

        p_server_descriptor^.header.read_write_count := p_server_descriptor^.header.read_write_count + 1;
        p_cpu_queue_entry^.transaction_count := p_cpu_queue_entry^.transaction_count + 1;

        spio_status.normal := TRUE;
        spio_status.condition := 0;

      ELSE { Request buffer queue full, or server terminated.}

{       Restore entry state.

        io_error := ioc$no_error;
        mmp$unlock_rma_list (ioc$no_io, p_rma_list, list_length, io_id, {MF_JOB_FILE} FALSE,
              io_error, m_status);
        IF NOT m_status.normal THEN
          mtp$error_stop ('DF - bad status:   unlock_rma_list: DFP$FILE_SERVER_ALLOCATION');
        IFEND;

        p_driver_queue_entry^.flags.driver_action := FALSE;
        dfp$release_queue_entry (p_queue_interface_table, queue_index, queue_entry_index,
              release_queue_entry_status);
        IF release_queue_entry_status <> dfc$rqes_entry_released THEN
          mtp$error_stop ('DF - unable to release queue entry: DFP$FILE_SERVER_ALLOCATION');
        IFEND;

        spio_status.normal := FALSE;
        IF queue_request_status = dfc$qrs_server_terminated THEN

{       The file_server has terminated sometime between the call to DFP$ASSIGN_QUEUE_ENTRY and the call to
{       DFP$QUEUE_REQUEST.  Send an abnormal status back to the caller of this procedure.

          spio_status.condition := dfe$server_has_terminated;
        ELSE
          spio_status.condition := dme$transient_error;
        IFEND;

      IFEND; {queue request status}

    ELSE {mmp$build_lock_rma_list m_status NOT normal}

      mtp$error_stop ('Unexpected system failure: DFP$FILE_SERVER_ALLOCATION');

    IFEND; {build lock rma list status}

    IF sfv$dynamic_file_space_limits AND (file_space_limit <> sfc$no_limit) THEN
      sfp$mtr_accumulate_file_space (file_space_limit, (segment_length - segment_offset),
          space_limit_exceeded);
    IFEND;
    gfp$mtr_unlock_fde_p (p_fde);

  PROCEND dfp$file_server_allocation;
?? OLDTITLE, OLDTITLE ??
MODEND dfm$file_server_allocation;
