?? RIGHT := 110 ??
*copyc osd$default_pragmats
?? NEWTITLE := 'DISTRIBUTED FILES - CDCNET DRIVER', EJECT ??
MODULE dfm$cdcnet_driver;

{===========================================================================
{ DFM$CDCNET_DRIVER contains the code for both the CLIENT and the SERVER
{ drivers. Except for initialization and somewhat different processing of a
{ received message, the two drivers are identical and ascertain which end of
{ a line they are driving from the connection descriptor in the driver queue
{ header.
{ The two drivers communicate with each other  using the application
{ protocol over CDCNET connection(s). The number of connections in use
{ is defined by DFC$MAX_NUMBER_OF_QUEUES.
{
{ Internally, the following global tables are used: Queue_Interface_Table,
{ CPU_Queue, Driver_Queue, and Request_Buffer.
{===========================================================================


?? NEWTITLE := '   Global Declarations   ', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dfd$driver_queue_types
*copyc dfe$cdcnet_errors
*copyc amt$access_level
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc dft$cpu_queue
*copyc dft$queue_index
*copyc fst$file_reference
*copyc nat$application_name
*copyc nat$create_attributes
*copyc nat$data_fragments
*copyc nat$network_address
*copyc nat$protocol
*copyc nat$se_peer_operation
*copyc nat$title
*copyc nat$wait_time
*copyc ost$activity_status
*copyc ost$caller_identifier
*copyc ost$name
*copyc ost$status
*copyc ost$wait
*copyc pmt$mainframe_id
?? POP ??
*copyc amp$close
*copyc amp$open
*copyc amp$return
*copyc clp$get_value
*copyc clp$scan_parameter_list
*copyc dfp$process_task_request
*copyc dfp$set_driver_active
*copyc nap$acquire_connection
*copyc nap$attach_server_application
*copyc nap$await_server_response
*copyc nap$detach_server_application
*copyc nap$request_connection
*copyc nap$se_receive_data
*copyc nap$se_send_data
*copyc nlp$get_title_translation
*copyc nlp$translate_title
*copyc osp$set_status_abnormal
*copyc pmp$get_microsecond_clock
*copyc pmp$get_task_cp_time
*copyc pmp$ready_task
*copyc pmp$wait
*copyc dfv$file_server_debug_enabled
*copyc dfi$display
*copyc i#move
?? TITLE := 'DF Constants, Types, and Module-Wide Structures.', EJECT ??

  CONST

{****************************************************************************
{ The line below is to get a clean assembly - take it out.
{****************************************************************************
    dfc$page_size = 4096,
    dfc$cdcnet_max_pages_sendable = 4,
{****************************************************************************
{ The line above is to get a clean assembly - take it out.
{****************************************************************************

    dfc$net_connection_wait_time = 3600 * 1000,
    dfc$data_transfer_timeout = 3600 * 1000,
    dfc$server_maximum_connections = 2;

  CONST
    dfc$min_message_size = 7;

  CONST

    dfc$command_message = 'C',
    dfc$data_message = 'D',
    dfc$connection_idle = 'I';

  TYPE

    dft$connect_status = array [1 .. dfc$max_number_of_queues] of dft$connect_status_entry,

    dft$connect_status_entry = record
      network_file_id: amt$file_identifier,
      network_file_lfn: amt$local_file_name,
      case connection_established: boolean of
      = TRUE =
        network_error: boolean,
        receive_outstanding: boolean,
        wait_for_header: boolean,
        wait_for_buffer: boolean,
        wait_for_ready_for_data: boolean,
        wait_for_data: boolean,
        receive_activity: ost$activity_status,
        peer_action: nat$se_peer_operation,
        received_header: dft$message_header,
        in_message: dft$in_message_buffer,
        send_outstanding: 0 .. dfc$max_queue_entries,
        send_activity: ost$activity_status,
        send_header: dft$message_header,
        out_message: dft$out_message_buffer,
      = FALSE =
        ,
      casend,
    recend,

    dft$message_header = record
      message_type: char,
      entry: dft$queue_entry_index,
      command_length: dfc$min_message_size .. dfc$command_buffer_size,
      data_length: 0 .. dfc$cdcnet_max_pages_sendable * dfc$page_size,
    recend,

    dft$out_message_buffer = record
      head: nat$data_fragment,
      command: nat$data_fragment,
      data: nat$data_fragment,
    recend,

    dft$in_message_buffer = record
      frag1: nat$data_fragment,
      frag2: nat$data_fragment,
    recend;

?? TITLE := '    Global Variables    ', EJECT ??

?? NOCOMPILE ??

  VAR
    dfv$cdcnet_p_qit: [XDCL] dft$p_queue_interface_table := NIL,
    dfv$cdcnet_driver_name: [XDCL] ost$name := ' ',
    queue_status: [XDCL] dft$connect_status;

  VAR
    cdcnet_cycle_time: integer,
    cdcnet_total_time: integer;

?? COMPILE ??

?? TITLE := 'Execute_Driver', EJECT ??

  PROCEDURE [XDCL] dfp$execute_cdcnet_driver
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{  pdt execute_driver_pdt (status)

?? PUSH (LISTEXT := ON) ??

    VAR
      execute_driver_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^execute_driver_pdt_names, ^execute_driver_pdt_params];

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

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

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

?? POP ??

?? NOCOMPILE ??

    VAR
      caller_id: ost$caller_identifier,
      entry_index: dft$queue_entry_index,
      number_of_queue_entries: 1 .. dfc$max_queue_entries,
      p_cpu_queue_entry: ^dft$cpu_queue_entry,
      p_driver_queue: ^dft$driver_queue,
      p_driver_queue_entry: ^dft$driver_queue_entry,
      queue_index: dft$queue_index,
      server: boolean;

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

    #CALLER_ID (caller_id);
{ddddddddddddddddddddddddddddddddddddddddddd
    adisplay (' execute_cdcnet_driver ');
{ddddddddddddddddddddddddddddddddddddddddddd
    dfp$set_driver_active (dfv$cdcnet_driver_name, TRUE, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF caller_id.ring = 3 THEN
      {---------------------------------------------
      {The driver is running in hands-on environment
      {---------------------------------------------
      WHILE TRUE DO
        cdcnet_driver (caller_id, dfv$cdcnet_p_qit, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        pmp$wait (500, 500);
      WHILEND;

    ELSE
      {------------------------------------------------
      {The driver is running in Closed-Shop environment
      {------------------------------------------------
      cdcnet_driver (caller_id, dfv$cdcnet_p_qit, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      FOR queue_index := 1 TO dfc$max_number_of_queues DO
        IF queue_status [queue_index].connection_established THEN
          p_driver_queue := dfv$cdcnet_p_qit^.queue_directory.driver_queue_pva_directory [queue_index].
                p_driver_queue;
          server := p_driver_queue^.queue_header.connection_descriptor.source.flags.server_to_client;
          IF server THEN
            number_of_queue_entries := dfv$cdcnet_p_qit^.queue_directory.
                  cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_header.
                  number_of_task_queue_entries + dfv$cdcnet_p_qit^.queue_directory.
                  cpu_queue_pva_directory [queue_index].p_cpu_queue^.queue_header.
                  number_of_monitor_queue_entries;

            FOR entry_index := 1 TO number_of_queue_entries DO
              p_driver_queue_entry := ^p_driver_queue^.queue_entries [entry_index];
              IF p_driver_queue_entry^.flags.subsystem_action THEN
                p_cpu_queue_entry := ^dfv$cdcnet_p_qit^.queue_directory.cpu_queue_pva_directory [queue_index].
                      p_cpu_queue^.queue_entries [entry_index];
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd
                adisplay ('Calling PROCESS_TASK_REQUEST');
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd
                dfp$process_task_request (dfv$cdcnet_p_qit, queue_index, entry_index, p_driver_queue_entry,
                      p_cpu_queue_entry, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;
              IFEND;
            FOREND;
          IFEND;

        IFEND;
      FOREND;

    IFEND;
?? COMPILE ??
  PROCEND dfp$execute_cdcnet_driver;
?? NOCOMPILE ??
?? TITLE := 'CDCNET Driver', EJECT ??

  PROCEDURE cdcnet_driver
    (    caller_id: ost$caller_identifier;
     VAR p_queue_interface_table: {^input/^output} dft$p_queue_interface_table;
     VAR status: ost$status);

    VAR
      cycle_end: pmt$task_cp_time,
      cycle_start: pmt$task_cp_time,
      driver_cycles: integer,
      p_driver_queue: ^dft$driver_queue,
      queue: dft$queue_index,
      receive_total: integer,
      send_total: integer,
      server: boolean;

    cdcnet_cycle_time := 0;
    driver_cycles := 0;
    receive_total := 0;
    send_total := 0;

    status.normal := TRUE;
    pmp$get_task_cp_time (cycle_start, status);
    receive_messages (caller_id, p_queue_interface_table, queue_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$get_task_cp_time (cycle_end, status);
    receive_total := receive_total + (cycle_end.task_time - cycle_start.task_time);

    pmp$get_task_cp_time (cycle_start, status);
    examine_request_buffer (caller_id, p_queue_interface_table, queue_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$get_task_cp_time (cycle_end, status);
    send_total := send_total + (cycle_end.task_time - cycle_start.task_time);
    driver_cycles := driver_cycles + 1;
    cdcnet_total_time := cdcnet_total_time + cdcnet_cycle_time;
    IF dfv$file_server_debug_enabled THEN
      adisplay_integer ('Driver_Cycles =', driver_cycles);
      adisplay_integer ('Avg. SEND time = ', send_total DIV driver_cycles);
      adisplay_integer ('Avg. RECEIVE time = ', receive_total DIV driver_cycles);
      adisplay_integer ('CDCNET cycle time (microsecs)=', cdcnet_cycle_time);
    IFEND;

  PROCEND cdcnet_driver;
?? COMPILE ??
?? TITLE := 'End_client', EJECT ??

  PROCEDURE [XDCL] dfp$end_client
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{    pdt end_client_pdt (client_queue_index, cqi: integer 1 .. 8 = 1
{                          status)

?? PUSH (LISTEXT := ON) ??

    VAR
      end_client_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^end_client_pdt_names, ^end_client_pdt_params];

    VAR
      end_client_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['CLIENT_QUEUE_INDEX', 1], ['CQI', 1], ['STATUS', 2]];

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

{ CLIENT_QUEUE_INDEX CQI }
      [[clc$optional_with_default, ^end_client_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$integer_value, 1, 8]],

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

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

?? POP ??

    VAR
      length: integer,
      lfn: amt$local_file_name,
      pfn: amt$file_identifier,
      queue_index: dft$queue_index,
      value: clt$value;

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

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

    queue_index := value.int.value;
?? NOCOMPILE ??
    lfn := queue_status [queue_index].network_file_lfn;
    pfn := queue_status [queue_index].network_file_id;
    terminate_connection (pfn, lfn, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    queue_status [queue_index].connection_established := FALSE;
?? COMPILE ??
  PROCEND dfp$end_client;

?? TITLE := 'End_Server', EJECT ??

  PROCEDURE [XDCL] dfp$end_server
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);


{   pdt end_server_pdt (server_queue_index, sqi: integer 1 .. 8 = 1
{                             status)

?? PUSH (LISTEXT := ON) ??

    VAR
      end_server_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
            [^end_server_pdt_names, ^end_server_pdt_params];

    VAR
      end_server_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
            clt$parameter_name_descriptor := [['SERVER_QUEUE_INDEX', 1], ['SQI', 1], ['STATUS', 2]];

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

{ SERVER_QUEUE_INDEX SQI }
      [[clc$optional_with_default, ^end_server_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed,
            [NIL, clc$integer_value, 1, 8]],

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

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

?? POP ??
?? NOCOMPILE ??

    VAR
      length: integer,
      lfn: amt$local_file_name,
      pfn: amt$file_identifier,
      queue_index: dft$queue_index,
      server: ost$name,
      value: clt$value,
      working_string: string (15);

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

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

    queue_index := value.int.value;
    working_string := '';
    STRINGREP (working_string, length, 'DF_SERVER', queue_index);
    server := working_string;
    server (10) := '_';

    lfn := queue_status [queue_index].network_file_lfn;
    pfn := queue_status [queue_index].network_file_id;
    terminate_connection (pfn, lfn, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    terminate_server (server, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    queue_status [queue_index].connection_established := FALSE;
?? COMPILE ??
  PROCEND dfp$end_server;

?? TITLE := 'Start_CDCNET_Client', EJECT ??

  PROCEDURE [XDCL] dfp$start_cdcnet_client
    (    p_queue_interface_table: dft$p_queue_interface_table;
         driver_name: ost$name;
         destination_mainframe: pmt$mainframe_id;
         queue_index: dft$queue_index;
     VAR status: ost$status);

?? NOCOMPILE ??

    VAR
      client: ost$name,
      length: integer,
      lfn: amt$local_file_name,
      pfn: amt$file_identifier,
      server: nat$title,
      working_string: string (15);

{ddddddddddddddddddddddddddddddddddddddddddddddddddd
    display (' --- dfp$start_cdcnet_client ');
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
    dfv$cdcnet_p_qit := p_queue_interface_table;
    dfv$cdcnet_driver_name := driver_name;
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
    display (dfv$cdcnet_driver_name);
    adisplay (destination_mainframe);
    display_pva (' queue interface table ', p_queue_interface_table);
    adisplay_integer (' queue index ', queue_index);
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
    working_string := '';
    STRINGREP (working_string, length, 'DF_SERVER', queue_index);
    server := working_string;
    server (10) := '_';

    working_string := '';
    STRINGREP (working_string, length, 'DF_CLIENT', queue_index);
    client := working_string;
    client (10) := '_';

    working_string := '';
    STRINGREP (working_string, length, 'DFF$', destination_mainframe (9, 9), queue_index);
    working_string (14) := '_';
    lfn := working_string;

    queue_status [queue_index].network_file_lfn := lfn;
    initiate_client (client, server, lfn, pfn, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    queue_status [queue_index].network_file_id := pfn;
    queue_status [queue_index].connection_established := TRUE;
    queue_status [queue_index].receive_outstanding := FALSE;
    queue_status [queue_index].send_outstanding := 0;
    queue_status [queue_index].network_error := FALSE;
    queue_status [queue_index].wait_for_header := FALSE;
    queue_status [queue_index].wait_for_buffer := FALSE;
    queue_status [queue_index].wait_for_data := FALSE;
    cdcnet_total_time := 0;
?? COMPILE ??
  PROCEND dfp$start_cdcnet_client;

?? TITLE := 'Start_CDCNET_Server', EJECT ??

  PROCEDURE [XDCL] dfp$start_cdcnet_server
    (    p_queue_interface_table: dft$p_queue_interface_table;
         driver_name: ost$name;
         destination_mainframe: pmt$mainframe_id;
         queue_index: dft$queue_index;
     VAR status: ost$status);

?? NOCOMPILE ??

    VAR
      length: integer,
      lfn: amt$local_file_name,
      pfn: amt$file_identifier,
      server: ost$name,
      working_string: string (15);

{ddddddddddddddddddddddddddddddddddddddddddddddddddddddd
    display (' ---- dfp$start_cdcnet_server ');
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddd
    dfv$cdcnet_p_qit := p_queue_interface_table;
    dfv$cdcnet_driver_name := driver_name;
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddd
    display (dfv$cdcnet_driver_name);
    adisplay (destination_mainframe);
    display_pva (' queue interface table ', p_queue_interface_table);
    adisplay_integer (' queue index ', queue_index);
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddd
    working_string := '';
    STRINGREP (working_string, length, 'DF_SERVER', queue_index);
    server := working_string;
    server (10) := '_';

    working_string := '';
    STRINGREP (working_string, length, 'DFF$', destination_mainframe (9, 9), queue_index);
    lfn := working_string;
    lfn (14) := '_';
    queue_status [queue_index].network_file_lfn := lfn;

    initiate_server (server, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_client_connection (server, lfn, pfn, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    queue_status [queue_index].network_file_id := pfn;
    queue_status [queue_index].connection_established := TRUE;
    queue_status [queue_index].receive_outstanding := FALSE;
    queue_status [queue_index].send_outstanding := 0;
    queue_status [queue_index].network_error := FALSE;
    queue_status [queue_index].wait_for_header := FALSE;
    queue_status [queue_index].wait_for_buffer := FALSE;
    queue_status [queue_index].wait_for_data := FALSE;
    cdcnet_total_time := 0;
?? COMPILE ??
  PROCEND dfp$start_cdcnet_server;
?? NOCOMPILE ??
?? TITLE := 'Get_Client_Connection', EJECT ??

  PROCEDURE get_client_connection
    (    server_name: ost$name;
         network_file_lfn: amt$local_file_name;
     VAR network_file_id: amt$file_identifier;
     VAR status: ost$status);

    VAR
      network_file_attribute: array [1 .. 1] of nat$create_attribute,
      network_file_attributes: ^nat$create_attributes,
      network_protocol: nat$protocol,
      network_wait: nat$wait_time;

    network_file_attribute [1].kind := nac$data_transfer_timeout;
    network_file_attribute [1].data_transfer_timeout := dfc$data_transfer_timeout;
    network_file_attributes := ^network_file_attribute;
    network_wait := dfc$net_connection_wait_time;
    nap$acquire_connection (server_name, network_file_lfn, network_file_attributes, network_wait, status);
    IF NOT status.normal THEN
      display ('Abnormal Status from ACQUIRE_CONNECTION.');
      display_status (status);
      RETURN;
    IFEND;
    display ('Connection Acquired - no problem.');

{==============================================================================
{ NOTE: NAP$ACCEPT_CONNECTION is not executed for now because the Distributed
{ Files Server is set up so that the network accepts the connection on behalf
{ of the application. This setup is defined in the Server's application
{ definition file by the network application administrator.
{
{ nap$accept_connection (network_file_lfn, status);
{  IF NOT status.normal THEN
{    display ('Abnormal Status from ACCEPT_CONNECTION.');
{    display_status (status);
{    RETURN;
{  IFEND;
{==============================================================================

    amp$open (network_file_lfn, {access_level=} amc$record, {access_selections=} NIL, network_file_id,
          status);
    IF NOT status.normal THEN
      display ('Abnormal Status from OPEN_FILE.');
      display_status (status);
      RETURN;
    IFEND;

  PROCEND get_client_connection;

?? TITLE := 'Initiate_Client', EJECT ??

  PROCEDURE initiate_client
    (    client: ost$name;
         server_title: nat$title;
         network_file_lfn: amt$local_file_name;
     VAR network_file_id: amt$file_identifier;
     VAR status: ost$status);

{==============================================================================
{ This PROC establishes a single connection to the DFServer. Status indicates
{ whether or not the connection was established.
{==============================================================================

    VAR
      activity_status: ost$activity_status,
      address: nat$translation_address,
      identifier: nat$directory_entry_identifier,
      network_file_attribute: array [1 .. 1] of nat$create_attribute,
      network_file_attributes: ^nat$create_attributes,
      network_protocol: nat$protocol,
      network_wait: nat$wait_time,
      priority: nat$directory_priority,
      protocol_service: nat$service,
      request_id: nat$translation_request_id,
      search_domain: nat$title_domain,
      selected_access: amt$file_access_selections,
      server_location: nat$network_address,
      server_title_returned: nat$title,
      title_class: nat$title_class,
      user_info_length: 0 .. nac$max_user_info;

    status.normal := TRUE;
    protocol_service := nac$session;
    search_domain.kind := nac$catenet_domain;
    title_class := nac$cdna_external;
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddd
    adisplay (' ----- initiate_client, s title, client ');
    display (server_title);
    adisplay (client);
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddd

    nlp$translate_title (server_title, {wild_card=} FALSE, protocol_service, {recurrent_search=} FALSE,
          search_domain, title_class, request_id, status);
    IF NOT status.normal THEN
      display ('Abnormal Status from TRANSLATE_TITLE.');
      display_status (status);
      RETURN;
    IFEND;

    priority := 1;
    protocol_service := nac$service_unknown;
    server_title_returned := '';
    status.normal := TRUE;
    user_info_length := 0;
    nlp$get_title_translation (request_id, server_title_returned, address, protocol_service,
          {user_information=} NIL, user_info_length, priority, identifier, status);
    IF NOT status.normal THEN
      display ('Abnormal Status from GET_TITLE_TRANSLATION.');
      display_status (status);
      RETURN;
    IFEND;

    network_file_attribute [1].kind := nac$data_transfer_timeout;
    network_file_attribute [1].data_transfer_timeout := dfc$data_transfer_timeout;
    network_file_attributes := ^network_file_attribute;
    network_protocol := nac$cdna_session;
    server_location.kind := nac$internet_address;
    server_location.internet_address := address.internet;
    nap$request_connection (server_location, client, network_file_lfn, network_protocol,
          network_file_attributes, {wait_time=} 0, status);
    IF NOT status.normal THEN
      display ('Abnormal Status from REQUEST_CONNECTION.');
      display_status (status);
      RETURN;
    IFEND;
    nap$await_server_response (network_file_lfn, dfc$net_connection_wait_time, status);

    IF NOT status.normal THEN
      display ('Abnormal Status from AWAIT_SERVER_RESPONSE.');
      display_status (status);
      RETURN;

    ELSE
      amp$open (network_file_lfn, {access_level=} amc$record, {access_selections=} NIL, network_file_id,
            status);
      IF NOT status.normal THEN
        display ('Abnormal Status from OPEN_FILE.');
        display_status (status);
        RETURN;
      IFEND;
    IFEND;

  PROCEND initiate_client;

?? TITLE := 'Initiate_Server', EJECT ??

  PROCEDURE initiate_server
    (    server_name: ost$name;
     VAR status: ost$status);

{==============================================================================
{ This PROC activates the DFServer on the CDCNET network. It is issued once
{ per Server job. Status indicates whether or not the SERVER application was
{ attached.
{==============================================================================

    nap$attach_server_application (server_name, dfc$server_maximum_connections, status);
    IF NOT status.normal THEN
      display ('Abnormal Status from ATTACH_SERVER_APPLICATION.');
      display_status (status);
    IFEND;
  PROCEND initiate_server;

?? TITLE := 'Terminate_Connection', EJECT ??

  PROCEDURE terminate_connection
    (    network_file_id: amt$file_identifier;
         network_file_lfn: amt$local_file_name;
     VAR status: ost$status);

{=============================================================================
{ TERMINATE_CONNECTION closes and returns the network file associated with a
{ single connection.
{=============================================================================

    amp$close (network_file_id, status);
    IF NOT status.normal THEN
      display ('Abnormal status from AMP$CLOSE.');
      RETURN;
    IFEND;

    amp$return (network_file_lfn, status);
    IF NOT status.normal THEN
      display ('Abnormal status from AMP$RETURN.');
      RETURN;
    IFEND;

  PROCEND terminate_connection;

?? TITLE := 'Terminate_Server', EJECT ??

  PROCEDURE terminate_server
    (    server_name: ost$name;
     VAR status: ost$status);

{=============================================================================
{ TERMINATE_SERVER detaches the job from the Server application indicated in
{ the input parameter.
{=============================================================================

    nap$detach_server_application (server_name, status);
    IF NOT status.normal THEN
      display ('Abnormal status from DETACH_SERVER_APPLICATION.');
      display_status (status);
    IFEND;

  PROCEND terminate_server;

?? TITLE := 'Receive_Messages', EJECT ??

  PROCEDURE receive_messages
    (    caller_id: ost$caller_identifier;
     VAR p_queue_interface_table: {^input/^output} dft$p_queue_interface_table;
     VAR queue_status: {input/output} dft$connect_status;
     VAR status: ost$status);

{==============================================================================
{ This PROC attempts to receive messages from all Servers/Clients.
{ No attempt is made to issue a receive message request on a connection which
{ already has such request pending and not yet completed.
{ One or two calls are made for each potential message: one (with a small
{ buffer) to receive the message header (which is processed within the
{ driver), and to receive the command buffer (present in every message). If the
{ message includes data page(s) and the data buffer has been pre-allocated then
{ it is also obtained. If the data buffer has not been allocated then completion
{ of the receive request is delayed until the data buffer becomes available.
{
{ The message header is part of the protocol of the two drivers. It is created
{ by one driver and decoded by the other. It is never seen by other Distributed
{ Files tasks. The balance of the message (the command and data) is ultimately
{ received by the other Distributed Files tasks.
{===========================================================================

    VAR
      cdcnet_wait: ost$wait,
      end_of_message: boolean,
      end_time: pmt$task_cp_time,
      entry: dft$queue_entry_index,
      p_buffer: dft$p_command_buffer,
      p_cpu_queue: ^dft$cpu_queue,
      p_data: dft$p_data_area,
      p_driver_queue: ^dft$driver_queue,
      p_flags: ^dft$queue_entry_flags,
      p_queue_status: ^dft$connect_status_entry,
      prealloc_data_buffer: boolean,
      queue: dft$queue_index,
      server: boolean,
{dddddddddddddddddddddddddddddddddddddddddddddd
      dummy: integer,
{dddddddddddddddddddddddddddddddddddddddddddddd
      start_time: pmt$task_cp_time;

    status.normal := TRUE;
    FOR queue := 1 TO dfc$max_number_of_queues DO

      IF queue_status [queue].connection_established AND NOT queue_status [queue].network_error THEN
        p_queue_status := ^queue_status [queue];
        IF p_queue_status^.receive_outstanding THEN
          check_received_status (p_queue_status, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF NOT queue_status [queue].receive_outstanding THEN
{           --------------------------------------------------------
{           Previously issued receive_request has just completed.
{           Set pointer to a specific connection and examine header.
{           --------------------------------------------------------
            p_cpu_queue := p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue].
                  p_cpu_queue;
            p_driver_queue := p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue].
                  p_driver_queue;
            validate_received_header (p_queue_status, p_driver_queue^.queue_header.number_of_queue_entries,
                  entry, status);

            IF status.normal THEN
{             ---------------------------------------------------------------
{             Set pointers to the queue entry for this connection. Validate
{             flags if appropriate for the received message and read the rest
{             of the message. Set flags to reflect the message just received.
{             ---------------------------------------------------------------
              p_flags := ^p_driver_queue^.queue_entries [entry].flags;
              p_buffer := p_cpu_queue^.queue_entries [entry].p_receive_buffer;
              p_data := p_cpu_queue^.queue_entries [entry].p_data_area;
              prealloc_data_buffer := (p_driver_queue^.queue_entries [entry].data_descriptor.actual_length <>
                    0);
              server := p_driver_queue^.queue_header.connection_descriptor.source.flags.server_to_client;
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
              IF dfv$cdcnet_debug_enabled THEN
                adisplay ('RECEIVE BEFORE process_received_msg');
                adisplay_integer ('Entry =', entry);
                adisplay_bytes ('Flags = ', p_flags, 2);
                adisplay_header ('Received Header=', p_queue_status^.received_header);
                adisplay_boolean ('Wait_for_header =', p_queue_status^.wait_for_header);
                adisplay_boolean ('Wait_for_ready =', p_queue_status^.wait_for_ready_for_data);
                adisplay_boolean ('Receive_Outstan =', p_queue_status^.receive_outstanding);
              IFEND;
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd
              process_received_message (p_buffer, p_data, prealloc_data_buffer, p_flags, p_queue_status,
                    server, status);
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
              IF dfv$cdcnet_debug_enabled THEN
                adisplay ('RECEIVE AFTER process_received_message');
                adisplay_bytes ('Flags = ', p_flags, 2);
                adisplay_boolean ('Wait_for_header =', p_queue_status^.wait_for_header);
                adisplay_boolean ('Wait_for_ready =', p_queue_status^.wait_for_ready_for_data);
                adisplay_boolean ('Receive_Outstan =', p_queue_status^.receive_outstanding);
              IFEND;
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
              IF NOT status.normal THEN
                RETURN;
              IFEND;
              IF p_flags^.subsystem_action AND (caller_id.ring = 3) THEN
{               -----------------------------------------------------------
{               Subsystem_action set in the hands-on environment - activate
{               caller.
{               -----------------------------------------------------------
                pmp$ready_task (p_cpu_queue^.queue_entries [entry].global_task_id, status);
                IF NOT status.normal THEN
                  display ('Abnormal status from pmp$ready_task.');
                  display_status (status);
                  RETURN;
                IFEND;
              IFEND;

            ELSE
              RETURN;
            IFEND;
          IFEND;
        IFEND;

        IF NOT p_queue_status^.receive_outstanding THEN
{         -----------------------------------------------------------------
{         This connection did not have 'receive request' pending or it may
{         have finished processing a just received message. Issue receive
{         request, with the message area for the header only.
{         -----------------------------------------------------------------
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
          IF dfv$cdcnet_debug_enabled THEN
            adisplay ('ISSUE RECEIVE - none outstanding');
            adisplay_bytes ('Flags = ', p_flags, 2);
            adisplay_boolean ('Wait_for_header =', p_queue_status^.wait_for_header);
            adisplay_boolean ('Wait_for_ready =', p_queue_status^.wait_for_ready_for_data);
          IFEND;
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
          p_queue_status^.in_message.frag1.address := ^p_queue_status^.received_header;
          p_queue_status^.in_message.frag1.length := #SIZE (p_queue_status^.received_header);
          p_queue_status^.in_message.frag2.address := NIL;
          p_queue_status^.in_message.frag2.length := 0;
          p_queue_status^.wait_for_header := TRUE;
          cdcnet_wait := osc$nowait;
          issue_receive_request (p_queue_status, cdcnet_wait, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        IFEND;
      IFEND;

    FOREND;

  PROCEND receive_messages;

?? TITLE := 'Check_Received_Length', EJECT ??

  PROCEDURE check_received_length
    (    received_header: dft$message_header;
         data_length: nat$data_length;
         peer_action: nat$se_peer_operation;
     VAR status: ost$status);

{==============================================================================
{ This PROC is called after the last fragment of the message has been received.
{ When only the command has been received then its length and the expected
{ length are compared.
{ If both the command and the data has been received then the comparison is
{ made of the expected and the actual lengths of the received{ data only (not
{ of the command). The Status is set to FALSE (via{ Set_Connection_Error) if
{ the two lengths do not match.
{ If the network did not set 'end_of message' when the data fragment was
{ received then the allocated area was not sufficient to hold the entire data
{ and the tail end of the message is still being held by the network. Something
{ went wrong either at the receiving or the sending end of the driver.
{=============================================================================

    status.normal := TRUE;
    IF peer_action.end_of_message THEN
      IF (received_header.message_type = dfc$command_message) THEN
        IF NOT (data_length = peer_action.data_length) THEN
          display ('Length of Received Command Does Not Match Length in Header.');
          set_connection_error (dfe$peer_error, {receive=} TRUE, status);
        IFEND;

      ELSE
        IF NOT (data_length = peer_action.data_length) THEN
          display ('Length of Received Data Does Not Match Length in Header.');
          set_connection_error (dfe$peer_error, {receive=} TRUE, status);
        IFEND;
      IFEND;

    ELSE
      display ('Data Buffer not Sufficient to Hold Received Message');
      set_connection_error (dfe$peer_error, {receive=} TRUE, status);
{     -----------------------------------------------------------------
{     Something must be done here with the part of the message still in
{     the network.
{     -----------------------------------------------------------------
    IFEND;

  PROCEND check_received_length;

?? TITLE := 'Check_Received_Status', EJECT ??

  PROCEDURE check_received_status
    (    p_queue_status: {^input/^output} ^dft$connect_status_entry;
     VAR status: ost$status);

{=============================================================================
{ This subroutine checks the activity status and the peer operation associated
{ with the received message.
{
{ Message Length returned by the network is not used currently.
{=============================================================================

    status.normal := TRUE;
    IF p_queue_status^.receive_activity.complete THEN
      p_queue_status^.receive_outstanding := FALSE;

      IF NOT p_queue_status^.receive_activity.status.normal THEN
        display ('Abnormal status from RECEIVE_ACTIVITY_STATUS');
        status := p_queue_status^.receive_activity.status;
        display_status (status);
        p_queue_status^.network_error := TRUE;
        RETURN;
      IFEND;

      CASE p_queue_status^.peer_action.kind OF
      = nac$se_send_data =

        IF p_queue_status^.peer_action.qualified_data THEN
          display ('Received QUALIFIED_DATA From the Peer.');
          set_connection_error (dfe$peer_error, {receive=} TRUE, status);
        IFEND;

{****************************************************************************
{ Next 3 lines - Temporary patch to get by CDCNET bug - should be taken out.
{****************************************************************************
        IF p_queue_status^.peer_action.end_of_message AND (p_queue_status^.peer_action.data_length = 3) THEN
          p_queue_status^.peer_action.end_of_message := FALSE;
        IFEND;
{****************************************************************************
{ Above 3 lines - Temporary patch to get by CDCNET bug - should be taken out.
{****************************************************************************

      ELSE
        display ('Peer_Action Other Than NAC$SE_Send_Data.');
        set_connection_error (dfe$peer_error, {receive=} TRUE, status);
      CASEND;

    ELSE
      p_queue_status^.receive_outstanding := TRUE;
      RETURN;

    IFEND;
  PROCEND check_received_status;

?? TITLE := 'Issue_Receive_Request', EJECT ??

  PROCEDURE issue_receive_request
    (    p_queue_status: {^output} ^dft$connect_status_entry;
         cdcnet_wait: ost$wait;
     VAR status: ost$status);

{==========================================================================
{ This PROC issues a 'receive_data' request to the network. The size of the
{ buffer passed to this PROC will determine whether a partial message
{ (header) or the rest (non-header) message is eventually received received
{ from the peer.
{==========================================================================

    VAR
      in_message_p: ^nat$data_fragments;

    VAR
      end_time: pmt$task_cp_time,
      start_time: pmt$task_cp_time;

    PUSH in_message_p: [1 .. 2];
    in_message_p^ [1] := p_queue_status^.in_message.frag1;
    in_message_p^ [2] := p_queue_status^.in_message.frag2;

    pmp$get_task_cp_time (start_time, status);
    nap$se_receive_data (p_queue_status^.network_file_id, in_message_p^, cdcnet_wait,
          p_queue_status^.peer_action, p_queue_status^.receive_activity, status);
    pmp$get_task_cp_time (end_time, status);
    cdcnet_cycle_time := cdcnet_cycle_time + (end_time.task_time - start_time.task_time);

    p_queue_status^.receive_outstanding := TRUE;
    IF NOT status.normal THEN
      display ('Abnormal status from ISSUE_RECEIVE_REQUEST');
      p_queue_status^.network_error := TRUE;
    IFEND;
  PROCEND issue_receive_request;

?? TITLE := 'Process_Received_Message', EJECT ??

  PROCEDURE process_received_message
    (    p_buffer: dft$p_command_buffer;
         p_data: dft$p_data_area;
         prealloc_data_buffer: boolean;
         p_flags: {^input/^output} ^dft$queue_entry_flags;
         p_queue_status: {^output} ^dft$connect_status_entry;
         server: boolean;
     VAR status: ost$status);

{=============================================================================
{ This PROC makes certain that the flags within the driver's entry 'expect'
{ the type of message that is being received, then the balance of the message
{ (command and/or data messages) is read. Some length checking is performed.
{=============================================================================

    VAR
      cdcnet_wait: ost$wait,
      data_length: nat$data_length,
      received_header: dft$message_header,
      peer_action: nat$se_peer_operation,
      in_message: dft$in_message_buffer;

{   -----------------------------------------------
{   Check if the message is for a legitimate entry.
{   -----------------------------------------------
    IF NOT p_flags^.active_entry THEN
      display ('Message received for inactive entry.');
      set_connection_error (dfe$peer_error, {receive=} TRUE, status);
      set_queue_error_flags (p_flags);
      RETURN;
    IFEND;
    CASE p_queue_status^.received_header.message_type OF
    = dfc$data_message =
      IF p_flags^.data_received THEN
        display ('Duplicate Data Message Received');
        set_connection_error (dfe$peer_error, {receive=} TRUE, status);
        set_queue_error_flags (p_flags);
        RETURN;
      IFEND;

      IF p_queue_status^.wait_for_header THEN
{       ----------------------------------------------------------------------
{       Both Client and Server have the command area preassigned so immediate
{       request for the command can be issued on either mainframe.
{
{       IF SERVER: Set the receiving area address for the command buffer only
{                  and set WAIT_FOR_READY_FOR_DATA flag.
{       IF CLIENT:
{          IF data area is preallocated:
{                Set to receive command AND data, finish the RECEIVE processing.
{          ELSEIF data area is not preallocated:
{                Set the receiving area address for the command buffer only
{                and set WAIT_FOR_READY_FOR_DATA.
{       -----------------------------------------------------------
        p_queue_status^.wait_for_header := FALSE;
        p_queue_status^.in_message.frag1.address := p_buffer;
        p_queue_status^.in_message.frag1.length := p_queue_status^.received_header.command_length;
        IF server OR (NOT server AND NOT prealloc_data_buffer) THEN
          p_queue_status^.wait_for_ready_for_data := TRUE;
          cdcnet_wait := osc$nowait;

        ELSE
          p_queue_status^.in_message.frag2.address := p_data;
          p_queue_status^.in_message.frag2.length := p_queue_status^.received_header.data_length;
          cdcnet_wait := osc$wait;
        IFEND;

        issue_receive_request (p_queue_status, cdcnet_wait, status);
        IF NOT status.normal THEN
          set_queue_error_flags (p_flags);
          RETURN;
        IFEND;
        check_received_status (p_queue_status, status);
        IF status.normal THEN
          IF p_queue_status^.receive_outstanding THEN
            display ('ERROR - Receive_Outstanding for BUFFER/DATA.');
            set_queue_error_flags (p_flags);
            RETURN;
          IFEND;
        ELSE
          RETURN;
        IFEND;

        IF p_queue_status^.wait_for_ready_for_data THEN
          p_queue_status^.receive_outstanding := TRUE;
        ELSE
          data_length := p_queue_status^.in_message.frag1.length + p_queue_status^.in_message.frag2.length;
          check_received_length (p_queue_status^.received_header, data_length, p_queue_status^.peer_action,
                status);
          p_flags^.data_received := TRUE;
{RRRRRRRRRRRrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
{ Try taking out Setting buffer_sent and data_sent in the two lines below
{RRRRRRRRRRRrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
          p_flags^.buffer_sent := FALSE;
          p_flags^.data_sent := FALSE;
        IFEND;
        p_flags^.buffer_received := TRUE;
        p_flags^.subsystem_action := TRUE;
        p_flags^.driver_action := FALSE;

      ELSEIF p_queue_status^.wait_for_ready_for_data THEN
{       ---------------------------------------------------------------
{       IF READY_FOR_DATA_SENT is set then get rest of data from the
{       network. Otherwise, keep 'receive_outstanding' = TRUE.
{       ---------------------------------------------------------------
        IF p_flags^.ready_for_data_sent THEN
          p_queue_status^.wait_for_ready_for_data := FALSE;
          p_queue_status^.in_message.frag1.address := p_data;
          p_queue_status^.in_message.frag1.length := p_queue_status^.received_header.data_length;
          cdcnet_wait := osc$wait;
          issue_receive_request (p_queue_status, cdcnet_wait, status);
          IF NOT status.normal THEN
            set_queue_error_flags (p_flags);
            RETURN;
          IFEND;
          check_received_status (p_queue_status, status);
          IF status.normal THEN
            IF p_queue_status^.receive_outstanding THEN
              display ('ERROR - Receive_Outstanding for DATA.');
              set_queue_error_flags (p_flags);
              RETURN;
            IFEND;
          ELSE
            RETURN;
          IFEND;

          p_flags^.data_received := TRUE;
          data_length := p_queue_status^.in_message.frag1.length;
          check_received_length (p_queue_status^.received_header, data_length, p_queue_status^.peer_action,
                status);
          p_flags^.subsystem_action := TRUE;
          p_flags^.driver_action := FALSE;
        ELSE
          p_queue_status^.receive_outstanding := TRUE;
          RETURN;
        IFEND;

      ELSE
        display ('Illogical Setting of Queue_Status Wait Flags');
        set_connection_error (dfe$program_logic_error, {receive=} TRUE, status);
        set_queue_error_flags (p_flags);
      IFEND;

    = dfc$command_message =
      IF server OR (NOT server AND p_flags^.buffer_sent) THEN
{       ----------------------------------------------------------------------
{       Set the receiving area address for the coming buffer, get the buffer,
{       check its length, and set the appropriate flags in the DRIVER QUEUE.
{       ----------------------------------------------------------------------
        IF p_queue_status^.wait_for_header THEN
          p_queue_status^.in_message.frag1.address := p_buffer;
          p_queue_status^.in_message.frag1.length := p_queue_status^.received_header.command_length;
          p_queue_status^.wait_for_header := FALSE;
          cdcnet_wait := osc$nowait;
          issue_receive_request (p_queue_status, cdcnet_wait, status);
          IF NOT status.normal THEN
            set_queue_error_flags (p_flags);
          IFEND;
          check_received_status (p_queue_status, status);
          IF status.normal THEN
            IF p_queue_status^.receive_outstanding THEN
              display ('ERROR - Receive_Outstanding for BUFFER.');
              set_queue_error_flags (p_flags);
              RETURN;
            IFEND;
          ELSE
            RETURN;
          IFEND;

{RRRRRRRRRRRrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
{ Try taking out Setting buffer_sent and data_sent in the code below
{RRRRRRRRRRRrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr
          p_flags^.buffer_received := TRUE;
          p_flags^.buffer_sent := FALSE;
          p_flags^.data_sent := FALSE;
          p_flags^.subsystem_action := TRUE;
          p_flags^.driver_action := FALSE;
          check_received_length (p_queue_status^.received_header, p_queue_status^.in_message.frag1.length,
                p_queue_status^.peer_action, status);

        ELSE
          display ('Illogical Setting of Queue_Status Wait Flags');
          set_connection_error (dfe$program_logic_error, {receive=} TRUE, status);
          set_queue_error_flags (p_flags);
        IFEND;

      ELSE
        display ('Unsolicited Buffer Received From Server');
        set_connection_error (dfe$peer_error, {receive=} TRUE, status);
        set_queue_error_flags (p_flags);
      IFEND;

    = dfc$connection_idle =
{     -------------------------------------------
{     Processing here will be decided upon later.
{     -------------------------------------------
      RETURN;

    ELSE
      display ('Received Unidentified Message Header.');
      set_connection_error (dfe$peer_error, {receive=} TRUE, status);
    CASEND;

  PROCEND process_received_message;

?? TITLE := 'Validate_Received_Header', EJECT ??

  PROCEDURE validate_received_header
    (    p_queue_status: ^dft$connect_status_entry;
         number_of_entries: 0 .. 0FFFF(16);
     VAR entry: dft$queue_entry_index;
     VAR status: ost$status);

{=========================================================================
{ This PROC validates the header of the message received from the peer for
{ the correctness of the message type and size. It also verifies that the
{ end of message indicator is set only for the prompt-type message.
{=========================================================================

    IF NOT ((p_queue_status^.received_header.message_type = dfc$command_message) OR
          (p_queue_status^.received_header.message_type = dfc$data_message) OR
          (p_queue_status^.received_header.message_type = dfc$connection_idle)) THEN
      display ('Unidentified message type in received header.');
      set_connection_error (dfe$peer_error, {receive=} TRUE, status);
      RETURN;
    IFEND;

    IF (p_queue_status^.received_header.message_type = dfc$connection_idle) AND
          NOT p_queue_status^.peer_action.end_of_message THEN
      display ('Received  Connection_Idle Header with Length Too Large.');
      set_connection_error (dfe$peer_error, {receive=} TRUE, status);
      RETURN;

    ELSEIF (p_queue_status^.received_header.message_type = dfc$connection_idle) THEN
{     -------------------------------------------------------------------
{     It has not been decided how to use this message type and what to do
{     with it.
{     -------------------------------------------------------------------
      RETURN;
    IFEND;

    IF (p_queue_status^.received_header.entry < 1) OR (p_queue_status^.received_header.entry >
          number_of_entries) THEN
      display ('Queue entry error in received header.');
      set_connection_error (dfe$peer_error, {receive=} TRUE, status);
      RETURN;
    IFEND;
    entry := p_queue_status^.received_header.entry;

    IF (p_queue_status^.received_header.command_length > dfc$command_buffer_size) OR
          (p_queue_status^.received_header.command_length < dfc$min_message_size) THEN
      display ('Received Erroneous Command Length in the Header.');
      set_connection_error (dfe$peer_error, {receive=} TRUE, status);
      RETURN;
    IFEND;

    IF (p_queue_status^.received_header.message_type = dfc$data_message) THEN
      IF (p_queue_status^.received_header.data_length <> dfc$page_size) AND
            (p_queue_status^.received_header.data_length <> 2 * dfc$page_size) AND
            (p_queue_status^.received_header.data_length <> 3 * dfc$page_size) AND
            (p_queue_status^.received_header.data_length <> 4 * dfc$page_size) THEN
        display ('Received Erroneous Data Length in the Header.');
        set_connection_error (dfe$peer_error, {receive=} TRUE, status);
        RETURN;
      IFEND;
    IFEND;
    status.normal := TRUE;

  PROCEND validate_received_header;

?? TITLE := 'Examine_Request_Buffer', EJECT ??

  PROCEDURE examine_request_buffer
    (    caller_id: ost$caller_identifier;
     VAR p_queue_interface_table: {^input/^output} dft$p_queue_interface_table;
     VAR queue_status: {^input/^output} dft$connect_status;
     VAR status: ost$status);

{=============================================================================
{ This PROC picks up the Request_Buffer entries between OUT and INN indecees.
{ It cleans out those that were previously processed and prepares for sending
{ newly posted requests.
{=============================================================================

    VAR
      command_length: 0 .. dfc$command_buffer_size,
      data_length: 0 .. dfc$page_size * dfc$cdcnet_max_pages_sendable,
      end_time: integer,
      entry: dft$queue_entry_index,
      inn_bytes: integer,
      limit: integer,
      out_index: 1 .. dfc$max_request_buffer_entries,
      out_bytes: integer,
      p_command_pva: dft$p_command_buffer,
      p_cpu_queue: ^dft$cpu_queue,
      p_data_pva: dft$p_data_area,
      p_driver_queue: ^dft$driver_queue,
      p_flags: ^dft$queue_entry_flags,
      p_queue_status: ^dft$connect_status_entry,
      p_request: ^dft$request_buffer_entries,
      p_request_table: ^dft$request_buffer,
      queue: dft$queue_index,
      server: boolean,
{dddddddddddddddddddddddddddddddd
      dummy: integer,
{dddddddddddddddddddddddddddddddd
      start_time: integer;

    finish_send_requests (caller_id, p_queue_interface_table, queue_status, status);

{   -------------------------------------------------------------------------
{   Scan the Request Buffer from the current value of OUT pointer to INN, and
{   initiate the Send request for every new request entry whose connection is
{   not busy. When the Send request has been issued, set the 'Previously
{   Processed' flag in the request entry to indicate that the request is in
{   progress. DO NOT increment the 'real' OUT pointer!
{   -------------------------------------------------------------------------

    p_request_table := p_queue_interface_table^.request_buffer_directory.p_request_buffer;
    p_request := ^p_request_table^.request_buffer_entries;
    limit := p_queue_interface_table^.request_buffer_directory.limit;
    inn_bytes := p_queue_interface_table^.request_buffer_directory.inn;
    out_bytes := p_queue_interface_table^.request_buffer_directory.out;
    out_index := (out_bytes DIV 8) + 1;

    WHILE (inn_bytes <> out_bytes) DO
      IF NOT (p_request^ [out_index].flags.previously_processed OR (p_request^ [out_index].queue_index = 0))
            THEN
        set_request_pointers (p_request, p_queue_interface_table, out_index, queue_status, queue, entry,
              p_cpu_queue, p_driver_queue, p_flags, p_queue_status);

{ddddddddddddddddddddddddddddddddddddddddddddddddddd
        IF dfv$cdcnet_debug_enabled THEN
          adisplay_integer ('/INITIATE_SEND/ - Queue_index= ', p_request^ [out_index].queue_index);
          dummy := p_queue_status^.send_outstanding;
          adisplay_integer ('Send_outstanding =', dummy);
          adisplay_bytes ('Flags = ', p_flags, 2);
          adisplay_header ('Current SEND_header =', p_queue_status^.send_header);
        IFEND;
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
        IF (p_queue_status^.send_outstanding = 0) THEN
          IF (NOT (p_flags^.active_entry AND p_flags^.driver_action) OR p_flags^.driver_error_alert) THEN
            display_integer ('Error-Request Buffer Entry Invalid', out_index);
            set_connection_error (dfe$program_logic_error, {receive=} FALSE, status);
            RETURN;
          IFEND;

          IF p_flags^.send_ready_for_data THEN
{           -------------------------------------------------------------
{           'send_ready_for_data' is a request for the local driver only.
{           The send is faked by turning flags off and on.
{           ------------------------------------------------------------
            p_flags^.ready_for_data_sent := TRUE;
            p_flags^.send_ready_for_data := FALSE;
            p_request^ [out_index].flags.previously_processed := TRUE;

          ELSE
            p_command_pva := p_cpu_queue^.queue_entries [entry].p_send_buffer;
            command_length := p_driver_queue^.queue_entries [entry].send_buffer_descriptor.actual_length;
            p_data_pva := p_cpu_queue^.queue_entries [entry].p_data_area;
            data_length := (p_driver_queue^.queue_entries [entry].data_descriptor.actual_length DIV 8) *
                  dfc$page_size;
            issue_send_request (p_flags, entry, p_command_pva, command_length, p_data_pva, data_length,
                  p_queue_status, status);
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
            IF dfv$cdcnet_debug_enabled THEN
              adisplay ('/INITIATE_SEND/ AFTER issue_send_request');
              adisplay_header ('SEND_HEADER just issued=', p_queue_status^.send_header);
            IFEND;
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
            IF NOT status.normal THEN
              RETURN;
            IFEND;
            p_request^ [out_index].flags.previously_processed := TRUE;
            p_flags^.buffer_sent := TRUE;
            p_flags^.send_command := FALSE;

            IF p_flags^.send_data THEN
              p_flags^.data_sent := TRUE;
              p_flags^.send_data := FALSE;
            ELSE
{             -------------------------------------------------------------
{             If request sends command buffer only, try to finish it (and
{             those issued on other connections) because the network ought
{             to be very fast with this size messages.
{             -------------------------------------------------------------
              finish_send_requests (caller_id, p_queue_interface_table, queue_status, status);
            IFEND;
          IFEND;
        IFEND;
      IFEND;

      advance_out (limit, out_bytes, out_index);
    WHILEND;

  PROCEND examine_request_buffer;

?? TITLE := 'Check_Send_Status', EJECT ??

  PROCEDURE check_send_status
    (    p_flags: ^dft$queue_entry_flags;
         p_queue_status: {^input/^output} ^dft$connect_status_entry;
     VAR status: ost$status);

{=========================================================================
{ This module checks the status of the SEND_DATA request and, if abnormal,
{ adjusts the Queue_Table.Queue_Flags to reflect the condition of the
{ particular Queue_Table entry. It also adjust the "status" to be the same
{ as that of network's send_activity_status.
{=========================================================================

    status.normal := TRUE;
    IF p_queue_status^.send_activity.complete THEN
      p_queue_status^.send_outstanding := 0;
      IF NOT p_queue_status^.send_activity.status.normal THEN
        status := p_queue_status^.send_activity.status;
        set_queue_error_flags (p_flags);
        display ('Abnormal status in SEND_ACTIVITY_STATUS');
        display_status (status);
      IFEND;

    ELSE
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd
      adisplay ('Send_Activity is NOT complete!');
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd
      RETURN;
    IFEND;

  PROCEND check_send_status;

?? TITLE := 'Complete_Send_Request', EJECT ??

  PROCEDURE complete_send_request
    (    caller_id: ost$caller_identifier;
         p_queue_status: ^dft$connect_status_entry;
         server: boolean;
         p_flags: {^input/^output} ^dft$queue_entry_flags;
     VAR status: ost$status);

{=============================================================================
{ This PROC checks the status of the previously issued network 'send request'
{ and then, in case of a SERVER, adjust the 'flags' in the Driver Queue Entry
{ to reflect the status of the request.
{ NOTE: Presence of 'send_ready_for_data' flag is considered an error
{       because there is no such network message.
{=========================================================================

    check_send_status (p_flags, p_queue_status, status);
    IF NOT status.normal THEN
      display ('Abnormal status from CHECK_SEND_STATUS');
      display_status (status);
      display ('Driver_Flags = ');
      display_bytes (p_flags, 2);
      RETURN;
    IFEND;

    IF p_queue_status^.send_activity.complete THEN

      IF server AND p_flags^.data_sent THEN
        p_flags^.data_sent := FALSE;
        IF (caller_id.ring = 3) THEN
          p_flags^.subsystem_action := TRUE;
          p_flags^.driver_action := FALSE;
        IFEND;
      IFEND;

      IF server THEN
        p_flags^.buffer_sent := FALSE;
{dddddddddddddddddddddddddddddddddddddddddd
        p_flags^.data_received := FALSE;
        p_flags^.buffer_received := FALSE;
{dddddddddddddddddddddddddddddddddddddddddd
      IFEND;
    IFEND;

  PROCEND complete_send_request;

?? TITLE := 'Finish_Send_Requests', EJECT ??

  PROCEDURE finish_send_requests
    (    caller_id: ost$caller_identifier;
     VAR p_queue_interface_table: {^input/^output} dft$p_queue_interface_table;
     VAR queue_status: {^input/^output} dft$connect_status;
     VAR status: ost$status);

{=============================================================================
{ This PROC picks up the Request_Buffer entries between OUT and INN indecees,
{ cleans out those that were previously processed.
{=============================================================================

    VAR
{dddddddddddddddddddddddddddddddd
      dummy: integer,
{dddddddddddddddddddddddddddddddd
      entry: dft$queue_entry_index,
      inn_bytes: integer,
      limit: integer,
      out_index: 1 .. dfc$max_request_buffer_entries,
      out_bytes: integer,
      p_cpu_queue: ^dft$cpu_queue,
      p_driver_queue: ^dft$driver_queue,
      p_flags: ^dft$queue_entry_flags,
      p_queue_status: ^dft$connect_status_entry,
      p_request: ^dft$request_buffer_entries,
      p_request_table: ^dft$request_buffer,
      queue: dft$queue_index,
      server: boolean;


    status.normal := TRUE;
    p_request_table := p_queue_interface_table^.request_buffer_directory.p_request_buffer;
    p_request := ^p_request_table^.request_buffer_entries;
    limit := p_queue_interface_table^.request_buffer_directory.limit;
    inn_bytes := p_queue_interface_table^.request_buffer_directory.inn;
    out_bytes := p_queue_interface_table^.request_buffer_directory.out;
    out_index := (out_bytes DIV 8) + 1;

    WHILE (inn_bytes <> out_bytes) AND (p_request^ [out_index].flags.previously_processed) DO

      set_request_pointers (p_request, p_queue_interface_table, out_index, queue_status, queue, entry,
            p_cpu_queue, p_driver_queue, p_flags, p_queue_status);
      server := p_driver_queue^.queue_header.connection_descriptor.source.flags.server_to_client;

{ddddddddddddddddddddddddddddddddddddddddddddddddddd
      IF dfv$cdcnet_debug_enabled THEN
        dummy := p_queue_status^.send_outstanding;
        adisplay_integer ('/FINISH_SEND/ -Before-  Send_outstanding =', dummy);
        adisplay_bytes ('Flags = ', p_flags, 2);
        adisplay_header ('Previous SEND_header =', p_queue_status^.send_header);
      IFEND;
{ddddddddddddddddddddddddddddddddddddddddddddddddddd
      IF p_flags^.ready_for_data_sent THEN
        IF p_queue_status^.wait_for_ready_for_data THEN
          RETURN;
        IFEND;
      ELSE
        complete_send_request (caller_id, p_queue_status, server, p_flags, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

{ddddddddddddddddddddddddddddddddddddddddddddddddddd
      IF dfv$cdcnet_debug_enabled THEN
        dummy := p_queue_status^.send_outstanding;
        adisplay_integer ('/FINISH_SEND/ -After- Send_outstanding =', dummy);
        adisplay_bytes ('Flags = ', p_flags, 2);
      IFEND;
{ddddddddddddddddddddddddddddddddddddddddddddddddddd

      IF p_queue_status^.send_activity.complete THEN
        p_request^ [out_index].flags.previously_processed := FALSE;
        p_request^ [out_index].queue_index := 0;
        p_request^ [out_index].queue_entry_index := 0;
        advance_out (limit, out_bytes, out_index);
        p_queue_interface_table^.request_buffer_directory.out := out_bytes;
        p_flags^.ready_for_data_sent := FALSE;

        IF p_flags^.subsystem_action AND (caller_id.ring = 3) THEN
{        -------------------------------------------------------------------
{        Subsystem_action set in the hands-on environment - activate caller.
{        -------------------------------------------------------------------
          pmp$ready_task (p_cpu_queue^.queue_entries [entry].global_task_id, status);
          IF NOT status.normal THEN
            display ('Abnormal status from pmp$ready_task.');
            display_status (status);
            RETURN;
          IFEND;
        IFEND;

      ELSE
        RETURN;
      IFEND;

    WHILEND;

  PROCEND finish_send_requests;

?? TITLE := 'Issue_Send_Request', EJECT ??

  PROCEDURE issue_send_request
    (    p_flags: ^dft$queue_entry_flags;
         entry: dft$queue_entry_index;
         p_command_pva: dft$p_command_buffer;
         command_length: dfc$min_message_size .. dfc$command_buffer_size;
         p_data_pva: dft$p_data_area;
         data_length: 0 .. dfc$cdcnet_max_pages_sendable * dfc$page_size;
     VAR p_queue_status: {^input/^output} ^dft$connect_status_entry;
     VAR status: ost$status);

{=============================================================================
{ This PROC issues send request to the network. Although both, 'p_data_pva'
{ and 'p_command_pva' are passed to the PROC, both or only one of them may
{ be used. If the driver's queue entry flags indicate 'send_data' then both of
{ them are used. Otherwise (only 'send_command' is set), 'p_command_pva' is
{ is used.
{=============================================================================

    VAR
      ignore_status: ost$status,
      network_file_id: amt$file_identifier,
      out_buffer_p: ^nat$data_fragments;

    VAR
      end_time: pmt$task_cp_time,
      start_time: pmt$task_cp_time;

    PUSH out_buffer_p: [1 .. 3];

    IF p_flags^.send_command AND p_flags^.send_data THEN
      p_queue_status^.send_header.message_type := dfc$data_message;
      p_queue_status^.send_header.command_length := command_length;
      p_queue_status^.send_header.data_length := data_length;
      p_queue_status^.out_message.command.address := p_command_pva;
      p_queue_status^.out_message.command.length := command_length;
      p_queue_status^.out_message.data.address := p_data_pva;
      p_queue_status^.out_message.data.length := data_length;

    ELSEIF p_flags^.send_command THEN
      p_queue_status^.send_header.message_type := dfc$command_message;
      p_queue_status^.send_header.command_length := command_length;
      p_queue_status^.send_header.data_length := 0;
      p_queue_status^.out_message.command.address := p_command_pva;
      p_queue_status^.out_message.command.length := command_length;
      p_queue_status^.out_message.data.address := NIL;
      p_queue_status^.out_message.data.length := 0;

    ELSE
      display ('Illogical Driver Flags in Issue_Send_Request');
      set_queue_error_flags (p_flags);
      set_connection_error (dfe$program_logic_error, {receive=} FALSE, status);
      RETURN;
    IFEND;

    p_queue_status^.send_header.entry := entry;
    p_queue_status^.out_message.head.address := ^p_queue_status^.send_header;
    p_queue_status^.out_message.head.length := #SIZE (p_queue_status^.send_header);
    out_buffer_p^ [1] := p_queue_status^.out_message.head;
    out_buffer_p^ [2] := p_queue_status^.out_message.command;
    out_buffer_p^ [3] := p_queue_status^.out_message.data;
    network_file_id := p_queue_status^.network_file_id;

    pmp$get_task_cp_time (start_time, ignore_status);
    nap$se_send_data (network_file_id, out_buffer_p^, {end_of_message=} TRUE, {qualifier=} FALSE, osc$nowait,
          p_queue_status^.send_activity, status);
    pmp$get_task_cp_time (end_time, ignore_status);
    cdcnet_cycle_time := cdcnet_cycle_time + (end_time.task_time - start_time.task_time);

    p_queue_status^.send_outstanding := entry;
    IF NOT status.normal THEN
      display ('Abnormal status from SEND_DATA');
      display_status (status);
    IFEND;
  PROCEND issue_send_request;

?? TITLE := 'Advance_Out', EJECT ??

  PROCEDURE advance_out
    (    limit: integer;
     VAR {input/output} out_bytes: integer;
     VAR out_index: 1 .. dfc$max_request_buffer_entries);

{========================================================================
{ This mini procedure increments the 'out pointer', checks for the limit,
{ and converts the out_pointer to a Request Buffer index.
{========================================================================

    out_bytes := out_bytes + 8;
    IF (out_bytes = limit) THEN
      out_bytes := 0;
    IFEND;

    out_index := (out_bytes DIV 8) + 1;
  PROCEND advance_out;

?? TITLE := 'Set Connection Error', EJECT ??

  PROCEDURE set_connection_error
    (    cs_error: dfc$min_cdcnet_errors .. dfc$max_cdcnet_errors;
         receive: boolean;
     VAR status: ost$status);

{=====================================================================
{ This PROC sets the Status variable to the error code passed to it as
{ input parameter. It also sets the product code and the error
{ message text in the status.
{=====================================================================

    osp$set_status_abnormal (dfc$file_server_id, cs_error, '', status);
    display ('Setting Abnormal Status');
    display_status (status);

{------------------------------------------------------------------------
{ Later on, it will be necessary to insert the SYNCHRONIZATION code in
{ here to provide for the recovery of the peer protocol error.
{
{ The synchro code should depend on the RECEIVE input parameter.
{------------------------------------------------------------------------

  PROCEND set_connection_error;

?? TITLE := 'Set_Queue_Error_Flags', EJECT ??

  PROCEDURE set_queue_error_flags
    (    p_flags: {^output} ^dft$queue_entry_flags);

{=======================================================================
{ This mini procedure sets the queue_flags whenever the driver discovers
{ an error to report.
{=======================================================================

    p_flags^.driver_error_alert := TRUE;
    p_flags^.driver_action := FALSE;
    p_flags^.subsystem_action := TRUE;

  PROCEND set_queue_error_flags;

?? TITLE := 'Set_Request_Pointers', EJECT ??

  PROCEDURE set_request_pointers
    (    p_request: ^dft$request_buffer_entries;
         p_queue_interface_table: dft$p_queue_interface_table;
         out_index: 1 .. dfc$max_request_buffer_entries;
     VAR queue_status: dft$connect_status;
     VAR queue: 1 .. dfc$max_number_of_queues;
     VAR entry: 1 .. dfc$max_queue_entries;
     VAR p_cpu_queue: ^dft$cpu_queue;
     VAR p_driver_queue: ^dft$driver_queue;
     VAR p_flags: ^dft$queue_entry_flags;
     VAR p_queue_status: ^dft$connect_status_entry);

    queue := p_request^ [out_index].queue_index;
    entry := p_request^ [out_index].queue_entry_index;

{ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd
    IF dfv$cdcnet_debug_enabled THEN
{     display_pva ('Set_Req_Ptrs p_request =', p_request);
{     display_pva ('Set_Req_Ptrs p_q_interface_tbl =', p_queue_interface_table);
      adisplay_integer ('Set_Req_Ptrs Out_index =', out_index);
      adisplay_integer ('Set_Req_Ptrs Queue =', queue);
      adisplay_integer ('Set_Req_Ptrs Entry =', entry);
    IFEND;
{ddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddddd

    p_cpu_queue := p_queue_interface_table^.queue_directory.cpu_queue_pva_directory [queue].p_cpu_queue;
    p_driver_queue := p_queue_interface_table^.queue_directory.driver_queue_pva_directory [queue].
          p_driver_queue;
    p_flags := ^p_driver_queue^.queue_entries [entry].flags;
    p_queue_status := ^queue_status [queue];

  PROCEND set_request_pointers;

  PROCEDURE adisplay
    (    display_line: string ( * <= 200));

    VAR
      length: integer,
      status: ost$status,
      working_string: string (256);

    STRINGREP (working_string, length, ' ', dfv$cdcnet_driver_name, '-', display_line);

    clp$put_job_command_response (working_string (1, length), status);

  PROCEND adisplay;

  PROCEDURE adisplay_integer
    (    display_line: string ( * <= 127);
         number: integer);

    VAR
      length: integer,
      working_string: string (200);

    STRINGREP (working_string, length, display_line, ' ', number);
    adisplay (working_string (1, length));

  PROCEND adisplay_integer;

  PROCEDURE adisplay_boolean
    (    display_line: string ( * <= 127);
         value: boolean);

    VAR
      length: integer,
      working_string: string (200);

    STRINGREP (working_string, length, display_line, ' ', value);
    adisplay (working_string (1, length));

  PROCEND adisplay_boolean;

  PROCEDURE adisplay_bytes
    (    display_line: string ( * <= 127);
         address: ^cell;
         length: integer);

    VAR
      hex_digits: [STATIC, READ] array [0 .. 15] of char := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
            'a', 'b', 'c', 'd', 'e', 'f'];

    VAR
      data: ^string ( * ),
      data_index: integer,
      length2: integer,
      line: string (72),
      line_index: integer,
      working_string: string (127);

    PUSH data: [length];

    i#move (address, data, length);
    line := ' ';
    line_index := 1;

    FOR data_index := 1 TO length DO

      line (line_index) := hex_digits [$INTEGER (data^ (data_index)) DIV 16];
      line (line_index + 1) := hex_digits [$INTEGER (data^ (data_index)) MOD 16];
      IF (data_index MOD 8) = 0 THEN
        line (line_index + 2) := ' ';
        line_index := line_index + 1;
      IFEND;

      line_index := line_index + 2;
      IF (line_index > 67) OR (data_index = length) THEN
        STRINGREP (working_string, length2, display_line, line (1, line_index - 1));
        adisplay (working_string (1, length2));
        line := ' ';
        line_index := 1;
        working_string := ' ';
      IFEND;

    FOREND;
  PROCEND adisplay_bytes;

  PROCEDURE adisplay_header
    (    display_line: string ( * <= 127);
         header: dft$message_header);

    VAR
      length: integer,
      working_string: string (200);

    STRINGREP (working_string, length, display_line, '***', header.message_type, '*', header.entry, '*',
          header.command_length, '*', header.data_length, '***');
    adisplay (working_string (1, length));

  PROCEND adisplay_header;
?? COMPILE ??
MODEND dfm$cdcnet_driver;
