*COMDECK SSRVS
_$J+? 
_***********************************************************************
*                                                                      *
*         STRUCTURE SERVICES TABLE DESCRIPTIONS        7/28/75         *
*                                                                      *
*   TYPE 1 TABLE                                                       *
*                                                                      *
*   A STATIC STRUCTURE WITH TWO-WORD ENTRIES.  THE FIRST WORD          *
*   HAS THE LEFT 8-BITS SPARE (FOR USER INFO) AND THE RIGHT            *
*   8-BITS THE ID TO LOOK UP.  THE SECOND WORD IS A STRUCTURE          *
*   POINTER.  THE LOOK-UP IS DONE BY SCANNING THE TABLE FOR            *
*   MATCHING ID.  THERE ARE NO HOLES IN THE TABLE AND AN END-OF-       *
*   TABLE DELIMITER ($FFFF,0) MUST ALWAYS EXIST.                       *
*                                                                      *
*   TYPE 2 TABLE                                                       *
*                                                                      *
*   A DYNAMIC TWO-LEVEL TABLE CURRENTLY IMPLEMENTED IN 16-WORD         *
*   BUFFERS.  THE FIRST LEVEL LOOK-UP IS THE UPPER 4-BITS OF           *
*   THE ID, GIVING A POINTER TO A SECOND LEVEL TABLE.  THE             *
*   SECOND LEVEL LOOK-UP IS THE BOTTOM 4-BITS OF THE ID.               *
*                                                                      *
***********************************************************************?
_$J+? 
_*****************************
*                            *
*        PN1GTPTR            *
* GET TYPE 1 ENTRY ADDRESS   *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW- PN1GTPTR RETURNS THE ADDRESS OF THE TYPE 1 TABLE ENTRY     *
*           SPECIFIED BY ID.                                           *
*                                                                      *
**INPUT- THE ADDRESS OF THE TYPE 1 TABLE AND THE ID TO LOOK UP.        *
*                                                                      *
**OUTPUT- THE ADDRESS OF THE ENTRY IN THE LIST, OR NIL IF ENTRY        *
*         NOT FOUND.                                                   *
*                                                                      *
**EXTERNAL SUBROUTINES- NONE                                           *
*                                                                      *
***********************************************************************?
FUNCTION PN1GTPTR_(ID : INTEGER; PTR : B0BUFPTR):B0BUFPTR?; 
BEGIN 
    PN1GTPTR := NIL;                        _ RETURN NIL IF ID NOT FND ?
    IF NIL " PTR THEN                       _ CHECK IF NIL TBLE ADDRESS?
 10:IF ID = PTR'.BRTYP1.BRID                _ CHECK FOR ID MATCH       ?
    THEN PN1GTPTR := PTR                    _ YES- RETURN ENTRY ADDRESS?
    ELSE
    IF BREND " PTR'.BRTYP1 THEN             _ NO- CHECK FOR END-OF-TBLE?
    BEGIN 
      PTR := PTR+2;                         _ BUMP TO NEXT ENTRY       ?
      GOTO 10;                              _ LOOP                     ?
    END;
END; _PN1GTPTR? 
_$J+? 
_*****************************
*                            *
*         PN1SRCH            *
*   SEARCH TYPE 1 TABLE      *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW- PN1SRCH SEARCHES A GIVEN TYPE 1 TABLE FOR MATCHING ID,     *
*           RETURNING THE TABLE ENTRY (A STRUCTURE POINTER) IF         *
*           FOUND AND NIL IF NOT FOUND.                                *
*                                                                      *
**INPUT- THE ADDRESS OF THE TYPE 1 TABLE AND THE ID TO LOOK UP.        *
*                                                                      *
**OUTPUT- THE TABLE ENTRY (IF FOUND) OR NIL (IF NOT FOUND).            *
*                                                                      *
**EXTERNAL SUBROUTINES- NONE                                           *
*                                                                      *
***********************************************************************?
FUNCTION PN1SRCH_(ID : INTEGER; PTR : B0BUFPTR):B0BUFPTR?;
BEGIN 
    PN1SRCH := NIL;                         _ INITIALIZE RETURN VALUE  ?
    IF PTR " NIL THEN                       _ IF POINTER VALID         ?
10: IF ID = PTR'.BRTYP1.BRID                _ IF ID FOUND              ?
    THEN
      PN1SRCH := PTR'.BRTYP1.BRPTR          _ RETURN POINTER           ?
    ELSE
      IF PTR'.BRTYP1 " BREND                _ IF MORE ENTRIES IN TABLE ?
      THEN
      BEGIN 
        PTR := PTR + 2;                     _ CONTINUE TO SEARCH       ?
        GOTO 10;
      END;
