?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE: Network Access : Channelnet' ??
?? NEWTITLE := 'Global Declarations Referenced by This Module' ??
MODULE nam$channelnet_ring3;
?? RIGHT := 110 ??

{
{    PURPOSE:
{      The purpose of this module is to contain NAM/VE Channelnet Protocol Layer interfaces
{      and services.  The interfaces include upper layer request interfaces, and interfaces
{      (flag and signal handlers) which receive network events.
{
{      The module also contains procedures which constitute the system input task, the
{      completed output task, and the connection establishment task.
{
{    DESIGN:
{      This module is designed to be contained on the OSF$JOB_TEMPLATE_23D library and may execute
{      in any task.  Contained interfaces are not available to callers above ring 3.
{

?? PUSH (LISTEXT := ON) ??
*copyc nac$null_connection_id
*copyc nae$application_interfaces
*copyc nae$namve_conditions
*copyc nlt$bm_pool_index
*copyc nlt$cc_work_list
*copyc nlt$pdu_type
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc ost$global_task_id
*copyc ost$system_flag
*copyc pmt$program_parameters
*copyc pmt$signal
*copyc nlt$bm_message_id
*copyc nat$data_fragments
*copyc nat$network_address
*copyc nat$cn_interface
*copyc nat$cn_active_sap_list
*copyc nlt$cn_event_processor
*copyc nlt$la_header_format
*copyc nlt$network_device
*copyc nlt$network_device_list
*copyc nlt$signal_device_error

{   The channelnet pdu header is composed of the
{   layer 2 and layer 3A headers.

*copyc nat$cn_pdu_header
?? POP ??
*copyc nap$add_buffer_pools
*copyc nap$condition_handler_trace
*copyc nap$get_received_messages
*copyc nap$get_sent_messages
*copyc nap$namve_system_error
*copyc nap$record_completed_output
*copyc nap$record_connection_establish
*copyc nap$record_system_input
*copyc nap$send_network_packet
*copyc nlp$bm_add_message_prefix
*copyc nlp$bm_build_pva_list
*copyc nlp$bm_extract_message_prefix
*copyc nlp$bm_get_buffer_list
*copyc nlp$bm_get_message_length
*copyc nlp$bm_release_message
*copyc nlp$bm_release_messages
*copyc nlp$cc_receive_data
*copyc nlp$cc_receive_event
*copyc nlp$cc_reset_device
*copyc nlp$cl_get_exclusive_access
*copyc nlp$cl_release_exclusive_access
*copyc nlp$delink_receiving_connection
*copyc nlp$dequeue_receiving_conection
*copyc nlp$get_exclusive_access
*copyc nlp$get_nonexclusive_access
*copyc nlp$get_receiving_connections
*copyc nlp$la_close_sap
*copyc nlp$la_open_sap
*copyc nlp$la_send_data
*copyc nlp$release_exclusive_access
*copyc nlp$release_nonexclusive_access
*copyc nlp$requeue_msgs_for_input_task
*copyc osp$append_status_integer
*copyc osp$begin_subsystem_activity
*copyc osp$decrement_locked_variable
*copyc osp$disestablish_cond_handler
*copyc osp$end_subsystem_activity
*copyc osp$establish_block_exit_hndlr
*copyc osp$increment_locked_variable
*copyc osp$pop_inhibit_job_recovery
*copyc osp$push_inhibit_job_recovery
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$find_executing_task_xcb
*copyc pmp$set_system_flag
*copyc pmp$wait
*copyc tmp$save_system_task_id
*copyc jmv$executing_within_system_job
*copyc nav$cdna_multicast_address
*copyc nav$cn_sap_list
*copyc nav$cn_maximum_data_length
*copyc nav$global_statistics
*copyc nav$host_subnet_id
*copyc nav$namve_active
*copyc nav$network_paged_heap
*copyc nav$network_wired_heap
*copyc nav$system_id
*copyc nav$network_procedures
*copyc nlv$cc_work_list
*copyc nlv$configured_network_devices
*copyc nlv$pp_buffer
*copyc nlv$replenish_pp_buffer_pools

*copyc nav$debug_mode

  VAR
    nav$multiple_flag_handler_calls: [XREF] integer,
    nav$multiple_namve_hndler_calls: [XREF] integer,
    nav$namve_tsk_hndl_active_count: [XREF] integer;

?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  TYPE
    detailed_system_identifier = packed record
      fill1: 0 .. 7f(16),
      multicast: boolean,
      system_id: 0 .. 0ffffffffff(16),
    recend;

  VAR
    nav$requeue_incoming_messages: [STATIC] boolean := FALSE,
    channelnet: [STATIC, oss$job_paged_literal, READ] string (10) := 'Channelnet',
    cn_flag_handler_activ_in_task: [STATIC, oss$task_private] boolean := FALSE,
    cn_flag_hndl_called_when_activ: [STATIC, oss$task_private] boolean := FALSE;

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

  PROCEDURE [XDCL, #GATE] nap$system_input_task
    (    parameters: pmt$program_parameters;
     VAR status: ost$status);

{
{     This procedure constitutes the system input task.  That is, entrance to the procedure causes
{  the executing task to become the system input task.  After recording the task identifier the
{  task merely waits.  The task is subsequently activated via as the result of an input response
{  from the network PPU (flag, signal, or ready task from monitor mode in the CPU), or a ready
{  task from the connection establishment task to replenish the PP buffer pools.

    CONST
      system_input_list = FALSE;

    VAR
      data: nlt$bm_message_id,
      received_messages: ^nlt$bm_message_descriptor,
      receiving_connections: ^nlt$cl_connection,
      wait_time: 0 .. 0ffffffffffff(16);

    IF jmv$executing_within_system_job THEN
      nap$record_system_input {task identifier} ;
      tmp$save_system_task_id (tmc$stid_namve_system_input, FALSE, status);
      IF status.normal THEN
        WHILE TRUE DO
          osp$begin_subsystem_activity;
          IF nlv$replenish_pp_buffer_pools THEN
            nap$replenish_pp_buffer_pools;
          IFEND;
          nap$get_received_messages (system_input_list, received_messages);
          IF (received_messages <> NIL) THEN
            deliver_received_messages (TRUE, received_messages);
          IFEND;
          nlp$get_receiving_connections (receiving_connections);
          IF receiving_connections <> NIL THEN
            process_receiving_connections (receiving_connections);
          IFEND;
          osp$end_subsystem_activity;
          IF NOT nlv$replenish_pp_buffer_pools THEN
            wait_time := 20000000;
          ELSE
            wait_time := 5000;
          IFEND;
          pmp$wait (wait_time, wait_time);
        WHILEND;
      IFEND;
    IFEND;
  PROCEND nap$system_input_task;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$completed_output_task', EJECT ??

  PROCEDURE [XDCL, #GATE] nap$completed_output_task
    (    parameters: pmt$program_parameters;
     VAR status: ost$status);

{
{     This procedure constitutes the completed output task.  That is, entrance to the procedure causes
{  the executing task to become the completed output task.  After recording the task identifier the
{  task merely waits.  The task is subsequently activated via a ready_task call from monitor to release
{  system buffers associated with sent messages.
{

    IF jmv$executing_within_system_job THEN
      nap$record_completed_output {task identifier} ;
      tmp$save_system_task_id (tmc$stid_completed_output, FALSE, status);
      IF status.normal THEN
        WHILE TRUE DO
          release_sent_messages;
          pmp$wait (20000000, 20000000);
        WHILEND;
      IFEND;
    IFEND;
  PROCEND nap$completed_output_task;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$connection_establish_task', EJECT ??

  PROCEDURE [XDCL, #GATE] nap$connection_establish_task
    (    parameters: pmt$program_parameters;
     VAR status: ost$status);

{
{     This procedure constitutes the connection establishment task.  That is, entrance to the procedure
{  causes the executing task to become the connection establishment task.  After recording the task
{  identifier the task merely waits.  The task is subsequently activated as the result of connect requests
{  received from the network.
{

    IF jmv$executing_within_system_job THEN
      nap$record_connection_establish {task identifier} ;
      WHILE TRUE DO
        pmp$wait (20000000, 20000000);
      WHILEND;
    IFEND;
  PROCEND nap$connection_establish_task;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL]  nap$cn_flag_handler', EJECT ??

  PROCEDURE [XDCL] nap$cn_flag_handler
    (    flag_id: ost$system_flag);

    CONST
      xcb_list = TRUE;

    VAR
      actual_value: integer,
      data: nlt$bm_message_id,
      ignore_error: boolean,
      ignore_status_p: ^ost$status,
      received_messages: ^nlt$bm_message_descriptor,
      xcb: ^ost$execution_control_block;

?? NEWTITLE := 'pop_inhibit_job_recovery', EJECT ??

    PROCEDURE pop_inhibit_job_recovery
      (    condition: pmt$condition;
           ignore_condition_descriptor: ^pmt$condition_information;
           sa: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      osp$end_subsystem_activity;
      osp$pop_inhibit_job_recovery;
      condition_status.normal := TRUE;
      cn_flag_handler_activ_in_task := FALSE;

{Debug Code
      osp$decrement_locked_variable (nav$namve_tsk_hndl_active_count, 1, actual_value, ignore_error);
{End Debug Code

      nap$condition_handler_trace (condition, sa);

    PROCEND pop_inhibit_job_recovery;
?? OLDTITLE ??
?? EJECT ??

    IF cn_flag_handler_activ_in_task THEN
      osp$increment_locked_variable (nav$multiple_flag_handler_calls, 0, actual_value);

{Note: We have to call the handler again only one, regardless on how many times we get stacked, as
{      all messages are processed in one attempt.

      cn_flag_hndl_called_when_activ := TRUE;

      nap$namve_system_error (TRUE {=recoverable} , 'NAP$CN_FLAG_HANDLER invoked while active.', NIL);
      RETURN; {----->
    IFEND;

{Debug Code
    osp$increment_locked_variable (nav$namve_tsk_hndl_active_count, 0, actual_value);
    IF actual_value > 1 THEN
      osp$increment_locked_variable (nav$multiple_namve_hndler_calls, 0, actual_value);
      IF nav$debug_mode > nac$no_debug THEN
        nap$namve_system_error (TRUE {=recoverable} ,
              'NAP$CN_FLAG_HANDLER invoked while another handler active.', NIL);
      IFEND;
    IFEND;
{End Debug Code

    cn_flag_handler_activ_in_task := TRUE;
    osp$push_inhibit_job_recovery;
    osp$begin_subsystem_activity;

    osp$establish_block_exit_hndlr (^pop_inhibit_job_recovery);
    nap$get_received_messages (xcb_list, received_messages);
    IF (received_messages <> NIL) THEN
      IF NOT nav$requeue_incoming_messages THEN
        deliver_received_messages (FALSE, received_messages);
      ELSE
        nlp$requeue_msgs_for_input_task (received_messages);
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;
    osp$end_subsystem_activity;
    osp$pop_inhibit_job_recovery;
    cn_flag_handler_activ_in_task := FALSE;

{Debug Code
    osp$decrement_locked_variable (nav$namve_tsk_hndl_active_count, 1, actual_value, ignore_error);
{End Debug Code

    #SPOIL (cn_flag_hndl_called_when_activ);
    IF cn_flag_hndl_called_when_activ THEN
      cn_flag_hndl_called_when_activ := FALSE;
      pmp$find_executing_task_xcb (xcb);

{We can set any of the two flags (nac$network_input_received, nac$channelnet_local_event) as they are
{handled the same way. Ans as far as I can see, nac$channelnet_local_event is no longer used.

      IF xcb <> NIL THEN
        PUSH ignore_status_p;
        pmp$set_system_flag (nac$network_input_received, xcb^.global_task_id, ignore_status_p^);
      IFEND;
    IFEND;

  PROCEND nap$cn_flag_handler;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nap$cn_signal_handler', EJECT ??

  PROCEDURE [XDCL] nap$cn_signal_handler
    (    originator: ost$global_task_id;
         signal: pmt$signal);

*copy nah$cn_signal_handler

    VAR
      actual_value: integer,
      ignore_error: boolean,
      signal_contents: ^nlt$signal_device_error;

    osp$push_inhibit_job_recovery;

{Debug Code
    osp$increment_locked_variable (nav$namve_tsk_hndl_active_count, 0, actual_value);
    IF actual_value > 1 THEN
      osp$increment_locked_variable (nav$multiple_namve_hndler_calls, 0, actual_value);
      IF nav$debug_mode > nac$no_debug THEN
        nap$namve_system_error (TRUE {=recoverable} ,
              'NAP$CN_SIGNAL_HANDLER invoked while another handler active.', NIL);
      IFEND;
    IFEND;
{End Debug Code

    signal_contents := #LOC (signal.contents);
    IF signal_contents^.pp_pools_need_replenishing THEN
      nap$replenish_pp_buffer_pools;
    IFEND;
    IF signal_contents^.message <> NIL THEN
      IF signal_contents^.reset_device THEN

{ The device reset request was issued from monitor mode module nam$process_network_response.
{ Either the message was addressed to a nonexistent connection (destination reference number not found)
{ or an invalid CC PDU kind was received.

        nlp$cc_reset_device (signal_contents^.device_id);
      IFEND;
      release_incomplete_message (signal_contents^.message);
    IFEND;

{Debug Code
    osp$decrement_locked_variable (nav$namve_tsk_hndl_active_count, 1, actual_value, ignore_error);
{End Debug Code

    osp$pop_inhibit_job_recovery;

  PROCEND nap$cn_signal_handler;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nap$incoming_message_cleanup', EJECT ??

  PROCEDURE [XDCL] nap$incoming_message_cleanup;

*copy nah$incoming_message_cleanup

    nav$requeue_incoming_messages := TRUE;
  PROCEND nap$incoming_message_cleanup;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nap$replenish_pp_buffer_pools', EJECT ??

{ PURPOSE:
{   The purpose of this request is to replenish the PP's buffers.  If buffers cannot be acquired to
{   fulfill the request the NLV$REPLENISH_PP_BUFFER_POOLS flag will be set and the wait time for the
{   input task will be reduced until the pools have been replenished.  This procedure should
{   only be called from the system input task except during initialization.  By only executing this
{   code in one task avoids the overhead of synchronization.

  PROCEDURE [XDCL] nap$replenish_pp_buffer_pools;

    VAR
      buffers_acquired: boolean,
      count: integer,
      header_p: ^nlt$pp_buffer_pool_header,
      i: nlt$bm_pool_index,
      replenish_buffers: boolean,
      reserved_buffers: nlt$bm_buffer_list_array;

    nlv$replenish_pp_buffer_pools := FALSE;
    replenish_buffers := FALSE;
    nav$global_statistics.pp_buffer_pool.replenish_pools_count :=
          nav$global_statistics.pp_buffer_pool.replenish_pools_count + 1;

    FOR i := nlc$bm_small_buffer_index TO nlc$bm_large_buffer_index DO
      header_p := ^nlv$pp_buffer^.pool_header [i];
      IF header_p^.inn >= header_p^.cpu_out THEN
        count := (header_p^.inn - header_p^.cpu_out) DIV #SIZE (nlt$pp_buffer_pool_entry);
      ELSE
        count := ((header_p^.limit - header_p^.cpu_out) + header_p^.inn) DIV #SIZE (nlt$pp_buffer_pool_entry);
      IFEND;

{ Replenish buffers only if the pool is below the threshold.
      IF count < header_p^.threshold THEN
        reserved_buffers [i].count := (header_p^.limit DIV #SIZE (nlt$pp_buffer_pool_entry)) - count - 1;

        IF reserved_buffers [i].count > 0 THEN
          replenish_buffers := TRUE;
          PUSH reserved_buffers [i].buffer_list: [1 .. reserved_buffers [i].count];
        ELSE
          reserved_buffers [i].buffer_list := NIL;
        IFEND;

      ELSE { Above threshold.
        reserved_buffers [i].count := 0;
        reserved_buffers [i].buffer_list := NIL;
      IFEND;

      IF count = 0 THEN
        nav$global_statistics.pp_buffer_pool.empty_pools_count [1] [i] :=
              nav$global_statistics.pp_buffer_pool.empty_pools_count [1] [i] + 1;
      IFEND;
    FOREND;

    IF replenish_buffers THEN
      nlp$bm_get_buffer_list (reserved_buffers, buffers_acquired);
      IF buffers_acquired THEN
        nap$add_buffer_pools (reserved_buffers);
      IFEND;

      FOR i := nlc$bm_small_buffer_index TO nlc$bm_large_buffer_index DO
        IF reserved_buffers [i].buffer_list <> NIL THEN
          nav$global_statistics.pp_buffer_pool.pools_replenished [i] :=
                nav$global_statistics.pp_buffer_pool.pools_replenished [i] + 1;
        IFEND;

        IF nlv$pp_buffer^.pool_header [i].inn = nlv$pp_buffer^.pool_header [i].cpu_out THEN
          nav$global_statistics.pp_buffer_pool.empty_pools_count [2] [i] :=
                nav$global_statistics.pp_buffer_pool.empty_pools_count [2] [i] + 1;
          nlv$replenish_pp_buffer_pools := TRUE;
        IFEND;
      FOREND;
    IFEND;

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

  FUNCTION [XDCL, #GATE] nap$namve_config_activated: boolean;

    nap$namve_config_activated := nlv$configured_network_devices.network_device_list <> NIL;

  FUNCEND nap$namve_config_activated;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] nap$namve_active' ??

  FUNCTION [XDCL, #GATE] nap$namve_active: boolean;

    nap$namve_active := nav$namve_active;

  FUNCEND nap$namve_active;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$process_receiving_conection', EJECT ??
*copy nlh$process_receiving_conection

  PROCEDURE [XDCL] nlp$process_receiving_conection
    (    connection_id: nlt$cl_connection_id);

?? OLDTITLE ??
?? NEWTITLE := 'release_connection_access', EJECT ??

    PROCEDURE release_connection_access
      (    condition: pmt$condition;
           ignore_condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      nap$condition_handler_trace (condition, save_area);
      IF ((pmc$program_termination IN condition.reason) OR (pmc$program_abort IN condition.reason)) THEN
        nlp$cl_release_exclusive_access (cl_connection);
      IFEND;
      condition_status.normal := TRUE;
    PROCEND release_connection_access;
?? OLDTITLE, EJECT ??

    VAR
      access_gained: boolean,
      cl_connection: ^nlt$cl_connection,
      connection_exists: boolean,
      cs_status: osc$cs_successful .. osc$cs_variable_locked,
      next_connection_id: nlt$cl_connection_id;

    nlp$cl_get_exclusive_access (connection_id, TRUE, connection_exists, access_gained, cl_connection);
    IF connection_exists AND access_gained THEN
      #SPOIL (cl_connection);
      osp$establish_block_exit_hndlr (^release_connection_access);

{ Turn off the IN QUEUE flag.

      nlp$dequeue_receiving_conection (cl_connection, {ignore} next_connection_id);
      nlp$cc_receive_data (cl_connection);
      osp$disestablish_cond_handler;
      nlp$cl_release_exclusive_access (cl_connection);
    ELSEIF connection_exists THEN

{ Add the connection to the work list.

      add_connection_to_cc_work_list (connection_id);
    ELSE { connection does not exist
      nap$namve_system_error ({Recoverable_error=} TRUE, 'Connection in work list does not exist.', NIL);
    IFEND;
  PROCEND nlp$process_receiving_conection;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$cn_open_sap', EJECT ??

  PROCEDURE [XDCL] nlp$cn_open_sap
    (    sap: nat$cn_sap_id;
         event_processor: nat$network_procedure;
     VAR maximum_data_length: nat$data_length;
     VAR status: ost$status);

*copyc nlh$cn_open_sap

    VAR
      i: integer,
      active_sap_list: ^nat$cn_active_sap_list,
      free_entry: integer,
      link_sap_open: boolean;

    status.normal := TRUE;
    free_entry := 0;
    nlp$get_exclusive_access (nav$cn_sap_list.access_control);
    active_sap_list := nav$cn_sap_list.active_sap_list;
    IF (active_sap_list = NIL) THEN
      ALLOCATE active_sap_list IN nav$network_paged_heap^;
      IF (active_sap_list <> NIL) THEN
        free_entry := LOWERBOUND (active_sap_list^);
        FOR i := free_entry TO UPPERBOUND (active_sap_list^) DO
          active_sap_list^ [i].in_use := FALSE;
        FOREND;
        nav$cn_sap_list.active_sap_list := active_sap_list;
      ELSE
        osp$set_status_condition (nae$allocation_failed, status);
      IFEND;
    ELSE

    /search_active_sap_list/
      FOR i := LOWERBOUND (active_sap_list^) TO UPPERBOUND (active_sap_list^) DO
        IF NOT active_sap_list^ [i].in_use THEN
          IF free_entry = 0 THEN
            free_entry := i;
          IFEND;
        ELSE
          IF active_sap_list^ [i].sap_id = sap THEN
            osp$set_status_condition (nae$sap_already_open, status);
            osp$append_status_integer (osc$status_parameter_delimiter, sap, 10, TRUE, status);
            EXIT /search_active_sap_list/; {----->
          IFEND;
        IFEND;
      FOREND /search_active_sap_list/;

      IF (free_entry = 0) AND status.normal THEN

{       ACTIVE SAP LIST full.

        osp$set_status_abnormal (nac$status_id, nae$unable_to_open_sap, channelnet, status);
      IFEND;
    IFEND;

    IF status.normal THEN
      open_link_access_sap (sap, event_processor, link_sap_open, status);
      IF status.normal THEN
        active_sap_list^ [free_entry].in_use := TRUE;
        active_sap_list^ [free_entry].sap_id := sap;
        active_sap_list^ [free_entry].event_processor := event_processor;
        active_sap_list^ [free_entry].link_access_sap_open := link_sap_open;
        maximum_data_length := nav$cn_maximum_data_length;
      IFEND;
    IFEND;

    nlp$release_exclusive_access (nav$cn_sap_list.access_control);

  PROCEND nlp$cn_open_sap;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$cn_close_sap', EJECT ??

  PROCEDURE [XDCL] nlp$cn_close_sap
    (    sap: nat$cn_sap_id;
     VAR status: ost$status);

*copyc nlh$cn_close_sap

    VAR
      i: integer,
      sap_closed: boolean,
      active_sap_list: ^nat$cn_active_sap_list;

    status.normal := TRUE;
    sap_closed := FALSE;
    nlp$get_exclusive_access (nav$cn_sap_list.access_control);
    active_sap_list := nav$cn_sap_list.active_sap_list;
    IF (active_sap_list <> NIL) THEN

    /close_sap/
      FOR i := LOWERBOUND (active_sap_list^) TO UPPERBOUND (active_sap_list^) DO
        IF (active_sap_list^ [i].in_use) AND (active_sap_list^ [i].sap_id = sap) THEN
          active_sap_list^ [i].in_use := FALSE;
          sap_closed := TRUE;
          IF active_sap_list^ [i].link_access_sap_open THEN
            nlp$la_close_sap (sap, status);
          IFEND;
          EXIT /close_sap/; {----->
        IFEND;
      FOREND /close_sap/;
    IFEND;
    nlp$release_exclusive_access (nav$cn_sap_list.access_control);
    IF NOT sap_closed THEN
      osp$set_status_abnormal (nac$status_id, nae$sap_not_open, channelnet, status);
      osp$append_status_integer (osc$status_parameter_delimiter, sap, 10, TRUE, status);
    IFEND;

  PROCEND nlp$cn_close_sap;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] get_sap_open', EJECT ??

  PROCEDURE [INLINE] get_sap_open
    (    sap: nat$cn_sap_id;
     VAR sap_open: boolean);

    VAR
      i: integer,
      active_sap_list: ^nat$cn_active_sap_list;

    sap_open := FALSE;
    nlp$get_nonexclusive_access (nav$cn_sap_list.access_control);
    active_sap_list := nav$cn_sap_list.active_sap_list;
    IF active_sap_list <> NIL THEN

    /search_active_sap_list/
      FOR i := LOWERBOUND (active_sap_list^) TO UPPERBOUND (active_sap_list^) DO
        IF (active_sap_list^ [i].in_use) AND (active_sap_list^ [i].sap_id = sap) THEN
          sap_open := TRUE;
          EXIT /search_active_sap_list/; {----->
        IFEND;
      FOREND /search_active_sap_list/;
    IFEND;
    nlp$release_nonexclusive_access (nav$cn_sap_list.access_control);

  PROCEND get_sap_open;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$cn_send_datagram', EJECT ??

  PROCEDURE [XDCL] nlp$cn_send_datagram
    (    sap: nat$cn_sap_id;
         device: nlt$device_identifier;
         destination: nat$system_address;
         datagram: nlt$bm_message_id;
     VAR status: ost$status);

*copyc nlh$cn_send_datagram

    VAR
      data_length: integer,
      data: nlt$bm_message_id,
      i: integer,
      new_data: nlt$bm_message_id,
      sap_open: boolean;

    status.normal := TRUE;
    nlp$bm_get_message_length (datagram, data_length);
    data := datagram;
    IF data_length <= nav$cn_maximum_data_length THEN
      get_sap_open (sap, sap_open);
      IF sap_open THEN
        nlp$get_nonexclusive_access (nlv$configured_network_devices.access_control);

{ Determine if the Channelnet PDU is destined for the directly connected device or
{ a remote device accessed by an ICA-II.

        IF (nlv$configured_network_devices.network_device_list^ [device].kind = nac$ica_2) AND
              (nlv$configured_network_devices.network_device_list^ [device].system_id <>
              destination.system) THEN
          nlp$release_nonexclusive_access (nlv$configured_network_devices.access_control);
          nlp$la_send_data (sap, destination.network, destination.system, nlc$la_standard_header,
                nlc$la_system_priority, data, status);
        ELSE { Channelnet PDU is destined for the directly connected device.
          route_channelnet_packet (^nlv$configured_network_devices.network_device_list^ [device],
                destination.system, sap, data_length, data);
          nlp$release_nonexclusive_access (nlv$configured_network_devices.access_control);
        IFEND;
      ELSE
        nlp$bm_release_message (data);
        osp$set_status_abnormal (nac$status_id, nae$sap_not_open, channelnet, status);
        osp$append_status_integer (osc$status_parameter_delimiter, sap, 10, TRUE, status);
      IFEND;
    ELSE
      nlp$bm_release_message (data);
      osp$set_status_abnormal (nac$status_id, nae$max_data_length_exceeded, channelnet, status);
    IFEND;

  PROCEND nlp$cn_send_datagram;
?? OLDTITLE ??
?? NEWTITLE := 'add_connection_to_cc_work_list', EJECT ??
{
{  PURPOSE:
{      The purpose of this procedure is to add a Channel Connection that has
{   input messages queued on it into the Channel Connection work list for
{   processing at a later time. The elements in the work list will be processed
{   via a flag handler.
{   This procedure is only executed in the system input task.
{
{   NOTE: This procedure will not return until the connection has been placed
{         in the work list. This may require a wait for system resources to
{         free up.
{
{        ADD_CONNECTION_TO_CC_WORK_LIST (CONNECTION_ID)
{
{  CONNECTION_ID: (input) This parameter specifies the local connection identifier.
{       This identifier will be used to obtain access to the connection structure.
{

  PROCEDURE add_connection_to_cc_work_list
    (    connection_id: nlt$cl_connection_id);

    VAR
      cc_event: ^nlt$cc_work_unit;

    REPEAT
      ALLOCATE cc_event IN nav$network_paged_heap^;
      IF cc_event = NIL THEN
        syp$cycle;
      IFEND;
    UNTIL cc_event <> NIL;
    cc_event^.next_work_unit := NIL;
    cc_event^.kind := nlc$cc_connection_work_unit;
    cc_event^.connection_id := connection_id;
    nlv$cc_work_list.append^ := cc_event;
    nlv$cc_work_list.append := ^cc_event^.next_work_unit;

  PROCEND add_connection_to_cc_work_list;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] route_channelnet_packet', EJECT ??

  PROCEDURE [INLINE] route_channelnet_packet
    (    network_device: ^nlt$network_device;
         destination_system_id: nat$system_identifier;
         sap_id: nat$cn_sap_id;
         data_length: nat$data_length;
     VAR data {INPUT, OUTPUT} : nlt$bm_message_id);


    VAR
      i: integer,
      pva_list: ^nat$data_fragments,
      channelnet_pdu_header: nat$cn_pdu_header;


    IF (network_device^.path_status = nlc$path_available) THEN
      channelnet_pdu_header.data_length := data_length + nac$3a_header_length;
      channelnet_pdu_header.source_address := nav$system_id;
      channelnet_pdu_header.destination_address := destination_system_id;
      channelnet_pdu_header.source_sap_id := sap_id;
      channelnet_pdu_header.destination_sap_id := sap_id;
      channelnet_pdu_header.control := 0;
      nlp$bm_add_message_prefix (^channelnet_pdu_header, #SIZE (nat$cn_pdu_header), data);
      nlp$bm_build_pva_list (data, pva_list);
      nap$send_network_packet (nlc$cc_normal_class, network_device^.device_id, data,
            network_device^.logical_unit, pva_list);
    ELSE
      nlp$bm_release_message (data);
    IFEND;
  PROCEND route_channelnet_packet;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] get_sap_info', EJECT ??

  PROCEDURE [INLINE] get_sap_info
    (    sap: nat$cn_sap_id;
     VAR sap_open: boolean;
     VAR event_processor: nlt$cn_event_processor);

    VAR
      i: integer,
      active_sap_list: ^nat$cn_active_sap_list;

    sap_open := FALSE;
    nlp$get_nonexclusive_access (nav$cn_sap_list.access_control);
    active_sap_list := nav$cn_sap_list.active_sap_list;
    IF active_sap_list <> NIL THEN

    /search_active_sap_list/
      FOR i := LOWERBOUND (active_sap_list^) TO UPPERBOUND (active_sap_list^) DO
        IF (active_sap_list^ [i].in_use) AND (active_sap_list^ [i].sap_id = sap) THEN
          sap_open := TRUE;
          event_processor := nav$network_procedures [active_sap_list^ [i].event_processor].cn_event_processor;
          EXIT /search_active_sap_list/; {----->
        IFEND;
      FOREND /search_active_sap_list/;
    IFEND;
    nlp$release_nonexclusive_access (nav$cn_sap_list.access_control);
  PROCEND get_sap_info;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] deliver_channelnet_event', EJECT ??

  PROCEDURE [INLINE] deliver_channelnet_event
    (    sap_id: nat$cn_sap_id;
         source_device: nlt$device_identifier;
         source_address: nat$system_address;
     VAR data: nlt$bm_message_id);

    VAR
      event_processor: nlt$cn_event_processor,
      sap_open: boolean;

    get_sap_info (sap_id, sap_open, event_processor);
    IF sap_open THEN
      event_processor^ (sap_id, source_device, source_address, data);
    ELSE
      nlp$bm_release_message (data);
    IFEND;
  PROCEND deliver_channelnet_event;
?? OLDTITLE ??
?? NEWTITLE := 'process_receiving_connections', EJECT ??
{ PURPOSE:
{   The purpose of this procedure is to process the input messages queued
{   on the connections in the given linked list. This process tries to get
{   exclusive access to the connection structure. If access is not gained
{   the connection identifier is queued in the work list to be processed
{   later.

  PROCEDURE process_receiving_connections
    (    receiving_connections: ^nlt$cl_connection);

?? OLDTITLE ??
?? NEWTITLE := 'release_connection_access', EJECT ??

    PROCEDURE release_connection_access
      (    condition: pmt$condition;
           ignore_condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      nap$condition_handler_trace (condition, save_area);
      IF ((pmc$program_termination IN condition.reason) OR (pmc$program_abort IN condition.reason)) THEN
        nlp$cl_release_exclusive_access (cl_connection);
      IFEND;
      condition_status.normal := TRUE;
    PROCEND release_connection_access;
?? OLDTITLE, EJECT ??

    VAR
      access_gained: boolean,
      cl_connection: ^nlt$cl_connection,
      connection_exists: boolean,
      cs_status: osc$cs_successful .. osc$cs_variable_locked,
      next_connection_id: nlt$cl_connection_id;

    next_connection_id := receiving_connections^.identifier;
    REPEAT
      nlp$cl_get_exclusive_access (next_connection_id, TRUE, connection_exists, access_gained, cl_connection);
      IF connection_exists AND access_gained THEN
        #SPOIL (cl_connection);
        osp$establish_block_exit_hndlr (^release_connection_access);

{ Dequeue the connection from the receiving connections queue.

        nlp$dequeue_receiving_conection (cl_connection, next_connection_id);
        nlp$cc_receive_data (cl_connection);
        osp$disestablish_cond_handler;
        nlp$cl_release_exclusive_access (cl_connection);
      ELSEIF connection_exists THEN

{ Delink the connection from the receiving connections queue. The IN QUEUE
{ flag is left set.
{ It is safe to compare swap to the connection queue without locking the
{ connection first as only monitor mode accesses the connection queue.
{ If the connection is in the receiving connection queue, monitor
{ mode process will not change the connection queue.

        nlp$delink_receiving_connection (cl_connection, next_connection_id);
        add_connection_to_cc_work_list (cl_connection^.identifier);
      ELSE { connection does not exist
        nap$namve_system_error ({Recoverable_error=} TRUE,
              'Connection in receiving connection queue does not exist.', NIL);
        next_connection_id := nac$null_connection_id;
      IFEND;
    UNTIL next_connection_id = nac$null_connection_id;

  PROCEND process_receiving_connections;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] release_sent_messages', EJECT ??

  PROCEDURE [INLINE] release_sent_messages;

    TYPE
      messages = array [1 .. 100] of nlt$bm_message_id;

    VAR
      message_id_seq: SEQ (REP 1 of messages),
      message_ids: ^SEQ ( * ),
      message_id_array: ^messages,
      more_messages: boolean,
      sent_messages: ^array [1 .. * ] of nlt$bm_message_id,
      sent_message_count: 0 .. 0ff(16);

    message_ids := ^message_id_seq;
    REPEAT
      RESET message_ids;
      NEXT message_id_array IN message_ids;
      nap$get_sent_messages (message_id_array, sent_message_count, more_messages);
      IF (sent_message_count > 0) THEN
        RESET message_ids;
        NEXT sent_messages: [1 .. sent_message_count] IN message_ids;
        nlp$bm_release_messages (sent_messages^);
      IFEND;
    UNTIL NOT more_messages;
  PROCEND release_sent_messages;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] receive_channelnet_packet', EJECT ??

{ PURPOSE:
{   The purpose of this routine is to process incoming XNS PDU's.
{   Currently the only XNS PDU's that will be received are Initialization ME PDU's.

  PROCEDURE [INLINE] receive_channelnet_packet
    (VAR data {input, output} : nlt$bm_message_id);


    VAR
      channelnet_pdu_header: nat$cn_pdu_header,
      data_length: integer,
      detailed_system_id: ^detailed_system_identifier,
      device_id: nlt$device_identifier,
      header_length: nat$data_length,
      ignore_byte_count: nat$data_length,
      network_device: ^nlt$network_device,
      source_address: nat$system_address,
      valid_multicast_address: boolean;

    nlp$bm_get_message_length (data, data_length);
    IF (data_length <= nav$cn_maximum_data_length + #SIZE (channelnet_pdu_header)) AND
          (data_length >= #SIZE (channelnet_pdu_header)) THEN

{ Device_id MUST be retrieved from the message descriptor BEFORE any extracts have been done. This is
{ because an extract could cause the message descriptor containing the received message descriptor to
{ be released.

      device_id := data.descriptor^.received_message.device_id;
      header_length := #SIZE (channelnet_pdu_header);
      nlp$bm_extract_message_prefix (^channelnet_pdu_header, header_length, data, ignore_byte_count);
      source_address.network := (nav$host_subnet_id + (device_id * 10000(16)));
      source_address.system := channelnet_pdu_header.source_address;
      nlp$get_nonexclusive_access (nlv$configured_network_devices.access_control);
      network_device := ^nlv$configured_network_devices.network_device_list^ [device_id];
      IF nav$system_id = channelnet_pdu_header.destination_address THEN
        nlp$release_nonexclusive_access (nlv$configured_network_devices.access_control);
        deliver_channelnet_event (channelnet_pdu_header.destination_sap_id, device_id, source_address, data);
      ELSE

{ Determine if it is a valid multicast.

        detailed_system_id := #LOC (channelnet_pdu_header.destination_address);
        valid_multicast_address := FALSE;
        IF detailed_system_id^.multicast THEN
          valid_multicast_address := channelnet_pdu_header.destination_address = nav$cdna_multicast_address;
        IFEND;

        nlp$release_nonexclusive_access (nlv$configured_network_devices.access_control);
        IF valid_multicast_address THEN
          deliver_channelnet_event (channelnet_pdu_header.destination_sap_id, device_id, source_address,
                data);
        ELSE
          nlp$bm_release_message (data);
        IFEND;
      IFEND;
    ELSE
      nlp$bm_release_message (data);
    IFEND;

  PROCEND receive_channelnet_packet;
?? OLDTITLE ??
?? NEWTITLE := 'deliver_received_messages' ??
?? NEWTITLE := 'terminate_input_processing -- Job Recovery / Task Termination', EJECT ??

  PROCEDURE deliver_received_messages
    (    system_input_task: boolean;
     VAR received_messages: ^nlt$bm_message_descriptor);

    VAR
      current_message,
      previous_message,
      next_message: ^nlt$bm_message_descriptor,
      ignore_status: ost$status,
      message_id: nlt$bm_message_id;

    PROCEDURE terminate_input_processing
      (    condition: pmt$condition;
           ignore_condition_descriptor: ^pmt$condition_information;
           sa: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      VAR
        i: integer;

      nap$condition_handler_trace (condition, sa);
      IF ((pmc$program_termination IN condition.reason) OR (pmc$program_abort IN condition.reason)) THEN
        IF next_message <> NIL THEN

{ Reverse the order of the remaining messages to LIFO.

          previous_message := NIL;
          current_message := next_message;
          REPEAT
            next_message := current_message^.received_message.next_received_message;
            current_message^.received_message.next_received_message := previous_message;
            previous_message := current_message;
            current_message := next_message;
          UNTIL (current_message = NIL);

          received_messages := previous_message;
          nlp$requeue_msgs_for_input_task (received_messages);
        IFEND;
      IFEND;
      condition_status.normal := TRUE;
    PROCEND terminate_input_processing;
?? OLDTITLE, EJECT ??
    osp$establish_block_exit_hndlr (^terminate_input_processing);

{ Relink the received message list in order to process the messages in FIFO order.

    IF (received_messages <> NIL) THEN
      previous_message := NIL;
      current_message := received_messages;
      REPEAT
        next_message := current_message^.received_message.next_received_message;
        current_message^.received_message.next_received_message := previous_message;
        previous_message := current_message;
        current_message := next_message;
      UNTIL (current_message = NIL);

      received_messages := previous_message;
      REPEAT
        next_message := received_messages^.received_message.next_received_message;
        message_id.descriptor := received_messages;
        message_id.sequence_number := received_messages^.sequence_number;
        IF received_messages^.received_message.pdu_type = nlc$channel_connection_pdu THEN
          nlp$cc_receive_event (message_id);
        ELSE
          receive_channelnet_packet (message_id);
        IFEND;
        received_messages := next_message;
      UNTIL (received_messages = NIL);
    IFEND;
    osp$disestablish_cond_handler;

  PROCEND deliver_received_messages;
?? OLDTITLE ??
?? NEWTITLE := 'open_link_access_sap', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to determine if the user request
{   to open a Channelnet SAP also requires that a Link Access SAP be
{   opened in an OSI communications device, and if so, over which
{   networks should the SAP be opened. A Link Access SAP is required
{   only if the directly connected network is only accessable via an
{   ICA-II.
{

  PROCEDURE open_link_access_sap
    (    sap_id: nat$cn_sap_id;
         event_processor: nat$network_procedure;
     VAR sap_opened: boolean;
     VAR status: ost$status);

    VAR
      device: nlt$device_identifier,
      device_count: nlt$device_identifier,
      device_list: ^array [1 .. * ] of nlt$device_identifier,
      network_device_list: ^nlt$network_device_list;


    status.normal := TRUE;
    sap_opened := FALSE;
    nlp$get_nonexclusive_access (nlv$configured_network_devices.access_control);
    network_device_list := nlv$configured_network_devices.network_device_list;
    PUSH device_list: [1 .. UPPERBOUND (network_device_list^)];
    device_count := 0;

    FOR device := 1 TO UPPERBOUND (network_device_list^) DO
      IF network_device_list^ [device].kind = nac$ica_2 THEN
        device_count := device_count + 1;
        device_list^ [device_count] := device;
      IFEND;
    FOREND;
    nlp$release_nonexclusive_access (nlv$configured_network_devices.access_control);
    IF device_count > 0 THEN
      nlp$la_open_sap (sap_id, device_count, device_list, nlc$cc_normal_class, event_processor, status);
      IF status.normal THEN
        sap_opened := TRUE;
      IFEND;
    IFEND;

  PROCEND open_link_access_sap;

?? OLDTITLE ??
?? NEWTITLE := 'release_incomplete_message', EJECT ??

  PROCEDURE release_incomplete_message
    (    incomplete_message: ^nlt$bm_message_descriptor);

    VAR
      message_id: nlt$bm_message_id;

    message_id.descriptor := incomplete_message;
    message_id.sequence_number := incomplete_message^.sequence_number;
    nlp$bm_release_message (message_id);

  PROCEND release_incomplete_message;
?? OLDTITLE ??
MODEND nam$channelnet_ring3;
