?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE: Network Access : Channelnet Ring1' ??
MODULE nam$channelnet_ring1;
?? RIGHT := 110 ??

{
{    PURPOSE:
{       The purpose of this module is to contain the functions necessary for
{       communication among job mode channelnet, monitor mode channelnet
{       (network response processor), and the network PPU.  The functions
{       exist in ring 1 to provide write access to the appropriate data
{       structures.
{
{    DESIGN:
{       The functions execute as the result of procedure call from ring 3
{       resident channelnet processes.
{
?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc iot$io_request
*copyc iot$pp_number
*copyc iot$pp_interface_table
*copyc iot$command
*copyc nac$max_preallocated_requests
*copyc nat$data_fragments
*copyc nat$request_block_list
*copyc nat$preallocated_request_blocks
*copyc nlt$bm_buffer_list_array
*copyc nlt$bm_message_id
*copyc nlt$cc_connection_class
*copyc nlt$master_control_table
*copyc ost$execution_control_block
*copyc ost$hardware_subranges
*copyc ost$signature_lock_status
*copyc ost$status
?? POP ??
*copyc nap$free_request_block
*copyc nap$get_request_block
*copyc osp$system_error
*copyc osp$begin_system_activity
*copyc osp$end_system_activity
*copyc pmf$executing_task_xcb
*copyc syp$cycle
*copyc cmv$logical_unit_table
*copyc cmv$logical_pp_table_p
*copyc nav$completed_output_requests
*copy nav$network_response_processor
*copyc nav$preallocated_request_block
*copy nav$si_received_message_list
*copyc nlv$pp_buffer
*copyc nlv$pp_send_queue_tails
*copy oss$mainframe_paged_literal
*copyc osv$mainframe_wired_cb_heap
*copy osv$mainframe_wired_heap
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    max_lock_retries = 20;

  VAR
    clear_lockword: [STATIC, READ, oss$mainframe_paged_literal] iot$lockword := [FALSE, 0, [FALSE, 0, 0]],
    set_lockword: [STATIC, READ, oss$mainframe_paged_literal] iot$lockword := [TRUE, 0, [TRUE, FALSE, 0, 0]];

?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$add_buffer_pools', EJECT ??

  PROCEDURE [XDCL, #GATE] nap$add_buffer_pools
    (    reserved_buffers: nlt$bm_buffer_list_array);

    VAR
      container_rma: integer,
      count: integer,
      current: integer,
      i: integer,
      j: integer,
      limit: integer,
      reserved_buffers_p: ^nlt$bm_buffer_list;

    FOR i := nlc$bm_small_buffer_index TO nlc$bm_large_buffer_index DO
      reserved_buffers_p := ^reserved_buffers [i];
      IF (reserved_buffers_p^.buffer_list <> NIL) AND (reserved_buffers_p^.count > 0) THEN
        count := reserved_buffers_p^.count;
        current := nlv$pp_buffer^.pool_header [i].inn DIV #SIZE (nlt$pp_buffer_pool_entry);
        limit := nlv$pp_buffer^.pool_header [i].limit DIV #SIZE (nlt$pp_buffer_pool_entry);

      /move_reserved_buffers_to_pool/
        FOR j := 1 TO count DO
          IF reserved_buffers_p^.buffer_list^ [j] = NIL THEN
            count := j - 1;
            EXIT /move_reserved_buffers_to_pool/; {----->
          IFEND;
          nlv$pp_buffer^.pool [i]^ [current].descriptor_pva := reserved_buffers_p^.buffer_list^ [j];
          #REAL_MEMORY_ADDRESS (reserved_buffers_p^.buffer_list^ [j]^.container, container_rma);
          nlv$pp_buffer^.pool [i]^ [current].container_rma := container_rma;
          current := current + 1;
          IF current = limit THEN
            current := 0;
          IFEND;
        FOREND /move_reserved_buffers_to_pool/;

        nlv$pp_buffer^.pool_header [i].inn := (nlv$pp_buffer^.
              pool_header [i].inn + (count * #SIZE (nlt$pp_buffer_pool_entry))) MOD
              nlv$pp_buffer^.pool_header [i].limit;
      IFEND;
    FOREND;

  PROCEND nap$add_buffer_pools;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$get_received_messages', EJECT ??
*copy nah$get_received_messages

  PROCEDURE [XDCL, #GATE] nap$get_received_messages
    (    xcb_list: boolean;
     VAR received_messages: ^nlt$bm_message_descriptor);

    VAR
      xcb: ^ost$execution_control_block,
      cs_status: osc$cs_successful .. osc$cs_variable_locked,
      current: nat$received_message_list,
      new: nat$received_message_list,
      actual: nat$received_message_list;

    received_messages := NIL;
    new.next_received_message := NIL;
    new.fill := 0;
    current := new;
    IF xcb_list THEN
      xcb := pmf$executing_task_xcb ();
      REPEAT
        #COMPARE_SWAP (xcb^.received_message_list, current, new, actual, cs_status);
        IF (cs_status = osc$cs_failed) THEN
          current.next_received_message := actual.next_received_message;
          received_messages := actual.next_received_message;
        IFEND;
      UNTIL cs_status = osc$cs_successful;
    ELSE
      REPEAT
        #COMPARE_SWAP (nav$si_received_message_list, current, new, actual, cs_status);
        IF (cs_status = osc$cs_failed) THEN
          current.next_received_message := actual.next_received_message;
          received_messages := actual.next_received_message;
        IFEND;
      UNTIL cs_status = osc$cs_successful;
    IFEND;

  PROCEND nap$get_received_messages;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$get_sent_messages', EJECT ??

  PROCEDURE [XDCL, #GATE] nap$get_sent_messages
    (    message_id_array {OUTPUT} : ^array [1 .. * ] of nlt$bm_message_id;
     VAR message_count: 0 .. 0ff(16);
     VAR more_messages: boolean);

    VAR
      retrieved_request_blocks: [STATIC] ^nat$request_block := NIL,
      complete_request: ^nat$request_block,
      next_request_block: ^nat$request_block,
      new,
      actual,
      current: nat$request_block_list,
      cs_status: osc$cs_successful .. osc$cs_variable_locked,
      i: integer;

    message_count := 0;
    REPEAT
      IF (retrieved_request_blocks <> NIL) THEN
        REPEAT
          IF (retrieved_request_blocks^.network_request.message_id.descriptor <> NIL) THEN
            message_count := message_count + 1;
            message_id_array^ [message_count] := retrieved_request_blocks^.network_request.message_id;
          IFEND;
          next_request_block := retrieved_request_blocks^.network_request.request_block_link;
          complete_request := retrieved_request_blocks;
          nap$free_request_block (complete_request);
          retrieved_request_blocks := next_request_block;
        UNTIL ((message_count = UPPERBOUND (message_id_array^)) OR (retrieved_request_blocks = NIL));
      IFEND;
      IF (retrieved_request_blocks = NIL) THEN
        new.request_block_link := NIL;
        new.requests_queued := 0;
        current := new;
        REPEAT
          #COMPARE_SWAP (nav$completed_output_requests, current, new, actual, cs_status);
          IF (cs_status = osc$cs_failed) THEN
            current := actual;
            retrieved_request_blocks := actual.request_block_link;
          IFEND;
        UNTIL (cs_status = osc$cs_successful);
      IFEND;
    UNTIL ((message_count = UPPERBOUND (message_id_array^)) OR (retrieved_request_blocks = NIL));
    more_messages := (retrieved_request_blocks <> NIL);

  PROCEND nap$get_sent_messages;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$initialize_request_blocks', EJECT ??

  PROCEDURE [XDCL, #GATE] nap$initialize_request_blocks;

*copy nah$initialize_request_blocks

    VAR
      i: nat$request_block_identifier,
      request_block_length: integer,
      complete_request: ^nat$complete_request_block,
      complete_request_block: ^SEQ ( * ),
      request_block: ^nat$request_block,
      peripheral_request_rma: integer;

    IF (nav$preallocated_request_block = NIL) THEN
      ALLOCATE nav$preallocated_request_block: [1 .. nac$max_preallocated_requests] IN
            osv$mainframe_wired_heap^;
      request_block_length := ((((#SIZE (nat$request_block) + #SIZE (ost$word) - 1) DIV #SIZE (ost$word)) *
            #SIZE (ost$word)) + (#SIZE (mmt$rma_list_entry) * UPPERVALUE (nat$fixed_rma_list)));

      FOR i := 1 TO UPPERBOUND (nav$preallocated_request_block^) DO
        ALLOCATE complete_request: [[REP request_block_length OF cell]] IN osv$mainframe_wired_cb_heap^;
        complete_request_block := ^complete_request^.complete_sequence;
        RESET complete_request_block;
        NEXT request_block IN complete_request_block;
        request_block^.complete_request_block := complete_request;
        NEXT request_block^.network_request.rma_list: [1 .. UPPERVALUE (nat$fixed_rma_list)] IN
              complete_request_block;

        request_block^.io_request.response_processor_p := nav$network_response_processor;
        request_block^.io_request.device_request_p := #LOC (request_block^.network_request);
        request_block^.io_request.pp_request_p := ^request_block^.network_request.peripheral_request;

        request_block^.network_request.request_block_link := NIL;
        request_block^.network_request.peripheral_request.recovery := ioc$attempt_recovery;
        request_block^.network_request.peripheral_request.interrupt.value := TRUE;
        request_block^.network_request.peripheral_request.priority := 1;

        request_block^.network_request.message_id.descriptor := NIL;

        request_block^.allocation_description.preallocated := TRUE;
        request_block^.allocation_description.block_identifier := i;
        request_block^.allocation_description.next_block_identifier := i + 1;

        #REAL_MEMORY_ADDRESS (^request_block^.network_request.peripheral_request, peripheral_request_rma);
        request_block^.peripheral_request_rma := peripheral_request_rma;

        nav$preallocated_request_block^ [i] := request_block;
      FOREND;
      nav$preallocated_request_block^ [UPPERBOUND (nav$preallocated_request_block^)]^.allocation_description.
            next_block_identifier := 0;
      nav$preallocated_rb_control.first_free_block := LOWERBOUND (nav$preallocated_request_block^);
    IFEND;
  PROCEND nap$initialize_request_blocks;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$send_network_packet', EJECT ??

  PROCEDURE [XDCL, #GATE] nap$send_network_packet
    (    class: nlt$cc_connection_class;
         device_id: nlt$device_identifier;
         data: nlt$bm_message_id;
         logical_unit_number: iot$logical_unit;
         pva_list: ^nat$data_fragments);

    VAR
      peripheral_request_p: ^nat$peripheral_request,
      request_block: ^nat$request_block,
      rma_list_length: integer;

    rma_list_length := UPPERBOUND (pva_list^);
    nap$get_request_block (rma_list_length, request_block);
    build_rma_list (pva_list, request_block^.network_request.rma_list);

    peripheral_request_p := ^request_block^.network_request.peripheral_request;

    peripheral_request_p^.request_length := (#SIZE (nat$peripheral_request) +
          (rma_list_length * #SIZE (mmt$rma_list_entry)));
    request_block^.network_request.message_id := data;
    peripheral_request_p^.logical_unit := logical_unit_number;
    peripheral_request_p^.command.command_code := ioc$cc_network_output;

    queue_send_request (request_block, class, logical_unit_number,
          ^nlv$pp_send_queue_tails^ [device_id] [class]);

  PROCEND nap$send_network_packet;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] queue_peripheral_request', EJECT ??

  PROCEDURE [INLINE] queue_peripheral_request
    (    request_block: ^nat$request_block;
         lockword: ^iot$lockword;
         request_queue: ^^iot$io_request;
         request_queue_rma: ^ost$real_memory_address);

    VAR
      actual: iot$lockword,
      count: integer,
      cs_status: osc$cs_successful .. osc$cs_variable_locked,
      io_request: ^iot$io_request,
      network_request: ^nat$network_request;

    request_block^.network_request.peripheral_request.pp_request := NIL;

    count := 0;
    osp$begin_system_activity;
    REPEAT
      #COMPARE_SWAP (lockword^, clear_lockword, set_lockword, actual, cs_status);
      CASE cs_status OF
      = osc$cs_successful =
        ;
      = osc$cs_failed =
        count := count + 1;
        IF (actual.lock_owner.cpu_lock) OR (count > max_lock_retries) THEN
          osp$end_system_activity;
          syp$cycle;
          osp$begin_system_activity;
        IFEND;
      = osc$cs_variable_locked =
        ;
      CASEND;
    UNTIL (cs_status = osc$cs_successful);

    IF (request_queue^ = NIL) THEN
      request_queue^ := ^request_block^.io_request;
      request_queue_rma^ := request_block^.peripheral_request_rma;
    ELSE
      io_request := request_queue^;
      REPEAT
        network_request := #LOC (io_request^.device_request_p^);
        io_request := network_request^.peripheral_request.pp_request;
      UNTIL (io_request = NIL);
      network_request^.peripheral_request.pp_request := ^request_block^.io_request;
      network_request^.peripheral_request.next_pp_request_rma := request_block^.peripheral_request_rma;
    IFEND;

    REPEAT
      #COMPARE_SWAP (lockword^, set_lockword, clear_lockword, actual, cs_status);
    UNTIL (cs_status = osc$cs_successful);
    osp$end_system_activity;

  PROCEND queue_peripheral_request;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] queue_send_request', EJECT ??

  PROCEDURE [INLINE] queue_send_request
    (    request_block: ^nat$request_block;
         class: nlt$cc_connection_class;
         logical_unit_number: iot$logical_unit;
         send_queue_tail {output} : ^nlt$pp_send_queue_tail);

    VAR
      actual: nlt$pp_send_queue_tail,
      current: nlt$pp_send_queue_tail,
      cs_status: osc$cs_successful .. osc$cs_variable_locked,
      master_control_table: ^nlt$master_control_table,
      new: nlt$pp_send_queue_tail;

    current.fill := 0;
    current.send_queue_tail := NIL;
    new.send_queue_tail := request_block;

    REPEAT
      #COMPARE_SWAP (send_queue_tail^, current, new, actual, cs_status);
      CASE cs_status OF
      = osc$cs_failed =
        current := actual;
      = osc$cs_successful, osc$cs_variable_locked =
        ;
      CASEND;
    UNTIL (cs_status = osc$cs_successful);

    IF current.send_queue_tail <> NIL THEN

{ Build the backward link to be used when flushing the queue.

      request_block^.network_request.request_block_link := current.send_queue_tail;

      current.send_queue_tail^.network_request.peripheral_request.next_pp_request_length :=
            request_block^.network_request.peripheral_request.request_length;
      current.send_queue_tail^.network_request.peripheral_request.next_pp_request_rma :=
            request_block^.peripheral_request_rma;
    ELSE { Queue empty.

{ The backward link does not need to be set to NIL here because the backward request chain is not
{ terminated by a NIL, but rather, by a comparison with the head-of-list RMA.

      master_control_table := #LOC (cmv$logical_unit_table^ [logical_unit_number].
            unit_communication_buffer_pva^);
      master_control_table^.request_queues [class].request_length :=
            request_block^.network_request.peripheral_request.request_length;
      master_control_table^.request_queues [class].request_rma := request_block^.peripheral_request_rma;
    IFEND;

  PROCEND queue_send_request;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] build_rma_list', EJECT ??

  PROCEDURE [INLINE] build_rma_list
    (    pva_list: ^nat$data_fragments;
         rma_list: ^nat$rma_list);

    VAR
      i: integer,
      rma: integer;

    FOR i := LOWERBOUND (pva_list^) TO UPPERBOUND (pva_list^) DO
      #REAL_MEMORY_ADDRESS (pva_list^ [i].address, rma);
      rma_list^ [i].rma := rma;
      rma_list^ [i].length := pva_list^ [i].length;
    FOREND;

  PROCEND build_rma_list;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$issue_pp_request', EJECT ??
*copy nah$issue_pp_request

  PROCEDURE [XDCL, #GATE] nap$issue_pp_request
    (    pp_number: iot$pp_number;
         command: iot$command;
         request_specific_data: ^nlt$ethernet_addr_and_checksum);
    VAR
      ethernet_address_rma: integer,
      pp_interface_table: ^iot$pp_interface_table,
      request_queue: ^^iot$io_request,
      request_queue_rma: ^ost$real_memory_address,
      lockword: ^iot$lockword,
      request_block: ^nat$request_block;

    nap$get_request_block (0, request_block);
    request_block^.network_request.peripheral_request.command := command;
    IF command.command_code = ioc$cc_define_ethernet_address THEN
      #REAL_MEMORY_ADDRESS (#LOC (request_block^.network_request.ethernet_address), ethernet_address_rma);
      request_block^.network_request.peripheral_request.command.address := ethernet_address_rma;
      request_block^.network_request.ethernet_address := request_specific_data^;
    IFEND;

    pp_interface_table := cmv$logical_pp_table_p^ [pp_number].pp_info.pp_interface_table_p;
    IF (pp_interface_table <> NIL) THEN
      request_block^.network_request.peripheral_request.logical_unit :=
            pp_interface_table^.first_logical_unit;
      lockword := ^pp_interface_table^.lockword;
      request_queue := ^pp_interface_table^.pp_request_queue;
      request_queue_rma := ^pp_interface_table^.pp_request_queue_rma;
      queue_peripheral_request (request_block, lockword, request_queue, request_queue_rma);
    ELSE
      osp$system_error ('PP CONFIGURATION ERROR', NIL);
    IFEND;
  PROCEND nap$issue_pp_request;
?? OLDTITLE ??
MODEND nam$channelnet_ring1