END; _ PN1SRCH ?
_$J+? 
_*****************************
*                            *
*        PN2SRCH             *
*   SEARCH TYPE 2 TABLE      *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW- PN2SRCH SEARCHES A GIVEN TYPE 2 TABLE FOR MATCHING ID,     *
*           RETURNING THE TABLE ENTRY (A STRUCTURE POINTER) IF         *
*           FOUND AND NIL IF NOT FOUND.                                *
*                                                                      *
**INPUT- THE ADDRESS OF THE TYPE 2 TABLE AND THE ID TO LOOK UP.        *
*                                                                      *
**OUTPUT- THE TABLE ENTRY (IF FOUND) OR NIL (IF NOT FOUND).            *
*                                                                      *
**EXTERNAL SUBROUTINES- NONE                                           *
*                                                                      *
***********************************************************************?
FUNCTION PN2SRCH_(ID : INTEGER; PTR : B0BUFPTR) : B0BUFPTR?;
BEGIN 
  PN2SRCH := NIL;                             _ RETURN NIL IF NOT FND  ?
  IF NIL " PTR THEN                           _ CHECK IF NIL TABLE ADDR?
  BEGIN 
    PTR := PTR'.BCCHAINS[ID/J0T2SZE+1];       _ UPPER 4-BITS OF ID     ?
    IF NIL " PTR THEN                         _ CHECK IF 2ND LEVEL     ?
    PN2SRCH := PTR'.BCCHAINS[ID MOD J0T2SZE+1];_LOWER 4 BITS OF ID     ?
  END;
END; _PN2SRCH?
_$J+? 
_*****************************
*                            *
*        PN2ADD              *
*  ADD ENTRY TO TYPE 2 TABLE *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW- PN2ADD ADDS A GIVEN ID AND STRUCTURE ADDRESS TO A          *
*           SPECIFIED TYPE 2 TABLE.                                    *
*                                                                      *
**INPUT- TYPE 2 TABLE ADDRESS, ID AND POINTER TO ADD TO TABLE.         *
*                                                                      *
**OUTPUT- PN2ADD CREATES A 1ST/2ND LEVEL TABLE IF NECESSARY,           *
*         RETURNING THE POINTER TO  A  NEWLY CREATED 1ST LEVEL         *
*         TABLE.  ADDING AN ID THAT IS ALREADY IN THE TABLE            *
*         IS ALLOWED- THE PREVIOUS TABLE ENTRY BEING REPLACED          *
*         BY THE NEW TABLE ENTRY.                                      *
*                                                                      *
**EXTERNAL SUBROUTINES-                                                *
*               1) PBGET1BF      GET ONE BUFFER                        *
*               2) PBCLR         CLEAR BLOCK OF CORE                   *
***********************************************************************?
PROCEDURE PN2ADD(ID : INTEGER;              _ ID TO ADD                ?
                 VAR PTR : B0BUFPTR;        _ TYPE 2 TABLE ADDRESS     ?
                 ADDPTR : B0BUFPTR);        _ ENTRY TO ADD             ?
VAR CHN1 : INTEGER;                         _ 1ST LEVEL CHAIN INDEX    ?
BEGIN 
  CHN1 := ID/J0T2SZE+1;                     _ CALC 1ST LEVEL CHAIN IND ?
  IF NIL = PTR THEN 
  BEGIN 
    PTR := PBGET1BF(J0T2BFSZE);             _ GET 1ST LEVEL BUFFER     ?
    PBCLR(PTR,J0T2SZE);                     _ SET TO NIL               ?
  END;
  IF NIL = PTR'.BCCHAINS[CHN1] THEN 
  BEGIN                                     _ GET 2ND LEVEL BUFFER     ?
    PTR'.BCCHAINS[CHN1] := PBGET1BF(J0T2BFSZE); 
    PBCLR(PTR'.BCCHAINS[CHN1],J0T2SZE);     _ SET TO NIL               ?
  END;                                      _ ADD ENTRY                ?
  PTR'.BCCHAINS[CHN1]'.BCCHAINS[ID MOD J0T2SZE+1] := ADDPTR;
END; _PN2ADD? 
_$J+? 
_*****************************
*                            *
*          PN2DLT            *
*  DELETE TYPE 2 TABLE ENTRY *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW- PN2DLT DELETES AN ID FROM A TYPE 2 TABLE.  BUFFERS         *
*           THAT BECOME EMPTY ARE RELEASED.                            *
*                                                                      *
**INPUT- ID TO DELETE AND TYPE 2 TABLE ADDRESS.                        *
*                                                                      *
**OUTPUT- PN2DLT RETURNS THE STRUCTURE POINTER OF THE ENTRY BEING      *
*         DELETED, IF FOUND, NIL IF NOT FOUND.                         *
*                                                                      *
**EXTERNAL SUBROUTINES-                                                *
*                 1) PN2ADD        ADD ENTRY TO TYPE 2 TABLE           *
*                 2) PBREL1BF      RELEASE A BUFFER                    *
*                 3) PBCOMP        COMPARE BLOCKS OF CORE              *
*                                                                      *
***********************************************************************?
FUNCTION PN2DLT(ID : INTEGER;                    _ ID TO DELETE        ?
                VAR PTR : B0BUFPTR) : B0BUFPTR;  _ TYPE 2 TABLE ADDR   ?
