?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE: UDP Global Socket Manager' ??
?? NEWTITLE := 'Global Declarations Referenced by This Module' ??
MODULE nlm$udp_global_socket_manager;

{ PURPOSE:
{   The prime purpose of this module is to isolate the knowledge of the structures required
{   to access a specific global_socket.  Secondarily, the module contains service procedures to
{   support the global_socket.
{ DESIGN:
{   This module is designed to reside on the  OSF$JOB_TEMPLATE_23D library.
{   The module contains a procedure to create a global socket, to delete a specific global socket,
{   to acquire exclusive access to a specific global socket, and to release exclusive access to a
{   specific global socket.

?? PUSH (LISTEXT := ON) ??
*copyc nlc$nam_configuration_constants
*copyc nlc$udp_max_pool_size
*copyc nlt$udp_global_sockets
*copyc nlt$udp_received_message
*copyc nlt$udp_receiver_task
?? POP ??
*copyc nlp$udp_allocate_receiver
*copyc nlp$udp_deallocate_receiver
*copyc nlp$udp_free_exclusive_access
*copyc osp$clear_job_signature_lock
*copyc osp$initialize_signature_lock
*copyc osp$set_job_signature_lock
*copyc osp$test_signature_lock
*copyc oss$mainframe_paged_literal
*copyc oss$network_paged
*copyc osp$begin_subsystem_activity
*copyc osp$end_subsystem_activity
*copyc syp$cycle
*copyc nav$network_paged_heap
*copyc nlv$configured_network_devices
*copyc nlv$maximum_system_connections
*copyc nlv$udp_active_global_sockets
*copyc nlv$udp_global_sockets

  CONST
    successful = 0,
    failed = 1,
    locked = 2;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$udp_clear_exclusive_access', EJECT ??
*copy nlh$udp_clear_exclusive_access

  PROCEDURE [XDCL] nlp$udp_clear_exclusive_access
    (VAR global_socket {INPUT, OUTPUT} : ^nlt$udp_global_socket);

    VAR
      lock_status: ost$signature_lock_status;

    IF global_socket <> NIL THEN
      osp$test_signature_lock (global_socket^.lock, lock_status);
      IF lock_status = osc$sls_locked_by_current_task THEN
        osp$clear_job_signature_lock (global_socket^.lock);
        osp$end_subsystem_activity;
      IFEND;
      global_socket := NIL;
    IFEND;
  PROCEND nlp$udp_clear_exclusive_access;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$udp_create_global_socket', EJECT ??
*copy nlh$udp_create_global_socket

  PROCEDURE [XDCL] nlp$udp_create_global_socket
    (VAR global_socket: ^nlt$udp_global_socket);

?? NEWTITLE := 'initialize_global_socket_list' ??

    PROCEDURE initialize_global_socket_list;

      VAR
        actual_lock: string (8),
        global_sockets: ^array [0 .. * ] of nlt$udp_global_socket_root,
        initial_lock: string (8),
        new_lock: string (8),
        null_global_socket_root: [READ, oss$mainframe_paged_literal] nlt$udp_global_socket_root :=
              [[0, FALSE, 0], NIL],
        number_of_entries: integer,
        result: successful .. locked,
        root: nlt$udp_reference_number;

      initial_lock := nlc$udp_global_sockets_unlocked;
      new_lock := nlc$udp_global_sockets_locked;
      osp$begin_subsystem_activity;
      REPEAT
        #COMPARE_SWAP (nlv$udp_global_sockets_control.lock, initial_lock, new_lock, actual_lock, result);
        IF (result = failed) THEN
          osp$end_subsystem_activity;
          syp$cycle;
          osp$begin_subsystem_activity;
        IFEND;
      UNTIL (result = successful);

      IF (nlv$udp_global_sockets.list = NIL) THEN
        number_of_entries := nlc$base_connection_array_size;
        WHILE (number_of_entries * 4) < nlv$maximum_system_connections DO
          number_of_entries := number_of_entries * 2;
        WHILEND;
        ALLOCATE global_sockets: [0 .. (number_of_entries - 1)] IN nav$network_paged_heap^;
        IF (nlv$udp_global_sockets.socket_seed = 0) THEN
          nlv$udp_global_sockets.socket_seed := (#FREE_RUNNING_CLOCK (0) MOD
                (UPPERVALUE (nlt$udp_reference_number) + 1));
        IFEND;
        FOR root := 0 TO (number_of_entries - 1) DO
          global_sockets^ [root] := null_global_socket_root;
        FOREND;
        nlv$udp_global_sockets.list := global_sockets;
      IFEND;

      initial_lock := nlc$udp_global_sockets_locked;
      new_lock := nlc$udp_global_sockets_unlocked;
      REPEAT
        #COMPARE_SWAP (nlv$udp_global_sockets_control.lock, initial_lock, new_lock, actual_lock, result);
      UNTIL (result = successful);
      osp$end_subsystem_activity;
    PROCEND initialize_global_socket_list;
?? OLDTITLE ??
?? NEWTITLE := 'assign_global_socket_identifier' ??
?? NEWTITLE := '[INLINE] get_global_socket_id', EJECT ??

    PROCEDURE assign_global_socket_identifier
      (    global_socket: ^nlt$udp_global_socket;
       VAR socket_id_assigned: boolean;
       VAR global_socket_id: nlt$udp_global_socket_id);


      PROCEDURE [INLINE] get_global_socket_id
        (VAR global_socket_id: nlt$udp_global_socket_id);

        VAR
          initial_seed: integer,
          new_seed: integer,
          result: successful .. locked;

        initial_seed := 0;
        new_seed := 1;
        REPEAT
          #COMPARE_SWAP (nlv$udp_global_sockets.socket_seed, initial_seed, new_seed, initial_seed, result);
          CASE result OF
          = successful =
            global_socket_id.sequence := (new_seed DIV (UPPERVALUE (nlt$udp_reference_number) + 1));
            global_socket_id.reference_number := (new_seed MOD (UPPERVALUE (nlt$udp_reference_number) + 1));
          = failed =
            IF (((initial_seed + 1) MOD (UPPERVALUE (nlt$udp_reference_number) + 1)) > 0) THEN
              new_seed := initial_seed + 1;
            ELSE
              new_seed := initial_seed + 2;
            IFEND;
          = locked =
            ;
          CASEND;
        UNTIL (result = successful);
      PROCEND get_global_socket_id;
?? OLDTITLE, EJECT ??

      VAR
        actual_active: integer,
        first_global_socket: ^nlt$udp_global_socket,
        new_active: integer,
        number_of_roots: nlt$udp_global_sckts_per_system,
        result: successful .. locked,
        root: nlt$udp_reference_number,
        stem: ^nlt$udp_global_socket,
        stem_length: nlt$udp_reference_number;

      number_of_roots := UPPERBOUND (nlv$udp_global_sockets.list^) + 1;
      global_socket^.next_entry := NIL;
      socket_id_assigned := FALSE;

      actual_active := 0;
      new_active := 1;

    /assign_id/
      WHILE (NOT socket_id_assigned AND (actual_active < nlv$maximum_system_connections)) DO
        #COMPARE_SWAP (nlv$udp_global_sockets.active, actual_active, new_active, actual_active, result);
        CASE result OF
        = successful =
          nlv$udp_active_global_sockets := new_active;

        /assign_global_socket/
          REPEAT
            get_global_socket_id (global_socket_id);
            root := (global_socket_id.reference_number MOD number_of_roots);
            get_exclusive_to_root (root);
            first_global_socket := nlv$udp_global_sockets.list^ [root].first;

            IF (first_global_socket = NIL) THEN
              { Place global_socket at root. }
              nlv$udp_global_sockets.list^ [root].first := global_socket;
              release_exclusive_to_root (root);
              socket_id_assigned := TRUE;
            ELSE
              stem := first_global_socket;
              stem_length := 1;

            /add_global_socket_to_stem/
              REPEAT
                IF (stem^.identifier.reference_number <> global_socket_id.reference_number) THEN
                  IF (stem^.next_entry = NIL) THEN
                    IF (stem_length < ((actual_active DIV number_of_roots) + 1)) THEN
                      stem^.next_entry := global_socket;
                      release_exclusive_to_root (root);
                      socket_id_assigned := TRUE;
                    ELSE
                      release_exclusive_to_root (root);
                      CYCLE /assign_global_socket/;
                    IFEND;
                  ELSE
                    stem_length := stem_length + 1;
                    stem := stem^.next_entry;
                  IFEND;
                ELSE
                  release_exclusive_to_root (root);
                  CYCLE /assign_global_socket/;
                IFEND;
              UNTIL socket_id_assigned {add_global_socket_to_stem};
            IFEND;
          UNTIL socket_id_assigned {assign_global_socket};

        = failed =
          new_active := actual_active + 1;

        = locked =
          ;
        CASEND;
      WHILEND /assign_id/;

    PROCEND assign_global_socket_identifier;
?? OLDTITLE, EJECT ??

    VAR
      ignore_status: ost$status,
      received_message: ^nlt$udp_received_message,
      receiver_task: ^nlt$udp_receiver_task,
      socket: ^nlt$udp_global_socket,
      socket_id_assigned: boolean;

    IF (nlv$udp_global_sockets.list = NIL) THEN
      initialize_global_socket_list;
    IFEND;

    ALLOCATE socket: [1 .. UPPERBOUND (nlv$configured_network_devices.network_device_list^)] IN
          nav$network_paged_heap^;
    IF socket <> NIL THEN
      socket^.next_entry := NIL;
      osp$initialize_signature_lock (socket^.lock, ignore_status);

{ Initialize the available receiver pool.

      REPEAT
        ALLOCATE receiver_task IN nav$network_paged_heap^;
        IF receiver_task = NIL THEN
          syp$cycle;
        IFEND;
      UNTIL receiver_task <> NIL;
      socket^.available_receiver_pool := receiver_task;
      receiver_task^.next_entry := NIL;

{ Initialize the available message pool.

      socket^.available_message_pool_size := 1;
      REPEAT
        ALLOCATE received_message IN nav$network_paged_heap^;
        IF received_message = NIL THEN
          syp$cycle;
        IFEND;
      UNTIL received_message <> NIL;
      socket^.available_message_pool := received_message;
      received_message^.next_entry := NIL;

{ Allocate active receiver.

      nlp$udp_allocate_receiver (socket^.active_receiver);

{ Remaining fields are initialized by the socket layer code.

      osp$begin_subsystem_activity;
      osp$set_job_signature_lock (socket^.lock);
      assign_global_socket_identifier (socket, socket_id_assigned, socket^.identifier);
      IF NOT socket_id_assigned THEN
        FREE socket^.available_receiver_pool IN nav$network_paged_heap^;
        FREE socket^.available_message_pool IN nav$network_paged_heap^;
        nlp$udp_deallocate_receiver (socket^.active_receiver);
        FREE socket IN nav$network_paged_heap^;
        osp$end_subsystem_activity;
      IFEND;
    IFEND;

    global_socket := socket;

  PROCEND nlp$udp_create_global_socket;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$udp_delete_global_socket', EJECT ??
*copy nlh$udp_delete_global_socket

  PROCEDURE [XDCL] nlp$udp_delete_global_socket
    (    global_socket_id: nlt$udp_global_socket_id);

    VAR
      global_socket: ^^nlt$udp_global_socket,
      global_socket_to_free: ^nlt$udp_global_socket,
      initial_active: integer,
      new_active: integer,
      next_received_message: ^nlt$udp_received_message,
      next_receiver_task: ^nlt$udp_receiver_task,
      received_message: ^nlt$udp_received_message,
      receiver_task: ^nlt$udp_receiver_task,
      result: successful .. locked,
      root: nlt$udp_reference_number;

    root := (global_socket_id.reference_number MOD (UPPERBOUND (nlv$udp_global_sockets.list^) + 1));
    get_exclusive_to_root (root);
    global_socket := ^nlv$udp_global_sockets.list^ [root].first;

    WHILE (global_socket^ <> NIL) AND (global_socket^^.identifier <> global_socket_id) DO
      global_socket := ^global_socket^^.next_entry;
    WHILEND;
    IF global_socket^ <> NIL THEN
      osp$set_job_signature_lock (global_socket^^.lock);
      global_socket_to_free := global_socket^;
      global_socket^ := global_socket^^.next_entry;
      release_exclusive_to_root (root);

{ Free the allocated structures associated with the global socket.

      receiver_task := global_Socket_to_free^.available_receiver_pool;
      WHILE receiver_task <> NIL DO
        next_receiver_task := receiver_task^.next_entry;
        FREE receiver_task IN nav$network_paged_heap^;
        receiver_task := next_receiver_task;
      WHILEND;

      received_message := global_Socket_to_free^.available_message_pool;
      WHILE received_message <> NIL DO
        next_received_message := received_message^.next_entry;
        FREE received_message IN nav$network_paged_heap^;
        received_message := next_received_message;
      WHILEND;

{ Free the active receiver.

      nlp$udp_deallocate_receiver (global_socket_to_free^.active_receiver);
      FREE global_socket_to_free IN nav$network_paged_heap^;

      initial_active := 1;
      new_active := 0;

    /decrement_active_global_sockets/
      REPEAT
        #COMPARE_SWAP (nlv$udp_global_sockets.active, initial_active, new_active, initial_active, result);
        IF (result = failed) THEN
          new_active := initial_active - 1;
        IFEND;
      UNTIL (result = successful);
      nlv$udp_active_global_sockets := new_active;
    ELSE { global_socket = NIL
      release_exclusive_to_root (root);
    IFEND;
  PROCEND nlp$udp_delete_global_socket;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$udp_free_nonexclu_to_root', EJECT ??
*copy nlh$udp_free_nonexclu_to_root

  PROCEDURE [XDCL] nlp$udp_free_nonexclu_to_root
    (    root: nlt$udp_reference_number);
    release_nonexclusive_to_root (root);
  PROCEND nlp$udp_free_nonexclu_to_root;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$udp_get_nonexclu_to_root', EJECT ??
*copy nlh$udp_get_nonexclu_to_root

  PROCEDURE [XDCL] nlp$udp_get_nonexclu_to_root
    (    root: nlt$udp_reference_number);
    get_nonexclusive_to_root (root);
  PROCEND nlp$udp_get_nonexclu_to_root;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] nlp$udp_get_exclusive_via_gsid', EJECT ??
*copy nlh$udp_get_exclusive_via_gsid

  PROCEDURE [XDCL] nlp$udp_get_exclusive_via_gsid
    (    global_socket_id: nlt$udp_global_socket_id;
     VAR global_socket: ^nlt$udp_global_socket);

    VAR
      root: nlt$udp_reference_number,
      socket: ^nlt$udp_global_socket;

    IF nlv$udp_global_sockets.list <> NIL THEN
      root := (global_socket_id.reference_number MOD (UPPERBOUND (nlv$udp_global_sockets.list^) + 1));
      get_nonexclusive_to_root (root);
      socket := nlv$udp_global_sockets.list^ [root].first;

    /search_stem/
      WHILE (socket <> NIL) AND (socket^.identifier.reference_number <> global_socket_id.reference_number) DO
        socket := socket^.next_entry;
      WHILEND /search_stem/;
      IF socket <> NIL THEN
        osp$begin_subsystem_activity;
        osp$set_job_signature_lock (socket^.lock);
      IFEND;
      global_socket := socket;
      release_nonexclusive_to_root (root);
    ELSE
      global_socket := NIL;
    IFEND;
  PROCEND nlp$udp_get_exclusive_via_gsid;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] get_exclusive_to_root', EJECT ??

  PROCEDURE [INLINE] get_exclusive_to_root
    (    root: nlt$udp_reference_number);

    VAR
      actual_root: nlt$udp_global_sckt_root_access,
      initial_root: nlt$udp_global_sckt_root_access,
      new_root: nlt$udp_global_sckt_root_access,
      result: successful .. locked;

    initial_root.nonexclusive_accessors := 0;
    initial_root.exclusive := FALSE;
    initial_root.fill := 0;
    new_root := initial_root;
    new_root.exclusive := TRUE;

    osp$begin_subsystem_activity;
    REPEAT
      #COMPARE_SWAP (nlv$udp_global_sockets.list^ [root].access_control, initial_root, new_root, actual_root,
            result);
      IF (result = failed) THEN
        osp$end_subsystem_activity;
        syp$cycle;
        osp$begin_subsystem_activity;
      IFEND;
    UNTIL (result = successful);
  PROCEND get_exclusive_to_root;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] get_nonexclusive_to_root', EJECT ??

  PROCEDURE [INLINE] get_nonexclusive_to_root
    (    root: nlt$udp_reference_number);

    VAR
      initial_root: nlt$udp_global_sckt_root_access,
      new_root: nlt$udp_global_sckt_root_access,
      result: successful .. locked;

    initial_root.nonexclusive_accessors := 0;
    initial_root.exclusive := FALSE;
    initial_root.fill := 0;
    new_root := initial_root;
    new_root.nonexclusive_accessors := 1;

    REPEAT
      #COMPARE_SWAP (nlv$udp_global_sockets.list^ [root].access_control, initial_root, new_root, initial_root,
            result);
      IF (result = failed) THEN
        IF initial_root.exclusive THEN
          syp$cycle;
          initial_root.exclusive := FALSE;
        IFEND;
        new_root.nonexclusive_accessors := initial_root.nonexclusive_accessors + 1;
      IFEND;
    UNTIL (result = successful);
  PROCEND get_nonexclusive_to_root;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] release_exclusive_to_root', EJECT ??

  PROCEDURE [INLINE] release_exclusive_to_root
    (    root: nlt$udp_reference_number);

    VAR
      actual_root: nlt$udp_global_sckt_root_access,
      initial_root: nlt$udp_global_sckt_root_access,
      new_root: nlt$udp_global_sckt_root_access,
      result: successful .. locked;

    initial_root.nonexclusive_accessors := 0;
    initial_root.exclusive := TRUE;
    initial_root.fill := 0;
    new_root := initial_root;
    new_root.exclusive := FALSE;

    REPEAT
      #COMPARE_SWAP (nlv$udp_global_sockets.list^ [root].access_control, initial_root, new_root, actual_root,
            result);
    UNTIL (result = successful);
    osp$end_subsystem_activity;
  PROCEND release_exclusive_to_root;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] release_nonexclusive_to_root', EJECT ??

  PROCEDURE [INLINE] release_nonexclusive_to_root
    (    root: nlt$udp_reference_number);

    VAR
      initial_root: nlt$udp_global_sckt_root_access,
      new_root: nlt$udp_global_sckt_root_access,
      result: successful .. locked;

    initial_root.nonexclusive_accessors := 1;
    initial_root.exclusive := FALSE;
    initial_root.fill := 0;
    new_root := initial_root;
    new_root.nonexclusive_accessors := 0;

  /release_root/
    REPEAT
      #COMPARE_SWAP (nlv$udp_global_sockets.list^ [root].access_control, initial_root, new_root, initial_root,
            result);
      IF (result = failed) THEN
        new_root.nonexclusive_accessors := initial_root.nonexclusive_accessors - 1;
      IFEND;
    UNTIL (result = successful);
  PROCEND release_nonexclusive_to_root;
?? OLDTITLE ??
MODEND nlm$udp_global_socket_manager;