TYPE ZERO = ARRAY [1..J0T2SZE] OF INTEGER;
VAR ZEROBUF : ZERO; 
    COMPEQU : BOOLEAN;                      _ RESULT OF PBCOMP         ?
    CHN1 : INTEGER;                         _ 1ST LEVEL CHAIN INDEX    ?
    ZEROPTR : INTEGER;
VALUE ZEROBUF = (J0T2SZE*0);
BEGIN 
  PN2DLT := NIL;
  CHN1 := ID/J0T2SZE+1;                     _ CALC 1ST LEVEL CHAIN IND ?
  ADDR(ZEROBUF,ZEROPTR);
  IF NIL " PTR THEN                         _ CHECK FOR NIL TABLE      ?
  WITH PTR' DO
  BEGIN 
    PN2DLT := PN2SRCH(ID,PTR);             _RETURN DELETED ENTRY       ?
    PN2ADD(ID,PTR,NIL);                     _ DELETE ENTRY             ?
    PBCOMP(BCCHAINS[CHN1],                  _ COMPARE 2ND LEVEL        ?
           ZEROPTR,J0T2SZE);
    INST($6400,COMPEQU);                    _ STORE RESULT OF COMPARE  ?
    IF COMPEQU THEN                         _ SEE IF 2ND LEVEL EMPTY   ?
    BEGIN 
      PBREL1BF(BCCHAINS[CHN1],J0T2BFSZE);  _ YES- RELEASE IT           ?
      PBCOMP(PTR,ZEROPTR,J0T2SZE);          _ COMPARE 1ST LEVEL        ?
      INST($6400,COMPEQU);                 _ STORE RESULT OF COMPARE   ?
      IF COMPEQU THEN                      _ SEE IF 1ST LEVEL EMPTY    ?
      PBREL1BF(PTR,J0T2BFSZE);             _ YES- RELEASE IT           ?
    END;
  END;
END; _PN2DLT? 
_$J+? 
_*****************************
*                            *
*          PN2FULL           *
*  TEST TYPE 2 TABLE FULL    *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW- PN2FULL TESTS IF A TYPE 2 TABLE IS FULL.                   *
*                                                                      *
**INPUT- TYPE 2 TABLE ADDRESS.                                         *
*                                                                      *
**OUTPUT- PN2FULL IS A BOOLEAN FUNCTION RETURNING TRUE IF THE          *
*         TYPE 2 TABLE IS FULL AND FALSE IF IT IS NOT FULL.            *
*                                                                      *
**EXTERNAL SUBROUTINES USED- NONE                                      *
*                                                                      *
***********************************************************************?
FUNCTION PN2FULL(PTR : B0BUFPTR) : BOOLEAN; 
VAR I,J : INTEGER;
BEGIN 
  PN2FULL := FALSE;                         _ RETURN FALSE IF NOT FULL ?
  IF NIL " PTR THEN                         _ CHECK IF NIL TYPE 2 TABLE?
  BEGIN 
    WITH PTR' DO
    FOR I := 1 TO J0T2SZE DO                _-CHECK 1ST LEVEL FOR      ?
    IF NIL = BCCHAINS[I] THEN GOTO 10;      _-NIL ENTRY                ?
    FOR I := 1 TO J0T2SZE DO
    WITH PTR'.BCCHAINS[I]' DO 
    FOR J := 1 TO J0T2SZE DO                _-TEST EACH 2ND LEVEL TABLE?
    IF NIL = BCCHAINS[J] THEN GOTO 10;      _-FOR NIL ENTRY            ?
    PN2FULL := TRUE;                        _ RETURN TRUE IF FULL      ?
  END;
 10:; 
END; _PN2FULL?
_$J+? 
_*****************************
*                            *
*          PNGTLLCB          *
*  PERFORM DN, SN LOOK-UP    *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
** OVERVIEW-  PNGTLLCB TAKES A GIVEN DN AND SN AND SEARCHES THE        *
*           ROUTING DIRECTORY, RETURNING A LOGICAL LINK CONTROL        *
*           BLOCK ADDRESS IF THE SEARCH IS SUCCESSFUL. THE DN          *
*           DIRECTORY IS A TYPE 1 TABLE CONTAINING POINTERS TO         *
*           THE SN TABLE, A TYPE 2 TABLE; AND TO COUPLER AND           *
*           TRUNK CONTROL BLOCKS.  THE SN DIRECTORY AND COUPLER        *
*           CONTROL BLOCKS POINT TO LLCB#S.                            *
*                                                                      *
**INPUT- DN AND SN.                                                    *
*                                                                      *
**OUTPUT- LLCB ADDRESS OR NIL, IF LOOK-UP UNSUCCESSFUL.                *
*                                                                      *
**EXTENAL SUBROUTINES-                                                 *
*              1) PN1GTPTR         GET TYPE 1 ENTRY ADDRESS            *
*              2) PN2SRCH          SEARCH TYPE 2 TABLE                 *
*                                                                      *
***********************************************************************?
FUNCTION PNGTLLCB (DN : INTEGER;SN : INTEGER) : B0BUFPTR ;
  
VAR 
      L7DNENTRY : B0BUFPTR;                 _POINTER TO DN ENTRY       ?
      L7CPRLLCB : B0BUFPTR;                 _POINTER TO COUPLER LLCB   ?
  
BEGIN 
PNGTLLCB  := NIL;                           _RETURN NIL IF NOT FOUND   ?
L7DNENTRY := PN1GTPTR (DN,DELOCDN);         _GET POINTER TO DN ENTRY   ?
IF L7DNENTRY " NIL                          _CHECK DN ENTRY EXISTS     ?
THEN
  WITH L7DNENTRY'.BRTYP1 DO                 _SET INDEX TO DN ENTRY     ?
    BEGIN 
    IF BRLNKT = NLTERM                      _CHECK LL ENDS IN THIS NODE?
    THEN
      PNGTLLCB := PN2SRCH (SN,BRPTR)        _RETURN RESULT OF SEARCH   ?
    ELSE
      IF BRLNKT = NLCOUPLER                 _CHECK LL ENDS AT A COUPLER?
      THEN
        BEGIN 
        L7CPRLLCB := BRPTR'.BHCCB.BHLLCB;   _GET POINTER TO FIRST LLCB ?
        WHILE L7CPRLLCB " NIL DO            _WHILE MORE LLCBS TO CHECK ?
          BEGIN 
          IF SN = L7CPRLLCB'.BLLLCB.        _CHECK FOR A SN MATCH      ?
                  BLSPART.BLSN
          THEN
            BEGIN                           _WE HAVE FOUND THE LLCB    ?
            PNGTLLCB := L7CPRLLCB;          _RETURN POINTER TO LLCB    ?
            GOTO 10;                        _EXIT ANY MORE SEARCHING   ?
            END;
          L7CPRLLCB := L7CPRLLCB'.BLLLCB.   _GET POINTER TO NEXT LLCB  ?
                       BLSPART.BLCHAIN; 
  
          END; _WHILE L7CPRLLCB " NIL DO? 
        END; _IF BRLNKT = NLCOUPLER?
    END; _WITH L7DNENTRY'.BRTYP1 DO?
10: 
END; _FUNCTION PNGTLLCB?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNACCHOST                                        * 
*                                                                     * 
*        CHECK ANY HOST ACCESSIBLE                                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNACCHOST CHECKS IF AT LEAST ONE HOST IS CURRENTLY     * 
*              ACCESSIBLE                                             * 
*                                                                     * 
** OUTPUT -    TRUE RETURNED IF AT LEAST ONE HOST IS ACCESSIBLE       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              1) PNGTLLCB         PERFORM DN, SN LOOKUP              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PNACCHOST (DUMMY : INTEGER) : BOOLEAN; 
  
VAR 
      A7HCB  : B0BUFPTR;                    _POINTER TO CURRENT HCB    ?
      A7LLCB : B0BUFPTR;                    _POINTER TO CURRENT LLCB   ?
  
BEGIN 
PNACCHOST := FALSE;                         _RETURN FALSE BY DEFAULT   ?
A7HCB     := DEHOSTABLE;                    _GET PTR TO FIRST HCB      ?
WHILE A7HCB'.BRTYP3.BRLAST " BREND DO       _WHILE MORE HCBS TO PROCESS?
  BEGIN 
  A7LLCB := PNGTLLCB (CKLOCNODE,            _GET PTR TO LLCB FOR NODE  ?
                      A7HCB'.BRTYP3.BRNODE);
  IF A7LLCB'.BLLLCB.BLSPART.BLCNFST         _CHECK IF ENABLED OR ACTIVE?
    \ C7ENABLED 
  THEN
    BEGIN                                   _AN ACCESSIBLE HOST FOUND  ?
    PNACCHOST := TRUE;                      _RETURN TRUE TO CALLER     ?
    GOTO 10;                                _EXIT ANY MORE SEARCHING   ?
    END; _IF A7LLCB' ....?
  A7HCB := A7HCB + 5;                       _ADVANCE PTR TO NEXT HCB   ?
  END; _WHILE A7HCB' .... DO? 
10: 
END; _FUNCTION PNACCHOST? 
