*COMDECK SVM
_$J+? 
_*****************************
*                            *
*         PNLNBAD            *
*     VALIDATE LINE NO.      *
*                            *
*****************************?
_$R-,G-,I-     NON-RECURSIVE
               INTERRUPTABLE ?
_***********************************************************************
*                                                                      *
**OVERVIEW- PNLNBAD VALIDATES A GIVEN LINE NUMBER AS FOLLOWS:          *
*           IF THE PORT IS ZERO THE LINE NO. IS VALID IF               *
*           THE SUBPORT IS NOT GREATER THAN THE CONFIGURED NO.         *
*           OF SUBPORTS.  IF                                           *
*           THE PORT IS NON-ZERO, THE LINE NO. IS VALID IF THE         *
*           PORT IS NOT GREATER THAN THE NO. OF CONFIGURED PORTS.      *
*           THE GLOBAL C0LCBADDR IS LOADED WITH THE LCB ADDRESS        *
*           OF THE GIVEN LINE NO.                                      *
*                                                                      *
**INPUT-  LINE NO. TO CHECK.                                           *
*                                                                      *
**OUTPUT- PNLNBAD IS A BOOLEAN FUNCTION RETURNING TRUE IF THE LINE     *
*         NO. IS INVALID AND FALSE IF THE LINE NO. IS VALID.           *
*                                                                      *
**EXTERNAL SUBROUTINES- NONE                                           *
*                                                                      *
**WARNING-   PNLNBAD MUST ALWAYS RESIDE IN ABSOLUTE MEMORY IN A        *
*            PAGED BUILD.  IT IS , LOGICALLY, A BASE SYSTEM ROUTINE.   *
*                                                                      *
***********************************************************************?
FUNCTION PNLNBAD_(LINENO : B0LINO) : BOOLEAN?;
BEGIN 
  WITH LINENO DO
  IF 0 = BDPORT THEN                        _CHECK PORT FOR 0          ?
  BEGIN 
    PNLNBAD := (C4SUBLCB < BDSUBPORT) !     _CHECK SUBPORT OUT-OF-RANGE?
               (0 = BDSUBPORT); 
    ADDR(CSUBLCBP'[BDSUBPORT],C0LCBADDR);   _PUT LCB ADDR IN C0LCBADDR ?
  END 
  ELSE
  BEGIN 
    PNLNBAD := (C4LCBS < BDPORT);           _CHECK PORT OUT-OF-RANGE   ?
    ADDR(CGLCBP'[BDPORT], C0LCBADDR);       _PUT LCB ADDR IN C0LCBADDR ?
  END;
END; _PNLNBAD?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                   PNCONFIGURE                                       * 
*                                                                     * 
*         PROCESS FIELD NUMBER/FIELD VALUES                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNCONFIGURE IS CALLED TO PROCESS FIELD NUMBERS (FN)    * 
*              AND FIELD VALUES (FV). THIS PROCEDURE HANDLES FV       * 
*              CHANGES AND REQUESTS TERMINAL CHARACTERISTICS *D9RTC*. * 
*              FV CHANGES ARE VALIDIATED IN CONJUNCTION WITH THE      * 
*              PASSED ACTION TABLE ADDRESS *D0AT*. IF ANY CHANGE IS   * 
*              INVALID OR ILLEGAL -- NONE OF THE PREVIOUS CHANGES     * 
*              PROCESSED BY *PNCONFIGURE* DURING THIS CALL WILL       * 
*              BE EFFECTED. NORMAL PROCCESSING FLOW CONSISTS OF       * 
*              SAVING THE CURRENT VALUES OF ALL FN(S) -- EITHER       * 
*              TCB OR LCB FIELD VALUES. THE ACTION TABLES ARE THEN    * 
*              USED TO VALIDIATE THE FV -- NOTE THAT TIP/DEVICE       * 
*              ACTION TABLES ARE THREADED TO EITHER THE TCB/LCB       * 
*              SYSTEM ACTION TABLE. IF THE FN CHANGE IS FOR A TCB     * 
*              AN ADDITION CHECK IS MADE TO ENSURE THAT THE FN        * 
*              IS NOT OUTSIDE THE DISPLACEMENT OFFSET FOR THE TIP     * 
*              TYPE -- THIS LOGIC IS EMPLOYED TO MINIMIZE THE NUMBER  * 
*              OF ACTION TABLES NEEDED FOR EACH TIP. AFTER ALL FN(S)  * 
*              HAVE BEEN PROCESSED AND STORED (VIA PNSTORE) A CHECK   * 
*              IS MADE TO SEE IF A VALID BUFFER IS PRESENT (D0IVT)    * 
*              AND THE APPROPRIATE RESPONSE (SERVICE MESSAGE) IS      * 
*              GENERATED.                                             * 
*                                                                     * 
** INPUT -     ALL INPUTS ARE PASSED VIA *GLOBL$S*                    * 
*              D0BFR - POINTER TO THE BUFFER CONTAINING THE FN/FV     * 
*                      PAIRS. CAN BE A PSEUDO BUFFER. FCD/LCD MUST    * 
*                      POINT TO THE FN/FV PAIRS                       * 
*              D0FDT - POINTER TO THE FIELD DESCRIPTION TABLE         * 
*              D0AT  - POINTER TO THE TIP/DEVICE ACTION TABLE         * 
*              D0IVT - FLAG USED TO INDICATE IF TERMINAL INPUT OR     * 
*                      PSEUDO BUFFER PRESENT.                         * 
*              D0CB  - POINTER TO LCB OR TCB                          * 
*                                                                     * 
** OUTPUT -    GLOBL$ CELL CONFIGOK INDICATES RESULTS OF PNCONFIGURE  * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              - PNSTORE          PUT/GET FV INTO LCB/TCB             * 
*              - PBXFER           TRANSFER TO PNSMGEN                 * 
*              - PBRELCHN         RELEASE BUFFER(S)                   * 
*              - PBRELZRO         RELEASE BUFFER(S) ZERO CHECK        * 
*              - PBULTS           ROUTE SVM MSG UPLINE                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNCONFIGURE;
  
LABEL 
  999;
  
CONST 
  D1GET     = 0;
  D1PUT     = 1;
  D1HN      = 20;                           _BSSHN FN                  ?
  D1AUTLOG  = 21;                           _BSAUTOLOG FN              ?
  D1AUTCON  = 22;                           _BSACON FN                 ?
  D1PRI     = 23;                           _BSIPRI FN                 ?
  D1UBL     = 24;                           _BSUBL FN                  ?
  D1UBZ     = 25;                           _BSUBZ FN                  ?
  D1ABL     = 26;                           _BSABL FN                  ?
  D1DBL     = 27;                           _BSDBL FN                  ?
  D1DBZMS   = 28;                           _BSDBZ FN1                 ?
  D1DBZLS   = 29;                           _BSDBZ FN2                 ?
  D1PARITY  = 50;                           _BSPARITY FN--NOT RESTRICTD?
  D1WINDOW  = 72;                           _BSLCW FN                  ?
  D1CTYP    = 73;                           _BSPVCSVC FN               ?
  D1NCIR    = 74;                           _BSNOSVC FN                ?
  D1NEN     = 75;                           _BSENSVC FN                ?
  D1RIC     = 77;                           _BSRIC FN                  ?
  D1BCF     = 78;                           _BSBCOMP FN                ?
  D1MREC    = 79;                           _BSMR FN                   ?
  D1DO      = 80;                           _BSDO FN                   ?
  D1RTSFC   =145;                           _BSARTSFC FN               ?
  D1NRESTRI = 19;                           _NUMBER OF RESTRICTED FN(S)?
  D1SETPAD  = A0WK28;                       _SET ITI PAD PARM WORKCODE ?
  D1LOPADPAR = 113;                         _LOW BOUND FOR PAD PARAM   ?
  D1HIPADPAR = 144;                         _UPPER BOUND FOR PAD PARAM ?
  
TYPE
  D1TYPCHAR = PACKED RECORD 
                D1TEST  : BOOLEAN;
                D1AFN   : B07BITS;
                D1ACHR  : B08BITS;
                D1OTH1  : B08BITS;
                D1OTH2  : B08BITS;
              END;
  
VAR 
  D1PFC     : INTEGER;                      _SAVE BUFFER PFC           ?
  D1SFC     : INTEGER;                      _SAVE BUFFER SFC           ?
  D1FCD     : INTEGER;                      _CURRENT BUFFER FCD        ?
  D1LCD     : INTEGER;                      _CURRENT BUFFER LCD        ?
  D1FN      : INTEGER;                      _CURRENT FIELD NUMBER      ?
  D1FV      : INTEGER;                      _CURRENT FIELD VALUE       ?
  D1INT     : INTEGER;                      _LOOP CONTROL              ?
  D1FDTSIZE : INTEGER;                      _SIZE OF FDT TABLE         ?
  D1PARSAV  : INTEGER;                      _SAVE PREVIOUS PARITY      ?
  D1CHLEN   : INTEGER;                      _PREVIOUS CHARACTER LENGTH ?
  D1BUFPTR  : B0BUFPTR;                     _POINTER TO MSG BUFFER     ?
  D1CHCREQD : BOOLEAN;                      _CHC/TE MSG REQUIRED       ?
  D1CTRLRTC : BOOLEAN;                      _CTRL/RTC MSG RECEIVED     ?
  D1PAR     : ARRAY [B7LOPARFV..B7HIPARFV]  _FOR TRANSFORMATION BETWEEN?
                OF INTEGER;                 _CCP AND HOST PARITY VALUES?
  D1SAVEFVS : ARRAY [1..D0TFDTLIM] OF INTEGER;
  D1RESTRIC : PACKED ARRAY [1..D1NRESTRI] 
                OF INTEGER; 
  D1CK4DUPE : BOOLEAN;
  D1CKCHAR  : PACKED ARRAY [1..9] OF D1TYPCHAR; 
  D1ISYNC   : BOOLEAN;                      _BSISYNC CHANGED           ?
  
VALUE 
  D1PAR     = (B7ZPAR,
               B7OPAR,
               B7EPAR,
               B7NPAR,
               B7IPAR); 
  D1RESTRIC = (D1HN,
               D1AUTLOG,
               D1AUTCON,
               D1PRI, 
               D1UBL, 
               D1UBZ, 
               D1ABL, 
               D1DBL, 
               D1DBZMS, 
               D1DBZLS, 
               D1WINDOW,
               D1CTYP,
               D1NCIR,
               D1NEN, 
               D1RIC, 
               D1BCF, 
               D1MREC,
               D1DO,
               D1RTSFC);
  D1CKCHAR  = ($2A00,$0000,                 _FN - B1                   ?
               $2B00,$0000,                 _FN - B2                   ?
               $3D00,$4000,                 _FN - EL CAN BE EQUAL TO EB?
               $4000,$3D00,                 _FN - EB CAN BE EQUAL TO EL?
               $2900,$2600,                 _FN - AB CAN BE EQUAL TO CN?
               $2700,$0000,                 _FN - BS                   ?
               $2800,$0000,                 _FN - CT                   ?
               $2600,$2900,                 _FN - CN CAN BE EQUAL TO AB?
               $0000,$0000);                _   - SECURITY CHARACTER   ?
_$J+? 
_ 
** PROCEDURE NAME  - P N 2 S T O R E
* 
** OVERVIEW        - THIS PROCEDURE CALLS *PNSTORE* TO GET OR PUT 
*                    FIELD VALUES INTO THE APPROPRIATE STRUCTURE. A 
*                    CHECK IS MADE FOR X25 EXTENSION. 
* 
** INPUT           - D2VALUE - VALUE TO STORE OR LOCATION TO RECEIVE
*                              FIELD VALUE
*                    D2ACTION - GET OR PUT ACTION 
* 
** NOTE            - D0CB  - MUST CONTAIN ADDRESS OF STRUCTURE
*                    D1INT - MUST CONTAIN FIELD NUMBER
*                    D0FDT - MUST CONTAIN PTR TO FIELD DESCRIPTION ARRAY
? 
PROCEDURE PN2STORE (VAR D2VALUE : INTEGER; D2ACTION : INTEGER); 
  
VAR 
  D2CB : B0BUFPTR;                          _ SAVE STRUCTURE ADDRESS   ?
  
BEGIN 
D2CB := D0CB;                               _ SAVE STRUCTURE POINTER   ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
IF D0FDT'.DDFDT[D1INT].DDX25EX              _ IF FV IS IN X25 EXTENSION?
THEN
  D0CB := D2CB'.BZZLCB.BZSLCBPTR;           _ FV IS STORED INTO X25 SUB?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
PNSTORE (D0FDT'.DDFDT[D1INT],D2VALUE,D2ACTION); 
D0CB := D2CB;                               _ RESTORE STRUCTURE POINTER?
END; _ PROCEDURE PN2STORE ? 
_ 
** PROCEDURE NAME  - P N 2 R O U T E
* 
** OVERVIEW        - THIS PROCEDURE DISPATCHES A MESSAGE BUFFER TO *BIP*
*                    A SPECIAL CHECK IS INCLUDED TO ENSURE THAT CNF/TE
*                    AND BF/CHG MESSAGES ARE NOT ROUTED.
* 
** INPUT           - PARAMETERS PASSED VIA *GLOBL$*/LEVEL 1 VARIABLES 
*                       D0BFR  - POINTER TO MESSAGE BUFFER
*                       D0CB   - CONTROL BLOCK POINTER (LCB/TCB)
*                       D1PFC  - PRIMARY FUNCTION CODE
* 
** EXTERNAL PROCEDURES
*                  - PBRELCHN - RELEASE CHAIN OF BUFFERS
*                  - PBULTS   - *BIP* UPLINE TIP SERVICES 
? 
PROCEDURE PN2ROUTE; 
  
BEGIN 
IF D1PFC " D8CTRL                           _IF PFC NOT CTRL           ?
THEN
  BEGIN 
  IF D1PFC " D8CNF                          _AND NOT CNF REQUEST       ?
  THEN
    PBRELCHN (D0BFR,BEDBSIZE);              _RELEASE THE BUFFER        ?
  END _ D1PFC " D8CTRL ?
ELSE
  BEGIN 
  D0BFR'.BFFCD   := PFC;                    _ADJUST FCD FOR *BIP*      ?
  B1FLGWD.KTWORD := HTCMD;                  _TYPE OF COMMAND           ?
  PBULTS (D0CB,D0BFR,B1FLGWD);              _HAVE *BIP* COMPLETE MSG   ?
  END; _ ELSE D1PFC = D8CTRL ?
END; _ PROCEDURE PN2ROUTE ? 
_ 
** PROCEDURE NAME  - P N 2 E R R O R
* 
** OVERVIEW        - THIS PROCEDURE IS CALLED TO CHECK FOR A POSSIBLE 
*                    ERROR IN THE PROCESSING OF FN/FV PAIRS. THE CONTROL
*                    BLOCK (LCB OR TCB) WILL BE RESTORED AND IF A VALID 
*                    BUFFER IS PRESENT THE ABNORMAL RESPONSE BIT WILL 
*                    SET AND *PN2ROUTE* CALLED TO DISPATCH BUFFER.
* 
** INPUT           - PARAMETERS PASSED VIA *GLOBL$*/LEVEL1 VARIABLES
*                      - CONFIGOK   USED TO DETERMINE IF ERROR
*                      - D0FDT      POINTER TO FIELD DESCRIPTION TBL
*                      - D0BFR      BUFFER POINTER
*                      - D0IVT      FLAG TO INDICATE BUFFER PRESENT 
*                      - D1SAVEFVS  ARRAY THAT HOLDS PREVIOUS VALUES
*                      - D1FN       OFFENDING FIELD NUMBER
*                      - D1SFC      SECONDARY FUNCTION CODE 
* 
** LEVEL 2 PROCEDURE CALLS
*                  - PN2STORE - RESTORE CONTROL BLOCK 
*                  - PN2ROUTE - DISPATCH BUFFER 
? 
PROCEDURE PN2ERROR; 
  
VAR 
 D2I     : INTEGER; 
  
BEGIN 
IF CONFIGOK " D3AC                          _IF ERROR THEN PROCESS IT  ?
THEN
  BEGIN 
  FOR D2I := 1 TO D1FDTSIZE DO
    BEGIN 
    D1INT := D2I;                           _USED BY *PN2STORE*        ?
    PN2STORE (D1SAVEFVS[D2I],D1PUT);        _RESTORE CONTROL BLOCK     ?
    END;
  IF D1FDTSIZE > D0LFDTLIM                  _IF WORKING ON TCB CHANGE  ?
  THEN
    BEGIN 
    D0CB'.BSTCB.BSPARITY  := D1PARSAV;      _RESTORE CORRECT PARITY    ?
    D0CB'.BSTCB.BSCHLEN   := D1CHLEN;       _AND CLA CHARACTER LENGTH  ?
    END;
  IF D0IVT = FALSE                          _IF BUFFER PRESENT         ?
  THEN
    BEGIN 
    WITH D0BFR' DO
      BEGIN 
      BFLCD          := SFC + 2;            _SET LENGTH OF RESPONSE    ?
      BFDATAC[SFC]   := CHR(D1SFC + $80);   _ABNORMAL RESPONSE         ?
      BFDATAC[SFC+1] := CHR(D1FN);          _OFFENDING FIELD NUMBER    ?
      BFDATAC[SFC+2] := CHR(CONFIGOK);      _ERROR REASON CODE         ?
      PBRELZRO(BCCHAINS[DBUFLENGTH],BEDBSIZE);
      END; _ WITH D0BFR' ?
    PN2ROUTE;                               _DISPATCH THE BUFFER       ?
    END; _ D0IVT = FALSE ?
  GOTO EXIT 999;                            _EXIT PNCONFIGURE          ?
  END; _ D2ERROR " D3AC ? 
END; _ PROCEDURE PN2ERROR ? 
_ 
** PROCEDURE NAME  - P N 2 A C T B L
* 
** OVERVIEW        - THIS PROCEDURE IS CALLED TO VALIDATE FIELD VALUES
*                    *D1FV* TO THE TIP/SYSTEM ACTION TABLES *D0AT*. IF
*                    NO ERROR OCCURS THEN THE NEW FIELD VALUE *D1FV*
*                    IS STORED IN THE CONTROL BLOCK STRUCTURE *D0CB*
*                    VIA *PN2STORE*. IF AN ERROR IS FOUND THEN ROUTINE
*                    EXITS TO *PN2ERROR* TO PROCESS THE ERROR.
* 
** INPUT           - PARAMETERS PASSED VIA *GLOBL$*/LEVEL 1 VARIABLES 
*                      D0CB      - POINTER TO CONTROL BLOCK (LCB/TCB) 
*                      D0AT      - POINTER TO ACTION TABLE
*                      D0IVT     - BOOLEAN TO INDICATE REAL BUFFER
*                      D0FDT     - POINTER TO FIELD DESCRIPTOR TABLE
*                      D1FDTSIZE - MAX. SIZE OF DESCRIPTOR TABLE
*                      D1CTRLRTC - BOOLEAN TO INDICATE CTRL/RTC MSG 
*                      D1FN      - FIELD NUMBER TO BE CHANGED 
*                      D1FV      - NEW FIELD VALUE
* 
** LEVEL 2 SUBROUTINES -
*                    PN2STORE - STORE *D1FV* INTO CONTROL BLOCK 
*                    PN2ERROR - PROCESS ERROR CONDITION 
* 
** SPECIAL NOTE    - THIS ROUTINE WILL NOT RETURN TO CALLER IF ERROR
*                    OCCURRED.
? 
PROCEDURE PN2ACTBL; 
  
CONST 
  D2FNTC    = 34;                           _FN FOR TERMINAL CLASS     ?
  D2FNPW    = 35;                           _FN FOR PAGE WIDTH         ?
  D2FNPL    = 36;                           _FN FOR PAGE LENGTH        ?
  D2FNEBX   = 65;                           _FN FOR EBX                ?
  
VAR 
  D2I       : INTEGER;
  D2TC      : INTEGER;
  D2INT     : INTEGER;
  D2FNHLD   : INTEGER;
  D2FVHLD   : INTEGER;
  D2DFHLD   : INTEGER;
  D2ACTKEY  : INTEGER;
  D2PARM    : B0OVERLAY;
  D2ACTBL   : DFATPTR;
  D2TCPWPL  : ARRAY [1..3] OF INTEGER;
  D2TCCHECK : ARRAY [N0HASP..N0734] OF INTEGER; 
  D2IDLECHR : ARRAY [N0110..N038400] OF INTEGER;
  D2VCHAR   : PACKED ARRAY [1..7] OF B0OVERLAY; 
  
VALUE 
  D2TCPWPL  = (D2FNTC, D2FNPW, D2FNPL); 
  D2TCCHECK = (1, 1, 0, 0, 0, 0, 1);
  D2IDLECHR = (100, 100, 66, 33, 17, 8, 4, 2, 1, 1, 1); 
  D2VCHAR   = ($3039,$415A,$617A,$0002,$2020,$3D3D,$7FFF);
  
BEGIN 
WITH D0CB'.BSTCB DO                         _ASSUME TCB POINTER        ?
  BEGIN 
  D2ACTBL := D0AT;                          _GET ACTION TABLE LOCAL    ?
  WHILE (D2ACTBL " NIL) &                   _ SEARCH ACTION TABLES     ?
        (CONFIGOK = D3AC) DO
    BEGIN 
    D2ACTKEY     := D2ACTBL'.DFAKEY;        _GET ACTION KEY            ?
    D2PARM.BAINT := D2ACTBL'.DFPARAM;       _ACTION PARAMTER           ?
    D2INT        := D2ACTBL'.DFFN;          _FN FROM ACTION TABLE      ?
    D2TC         := BSTCLASS;               _GET CURRENT TERM. CLASS   ?
    IF D2ACTBL'.DFEND = D0ATEND             _IF AT END OF USER         ?
    THEN                                    _ACTION TABLE THEN         ?
      D2ACTBL := D2ACTBL'.DFNEXT            _LINK TO SYSTEM TABLE      ?
    ELSE
      D2ACTBL := D2ACTBL + D0ATESIZE;       _INCREMENT TO NEXT         ?
    IF D2INT = D1FN                         _IF MATCH ON FN VALUE      ?
    THEN
      BEGIN 
      CASE D2ACTKEY OF                      _PROCESS ACTION KEY        ?
_ 
****  1.0 VERIFY THAT FIELD VALUE FALLS IN UPPER/LOWER RANGE
? 
      D2VUL:                                _VERIFY UPPER - LOWER      ?
      BEGIN 
      CONFIGOK := D3FNFVERR;                _ASSUME ERROR              ?
      IF D1FV @ D2PARM.BALBYT               _IF .LE. MAX. VALUE        ?
      THEN
        IF D1FV \ D2PARM.BARBYT             _AND .GE. MIN. VALUE       ?
        THEN
          CONFIGOK := D3AC;                 _THEN NO ERROR             ?
      END; _ D2VUL ?
_ 
****  2.0 VERIFY THAT FIELD VALUE DOES NOT LIE BETWEEN MIDDLE VALUE 
? 
      D2VM:                                 _VERIFY MIDDLE GROUND      ?
      IF D1FV > D2PARM.BALBYT               _IF HIGHER THAN MAX AND    ?
      THEN
        IF D1FV < D2PARM.BARBYT             _LESS THAN MINIMUN THE     ?
        THEN                                _ILLEGAL VALUE             ?
          CONFIGOK := D3FNFVERR;            _ERROR                     ?
_ 
****  3.0 RESTORE CARRIAGE RETURN IDLES FROM CHARACTERISTICS TABLE
? 
      D2CRIDLE:                             _RESTORE CR IDLE COUNT     ?
      IF D1FV = 1                           _ONLY IF FIELD VALUE       ?
      THEN                                  _IS TRUE                   ?
        BSCRIDLES := NJTECT[D2TC].NJCRIDLES;_GET COUNT FROM NJ TABLE   ?
_ 
****  4.0 RESTORE LINE FEED IDLES FROM CHARACTERISTICS TABLE
? 
      D2LFIDLE:                             _RESTORE LF IDLE COUNT     ?
      IF D1FV = 1                           _BUT ONLY IF TRUE PASSED   ?
      THEN
        BSLFIDLES := NJTECT[D2TC].NJLFIDLES;_GET COUNT FROM NJ TABLE   ?
_ 
****  5.0 PRECLUDE USER FROM CHANGING TO OR FROM 2741 TERMINAL CLASS
? 
      D2TC2741:                             _SPECIAL CHECK FOR 2741    ?
      IF D2TC " D1FV                        _IF CHANGING TERM. CLASS   ?
      THEN
        IF (D2TC = N02741) !                _IF CURRENTLY 2741         ?
           (D1FV = N02741)                  _OR CHANGING TO 2741       ?
        THEN
          CONFIGOK := D3ILLGTC;             _ERROR - ILLEGAL TC CHG    ?
_ 
****  6.0 PRECLUDE USER FROM CHANGING M4C TO M4A OR POST TO PRE HASP
? 
      D2TCM4HS:                             _SPECIAL CHECK FOR MODE 4C ?
      IF D2TCCHECK[D2TC] " D2TCCHECK[D1FV]  _AND HASP TO PRECLUDE USER ?
      THEN                                  _FROM CHANGING M4C TO M4A  ?
        CONFIGOK := D3ILLGLTC;              _OR PRE TO POST HASP       ?
_ 
****  7.0 MOVE DEFAULT TERMINAL CLASS VALUES INTO TCB 
? 
      D2TCBDFLT:                            _MOVE IN TCB DEFLT FIELDS  ?
      BEGIN 
      BSXB12 := FALSE;                      _SET USER BRK IN XPT FALSE ?
      D2INT := BJTIPTYPT[BSLCBP'.BZTIPTYPE]._GET SIZE OF IVT PORTION   ?
                         BJIVTSIZE;         _FROM TIP TYPE TABLE       ?
      FOR D2I := 1 TO D2INT DO              _MOVE IVT PORTION INTO     ?
        D0CB'.BIINT[D2I+CNTCBIVT] :=        _THE TCB                   ?
        NJTECT[D1FV].NJARRY[D2I+CNTCTIVT];
_ 
****  7.1 SPECIAL CASE PAGE WIDTH AND PAGE LENGTH ON LINE PRINTERS
? 
      IF BSDEVTYPE = N1LP                   _IF LINE PRINTER - SPECIAL ?
      THEN
        BEGIN 
        BSPGWIDTH  := NJTECT[D1FV].NJLPPW;
        BSPGLENGTH := NJTECT[D1FV].NJLPPL;
        END; _ BSDEVTYPE = N1LP ? 
      END; _ D2TCBDFLT ?
_ 
****  8.0 SPECIAL CASE THOSE FIELD VALUES THAT HAVE 2 FIELD NUMBERS 
? 
      D2UPPAIR:                             _PROCESS UPPER PAIR        ?
      BEGIN 
      D2FNHLD := D1FN + 1;                  _SAVE FIELD NUMBER         ?
      D2FVHLD := D1FV * $100;               _SAVE UPPER VALUE          ?
      D2DFHLD := D2PARM.BAINT;              _SAVE UPPER LIMIT          ?
      IF D1FV > D2PARM.BALBYT               _IF VALUE TOO LARGE        ?
      THEN
        CONFIGOK := D3INVLDVAL;             _SET ERROR                 ?
      END; _ D2UPPAIR ? 
_ 
****  9.0 PROCESS 2ND FIELD VALUE AND MERGE WITH 1ST VALUE
? 
      D2LOPAIR:                             _PROCESS LOWER PAIR        ?
      BEGIN 
      D2FVHLD    := D2FVHLD + D1FV;         _COMBINE UPPER-LOWER       ?
      CONFIGOK   := D3FNFVERR;              _ASSUME ERROR              ?
      IF D2FNHLD = D1FN                     _IF CORRECT FN             ?
      THEN
        IF D2FVHLD @ D2DFHLD                _IF .LE. TO MAX            ?
        THEN
          IF D2FVHLD \ D2PARM.BAINT         _IF .GE. TO MIN            ?
          THEN                              _NO ERROR                  ?
            CONFIGOK := D3AC;               _CLEAR ERROR INDICATOR     ?
      END; _ D2LOPAIR ? 
_ 
****  10.0 PARITY CHANGE REQUIRES THAT CHARACTER LENGTH ALSO CHANGE 
? 
      D2PARITY:                             _CHECK PARITY CHG          ?
      BEGIN 
      BSCHLEN := CWCHLEN[D1FV];             _CHG CHARACTER LENGTH      ?
      D1FV    := D1PAR[D1FV];               _CHG FV TO CLA (TCB) PARITY?
      END; _ D2PARITY ? 
_ 
****  11.0 VALIDATE THAT CODE SET AND TERMINAL CLASS AGREE
? 
      D2CD2741:                             _2741 CODE CHECK           ?
      IF D2TC " N02741                      _IF NOT A 2741             ?
      THEN                                  _THEN CODE SET CANNOT      ?
        IF D1FV > N0BITPAPL                 _BE A 2741 CODE SET        ?
        THEN
          CONFIGOK := D3INVLDVAL;           _ERROR                    ? 
_ 
****  12.0 CHECK THAT CERTAIN  CHARACTERS ARE VALID 
? 
      D2CHKCHAR:                            _CHECK CHARACTER           ?
      BEGIN 
      FOR D2INT := 1 TO 7 DO                _SEE IF ILLEGAL CHARACTER  ?
        IF D1FV \ D2VCHAR[D2INT].BALBYT     _IF CHARACTER FALLS        ?
        THEN                                _WITHIN THE RANGE THEN     ?
          IF D1FV @ D2VCHAR[D2INT].BARBYT 
          THEN
            CONFIGOK := D3FNFVERR;          _ERROR                     ?
      D1CK4DUPE := TRUE;                    _DUPLICATE CHAR TEST REQ   ?
      END; _ D2CKCHAR ? 
_ 
****  13.0 RESTORE END-OF-BLOCK OR END-OF-LINE CHARACTER
? 
      D2ELX:                                _CHANGE FN-FV VALUES       ?
      BEGIN 
      D2ACTBL := D0AT;                      _RESET ACTION TABLE        ?
      IF D1FV = 0                           _IF NOT VALUE CHANGE       ?
      THEN                                  _DUMMY IT UP               ?
        BEGIN 
        D1FV := BSELCHAR;                   _ASSUME *BSELX* FN         ?
        IF D1FN = D2FNEBX                   _BUT IF *BSEBX* FN         ?
        THEN
          D1FV := BSEBCHAR;                 _CHANGE VALUE              ?
        END 
      ELSE
        BEGIN 
        IF D1FV = 1                         _IF RESTORE E-O-L CHARACTER?
        THEN
          BEGIN 
          D1FV := NJTECT[D2TC].NJELCHAR;    _GET FROM *NJTECT* TABLE   ?
          IF D1FN = D2FNEBX                 _BUT IF *BSEBX* FN THEN GET?
          THEN
            D1FV := BSELCHAR;               _FROM CURRENT TCB SETTING  ?
          END 
        ELSE
          BEGIN 
          D1FV := BSEBCHAR;                 _RESTORE E-O-B CHARACTER   ?
          IF D1FN = D2FNEBX                 _BUT IF *BSEBX* FN THEN    ?
          THEN                              _RESTORE FROM *NJTECT* TBL ?
            D1FV := NJTECT[D2TC].NJEBCHAR;
          END; _ ELSE D1FV " 1 ?
        END; _ ELSE D1FV " 0 ?
      D1FN := D2PARM.BAINT;                 _GET APPROPRIATE FN        ?
      END; _ D2ELX ?
_ 
****  14.0 HARD ERROR IF TERMINAL CLASS IS IBM 2741 
? 
      D2E2741:                              _ERROR IF TC=2741          ?
      IF D2TC = N02741
      THEN                                  _YES                       ?
        CONFIGOK := D3INVLDVAL; 
_ 
****  15.0 SPECIAL RANGE CHECK FOR 2741 TERMINAL CLASS
? 
      D2CK2741:                             _SPECIAL D2VUL FOR 2741    ?
      BEGIN 
      IF D2TC = N02741
      THEN                                  _YES - START RANGE CHECK   ?
        BEGIN 
        IF D1FV > D2PARM.BALBYT             _IF LARGER THAN MAX        ?
        THEN
          CONFIGOK := D3INVLDVAL;           _ERROR                     ?
        IF D1FV < D2PARM.BARBYT             _IF LESS THAN MIN          ?
        THEN
           CONFIGOK := D3INVLDVAL;
        END; _ D2TC = N02741 ?
      END; _ D2CK2741 ? 
_ 
****  16.0 SOFT ERROR IF TERMINAL CLASS IS 2741 
? 
      D2I2741:                              _IGNORE ERROR IF 2741      ?
      IF D2TC = N02741
      THEN
        CONFIGOK := D3IGNORE;               _SET ERROR                 ?
_ 
****  17.0 SOFT ERROR 
? 
      D2IGNORE:                             _IGNORE ERROR              ?
      CONFIGOK := D3IGNORE;                 _SET CORRECT ERROR         ?
_ 
****  18.0 UNCONDITIONAL HARD ERROR 
? 
      D2ERROR:                              _HARD ERROR                ?
      CONFIGOK := D3INVLDVAL;               _DEFAULT ERROR             ?
_ 
****  19.0 SYNCHRONIZE INPUT
? 
      D2ISYNC:  
      IF BSDEVTYPE = N1CON
      THEN
        D1ISYNC := TRUE 
      ELSE
        CONFIGOK := D3INVLDVAL; 
_ 
****  20.0 COMPUTE CR/LF IDLES FROM DELAY SPECIFIED IN MILLISECONDS 
? 
      D2CRLFNULS: 
      BEGIN 
      IF D1FV " 0 
      THEN
        D1FV := PBMIN (((D1FV * 4 + D2IDLECHR[BSLCBP'.BZLNSPD] - 1) / 
                         D2IDLECHR[BSLCBP'.BZLNSPD]), 127); 
      CONFIGOK := D3AC;                     _NO ERROR                  ?
      END;
  
      END; _ CASE D2ACTKEY OF ? 
      END; _ D2TEMP = D1FV ?
_ 
************************************************************************
***************************END WHILE LOOP*******************************
************************************************************************
? 
  END; _ WHILE LOOP ? 
_ 
****    IF TCB FIELD NUMBER - MAKE A SPECIAL CHECK TO ENSURE THAT FIELD 
****    NUMBER LIES IN THE IVT RANGE OF THE TIP.
? 
  IF D1FDTSIZE > D0LFDTLIM                  _IF PROCESSING TCB FN(S)   ?
  THEN
    BEGIN 
    IF CONFIGOK = D3AC                      _AND NO ERROR FOUND YET    ?
    THEN
      BEGIN 
      IF D0FDT'.DDFDT[D1FN].DDFDISP >       _IF DISPLACEMENT TO STORE  ?
         BJTIPTYP[BSLCBP'.BZTIPTYPE]        _GREATER THAN SIZE OF TIP  ?
           .BJLIVTBVT.BAINT                 _IVT AREA THEN ERROR       ?
      THEN
        CONFIGOK := D3IGNORE;               _ASSUME A SOFT ERROR       ?
      END; _ CONFIGOK = D3AC ?
    END; _ D1FDTSIZE = D0TFDTLIM ?
_ 
****    IF TERMINAL INPUT AND SOFT ERROR FOUND - CHANGE TO HARD ERROR 
? 
  IF D0IVT = TRUE                           _TERMINAL INPUT            ?
  THEN
    BEGIN 
    IF CONFIGOK = D3IGNORE                  _AND SOFT ERROR            ?
    THEN
      CONFIGOK := D3INVLDVAL;               _CHANGE TO HARD ERROR      ?
    END; _ D0IVT = TRUE ? 
_ 
****    STORE THE NEW FIELD VALUE IF NO ERROR(S) FOUND AND CHECK
****    FOR A CHANGE IN TERMINAL CLASS/PAGE LENGTH/PAGE WIDTH 
? 
  IF CONFIGOK = D3AC                        _IF NO ERROR(S) FOUND      ?
  THEN
    BEGIN 
    D1INT := D1FN;
    PN2STORE (D1FV,D1PUT);
    FOR D2INT := 1 TO 3 DO
      BEGIN 
      IF D1FN = D2TCPWPL[D2INT]             _IF *TC*/*PW* OR *PL*      ?
      THEN
        D1CHCREQD := TRUE;                  _SET FLAG TO REMEMBER      ?
      END; _ FOR D2INT... ? 
    END; _ CONFIGOK = D3AC ?
_ 
****     EXIT IF HARD ERROR - IGNORE IF SOFT ERROR
? 
  IF CONFIGOK " D3IGNORE                    _AND NOT A SOFT ERROR      ?
  THEN
    PN2ERROR;                               _PROCESS ERROR - NO RETURN ?
  END; _ WITH D0CB'.BSTCB DO ?
END; _ PROCEDURE PN2ACTBL ? 
_$J+? 
_ 
****    S T A R T   P R O C E D U R E   P N C O N F I G U R E 
? 
BEGIN 
D1CTRLRTC := FALSE;                         _CTRL/RTC MSG = FALSE      ?
D1CHCREQD := FALSE;                         _CHC/TE REQUIRED = FALSE   ?
D1CK4DUPE := FALSE;                         _DUPLICAT CHAR TEST NOT REQ?
D1FDTSIZE := D0FDT'.DDNUMENT;               _GET SIZE OF FDT TABLE     ?
WITH D0BFR' DO
  BEGIN 
  D1PFC := ORD(BFDATAC[PFC]);               _GET PFC AND SFC LOCAL     ?
  D1SFC := ORD(BFDATAC[SFC]); 
  END; _ WITH D0BFR' ?
FOR D1INT := 1 TO D1FDTSIZE DO              _SAVE CURRENT IVT SETTINGS ?
  PN2STORE (D1SAVEFVS[D1INT],D1GET);        _VIA *PN2STORE*            ?
D1PARSAV  := D0CB'.BSTCB.BSPARITY;          _SPECIAL CASE PARITY AND   ?
D1CHLEN   := D0CB'.BSTCB.BSCHLEN;           _CLA CHARACTER LENGTH      ?
_ 
****  PROCESS MESSAGE DEPENDING ON *D0IVT* AND *D1PFC* SETTINGS 
? 
D1BUFPTR := D0BFR;                          _GET BUFFER POINTER LOCAL  ?
WHILE D1BUFPTR " NIL DO                     _PROCESS ALL BUFFERS       ?
  BEGIN 
  WITH D1BUFPTR' DO 
    BEGIN 
    D1FCD := BFFCD;                         _GET BUFFER FCD AND LCD    ?
    D1LCD := BFLCD; 
    REPEAT
      BEGIN 
      D1FN  := ORD(BFDATAC[D1FCD]);         _GET FIELD NUMBER          ?
      D1FV  := ORD(BFDATAC[D1FCD+1]);       _AND PASSED FIELD VALUE    ?
_ 
****  VALIDATE THAT THE FIELD NUMBER EXISTS 
? 
      CONFIGOK := D3FNERR;                  _ASSUME FN PASSED IS BAD   ?
      IF D0FDT'.DDFDT[D1FN].DDFDISP " 0     _IF FIELD NUMBER DEFINED   ?
      THEN
        IF D1FN \ D0FDT'.DDSTART            _AND .GE. LOWEST FIELD NO. ?
        THEN
          IF D1FN @ D1FDTSIZE               _AND .LE. HIGHEST FIELD NO.?
          THEN
            CONFIGOK := D3AC;               _THEN VALID FIELD NUMBER   ?
      PN2ERROR;                             _IF BAD FN - EXIT PDQ      ?
_ 
****  DETERMINE IF APPLICATION IS TRYING TO CHANGE A RESTRICTED FN
? 
      IF D0IVT = FALSE                      _IF CALLED WITH A BUFFER   ?
      THEN
        BEGIN 
        IF D1PFC " D8CNF                    _AND NOT CNF/TE MESSAGE    ?
        THEN
          BEGIN 
          IF D1SFC " D9RTC                  _AND NOT CTRL/RTC MESSAGE  ?
          THEN
_ 
****  ONLY CHECK IF VALID BUFFER PASSED AND NOT A CNF/TE OR CTRL/RTC
? 
            BEGIN 
            IF (D1FN \ D1LOPADPAR) &        _IF WITHIN PAD PARAMETER   ?
               (D1FN @ D1HIPADPAR)          _RANGE                     ?
            THEN
              BEGIN 
              CONFIGOK := D3INVLDAVL;       _INVALID FN CHANGE         ?
              PN2ERROR; 
              END 
            ELSE
              BEGIN 
              FOR D1INT := 1 TO D1NRESTRI DO _CHECK IF FN INVALID      ?
                BEGIN 
                IF D1RESTRIC[D1INT] = D1FN  _FOR CHANGE BY APPLICATION ?
                THEN
                  BEGIN 
                  CONFIGOK := D3INVLDAVL;   _INVALID FN CHANGE         ?
                  IF D1FN = D1UBZ           _ALLOW APPLICATIONS TO CHG ?
                  THEN                      _UPLINE BLOCK SIZE ON ALL  ?
                    IF D0CB'.BSTCB.BSDEVTYPE
                                  " N1CR
                    THEN                    _EXCEPT CARD READER        ?
                      CONFIGOK := D3AC; 
                  PN2ERROR;                 _PROCESS POSSIBLE ERROR    ?
                  END; _ D1RESTRIC... = D1FN? 
                END; _ FOR D1INT..? 
              END; _ ELSE D1FN ?
            END  _ D1SFC " D9RTC ?
          ELSE _ D1SPC = D9RTC ?
_ 
****  IF CTRL/RTC SERVICE MESSAGE - GET CURRENT VALUE AND PUT IN BUFFER 
? 
            BEGIN 
            D1FV := D1SAVEFVS[D1FN];        _GET CURRENT FIELD VALUE   ?
            IF D1FN = D1PARITY              _FOR PARITY, MUST TRANSLATE?
            THEN                            _TO HOST FV VALUE          ?
              BEGIN 
              D1INT := B7LOPARFV; 
              REPEAT
                IF D1FV = D1PAR[D1INT]
                THEN
                  BEGIN 
                  D1FV  := D1INT;           _SET TO HOST FV            ?
                  D1INT := B7HIPARFV;       _END LOOP                  ?
                  END;
                D1INT := D1INT + 1; 
              UNTIL D1INT > B7HIPAR;
              END;  _IF D1FN = D1PARITY?
            BFDATAC[D1FCD+1] := CHR(D1FV);  _AND PLACE IN BUFFER       ?
            D1CTRLRTC        := TRUE; 
            END; _ ELSE D1PFC = D9RTC ? 
          END; _ D1PFC " D8CNF ?
        END; _ D0IVT = FALSE ?
      IF D1CTRLRTC = FALSE                  _IF NOT A CTRL/RTC         ?
      THEN
        PN2ACTBL;                           _PROCESS ACTION TABLES     ?
      D1FCD := D1FCD + 2;                   _ADJUST FCD TO NEXT FN     ?
      END;
    UNTIL D1FCD \ D1LCD;                    _UNTIL BUFFER COMPLETED    ?
    D1BUFPTR := BCCHAINS[DBUFLENGTH]; 
    IF D0IVT                                _ONLY A PSEUDO BUFFER      ?
    THEN
      D1BUFPTR := NIL;                      _PRESENT - MAKE CHAIN NIL  ?
    END; _ WITH D1BUFPTR' DO ?
  END; _ WHILE D1BUFPTR " NIL ? 
IF D1CK4DUPE                                _IF DUPLICATE CHARACTER TST?
THEN                                        _REQUIRED                  ?
BEGIN                                       _GET CURRENT CHARACTERS    ?
  D1INT :=                                  _USE LOCAL VARIABLE        ?
    BJTIPTYPT[D0CB'.BSTCB.BSLCBP'.BZTIPTYPE].BJLIVTBVT.BAINT; 
  D1CKCHAR[9].D1TEST := D0CB'.BSTCB.BSSECHAR " 0;  _SET IVT TEST FLAG  ?
  FOR D1FN := 1 TO 8 DO                     _FOR SECURITY AND OTHERS   ?
    IF D0FDT'.DDFDT[D1CKCHAR[D1FN].D1AFN].DDFDISP 
       @ D1INT                              _IF FIELD IS WITHIN TCB IVT?
    THEN
      D1CKCHAR[D1FN].D1TEST := TRUE         _THEN TEST IT              ?
    ELSE                                    _ELSE                      ?
      D1CKCHAR[D1FN].D1TEST := FALSE;       _DONT TEST IT              ?
  D1CKCHAR[1].D1ACHR := D0CB'.BSTCB.BSUSR1; 
  D1CKCHAR[2].D1ACHR := D0CB'.BSTCB.BSUSR2; 
  D1CKCHAR[3].D1ACHR := D0CB'.BSTCB.BSELCHAR; 
  D1CKCHAR[4].D1ACHR := D0CB'.BSTCB.BSEBCHAR; 
  D1CKCHAR[5].D1ACHR := D0CB'.BSTCB.BSABTBLK; 
  D1CKCHAR[6].D1ACHR := D0CB'.BSTCB.BSBSCHAR; 
  D1CKCHAR[7].D1ACHR := D0CB'.BSTCB.BSCNTRLCHAR;
  D1CKCHAR[8].D1ACHR := D0CB'.BSTCB.BSCANCHAR;
  D1CKCHAR[9].D1ACHR := D0CB'.BSTCB.BSSECHAR; 
  FOR D1INT := 1 TO 8 DO                    _NOW SEE IF ANY DUPLICATES ?
      FOR D1FN := D1INT + 1 TO 9 DO         _CHECK AGAINST THOSE ABOVE ?
        IF D1CKCHAR[D1FN].D1ACHR =          _IF VALUE MATCH            ?
           D1CKCHAR[D1INT].D1ACHR 
        THEN
          IF D1CKCHAR[D1INT].D1AFN "        _AND FN(S) CANNOT HAVE THE ?
             D1CKCHAR[D1FN].D1OTH1          _SAME VALUE                ?
          THEN
            IF D1CKCHAR[D1FN].D1TEST = TRUE 
            THEN
              IF D1CKCHAR[D1INT].D1TEST = TRUE
              THEN
              BEGIN 
                CONFIGOK :=D3DUPCHAR; 
                PN2ERROR;                   _THEN EXIT PDQ WITH ERROR  ?
              END;
END; _IF D1CK4DUPE ?
IF D1ISYNC                                  _IF SYNC INPUT CHANGE      ?
THEN
  BEGIN 
  D0CB'.BSTCB.BSISSENT := 
              D0CB'.BSTCB.BSISYNC;          _RESET SYNC INPUT SENT FLAG?
  D1ISYNC := FALSE; 
  END;
_ 
****  COMPLETED PROCESSING BUFFER - SEE IF *TC*/*PW*/*PL* CHANGED 
? 
IF D1CHCREQD                                _IF *TC*/*PL*/*PW* CHGD    ?
THEN
  BEGIN 
  IF D0CB'.BSTCB.BSSTATE = D4ICONF          _AND CONFIG CONFIRMED      ?
  THEN
    BEGIN 
    GENPFC          := D8CHC;               _CHC/TE SERVICE MSG        ?
    GENSFC.DHINT    := D9TE;
    GENPAR.BABUFPTR := D0CB;                _POINTER TO TCB            ?
    PBXFER (BRTNJUMP[C1PNSMGEN].JENTADDR,   _SWITCH TO *PNSMGEN*       ?
            BRTNJUMP[C1PNSMGEN].JPAGEVAL);
    END; _ BSSTATE = D4ICONF ?
  END; _ D1CHCREQD = TRUE ? 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
_ 
****  NOTIFY THE X.25 TIP IF A CHANGE HAS OCCURRED
? 
IF D1FDTSIZE > D0LFDTLIM                    _ONLY CHECK IF TCB         ?
THEN
  IF D0CB'.BSTCB.BSLCBP'.BZTIPTYPE = N1X25  _FOR X25 TIP               ?
  THEN
    BEGIN 
    IF X25STTABLE[D0CB'.BSTCB.BSLCBP'.BZSUBTIP].XASTADDR = 0
                                            _IF SUBTIP CODE UNAVAILABLE?
    THEN                                    _THEN RETURN ERROR AND     ?
      BEGIN 
      CONFIGOK := D3NOSUBTIP; 
      PN2ERROR;                             _DISABLE THIS LINE         ?
      END;
    IF D0CB'.BSTCB.BSLCCBPTR " NIL          _AND ACTUAL TCB'S ASSIGNED ?
    THEN
      BEGIN 
      WITH BWWLENTRY[OPS].CMSMLEY DO        _USING OPS WORKLIST ARRAY  ?
        BEGIN 
        CMWKCODE := D1SETPAD;               _CHANGE PAD PARMETERS      ?
        CMPTR    := D0CB;                   _TCB POINTER               ?
        END; _ WITH BWWLENTRY... ?
      PBLSPUT (BWWLENTRY[OPS],              _NOTIFY X25 THAT FORWARDING?
               BYWLCB[B0X25TIP]);           _SIGNAL MAY HAVE CHANED    ?
      END; _ BSLCCBPTR " NIL ?
    END; _ IF X25 TIP?
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
*ENDIF
_ 
****  IF A VALID BUFFER PASSED - SET-UP NORMAL RESPONSE 
? 
IF D0IVT = FALSE
THEN
  BEGIN 
  WITH D0BFR' DO                            _USING BUFFER POINTER      ?
    BEGIN 
    IF D1SFC = D9RTC                        _IF REQUEST TERMINAL       ?
    THEN                                    _CHARACTERISTICS           ?
      BFDATAC[SFC] := CHR(D9TCD)            _CHANGE SFC                ?
    ELSE
      BEGIN 
      BFLCD        := SFC;                  _SET CORRECT LCD           ?
      BFDATAC[SFC] := CHR(D1SFC + $40);     _AND NORMAL REPLY          ?
      PBRELZRO (BCCHAINS[DBUFLENGTH],BEDBSIZE); 
      END; _ ELSE D1PFC " D8RTC ? 
    PN2ROUTE;                               _ROUTE BUFFER TO *BIP*     ?
    END; _ WITH D0BFR' ?
  END; _ D0IVT = FALSE ?
999:  
END; _ PROCEDURE PNCONFIGURE ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNFNDTCB                                         * 
*                                                                     * 
*       FIND MATCHING TCB                                             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - PNFNDTCB RETURNS A TCB ADDRESS GIVEN A LINE NUMBER,     * 
*             AND A TERMINAL NAME                                     * 
*                                                                     * 
** INPUTS -   LINE NUMBER                                             * 
*             POINTER TO SERVICE MESSAGE                              * 
*             CHARACTER INDEX TO START OF TERMINAL NAME               * 
*                                                                     * 
** OUTPUT -   TCB ADDRESS OR NIL, IF TCB NOT FOUND                    * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*             1) PNLNBAD          VALIDATE LINE NUMBER                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PNFNDTCB (LINENO:B0LINO;BUF:B0BUFPTR;START:INTEGER) : B0BUFPTR;
  
VAR 
      TCB    : B0BUFPTR;                    _PTR TO CURRENT TCB        ?
      OFFSET : INTEGER;                     _INDEX TO CURRENT CHARACTER?
  
BEGIN 
PNFNDTCB := NIL;                            _RETURN NIL IF NOT FOUND   ?
IF PNLNBAD (LINENO) = FALSE                 _CHECK IF VALID LINE NUMBER?
THEN
  BEGIN                                     _YES IT IS                 ?
  TCB := C0LCBADDR'.BZTCBPTR;               _GET PTR TO FIRST TCB      ?
  WHILE TCB " NIL DO                        _WHILE MORE TCBS TO CHECK  ?
    BEGIN 
    FOR OFFSET := 0 TO 6 DO                 _FOR EACH CHAR IN TERM NAME?
      IF TCB'.BSTCB.BSTNAME[OFFSET] "       _CHECK FOR CHAR MISMATCH   ?
         BUF'.BFDATAC[START + OFFSET] 
      THEN
        GOTO 10;                            _EXIT CHECKING THIS TCB    ?
    GOTO 20;                                _WE HAVE FOUND THE TCB     ?
10: 
    TCB := TCB'.BSTCB.BSCHAIN;              _GET PTR TO NEXT TCB       ?
    END; _WHILE TCB " NIL DO? 
20: 
  PNFNDTCB := TCB;                          _RETURN TCB ADDR OR NIL    ?
  END; _IF PNLNBAD (LINENO) = FALSE?
END; _FUNCTION PNFNDTCB?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNTCBCHAIN                                       * 
*                                                                     * 
*       FIND TCB CHAINED ON LCB                                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW       - THIS FUNCTION VERIFIES THAT A TCB HAS NOT         * 
*                   BEEN UNCHAINED SINCE THE CURRENT WORKLIST ENTRY   * 
*                   WAS CREATED.                                      * 
*                                                                     * 
** INPUTS -   CURRENT WORKLIST ENTRY - CMPOINT                        * 
*                                                                     * 
** OUTPUT -   IT RETURNS FALSE IF THE TCB IS UNCHAINED.               * 
*             IT RETURNS TRUE IF THE TCB IS CHAINED.                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES - NONE                                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PNTCBCHAIN(VAR TCBPTR:B0BUFPTR):BOOLEAN; 
VAR 
  
  LCBVAR : PACKED RECORD CASE LCBTAG : INTEGER OF 
         0:  (LCBBUF : B0BUFPTR); 
         1:  (LCBPTR : BZLCBP); 
         END; 
  
BEGIN 
WITH LCBVAR DO
  BEGIN 
  PNTCBCHAIN := FALSE;                      _PRESUME GUILTY            ?
  ADDR(CGLCBP'[TCBPTR'.BSTCB.BSLCBP'. 
               BZLINO.BDPORT],LCBBUF);      _VERIFY WE HAVE A POINTER  ?
  IF LCBPTR = TCBPTR'.BSTCB.BSLCBP          _TO AN LCB                 ?
  THEN
    BEGIN                                   _USE LOCAL VAR TO REMEMBER ?
    LCBBUF := TCBPTR;                       _TCB BEING SEARCHED FOR    ?
    TCBPTR :=                               _START SEACH AT FIRST TCB  ?
         TCBPTR'.BSTCB.BSLCBP'.BZTCBPTR;    _ON THE LCB AND WHILE WE   ?
    WHILE (TCBPTR " NIL) &
          (TCBPTR " LCBBUF)                 _HAVE NOT FOUND THE TCB    ?
      DO                                    _THAT MATCHS THE ONE IN THE?
      TCBPTR := TCBPTR'.BSTCB.BSCHAIN;      _WORKLIST ENTRY AND HAVE   ?
                                            _NOT REACHED THE END OF THE?
    PNTCBCHAIN := (TCBPTR = LCBBUF);        _CHAIN THEN KEEP SEARCHING ?
    END; _IF TCBPTR = ... ? 
  END; _ WITH BWWLENTRY ?                   _RETURN TRUE IF TCB FOUND  ?
END; _FUNCTION PNTCBCHAIN ? 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNFNDSVC                                         * 
*                                                                     * 
*       FIND MATCHING TCB FOR SVC ARCHETYPE                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - PNFNDSVC RETURNS A GROUP TCB ADDRESS GIVEN THE LINE     * 
*             NUMBER AND SVC ARCHETYPE NAME                           * 
*                                                                     * 
** INPUTS -   LINE NUMBER                                             * 
*             POINTER TO SERVICE MESSAGE                              * 
*             CHARACTER INDEX TO START OF ARCHETYPE NAME              * 
*                                                                     * 
** OUTPUTS -  TCB ADDRESS OR NIL, IF TCB NOT FOUND                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PNFNDSVC (LINENO:B0LINO;BUF:B0BUFPTR;START:INTEGER) : B0BUFPTR;
  
VAR 
  TCB    : B0BUFPTR;                        _CURRENT GROUP TCB PTR     ?
  OFFSET : INTEGER;                         _INDEX TO CURRENT CHARACTER?
  I      : INTEGER;                         _LOOP INDEX                ?
BEGIN 
PNFNDSVC := NIL;                            _RETURN NIL IF NOT FOUND   ?
IF PNLNBAD (LINENO) = FALSE                 _CHECK IF VALID LINE NUMBER?
THEN
  BEGIN 
  FOR I := N0XPAD TO N0X2USR DO             _X25 GROUP TCB             ?
    BEGIN 
    TCB := C0LCBADDR'.BZSLCBPTR'.BZXSLCB.BZGRPTCB[I]; 
    FOR OFFSET := 0 TO 6 DO                 _FOR EACH CHAR IN TERM NAME?
      IF TCB'.BSTCB.BSTNAME[OFFSET] " BUF'.BFDATAC[START + OFFSET]
      THEN
        GOTO 10;                            _CHARACTER MISMATCH        ?
    PNFNDSVC := TCB;                        _RETURN TCB ADDRESS        ?
    GOTO 20;                                _FOUND TCB, EXIT           ?
10: 
    END; _ FOR N0XPAD TO N0X2USR ?
20: 
  END; _IF PNLNBAD(LINENO) = FALSE ?
END; _ FUNCTION PNFNDSVC ?
_$J+? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNREVERSE                                        * 
*                                                                     * 
*        REVERSE DN , SN                                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNREVERSE REVERSES THE DN AND SN OF A SERVICE MESSAGE  * 
*                                                                     * 
** INPUT -     POINTER TO SERVICE MESSAGE                             * 
*                                                                     * 
** OUTPUT -    DN AND SN REVERSED IN SERVICE MESSAGE                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNREVERSE (BUF : B0BUFPTR); 
  
VAR 
      SAVEDN : CHAR;                        _SAVED DN OF SERVICE MSG   ?
  
BEGIN 
WITH BUF' DO                                _SET INDEX TO SERVICE MSG  ?
  BEGIN 
  SAVEDN := BFDATAC[DN];                    _SAVE DN                   ?
  BFDATAC[DN] := BFDATAC[SN];               _NEW DN IS OLD SN          ?
  BFDATAC[SN] := SAVEDN;                    _NEW SN IS SAVED DN        ?
  END; _WITH BUF' DO? 
END; _PROCEDURE PNREVERSE?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNUSSM                                           * 
*                                                                     * 
*        GENERATE UNSOLICITED STATUS REPORT (UNSOLICITED) SM          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNUSSM PROVIDES AN INTERFACE FOR GENERATING A          * 
*              STU/XX/U SERVICE MESSAGE                               * 
*              PNUSSM ACHIEVES THIS BY MAKING A STATUS WORKLIST ENTRY * 
*              (SWE) FOR THE STATUS WORK EVENT PROCESSOR AND THEN     * 
*              MAKING A D0SACTIVATE WORKLIST FOR THE SERVICE MODULE   * 
*              WORKLIST PROCESSOR, IF ONE IS NOT ALREADY OUTSTANDING  * 
*                                                                     * 
** INPUTS -    STATUS TO BE REPORTED                                  * 
*              REASON CODE FOR REPORTING STATUS                       * 
*              SECONDARY FUNCTION CODE OF THE STU/XX/U SM             * 
*              POINTER TO CONTROL BLOCK                               * 
*                      OR STATUS BUFFER IF (SFC = D9TE) AND           * 
*                                          (STS = C7NOTCNF)           * 
*                                                                     * 
** OUTPUTS -   SWE FOR THE STATUS WORK EVENT PROCESSOR                * 
*              D0SACTIVATE WORKLIST FOR THE SVM WORKLIST PROCESSOR    * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              1) PBLSPUT          MAKE A WORKLIST ENTRY              * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              1) PNSWEPROC        STATUS WORK EVENT PROCESSOR        * 
*              2) PNSMWL           SVM WORKLIST PROCESSOR             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNUSSM (STS:INTEGER;RC:INTEGER;SFC:INTEGER;PTR:B0BUFPTR); 
  
BEGIN 
_ 
****  BUILD APPROPRIATE WORKLIST FOR STATUS WORKLIST PROCESSOR
? 
WITH DWWLENTRY.CMSMLEY DO                   _DELAYED WORKLIST AREA     ?
  BEGIN 
  CMDATA    := RC;                          _STORE REASON CODE         ?
  CMWKCODE  := SFC;                         _STORE SFC (WORK CODE)     ?
  CMCNFST   := STS;                         _STORE STATUS              ?
  CMUNSOLIT := TRUE;                        _SET UNSOLICITED STATUS FLG?
  CMCBP     := PTR;                         _STORE PTR TO CTL BLK / BUF?
  PBLSPUT (DWWLENTRY,DYLISTCB[D6STAT]);     _QUEUE STATUS WL ENTRY     ?
_ 
****  BUILD D0SACTIVATE WORKLIST FOR SERVICE MODULE 
? 
  IF DYLISTCB[D6STAT].BYCNT = 1             _CHECK ONLY SWE TO PROCESS ?
  THEN
    BEGIN                                   _YES IT IS                 ?
    CMWKCODE := D0SACTIVATE;                _WAKE UP WORK CODE         ?
    PBLSPUT (DWWLENTRY,BYWLCB[B0SMWL]);     _QUEUE D0SACTIVATE WL ENTRY?
    END; _IF DYLISTCB[D6STAT].BYCNT = 1?
  END; _WITH DWWLENTRY.CMSMLEY? 
END; _PROCEDURE PNUSSM? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                  PNNOTIFY                                           * 
*                                                                     * 
*        SEND MESSAGE TO TERMINAL                                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNNOTIFY PROVIDES AN INTERFACE FOR SENDING A CANNED    * 
*              MESSAGE (INCLUDING THE HOST AVAILABILITY DISPLAY)      * 
*              TO A TERMINAL.                                         * 
*              PNNOTIFY ACHIEVES THIS BY MAKING A NOTIFY WORKLIST     * 
*              ENTRY (NWE) FOR THE NOTIFY WORK EVENT PROCESSOR, AND   * 
*              THEN DECIDING IF AND HOW TO INITIATE THE NOTIFY        * 
*              WORKLIST PROCESSOR.                                    * 
*                                                                     * 
** INPUT -     MESSAGE ORDINAL : POSITIVE  -  IMMEDIATE DELIVERY      * 
*                                NEGATIVE  -  DEFERRED DELIVERY       * 
*              POINTER TO TERMINAL CONTROL BLOCK                      * 
*                                                                     * 
** OUTPUT -    NWE FOR THE NOTIFY WORKLIST PROCESSOR                  * 
*              D0NACTIVATE WORKLIST FOR THE SVM WORKLIST PROCESSOR    * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              1) PBLSPUT          MAKE A WORK LIST ENTRY             * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              1) PNNWEPROC        NOTIFY WORK EVENT PROCESSOR        * 
*              2) PNSMWL           SVM WORKLIST PROCESSOR             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNNOTIFY (MSG : INTEGER ; TCB : B0BUFPTR);
  
BEGIN 
_ 
****  BUILD APPROPRIATE WORKLIST FOR THE NOTIFY WORK EVENT PROCESSOR
? 
WITH DWWLENTRY.CMSMLEY DO                   _DELAYED WORKLIST AREA     ?
  BEGIN 
  IF MSG > 0                                _CHECK IF DIRECT CALL      ?
  THEN
    CMNMSG := MSG                           _YES STORE MESSAGE ORDINAL ?
  ELSE
    CMNMSG := - MSG;                        _NO  STORE NEGATED ORDINAL ?
  CMCBP := TCB;                             _STORE TCB ADDRESS         ?
  PBLSPUT(DWWLENTRY,DYLISTCB[D6NOTIFY]);    _PUT WORKLIST IN QUEUE     ?
  
  END; _WITH DWWLENTRY.CMSMLEY? 
_ 
****  DECIDE IF AND HOW TO KICK OFF THE NOTIFY WORK EVENT PROCESSOR 
****  AND TAKE THE APPROPRIATE ACTION 
? 
WITH DYLISTCB[D6NOTIFY] DO                  _NOTIFY WORKLIST CONTROL BK?
  BEGIN 
  IF BYCNT = 1                              _CHECK FOR PRIOR QUEUING   ?
  THEN
    BEGIN                                   _THIS ONE IS THE ONLY ONE  ?
    DWXACTIVATE.CMSMLEY.                    _NOTIFY WAKE UP WORK CODE  ?
      CMWKCODE := D0NACTIVATE;
    IF MSG > 0                              _CHECK IF DIRECT CALL      ?
    THEN
      PBXFER (BYPRADDR,BYPAGE)              _YES - DO SO               ?
    ELSE
      PBLSPUT(DWXACTIVATE,                  _NO  - SEND WORKLIST TO SVM?
              BYWLCB[B0SMWL]);
    END; _IF BYCNT = 1? 
  END; _WITH DYLISTCB[D6NOTIFY] DO? 
END; _PROCEDURE PNNOTIFY? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNENBLINES                                       * 
*                                                                     * 
*        ENABLE ALL LINES / OR PROCESS CS LOST GAINED                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNENBLINES ENABLES ALL LINES ON THE NPU AFTER          * 
*              SUPERVISION HAS BEEN OBTAINED I.E. *CS*.               * 
*              THIS PROCEDURE WILL ALSO HANDLE SUPERVISION CHANGES.   * 
*              THOSE LINES THAT HAVE CONFIGURATION PENDING WHEN *CS*  * 
*              IS LOST WILL HAVE ALL PENDING TCB(S) DELETED.          * 
*              WHEN *CS* IS GAINED AGAIN A CNF/TE REQUEST WILL BE     * 
*              FIRED OFF.                                             * 
*                                                                     * 
** INPUTS -    BOOLEAN TO INDICATE LOST/GAINED *CS*                   * 
*                                                                     * 
** OUTPUT -    WORKLIST TO LINE INITIALIZER FOR EACH LINE             * 
*              CALL TO PNSMGEN FOR EACH LINE THAT HAD CONFIGURATION   * 
*              PENDING WHEN *CS* IS RE-GAINED.                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS-                                          * 
*                - PBLLENTR            ADD LINE TO TIMER CHAIN        * 
*                - PBLSPUT             MAKE WOTKLIST ENTRY            * 
*                - PNDLTCB             DELETE TCB(S) ON THE LINE      * 
*                - PBXFER              TO TRANSFER TO PNSMGEN         * 
*                - PNCKTCON            START CONNECTION TIMER         * 
*              WORKLIST ENTRIES MADE TO -                             * 
*                - PTLINIT             LINE INITIALIZER               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNENBLINES (LOSTCS : BOOLEAN);
  
VAR 
  I       : INTEGER;
  LCBPTR  : BZLCBP; 
  ALLINES : BOOLEAN;
  LOCWLCB : BWWORKLIST; 
  LPTR    : B0BUFPTR; 
  
VALUE 
  ALLINES = TRUE; 
  LOCWLCB = (A0SMEN); 
  
BEGIN 
FOR I := C0NPBL+1 TO C4LCBS DO              _ SEARCH ALL LINES         ?
  BEGIN 
  ADDR (CGLCBP'[I],LCBPTR);                 _ GET LCB ADDRESS          ?
  WITH LOCWLCB.CMSMLEY DO                   _ USING WORKLIST STRUCTURE ?
    BEGIN 
    CMLINO := LCBPTR'.BZLINO;               _ PRESTORE LINE NUMBER     ?
    IF LCBPTR'.BZCNFST \ C7ENABLED          _ IF LINE ACTIVE OR ENABLED?
    THEN
_ 
****  ONLY LOOK AT LINES THAT ARE ENABLED OR ACTIVE 
? 
      BEGIN 
      IF ALLINES                            _ IF ALL LINES             ?
      THEN
_ 
****  ALL LINES ARE ONLY ENABLED ONCE 
? 
        BEGIN 
        IF CS " 0                           _ AND CS AVAILABLE         ?
        THEN
          BEGIN 
          PBLLENTR (CMLINO);                _ ADD LINE TO TIMER QUEUE  ?
          PBLSPUT (LOCWLCB,BYWLCB[B0LIWL]); _ GIVE LINE TO INITIALIZER ?
          END; _ CS " 0 ? 
        END _ ALLINES = FALSE ? 
      ELSE _ ALLINES = FALSE ?
_ 
****  SUPERVISION HAS CHANGED - SEE IF CONFIGURATION PENDING
? 
        BEGIN 
        IF LCBPTR'.BZCNFPEND                _ IF CONFIGURATION PENDING ?
        THEN
          BEGIN 
          IF LOSTCS                         _ IF LOST CS               ?
          THEN
_ 
****  SUPERVISION LOST - DELETE TCB(S) / LINE NO LONGER ACTIVE
? 
            BEGIN                           _ REMOVE LINE FROM TIMER   ?
            IF LCBPTR'.BZTIPTYPE " N1X25    _ CHECK IF NON-X25         ?
            THEN
              WHILE LCBPTR'.BZTCBPTR " NIL   _ DELETE ALL TCBS         ?
              DO
                PNDLTCB (LCBPTR'.BZTCBPTR); 
            IF CSPEND = 0                   _ IF SUPERVISION NOT PEND. ?
            THEN
              PNTCKCON (LCBPTR);            _ START CONNECTION TIMER   ?
            END _ LOSTCS ?
          ELSE _ LOSTCS = FALSE ?           _ GAINED A NEW CS          ?
_ 
****  SUPERVISION GAINED - SEND CONFIGURATION REQUEST TO *CS* 
? 
            BEGIN 
            GENPFC := D8CNF;                _ SEND CNF/TE TO NEW CS    ?
            GENSFC.DHINT := D9TE; 
            GENPAR.BABUFPTR := LCBPTR;      _ PASSING LCB POINTER      ?
            PBXFER (BRTNJUMP[C1PNSMGEM]     _ CALL PNSMGEN             ?
                             .JENTADDR, 
                    BRTNJUMP[C1PNSMGEN] 
                             .JPAGEVAL);
            END; _ ELSE LOSTCS = FALSE ?
          END _ BZCNFPEND ? 
        ELSE _ CONFIGURATION NOT PENDING ?
          IF LOSTCS = FALSE 
          THEN
            BEGIN 
            LPTR := LCBPTR'.BZTCBPTR; 
            WHILE LPTR " NIL DO 
              BEGIN 
              IF LPTR'.BSTCB.BSRCNFPEND 
              THEN
                BEGIN                       _THEN SET UP SVM MSG PARMS ?
                GENPFC        := D8CNF;     _TO SEND CNF/RC TO CS      ?
                GENSFC.DHINT  := D9RC;
                GENSUP        := CS;
                GENPAR.BALCBP := LPTR;      _FOR THIS TCB              ?
                WITH BRTNJUMP[C1PNSMGEN] DO 
                  PBXFER (JENTADDR,JPAGEVAL); 
                END; _ BSRCNFPEND ? 
              LPTR := LPTR'.BSTCB.BSCHAIN;
              END; _ WHILE LPTR " NIL ? 
            END                             _REGAINED SUPERVISION WHILE?
                                            _RECONFIGURING TCB         ?
  
        END; _ ELSE ALLINES = FALSE ? 
      END; _ BZCNFST \ C7ENABLED ?
    END; _ WITH LOCWLCB... ?
  END; _ FOR C0NPBL... ?
_ 
****  CLEAR *ALLINES* FLAG - ONLY PROCESSED ONCE
? 
IF ALLINES
THEN
  IF CS " 0 
  THEN
    ALLINES := FALSE; 
END; _ PROCEDURE PNENBLINES ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                   PNTCKENB                                          * 
*                                                                     * 
*         CHECK IF ALL TERMINALS ON A LINE ARE DISABLED               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNTCKENB IS CALLED TO CHECK IF ALL TERMINALS ON        * 
*              A LINE ARE DISABLED. IF ENTERED VIA A DIRECT CALL      * 
*              AND ALL TERMINALS ARE DISABLED, THIS ROUTINE MAKES     * 
*              AN ALARM WORKLIST ENTRY TO *PNINITERR* SO THE CENTRAL  * 
*              SITE OPERATOR HAS A CHANCE TO ENABLE SOME TERMINALS    * 
*              ON THE LINE. PNTCKENB THEN GOES ON A TIMER DELAY.      * 
*              WHEN ENTERED AFTER THE TIMER DELAY AND THE CONTENTION  * 
*              COUNTER HAS NOT CHANGED, THE LINE IS DISABLED.         * 
*                                                                     * 
** INPUTS   -  POINTER TO LINE CONTROL BLOCK                          * 
*                                                                     * 
** OUTPUT   -  CALL TO *PNSMBLINDWN* TO DISABLE THE LINE              * 
*              WORKLIST TO *PNINITERR* TO REPORT ALARM                * 
*              WORKLIST TO *PNSMTMR* FOR TIMER DELAY                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS-                                          * 
*                - PNSMBLINDWN              BRING LINE DOWN           * 
*                - PBLSPUT                  MAKE WORKLIST ENTRY       * 
*              WORKLIST ENTRIES MADE TO-                              * 
*                - PNINITERR                PROCESS ALARM MESSAGE     * 
*                - PNSMWL                   ACTIVATE PNINITERR        * 
*                - PNSMTMR                  SVM TIMER ROUTINE         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNTCKENB (LPTR : B0BUFPTR); 
  
CONST 
  TIMENB = 90;                              _ WAIT 1 1/2 MINS          ?
  
VAR 
  TCBPTR : B0BUFPTR;
  
BEGIN 
WITH BWWLENTRY[OPS].CMSMLEY,                _ USING INTERMEDIATE ARRAY ?
     LPTR'.BZZLCB DO                        _ AND LINE CONTROL BLOCK   ?
_ 
****  ONLY CHECK LINES THAT ARE STILL ACTIVE
? 
  BEGIN 
  IF BZCNFST = C7ACTIVE                     _ IF LINE STILL ACTIVE     ?
  THEN
    BEGIN 
    TCBPTR := BZTCBPTR;                     _ GET CHAIN OF TCB(S)      ?
_ 
****  SEE IF ALL TCB(S) ON THE LINE ARE DISABLED
? 
    REPEAT
      BEGIN 
      IF TCBPTR'.BSTCB.BSCNFST " C7DISABLED _ IF TERMINAL FOUND THAT   ?
      THEN                                  _ IS NOT DISABLED - EXIT   ?
        GOTO 10;                            _ IMMEDIATELY              ?
      TCBPTR := TCBPTR'.BSTCB.BSCHAIN;      _ SEARCH ALL TCB(S) ON LINE?
      END; _ REPEAT ? 
    UNTIL TCBPTR = NIL; 
_ 
****  ALL TCB(S) ARE DISABLED - 
****  DISABLE THE LINE IF COMING OFF THE TIMER DELAY
? 
    IF CMWKCODE = D0TCKENB                  _ IF COMING OFF TIMER      ?
    THEN                                    _ THEN DISABLED THE LINE   ?
      BEGIN 
      IF BZWTCENB = CMPRM2                  _ IF CONTENTION COUNTER OK ?
      THEN
        BEGIN 
        IF BZSMCNTRL = FALSE                _ IF SVM NOT CONTROLLING   ?
        THEN
          BEGIN 
          BZSMDISC := BZSWLINE;             _ DISCONNECT IF SWITCHED   ?
          BZSMCNTRL := TRUE;                _ SVM CONTROLLING LINE     ?
          PNSMBLINDWN (LPTR,DADISA);        _ BRING LINE DOWN          ?
          END; _ BZSMCNTRL = FALSE ?
        END; _ CMPRM2 = BZWTCENB ?
      END _ CMWKCODE = D0TCKENB ? 
    ELSE _ CMWKCODE " D0TCKENB ?
_ 
****  ENTERED VIA DIRECT CALL - SEND ALARM TO OPERATOR
? 
      BEGIN 
      CMDATA := D5TESDISA;                  _ ALL TERMINALS DISABLED   ?
      CMPRM2 := BZLINO.BDPORT;              _ PASS LINE NUMBER         ?
      PBLSPUT (BWWLENTRY[OPS],              _ WILL GENERATE AN ALARM   ?
               DYLISTCB[D6INITERR]);        _ TO CS OPERATOR           ?
_ 
**** WAKE-UP *PNINITERR* IF WORKLIST COUNT .EQ. 1 
? 
      IF DYLISTCB[D6INIT].BYCNT = 1         _ IF ONLY ONE WORKLIST THEN?
      THEN                                  _ WAKE UP PNINIT           ?
        BEGIN 
        CMWKCODE := D0IACTIVATE;            _ ACTIVATE PNINITERR       ?
        PBLSPUT (BWWLENTRY[OPS],            _ WORKLIST TO SVM          ?
                 BYWLCB[B0SMWL]); 
        END; _ BYCNT = 1 ?
_ 
**** MAKE A TIMER DELAY WORKLIST TO *PNSMTMR* PASSING CONTENTION COUNTER
? 
      BZWTCENB := BZWTCENB + 1;             _ BUMP CONTENTION COUNTER  ?
      CMPRM2 := BZWTCENB;                   _ PASS COUNTER IN TIMER WL ?
      CMPTR := LPTR;                        _ PASS LCB STRUCTURE       ?
      CMWKCODE := D0TCKENB;                 _ CHECK THEN LINE IN       ?
      CMTIMER := TIMENB;                    _ DELAY FOR TIME QUANTUM   ?
      PBLSPUT (BWWLENTRY[OPS],              _ SVM TIMER PROCESSOR      ?
               BYWLCB[B0SMTMR]);
      END; _ ELSE CMWKCODE " D0TCKENB ? 
    END; _ BZCNFST = C7ACTIVE?
10:                                         _ QUICK EXIT               ?
  END; _ WITH BWWLENTRY[OPS]... ? 
END; _ PROCEDURE PNCKTENB ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMBLINDWN                                      * 
*                                                                     * 
*         BRING LINE DOWN - GET RID OF TCB(S) TOO                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMBLINDWN CONTROLS THE ORDERLY PROCESS OF DISABLING  * 
*              A LINE. IF TCB(S) ARE ATTACHED AND CONNECTIONS EXIST   * 
*              THEN THE CONNECTIONS ARE BROKEN AND TCB(S) DELETED     * 
*              BEFORE THE LINE IS DISABLED.                           * 
*                                                                     * 
** INPUT -     POINTER TO THE LINE CONTROL BLOCK                      * 
*                                                                     * 
** OUTPUTS -   WORKLIST TO SVM TO DISCONNECT A CONNECTION             * 
*              *A0SMDLTCB* WORKLIST(S) TO TIPS                        * 
*              *A0SMDA* WORKLIST(S) TO TIPS                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS-                                          * 
*                - PBLSPUT                MAKE WORKLIST ENTRY         * 
*                - PBPUTYP                WORKLIST ON TIP TYPE        * 
*                - PNDLTCB                DELETE TCB(S) ON THE LINE   * 
*              WORKLIST ENTRIES MADE TO-                              * 
*                - PNSMWL                 SVM DISCONNECT *D5DISC*     * 
*                - TIPS                   *AOSMDLTCB* AND *A0SMDA*    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMBLINDWN (LPTR : B0BUFPTR; LRC : INTEGER); 
  
VAR 
  TCBPTR : B0BUFPTR;
  TMPLNO : B0LINO;
  
BEGIN 
WITH DWWLENTRY.CMSMLEY DO                   _ USING SVM WORKLIST ARRAY ?
  BEGIN 
  CMLINO := LPTR'.BZZLCB.BZLINO;            _ GET LINE NUMBER          ?
  TCBPTR := LPTR'.BZZLCB.BZTCBPTR;          _ TCB CHAIN POINTER        ?
  IF (LPTR'.BZZLCB.BZTCBCNT " 0) &          _ IF TCB(S) ATTACHED       ?
     (LPTR'.BZZLCB.BZCNFPEND = FALSE)       _ AND CONF. NOT PENDING    ?
  THEN                                      _ WE HAVE TO DELETE THEM   ?
_ 
****  TCB(S) ATTACHED TO LINE AND CONFIGURATION NOT PENDING 
****   WE HAVE TO BREAK POSSIBLE CONNECTIONS AND NOTIFY THE TIPS
****   BEFORE WE DELETE THE TCB(S). 
? 
    BEGIN 
    TMPLNO := CMLINO;                       _SAVE THE LINE NUMBER      ?
    WHILE TCBPTR " NIL DO                   _ IF TCB EXISTS            ?
      WITH TCBPTR'.BSTCB DO                 _ USING TCB STRUCTURE      ?
      BEGIN 
      CMPTR := TCBPTR;                      _ PASS TCB IN WORKLIST     ?
      BSCNFST := C7DOWN;                    _ MARK TCB AS DOWN         ?
      IF BSCN " 0                           _ IF CONNECTED TO HOST     ?
      THEN                                  _ WE HAVE TO BREAK THE     ?
_ 
****  TERMINAL CONNECTED TO HOST - HAVE SVM BREAK CONNECTION
? 
        BEGIN                               _ CONNECTION               ?
        CMWKCODE := D0TCB;                  _ TCB EVENT                ?
        CMDATA   := D5DISC;                 _ DISCONNECT FROM HOST     ?
        CMRC     := LRC;                    _ PASS ON REASON CODE      ?
        PBLSPUT (DWWLENTRY,BYWLCB[B0SMWL]); _ LAUNCH THE WORKLIST      ?
        END _ BSCN " 0 ?
      ELSE _ BSCN = 0 ?                     _ NOT CONNECTED TO HOST    ?
_ 
****  IF NOT ON CONNECTION TIMER - TELL TIP WE ARE DELETING TCB 
? 
        BEGIN 
        IF BSCNTIMER = FALSE                _ IF CONNECTION TIMER      ?
        THEN                                _ OUTSTANDING AND IF WE    ?
          IF BSDELTCB = FALSE               _ HAVENT ALREADY SHIPPED A ?
          THEN                              _ AOSMDLT WLE TO THE TIP   ?
            BEGIN                           _ THEN WE WILL SHIP ONE    ?
            CMWKCODE := A0SMDLTCB;
            CMLINO   := TMPLNO;             _RESTORE LINE NUMBER       ?
            PBPUTYP (DWWLENTRY);
            END; _ IF BSCNTIMER = FALSE ? 
        IF BSRCNFP
        THEN
          BSRCNFP := FALSE; 
        END; _ ELSE BSCN = 0 ?
      BSDELTCB := TRUE;                     _ SET FLAG THAT TCB IS     ?
      TCBPTR := BSCHAIN;                    _ TO BE DELETED            ?
      END; _ WITH TCBPTR'.BSTCB ? 
    END _ TCBPTR " NIL ?                    _ END TCB(S) ON LINE       ?
_ 
****  SINCE NO TCB(S) ON THE LINE OR CONFIGURATION PENDING
****    WE DO NOT HAVE TO NOTIFY THE TIPS THAT TCB(S) ARE 
****    BEING DELETED. JUST DISABLE THE LINE. 
? 
  ELSE _ BZTCBCNT = 0 ? 
    BEGIN 
    IF LPTR'.BZZLCB.BZCNFPEND               _ IF CONFIGURATION PENDING ?
    THEN
      BEGIN 
      IF LPTR'.BZZLCB.BZTIPTYPE " N1X25     _ CHECK IF NON-X25         ?
      THEN
        WHILE LPTR'.BZZLCB.BZTCBPTR " NIL   _ DELETE ALL ATTACHED      ?
        DO
          PNDLTCB(LPTR'.BZZLCB.BZTCBPTR);   _ TCBS                     ?
      LPTR'.BZZLCB.BZCNFST := C7ENABLED;
      END; _ BZCNFPEND ?
    CMWKCODE := A0SMDA;                     _ DISABLE THE LINE         ?
    PBPUTYP (DWWLENTRY);                    _ NOTIFY THE TIP           ?
    END; _ ELSE BZTCBCNT = 0 ?
  END; _ WITH DWWLENTRY.CMSMLEY ? 
END; _ PROCEDURE PNSMBLINDWN ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNTCKCON                                         * 
*                                                                     * 
*         CHECK IF TERMINALS ARE CONNECTED TO A HOST                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNTCKCON MONITERS DIAL-UP LINE(S) FOR INACTIVITY AND   * 
*              DISCONNECTS THE USER IF THERE IS NO CONNECTION TO A    * 
*              HOST WITHIN 2 MINUTES. A CONTENTION COUNTER IS         * 
*              MAINTAINED IN THE LCB TO ENSURE THAT THE DELAY TIMER   * 
*              IS VALID WHEN IT EXPIRES.                              * 
*                                                                     * 
** INPUT -     POINTER TO THE LINE CONTROL BLOCK                      * 
*                                                                     * 
** OUTPUTS -   CALL TO *PNSMBLINDWN* TO DISABLE THE LINE              * 
*              WORKLIST TO *PNSMTMR* FOR TIMER DELAY                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS-                                          * 
*                - PNSMBLINDWN              BRING LINE DOWN           * 
*                - PBLSPUT                  MAKE WORKLIST ENTRY       * 
*              WORKLIST ENTRIES MADE TO-                              * 
*                - PNSMTMR                  SVM TIMER ROUTINE         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNTCKCON (LPTR : B0BUFPTR); 
  
CONST 
  TIMCON = 120;                             _ TIMER DELAY 2 MINUTES    ?
  
VAR 
  TCBPTR : B0BUFPTR;
  
BEGIN 
WITH LPTR'.BZZLCB DO                        _ USING LCB STRUCTURE      ?
  BEGIN 
  IF BZSWLINE                               _ ONLY CHECK IF DIAL-UP    ?
  THEN                                      _ LINE                     ?
    BEGIN 
    IF BZCNFST \ C7ENABLED                  _ AND ENABLED OR ACTIVE    ?
    THEN
      BEGIN 
      IF BZTCBCNT " 0                       _ AND TCB(S) ATTACHED      ?
      THEN
_ 
****  SEARCH ALL TCB(S) ON THE LINE - LOOKING FOR TERMINAL CONNECTED
****  TO A HOST 
? 
        BEGIN 
        TCBPTR := BZTCBPTR;                 _ GET CHAIN OF TCB(S)      ?
        WHILE TCBPTR " NIL DO               _ AND SEE IF ANY ARE       ?
          BEGIN                             _ CONNECTED TO A HOST      ?
          IF TCBPTR'.BSTCB.BSHN " 0         _ IF ATTEMPTING CONNECTION ?
          THEN                              _ OR CONNECTED THEN        ?
            IF TCBPTR'.BSTCB.BSDEVTYPE = N1CON
            THEN                            _ IF THIS IS A CONSOLE     ?
              GOTO 10;                      _ THEN EXIT PDQ            ?
          TCBPTR := TCBPTR'.BSTCB.BSCHAIN;  _ GET NEXT TCB             ?
          END; _ WHILE LOOP ? 
        END; _ BZTCBCNT " 0 ? 
_ 
****  NO TERMINAL(S) ON THE LINE ARE CONNECTED TO A HOST
? 
      IF BWWLENTRY[OPS].CMSMLEY.CMWKCODE    _ DETERMINE WHO CALLED US  ?
                       = D0TCKCON 
      THEN
_ 
****  TIMER DELAY EXPIRED - DISABLE LINE IF THE CONTENTION
****  COUNTER HAS NOT CHANGED DURING THE TIMER DELAY
? 
        BEGIN 
        IF BWWLENTRY[OPS].CMSMLEY.CMPRM2    _ VERIFY CONTENTION COUNTER?
                         = BZWTCCON         _ IN LCB                   ?
        THEN
          BEGIN 
          IF BZSMCNTRL = FALSE              _ SVM NOT CONTROLLING      ?
          THEN
            BEGIN 
            BZSMCNTRL := TRUE;              _ SET CONTROLLING FLAG     ?
            BZSMDISC  := TRUE;              _ REQUEST A DISCONNECT     ?
            PNSMBLINDWN (LPTR,DAUSER);      _ KNOCK LINE DOWN          ?
            END; _ BZSMCNTRL = FALSE ?
          END; _ CMPRM2 = BZWTCCON ?
        END _ CMWKCODE = D0TCKCON ? 
      ELSE _ CMWKCODE " D0TCKCON ?
        IF BZQDISC                          _ IF THIS IS AN IMMEDIATE  ?
        THEN                                _ DISCONNECT LINE AND      ?
          BEGIN 
          IF BZSMCNTRL = FALSE              _ SVM IS NOT CONTROLLING   ?
          THEN                              _ SPECIAL CASE CNF/TE      ?
            IF BWWLENTRY[OPS].CMSMLEY.      _ IF THE CURRENT WORKLIST  ?
              CMWKCODE = D0SM               _ ENTRY IS A CNF/TE SM     ?
            THEN
              IF BWWLENTRY[OPS].CMSMLEY.
                CMPOINT'.BFDATAC[PFC]       _ THE LINE HAS JUST GONE   ?
                = CHR(D8CNF)                _ OPERATIONAL              ?
              THEN                          _ GO ON TIMER DELAY        ?
                GOTO 100;                   _ OTHERWISE                ?
                                            _ ITS TIME TO KNOCK DOWN   ?
                                            _ THE LINE                 ?
          BZSMCNTRL := TRUE;                _ SET CONTROLLING FLAG     ?
          BZSMDISC  := TRUE;                _ REQUEST DISCONNECT       ?
          PNSMBLINDWN (LPTR,DAUSER);        _ KNOCK LINE DOWN          ?
          END _ BZQDISC ? 
_ 
****  GO ON TIMER DELAY FOR 2 MINUTES 
? 
        ELSE _ NOT IMMEDIATE DISCONNECT ? 
100:  
          BEGIN 
          BZWTCCON := BZWTCCON + 1;         _ BUMP CONTENTION COUNTER  ?
          BWWLENTRY[OPS].CMSMLEY.CMWKCODE :=
                         D0TCKCON;          _ CONNECTION WORKCODE      ?
          BWWLENTRY[OPS].CMSMLEY.CMTIMER  :=
                         TIMCON;            _ TIMER INTERVAL           ?
          BWWLENTRY[OPS].CMSMLEY.CMPRM2   :=
                         BZWTCCON;          _ CONTENTION COUNTER       ?
          BWWLENTRY[OPS].CMSMLEY.CMPTR    :=
                         LPTR;              _ PASS LCB ADDRESS         ?
          PBLSPUT (BWWLENTRY[OPS],          _ LAUNCH WORKLIST TO SVM   ?
                         BYWLCB[B0SMTMR]);  _ TIMER FUNCTION           ?
          END; _ ELSE CMWKCODE " D0TCKCON ? 
      END; _ BZCNFST @ C7ENABLED ?
    END; _ BZSWLINE ? 
10:                                         _ QUICK EXIT               ?
  END; _ WITH LPTR'.BZZLCB DO ? 
END; _ PROCEDURE PNTCKCON ? 
_$J+? 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNXCKCON                                         * 
*                                                                     * 
*         CHECK IF X.25 TERMINAL IS CONNECTED TO A HOST               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - PNXCKCON MONITORS AN X.25 SVC FOR INACTIVITY AND        * 
*             NOTIFIES THE TIP TO CLEAR THE CALL IF THERE IS NO       * 
*             CONNECTION TO A HOST WITHIN 2 MINUTES. A FLAG IS        * 
*             MAINTAINED IN THE TCB INDICATING THAT A DELAY           * 
*             TIMER EXISTS, WHICH SHOULD BE REMOVED FROM SVM'S        * 
*             TIME OUT WL QUEUE IF THE TCB IS DELETED OR RE-          * 
*             CONNECTION TO A HOST IS ATTEMPTED.  THIS ENSURES        * 
*             THAT THE DELAY TIMER IS VALID WHEN IT EXPIRES.          * 
*                                                                     * 
** INPUT -     POINTER TO THE TCB                                     * 
*                                                                     * 
** OUTPUTS -   WORKLIST TO *PNSMTMR* FOR TIMER DELAY                  * 
*              WORKLIST TO *PX25TIP* FOR DELETE TCB                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS -                                         * 
*                - PBLSPUT                  MAKE A WORKLIST ENTRY     * 
*              WORKLIST ENTRIES MADE TO -                             * 
*                - PNSMTMR                  SVM TIMER ROUTINE         * 
*                - PX25TIP                  X25 TIP                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNXCKCON (TCBPTR : B0BUFPTR); 
  
CONST 
  TIMCON = 120;                             _ TIMER DELAY 2 MINUTES    ?
  
BEGIN 
WITH TCBPTR'.BSTCB DO                       _ USING TCB STRUCTURE      ?
  BEGIN 
  IF BWWLENTRY[OPS].CMSMLEY.CMWKCODE        _ DETERMINE WHO CALLED US  ?
                   = D0XCKCON 
  THEN
_ 
****  TIMER DEALY EXPIRED - TCB MUST STILL EXIST, NOTIFY X25TIP THAT
****  TCB IS TO BE DELETED IF TERMINAL NOT ATTEMPTING CONNECTION
****  OR CONNECTED TO A HOST. 
? 
    BEGIN 
    BSXTOCON := FALSE;                      _ NO LONGER EXPECTING TIMER?
    IF BSLCBP'.BZSMCNTRL = FALSE            _ SVM NOT CONTROLLING      ?
    THEN
      IF BSHN = 0                           _ IF TERMINAL NOT CONNECTED?
      THEN                                  _  TO HOST                 ?
        PNDNTCB(TCBPTR);                    _ DOWN THE TERMINAL        ?
    END _ CMWKCODE = D0XCKCON ? 
  ELSE
    IF BSLCBP'.BZQDISC = FALSE              _ IF THE LINE IS NOT AN    ?
    THEN                                    _ IMMEDIATE DISCONNECT LINE?
_ 
****  GO ON TIMER DELAY FOR 2 MINUTES 
? 
      BEGIN 
      BSXTOCON := TRUE;                     _ X25 CONNECTION TIMEOUT   ?
      WITH BWWLENTRY[OPS].CMSMLEY DO
        BEGIN 
        CMWKCODE := D0XCKCON;               _ CHECK X25 CONNECT WKCODE ?
        CMTIMER  := TIMCON;                 _ TIMER INTERVAL           ?
        CMPTR    := TCBPTR;                 _ TCB ADDRESS              ?
        END;
      PBLSPUT(BWWLENTRY[OPS],BYWLCB[B0SMTMR]);_SEND WL TO SVM TMR QUEUE?
      END _ CMWKCODE " D0XCKCON AND NOT IMMEDIATE DISCONNECT ?
    ELSE                                    _ IMMEDIATELY DISCONNECT   ?
      PNDNTCB(TCBPTR);                      _ DOWN THE TERMINAL        ?
  END; _ WITH TCBPTR ?
END;  _ PROCEDURE PNXCKCON ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNXRMOVWLE                                       * 
*                                                                     * 
*         REMOVE X25 DELAYED WLE FROM SVM'S TIMEOUT WORKLIST QUEUE.   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNXRMOVWLE IS CALLED WHEN A DELAY TIMER EXISTS FOR     * 
*              AN X25 TERMINAL THAT HAS RE-ESTABLISHED CONNECTION     * 
*              TO THE HOST OR THE TCB IS BEING DELETED (USER HUNGUP,  * 
*              OR LINE DISABLED).  THE WLE IS REMOVED FROM SVM'S      * 
*              TIMEOUT WORKLIST QUEUE.                                * 
*                                                                     * 
** INPUT -     POINTER TO THE TCB                                     * 
*              SM TIMEOUT WL                                          * 
*                                                                     * 
** OUTPUTS -   UPDATED SM TIMEOUT WL                                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS -                                         * 
*                - PBLSGET                  GET A WL ENTRY            * 
*                - PBLSPUT                  PUT A WL ENTRY            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNXRMOVWLE (TCB : B0BUFPTR);
  
VAR 
  RESP : BOOLEAN;                           _ FLAG FOR PBLSGET RESPONSE?
  LOCWLENTRY : BWWORKLIST;                  _ LOCAL WORKLIST ENTRY     ?
  
BEGIN 
WITH LOCWLENTRY.CMSMLEY,                    _ USING LOCAL WLE AND TCB  ?
     TCB'.BSTCB         DO
REPEAT
  BEGIN 
  RESP := PBLSGET(LOCWLENTRY,               _ GET A WORKLIST ENTRY     ?
                  BYWLCB[B0SMTMR]); 
  IF ((CMLINO = BSLCBP'.BZLINO) &           _ IF MATCH ON LINE NUMBER, ?
      (CMPTR = TCB) &                       _ TCB ADDRESS, AND WORKCODE?
      (CMWKCODE = D0XCKCON))
  THEN
    BSXTOCON := FALSE                       _ RESET CONNECTION TIMEOUT ?
  ELSE
    PBLSPUT(LOCWLENTRY,BYWLCB[B0SMTMR]);    _ PUT WLE BACK INTO QUEUE  ?
  END; _ REPEAT ? 
UNTIL NOT BSXTOCON; 
END; _ PROCEDURE PNXRMOVWLE  ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNGLNKWL                                         * 
*                                                                     * 
*         GENERATE A LOGICAL LINK WORKLIST ENTRY                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNGLNKWL MAKES A *LOGL* WORKLIST ENTRY TO *PNLINK*     * 
*              TO CONTROL SENDING REG/LL SERVICE MESSAGES TO NETWORK  * 
*              NODES.                                                 * 
*                                                                     * 
** INPUT -     POINTER TO THE LOGICAL LINK CONTROL BLOCK              * 
*              BOOLEAN FLAG USED TO INDICATE DN-SN REVERSAL           * 
*                                                                     * 
** OUTPUT -    WORKLIST MADE TO *PNLINK* (SVM ROUTINE)                * 
*                                                                     * 
** EXTERNAL SUBROUTINES-                                              * 
*              DIRECT CALLS-                                          * 
*                - PBLSPUT               MAKE WORKLIST ENTRY          * 
*              WORKLIST ENTRIES MADE TO-                              * 
*                - PNLINK                LOGICAL LINK PROCESSOR       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNGLNKWL (LLCB : B0BUFPTR ; REVERSE : BOOLEAN); 
  
BEGIN 
BWWLENTRY[OPS].CMSMLEY.CMWKCODE := D0LINK;  _ LINK WORK CODE           ?
BWWLENTRY[OPS].CMSMLEY.CMLTYP   := LOGL;    _ TYPE ORF WORKCODE        ?
BWWLENTRY[OPS].CMSMLEY.CMSWAP   := REVERSE; _ REVERSE LLCB DN-SN       ?
BWWLENTRY[OPS].CMSMLEY.CMPTR    := LLCB;    _ LOGICAL LINK POINTER     ?
PBLSPUT (BWWLENTRY[OPS],BYWLCB[B0SMWL]);    _ LAUNCH WORKLIST TO PNLINK?
END; _ PROCEDURE PNGLNKWL ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                     PNGREGLL                                        * 
*                                                                     * 
*         GENERATE A REG/LL REGULATION SERVICE MESSAGE                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNGREGLL IS CALLED TO BUILD AND DISPATCH A REG/LL      * 
*              REGULATION SERVICE MESSAGE. THIS ROUTINE NOT ONLY SENDS* 
*              REGULATION MESSAGES TO NETWORK HOSTS, BUT ALSO TO      * 
*              OTHER NETWORK NPUS. THE FORMAT OF THE REG/LL MESSAGE   * 
*              IS DEPENDENT UPON WHERE THE REG/LL IS BEING SENT.      * 
*              ADDITIONAL INFORMATION IS CONTAINED IN THE NPU-NPU     * 
*              REG/LL(S) SO THAT THE NPU(S) CAN CORRECTLY CONTROL     * 
*              NODAL REGULATION FOR THE HOST(S) AND UPDATE LOGICAL    * 
*              LINK REGULATION FOR THE ENTIRE NETWORK.                * 
*                                                                     * 
** INPUT -     POINTER TO A LOGICAL LINK CONTROL BLOCK                * 
*              REGULATION LEVEL TO BE SENT                            * 
*              BOOLEAN FLAG TO INDICATE DN-SN REVERSAL                * 
*                                                                     * 
** OUTPUT -    DISPATCHED REG/LL REGULATION MESSAGE                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES-                                              * 
*              DIRECT CALLS-                                          * 
*                - PBSWLE                  MAKE WORKLIST TO *BIP*     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNGREGLL (LLCBP : B0BUFPTR; SNREG : B0OVERLAY;
                                      REVERSE : BOOLEAN); 
  
CONST 
  REG  = 14;
  LLDN = 15;
  LLSN = 16;
  LCS  = 17;
  LNS  = 18;
  
VAR 
  PTR  : B0BUFPTR;
  
BEGIN 
B1BUFF := PBGET1BF (BEDBSIZE);              _ GET BUFFER FOR REG/LL    ?
WITH B1BUFF',                               _ WITH DATA BUFFER         ?
     LLCBP'.BLLLCB.BLSPART DO               _ AND LLCB PASSED          ?
  BEGIN 
  BIINT[BTPT/2+1] := HTCMD + $80;           _ CN AND BTPT              ?
  BIINT[SFC/2+1] := D8REG * $100 + D9LL;    _ REG - PFC LL - SFC       ?
  IF REVERSE                                _ SEE IF WE REVERSE DN-SN  ?
  THEN                                      _ YES                      ?
_ 
****  THE REG/LL IS BEING SENT TO ANOTHER NPU - THE MESSAGE 
****  WILL CONTAIN ADDITIONAL INFORMATION 
? 
    BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
    PTR := PN1SRCH (BLSN,DELOCDN);          _ GET POINTER TO DN TABLE  ?
    BFDATAC[DN] := CHR(PTR'.TRKCB.TRTNID);  _ REMOTE NPU NODE          ?
    BFDATAC[SN] := CHR(CKLOCNODE);          _ SOURCE THIS NPU          ?
    SNREG.BABOOL.B0B2 := BLTCS;             _ IF NS AVAILABLE AT HOST  ?
    SNREG.BABOOL.B0B3 := BLTNS;             _ ALSO TELL NPU IF CS      ?
    BFDATAC[LLDN] := CHR(BLSN);             _ LOGICAL LINK DN TO NODE  ?
    BFDATAC[LLSN] := CHR(BLDN);             _ LOGICAL LINK SN TO NODE  ?
    BFDATAC[LCS] := CHR(CS);                _ TELL NPU OUR CS          ?
    IF CS = 0                               _ IF NO *CS* PRESENT - SEND?
    THEN
      BFDATAC[LCS] := CHR(CSPEND);          _ PENDING *CS* - IF ANY    ?
    BFDATAC[LNS] := CHR(NS);                _ ALSO OUR NS              ?
    BIINT[1] := LNS * $100 + BLOCK;         _ SET LCD AND FCD          ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
    END _ REVERSE ? 
_ 
****  FORMAT REG/LL MESSAGE FOR HOST
? 
  ELSE _ NOT REVERSE ?
    BEGIN 
    BFDATAC[DN] := CHR(BLDN);               _ LOGICAL LINK DN          ?
    BFDATAC[SN] := CHR(BLSN);               _ LOGICAL LINK SN          ?
    IF BLSNHST                              _ IF HOST-TO-HOST REG/LL   ?
    THEN                                    _ THEN TELL THE HOST       ?
      SNREG.BABOOL.B0B4 := TRUE 
    ELSE _ NOT BLSNHST ?                    _ NOT HOST-TO-HOST         ?
_ 
****  THE REG/LL IS REPORTING NPU REGULATION TO HOST
****  WE ALSO NEED TO REPORT *CS* AND *NS* USAGE TO HOST
? 
      BEGIN 
      IF CKLOCNODE = BLSN                   _ IF WE ARE SOURCE         ?
      THEN                                  _ CHECK CS AND NS          ?
        BEGIN 
        SNREG.BABOOL.B0B3 := NS = BLDN;     _ DITTO                    ?
        SNREG.BABOOL.B0B2 := CS = BLDN;     _ SET CS BEING USED        ?
        IF CS = 0                           _ IF NO CS SEE IF PENDING  ?
        THEN
          SNREG.BABOOL.B0B2 := CSPEND = BLDN;_ SET BIT                 ?
        END 
      ELSE
_ 
****  REPORT USE OF *CS* AND *NS* BY A REMOTE NPU TO THE HOST 
? 
        BEGIN 
        SNREG.BABOOL.B0B2 := (BLTCS & BLCS);_ REMOTE NPU USE OF CS-NS  ?
        SNREG.BABOOL.B0B3 := (BLTNS & BLNS);_ IF CS - NS PRESENT       ?
        END;
      END; _ ELSE NOT BLHH ?
    BIINT[1] := REG * $100 + BLOCK;         _ SET LCD FCD              ?
    END; _ ELSE NOT REVERSE ? 
  BFDATAC[REG] := SNREG.BARCHAR;            _ SET REGULATION LEVEL     ?
  PBSWLE (B1BUFF);                          _ LAUNCH REG/LL            ?
  END; _ WITH B1BUFF'.. ? 
END; _ PROCEDURE PNGREGLL ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNCSUPCHG                                        * 
*                                                                     * 
*         CHECK SUPERVISION (CS) CHANGE                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNCSUPCHG IS CALLED TO POST *CS* AND *NS* AVAILIBILITY * 
*              TO THE COUPLER LOGICAL LINK CONTROL BLOCKS. IT THEN    * 
*              SEARCHS THE *DELOCDN* LOOKING FOR THE MOST PREFERRED   * 
*              *NS* (AVAILABLE VIA A COUPLER OR LOWEST NODE ID).      * 
*              *CS* AVAILIBILITY IS DETERMINED BY SEARCHING THE       * 
*              *DESUPDN* TABLE. THIS ROUTINE WILL GENERATE A SUP/IN   * 
*              SUPERVISION REQUEST WHEN A NEW *CS* IS FOUND.          * 
*                                                                     * 
** INPUT -     NODE ID FOR WHICH SUPERVISION HAS CHANGED              * 
*              SUPERVISION AVAILIBILITY OF NODE ID                    * 
*                                                                     * 
** OUTPUT -    COUPLER LOGICAL LINK(S) POSTED                         * 
*              THE GLOBL$ *CS* AND *NS* SET OR CLEARED                * 
*              SUP/IN SUPERVISION REQUEST SENT                        * 
*              WORKLIST TO *PNLINK* TO GENERATE REG/LL IF SUP/IN      * 
*                SENT                                                 * 
*                                                                     * 
** EXTERNAL SUBROUTINES-                                              * 
*              DIRECT CALLS-                                          * 
*                - PN1GTPTR            GET POINTER TO TYPE 1 TABLE    * 
*                - PBLSPUT             MAKE WORKLIST ENTRY            * 
*                - PNENBLINES          CHECK LINES WITH CNF/TE PENDING* 
*              WORKLISTS ENTRIES MADE TO-                             * 
*                - PNLINK              GENERATE REG/LL(S)             * 
*                - PNSMTMR             SVM TIMER - TO DELAY SENDING   * 
*                                      THE SUP/IN REQUEST UNTIL REG/LL* 
*                                      RECIEVED AT HOST               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNCSUPCHG (SNID : INTEGER; SNREG : B0OVERLAY);
  
VAR 
  PTR     : B0BUFPTR; 
  DUMMY   : BOOLEAN;
  CSAVAIL : BOOLEAN;
  NSAVAIL : BOOLEAN;
  
_ 
** FUNCTION NAME - P N 2 C H K L O S T
* 
** OVERVIEW      - THIS FUNCTION CHECKS FOR THE LOSS OF *NS* AND *CS* 
*                  RETURNING A BOOLEAN TRUE VALUE IF THE PASSED 
*                  VARIABLE HAS BEEN LOST.
? 
FUNCTION PN2CHKLOST (CSORNS : INTEGER; PRESENT : BOOLEAN) : BOOLEAN;
  
BEGIN 
PN2CHKLOST := FALSE;                        _ ASSUME NOT LOST          ?
IF CSORNS = SNID                            _ IF USING THIS NODE ID    ?
THEN
  IF PRESENT = FALSE                        _ AND *NS* OR *CS* LOST    ?
  THEN
    PN2CHKLOST := TRUE;                     _ RETURN TRUE              ?
END; _ FUNCTION PN2CHKLOST ?
_ 
** PROCEDURE NAME - P N 2 G N P U R E G 
* 
** OVERVIEW       - THIS PROCEDURE IS CALLED TO TRIGGER A NPU 
*                   REGULATION CHECK SO THAT HOST/NPU NODES IN THE
*                   NETWORK WILL BE NOTIFIED OF A CHANGE/LOSS OF
*                   SUPERVISION I.E. *CS*.
? 
PROCEDURE PN2GNPUREG; 
  
BEGIN 
DWWLENTRY.CMSMLEY.CMWKCODE := D0LINK;       _ LINK WORKCODE            ?
DWWLENTRY.CMSMLEY.CMDATA   := NPUREG;       _ PASS CURRENT REGULATION  ?
DWWLENTRY.CMSMLEY.CMLTYP   := NPU;          _ NPU REGULATION CHANGE    ?
PBLSPUT (DWWLENTRY,BYWLCB[B0SMWL]);         _ WORKLIST BACK TO SVM     ?
END; _ PROCEDURE PN2GNPUREG ? 
_$J+? 
_ 
****  S T A R T   P R O C E D U R E   P N C S U P C H G 
? 
BEGIN 
CSAVAIL := SNREG.BACPOW.BACSAV;             _ MOVE TO LOCAL VAR        ?
NSAVAIL := SNREG.BACPOW.BANSAV; 
PTR := PN1GTPTR (SNID,DELOCDN);             _ GET NODE ID FROM TABLE   ?
IF PTR " NIL                                _ IF NODE EXISTS           ?
THEN                                        _ SEE IF IT IS A LOCAL HOST?
_ 
****  POST PRESENCE OF *NS* AND *CS* TO THE NODE ID TABLE 
? 
  BEGIN 
  PTR'.BRTYP1.BRNSAV := NSAVAIL;            _ SET *NS* AVAILABLE       ?
  PTR'.BRTYP1.BRCSAV := CSAVAIL;            _ AND *CS* AVAILABLE       ?
  IF PTR'.BRTYP1.BRLNKT = NLCOUPLER 
  THEN
_ 
****  THEN POST *NS* AND *CS* AVAILIBILITY TO COUPLER LLCB(S) 
? 
    BEGIN 
    PTR := PTR'.BRTYP1.BRPTR'.BHCCB.BHLLCB; _ GET LLCB CHAIN           ?
    WHILE PTR " NIL DO                      _ SEARCH ENTIRE CHAIN      ?
      WITH PTR'.BLLLCB.BLSPART DO           _ LLCB TYPE                ?
      BEGIN 
      BLTNS := NSAVAIL;                     _ POST PRESENCE OF NS      ?
      BLTCS := CSAVAIL;                     _ POST PRESENCE OF CS      ?
      IF NSAVAIL = FALSE                    _ IF *NS* NOT AVAILABLE    ?
      THEN
        BLNS := FALSE;                      _ CLEAR USE BY REMOTE NPU  ?
      IF CSAVAIL = FALSE                    _ IF *CS* NOT AVAILABLE    ?
      THEN
        BLCS := FALSE;                      _ CLEAR USE BY REMOTE NPU  ?
      PTR := BLCHAIN;                       _ BUMP THE THREAD          ?
      END; _ WHILE PTR " NIL ?
    END; _ PTR'... = LOCAL HOST ? 
_ 
****  DETERMINE IF *NS* HAS BEEN LOST AND START SEARCH FOR NEW *NS* 
****  BUT ONLY IF GLOBL$ *LIP* REMOTE LOADING NOT SET.
? 
  IF PN2CHKLOST (NS,NSAVAIL)                _ SEE IF CURRENT *NS* LOST ?
  THEN
    BEGIN 
    NSLAST := NS;                           _ SAVE PREVIOUS *NS*       ?
    NS := 0;                                _ *NS* LOST                ?
*IF DEF,HLIP,1
    LOADFLG := FALSE;                       _ CLEAR LOADING FLAG       ?
    END;
*IF DEF,HLIP
  IF LOADFLG = FALSE                        _ ONLY LOOK FOR NEW *NS*   ?
  THEN                                      _ NOT CURRENTLY LOADING    ?
*ENDIF
 _
****  LOOK FOR MOST PERFERRED *NS* TO USE. *NS* VIA A COUPLER 
****  HAS PREFERENCE, BUT IF NONE AVAILBLE VIA A COUPLER THEN 
****  TAKE THE LOWEST NODE ID.
? 
    BEGIN 
    PTR := DELOCDN;                         _ SEARCH ALL NODES FOR *NS*?
    IF NS " 0                               _ IF WE HAVE A *NS* SAVE   ?
    THEN
      NSLAST := NS;                         _ IN CASE WE FIND A NEW ONE?
    REPEAT
      WITH PTR'.BRTYP1 DO                   _ USING TYPE 1 STRUCTURE   ?
        BEGIN 
        IF BRNSAV                           _ IF *NS* IS AVAILABLE     ?
        THEN
          BEGIN 
          IF BRLNKT = NLCOUPLER             _ AND AVAILABLE VIA COUPLER?
          THEN
            BEGIN 
            NS := BRID;                     _ FOUND A PREFERRED *NS*   ?
            GOTO 10;                        _ EXIT REPEAT LOOP         ?
            END  _ BRLNKT = NLCOUPLER ? 
          ELSE _ BRLNKT " NLCOUPLER ? 
            BEGIN 
            IF NS = 0                       _ IF NO *NS* IN USE        ?
            THEN
              NS := BRID                    _ USE THIS ID AS *NS*      ?
            ELSE
              IF BRID < NS                  _ IF THIS ID LOWER THAN    ?
              THEN                          _ CURRENT *NS*             ?
                NS := BRID;                 _ THEN USE IT              ?
            END; _ ELSE BRLNKT " NLCOUPLER ?
          END; _ BRNSAV ? 
        END; _ WITH PTR'.BRTYP1 DO ?
      PTR := PTR + 2;                       _ POINT TO NEXT TABLE ENTRY?
    UNTIL PTR'.BRTYP1 = BREND;              _ STOP AT END OF TABLE     ?
    END; _ LOADFLG = FALSE ?
10:                                         _ QUICK EXIT FROM REPEAT   ?
_ 
****  NOW START SEARCH TO DETERMINE AVAILIBILTY OF *CS*.
****  PRIORITY OF *CS* IS DETERMINED BY SEARCHING THE *DESUPDN* TABLE 
? 
  PTR := PN1GTPTR (SNID,DESUPDN);           _ SEE IF ID IS SUPERVISOR  ?
  IF PTR " NIL                              _ YES - *CS* ID            ?
  THEN
    BEGIN 
    PTR'.BRTYP1.BRCSAV := CSAVAIL;          _ POST *CS* AVAILIBILITY   ?
    PTR := DESUPDN;                         _ NOW SEARCH ENTIRE TABLE  ?
    IF PN2CHKLOST (CSPEND,CSAVAIL)          _ IF PENDING *CS* LOST     ?
    THEN
      CSPEND := 0;                          _ CLEAR PENDING NODE ID    ?
    REPEAT                                  _ SEARCH TABLE FOR NEW *CS*?
      WITH PTR'.BRTYP1 DO 
        BEGIN 
        IF BRCSAV                           _ IF *CS* AVAILABLE        ?
        THEN
          BEGIN 
          IF CS = BRID                      _ DO NOT SEND SUP/IN TO    ?
          THEN
            GOTO 999;                       _ EXIT IMMEDIATELY         ?
          IF CSPEND = 0                     _ AND NO PENDING *CS*      ?
          THEN
_ 
****  HAVE FOUND HIGHEST PRIORITY *CS* CANDIDATE - SEND SUP/IN. 
? 
            BEGIN 
            WITH DWWLENTRY.CMSMLEY DO       _ SVM WORKLIST ARRAY       ?
              BEGIN 
              CMSMGEN     := TRUE;          _ WORKCODE FOR PNSMGEM     ?
              CMREALTIMER := 2;             _ DELAY SENDING 2 SECS     ?
              CMPRM1      := D8SUP;         _ PFC SUPERVISION          ?
              CMPRM2      := D9IN;          _ SFC REQUEST              ?
              CMPRM3      := CS;            _ CURRENT *CS*             ?
              CMPRM4.BABUFPTR := PTR;       _ POINTER TO ID ENTRY      ?
              PBLSPUT (DWWLENTRY, 
                       BYWLCB[B0SMTMR]);    _ W/C TO SVM TIMER         ?
_ 
****  WE MUST NOTIFY THE NETWORK VIA REG/LL THAT WE ARE ATTEMPTING
****  TO USE A NEW *CS*. FORCE A DUMMY NPU REGULATION CHECK 
? 
              PN2GNPUREG;                   _ FORCE NPU REGULATION CHK ?
              END; _ WITH DWWLENTRY.CMSMLEY ? 
            CS := 0;                        _ CLEAR CURRENT *CS*       ?
            CSPEND := PTR'.BRTYP1.BRID;     _ SET CS PENDING           ?
            PDOTERM (CHR(0),TRUE);          _TERMINATE DIAGNOSTICS     ?
            PNENBLINES(TRUE);               _ CHECK FOR CNF PENDING    ?
            END; _ CSPEND = 0 ? 
          END; _ BRCSAV ? 
        END; _ WITH PTR'.BRTYP1 DO ?
      PTR := PTR + 2;                       _ KEEP SEARCHING TABLE     ?
    UNTIL PTR'.BRTYP1 = BREND;              _ UNTIL END                ?
999:  
    IF PN2CHKLOST (CS,CSAVAIL)              _ IF *CS* LOST - CLEAR     ?
    THEN
      BEGIN 
      CS := 0;                              _ CLEAR PRESENCE OF *CS*   ?
      PDOTERM (CHR(0),TRUE);                _TERMINATE DIAGNOSTICS     ?
      DWWLENTRY.CMSMLEY.CMWKCODE := A0SMNH; _ NO SUPERVISION PRESENT   ?
      PBLSPUT (DWWLENTRY,BYWLCB[B0LIWL]);   _ NOTIFY LINE INITIALIZER  ?
      PN2GNPUREG;                           _ FORCE NPU REGULATION CHK ?
      PNENBLINES (TRUE);                    _ CHECK FOR CNF PENDING    ?
      END; _ PN2CHKLOST ? 
    END; _ PTR " NIL ?
  END; _ PTR " NIL ?
END; _ PROCEDURE PNCSUPCHG ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMGEN                                          * 
*                                                                     * 
*        GENERATE SERVICE MESSAGE                                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMGEN BUILDS SERVICE MESSAGES GENERATED BY A         * 
*              NODE BASED ON PARAMETERS PASSED TO IT.  PNSMGEN        * 
*              DETERMINES THE TYPE OF RECIPIENT - NEIGHBOR NPU, NAM,  * 
*              NS, OR CS - AND OBSERVES THE APPROPRIATE PROTOCOL.     * 
*                                                                     * 
** INPUT -     PFC, SFC, CONTROL BLOCK OR BUFFER POINTER, SUPERVISOR  * 
*              OR RESPONSE CODE                                       * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PTIVTCMD     - IVT COMMAND PROCESSOR                   * 
*              PNCONNECT    - ESTABLISH A TCB CONNECTION              * 
*              PNDISCONNECT - DISCONNECT A TCB                        * 
*              PNCNTERM     - TERMINATE A CONNECTION                  * 
*              PNICNORMAL   - PROCESS NORMAL CONNECTION RESPONSE      * 
*              PNTCNREQUEST - PROCESS TERMINATE CONNECTION REQUEST    * 
*                                                                     * 
** OUTPUT -    COMPLETED SERVICE MESSAGE                              * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBSWLE       - MAKE A WORKLIST ENTRY TO BIP            * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMGEN_(GENPFC:INTEGER;GENSFC:DHSFCTYPE; 
                  GENPAR:B0OVERLAY;GENSUP:INTEGER)?;
CONST 
      GENAMMAX   =  6;                      _ MAX PFC USED BY NAM      ?
      GENSMAX    = $D;                      _ MAX PFC USED BY NS       ?
VAR 
      GESMP : B0BUFPTR;                     _ SM BUFFER POINTER        ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMTIME - LEVEL 2 PROCEDURE                     * 
*                                                                     * 
*        GENERATE A TIMEOUT FOR A SERVICE MESSAGE                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMTIME IS CALLED TO MAKE A TIMER WORKLIST ENTRY BACK * 
*              TO THE SERVICE MODULE.                                 * 
*                                                                     * 
** INPUT -     PNSMGEN GLOBALS                                        * 
*              TIME - NUMBER OF SECONDS TO DELAY                      * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMBUFGET - GET A BUFFER FOR A SERVICE MESSAGE        * 
*                                                                     * 
** OUTPUT -                                                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBLSPUT - MAKE A WORKLIST ENTRY                        * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMTIME (TIME : INTEGER);
  
BEGIN 
WITH DWWLENTRY.CMSMLEY DO                   _DELAYED WORKLIST AREA     ?
  BEGIN 
  CMSMGEN     := TRUE;                      _TELL PNSMTMR ITS PNSMGEN  ?
  CMREALTIMER := TIME;                      _SET TIMER PERIOD          ?
  CMPRM1      := GENPFC;                    _SAVE PFC                  ?
  CMPRM2      := GENSFC.DHINT;              _SAVE SFC                  ?
  CMPRM3      := GENSUP;                    _SAVE SUPERVISOR           ?
  CMPRM4      := GENPAR;                    _SAVE PARAMETER            ?
  
  PBLSPUT (DWWLENTRY,BYWLCB[B0SMTMR]);      _PUT WORKLIST INTO TIMER Q ?
  END; _WITH DWWLENTRY.CMSMLEY DO?
END; _PROCEDURE PNSMTIME ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMBUFGET - LEVEL 2 PROCEDURE                   * 
*                                                                     * 
*        GET A BUFFER FOR A SERVICE MESSAGE                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMBUFGET CHECKS BUFFER THRESHOLD, AND IF THERE ARE   * 
*              SUFFICIENT BUFFERS, GETS ONE FOR THE SERVICE MESSAGE.  * 
*              IF NOT SUFFICIENT BUFFERS, IT MAKES A TIMER ENTRY.     * 
*                                                                     * 
** INPUT -                                                            * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNNAMSM - GENERATE A SERVICE MESSAGE TO NAM            * 
*                                                                     * 
** OUTPUT -    SERVICE MESSAGE BUFFER POINTER, GESMP = BUFFER         * 
*              ADDRESS, OR NIL                                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBGET1BF  - GET A BUFFER                               * 
*              PNSMIME   - MAKE TIMER ENTRY TO GENERATE SM            * 
*              PB1BFAVAIL - CHECK BUFFER AVAILABILITY                 * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMBUFGET; 
BEGIN 
IF PB1BFAVAIL (B0THDIS)                     _ IF ENOUGH BUFFERS,       ?
THEN
  BEGIN 
  GESMP := PBGET1BF(BEDBSIZE);              _ GET A BUFFER             ?
  WITH GESMP' DO                            _ USING POINTER TO BUFFER  ?
    BEGIN 
    BFFCD := BLOCK;                         _ SET-UP FCD               ?
    BIINT[BTPT/2+1] := HTCMD+$80;           _ CN AND BTPT              ?
    BFDATAC[PFC] := CHR(GENPFC);            _ SET IN PFC               ?
    BFDATAC[SFC] := CHR(GENSFC.DHINT);      _ SET IN SFC               ?
    END; _ WITH GESMP' ?
  END 
ELSE
  PNSMTIME(2);                              _ MAKE A SM GEN TIMER ENTRY?
END; _ PNSMBUFGET ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNNAMSM - LEVEL 2 PROCEDURE                      * 
*                                                                     * 
*        GENERATE A SERVICE MESSAGE TO NAM                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNNAMSM GENERATES ALL SERVICE MESSAGES TO NAM          * 
*                                                                     * 
** INPUT -     PNSMGEN GLOBALS                                        * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMGEN - GENERATE A SERVICE MESSAGE                   * 
*                                                                     * 
** OUTPUT -    GESMP POINTS TO SERVICE MESSAGE                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNNAMSM;
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNGICNREQUEST - LEVEL 3 PROCEDURE                * 
*                                                                     * 
*        PUT ICN/TA/R PARAMETERS INTO UPLINE SERVICE MESSAGE BUFFER   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNGICNREQUEST GENERATES AN ICN/TA/R SERVICE MESSAGE.   * 
*                                                                     * 
** INPUT -     SERVICE MESSAGE BUFFER                                 * 
*              TCB                                                    * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNNAMSM - GENERATE AN UPLINE SERVICE MESSAGE TO NAM    * 
*                                                                     * 
** OUTPUT -    COMPLETED SERVICE MESSAGE                              * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNGICREQUEST; 
CONST 
      SVTC  = 15;                           _BYTE 15                   ?
      SVPL  = 16;                           _BYTE 16                   ?
      SVPW  = 17;                           _BYTE 17                   ?
      SVDT  = 18;                           _BYTE 18                   ?
      SVDBL = 19;                           _BYTE 19                   ?
      SVT1  = 20;                           _BYTE 20                   ?
      SVT2  = 21;                           _BYTE 21                   ?
      SVT3  = 22;                           _BYTE 22                   ?
      SVT4  = 23;                           _BYTE 23                   ?
      SVT5  = 24;                           _BYTE 24                   ?
      SVT6  = 25;                           _BYTE 25                   ?
      SVT7  = 26;                           _BYTE 26                   ?
      SVABL = 27;                           _BYTE 27                   ?
      SVDZM = 28;                           _BYTE 28                   ?
      SVDZL = 29;                           _BYTE 29                   ?
      SVSP1 = 30;                           _BYTE 30                   ?
      SVDO  = 31;                           _BYTE 31                   ?
      SVBZM = 32;                           _BYTE 32                   ?
      SVBZL = 33;                           _BYTE 33                   ?
      SVSDT = 34;                           _BYTE 34                   ?
      SVC1  = 35;                           _BYTE 35                   ?
      SVC2  = 36;                           _BYTE 36                   ?
      SVC3  = 37;                           _BYTE 37                   ?
      SVC4  = 38;                           _BYTE 38                   ?
      SVC5  = 39;                           _BYTE 39                   ?
      SVC6  = 40;                           _BYTE 40                   ?
      SVC7  = 41;                           _BYTE 41                   ?
      SVSEC = 42;                           _BYTE 42                   ?
      SVPRI = 43;                           _BYTE 43                   ?
      SVRIC = 44;                           _BYTE 44                   ?
      SVEP  = 45;                           _BYTE 45                   ?
      SVUBZ = 46;                           _BYTE 46                   ?
      SVSWL = 47;                           _BYTE 47                   ?
      SVACT = 50;                           _BYTE 50                   ?
VAR 
      I     : INTEGER;                      _ LOOP COUNTER             ?
      TCELL : B0OVERLAY;                    _ TEMPORARY CELL           ?
      BFFR  : B0BUFPTR;                     _ACCOUNTING BUFFER         ?
      SVLCD : INTEGER;                      _LCD FOR SM                ?
BEGIN 
SVLCD := SVSWL;                             _SET LCD VARIABLE          ?
WITH GESMP',GENPAR.BABUFPTR'.BSTCB DO       _ WITH SM BUF, AND TCB     ?
  BEGIN 
_  *****  CAUTION - HIDDEN *IF DEF,X25  *****  ?
*IF DEF,X25 
  IF (BSLCCBPTR'.LCCB.LCCNTYPE = N0XPAD)    _PAD SUBTIP                ?
  THEN
    IF (BSLCBP'.BZTIPTYPE = N1X25)          _X.25                      ?
    THEN                                    _PASS PAD LOGIN ACCOUNTING ?
      BEGIN                                 _INFO UPLINE IN SM         ?
      BFFR := BSLCCBPTR'.LCCB.LCACCTPTR;    _LOGIN ACCOUNTING BUFFER   ?
      IF BFFR " NIL                         _IF ACCTG INFO PROVIDED    ?
      THEN
        BEGIN 
        I            := GESMP'.BFFCD;       _SAVE FCD                  ?
        GESMP'.BFFCD := SVACT;              _SET LOCATION FOR ACCTING  ?
                                            _INFO IN SM MSG BUFFER     ?
        PBFCOPY(BFFR,GESMP);                _COPY ACCOUNTING INFO      ?
        GESMP'.BFFCD := I;                  _RESTORE FCD               ?
        SVLCD        := GESMP'.BFLCD;       _SET X25 LCD FROM PBFCOPY  ?
        PBREL1BF(BFFR,BEDBSIZE);            _RELEASE PAD ACCT BUFFER   ?
        BSLCCBPTR'.LCCB.LCACCTPTR := NIL;   _CLEAR BUFFER POINTER      ?
        END;
      END;
*ENDIF
_  ***** CAUTION - HIDDEN *ENDIF FOR X.25 CODE  *****  ?
  BFDATAC[ SVTC] := CHR(BSTCLASS);          _ PUT TCLASS INTO SM       ?
  BFDATAC[ SVPL] := CHR(BSPGLENGTH);        _ PUT PGLENGTH INTO SM     ?
  BFDATAC[ SVPW] := CHR(BSPGWIDTH);         _ PUT PGWIDTH INTO SM      ?
  BFDATAC[ SVDT] := CHR(BSDEVTYPE);         _ PUT DEVICE TYPE INTO SM  ?
  BFDATAC[SVDBL] := CHR(BSDBL);             _ PUT NW BLK LIMIT INTO SM ?
  FOR I := 0 TO 6 DO                        _ MOVE TERMINAL NAME       ?
    BFDATAC[SVT1+I] := BSTNAME[I];
  BFDATAC[SVABL] := CHR(BSABL);             _ PUT APPLICATION BLOCK LMT?
  TCELL.BAINT := BSDBZ;                     _ DOWNLINE BLOCK SIZE      ?
  BFDATAC[SVDZM] := TCELL.BALCHAR;          _ TO MESSAGE BUFFER        ?
  BFDATAC[SVDZL] := TCELL.BARCHAR;          _ BOTH PORTIONS            ?
  BFDATAC[SVSP1] := CHR(0);                 _ SPARE EX-AUTOLOGIN FIELD ?
  BFDATAC[ SVDO] := CHR(BSDO);              _ PUT DEVICE ORDINL INTO SM?
  TCELL.BAINT := BSXBZ;                     _ POSITION TRANSMISSION    ?
  BFDATAC[SVBZM] := TCELL.BALCHAR;          _ BLOCK SIZE AND           ?
  BFDATAC[SVBZL] := TCELL.BARCHAR;          _ MOVE TO BUFFER           ?
  BFDATAC[SVSDT] := CHR(BSSUBDT);           _ PUT SUBDEVICE TYPE IN SM ?
  FOR I := 0 TO 6 DO                        _ CONSOLE NAME TO MSG      ?
    BFDATAC[SVC1+I] := BSCONSOLE'.BSTCB.BSTNAME[I]; 
  BFDATAC[SVSEC] := CHR(BSLCBP'.BZSECURITY);_ PUT SECURITY LEV INTO SM ?
  BSLCBP'.BZWTCCON := BSLCBP'.BZWTCCON+1;   _ BUMP CONTENTION TIMER    ?
  BFDATAC[SVPRI] := CHR(BSIPRI);            _ PUT PRIORITY INTO SM     ?
  BFDATAC[SVRIC] := CHR(0);                 _DEFAULT IC FLAG           ?
  IF BSRIC                                  _IF RESTRICTED IC          ?
  THEN
    BFDATAC[SVRIC] := CHR(1); 
  BFDATAC[SVEP] := CHR(0);                  _ECHOPLEX MODE DEFAULT     ?
  IF BSECHOPLEX 
  THEN
    BFDATAC[SVEP] := CHR(1);                _ SET FLAG ACCORDINGLY     ?
  BFDATAC[SVUBZ] := CHR(BSUBZ);             _PASS UPLINE BLOCK SIZE    ?
  BFDATAC[SVSWL] := CHR(0);                 _DEFAULT TO SWITCHED LINE  ?
  IF BSLCBP'.BZSWLINE = FALSE               _HARD-WIRED LINE           ?
  THEN
    BFDATAC[SVSWL] := CHR(1);               _INDICATE HARD-WIRED LINE  ?
  BFLCD := SVLCD;                           _ SET LCD                  ?
  END; _ WITH GESMP',GENPAR.BABUFPTR'.BSTCB ? 
END; _ PNGICREQUEST ? 
_$J+? 
_ 
* * * *  PNNAMSM STARTS HERE
? 
BEGIN 
PNSMBUFGET;                                 _  GET A SM BUFFER         ?
IF GESMP " NIL                              _ IF SM POINTER NON NIL    ?
THEN
  WITH GESMP',                              _ WITH SM POINTER          ?
       GENPAR.BABUFPTR'.BSTCB DO            _ AND TCB POINTER          ?
    BEGIN 
    BFDATAC[  DN] := CHR(BSHN);             _ PUT HOST NODE INTO BUFFER?
    BFDATAC[  SN] := CHR(BSLLCB'.BLLLCB     _ PUT SRCE NODE INTO BUFFER?
                        .BLSPART.BLDN); 
    BFDATAC[  P3] := CHR(BSCN);             _ PUT CN INTO SM PARAMETER ?
    CASE GENPFC OF                          _ CASE PFC                 ?
  
      D8ICN:                                _ INITIATE CONNECTION SM   ?
        BEGIN 
        IF GENSFC.DHRTYPE = SMREQUEST       _ IF ICN/TA/R              ?
        THEN
          PNGICREQUEST;                     _ CALL ICN/TA/R GENERATOR  ?
        END; _ ICN ?
  
      D8TCN:                                _ TERMINATE CONNECTION SM  ?
        BEGIN 
        BFLCD := P3;                        _ SET LCD OF TCN/TA        ?
        IF GENSFC.DHRTYPE = SMREQUEST       _ IF TCN/TA/R              ?
        THEN
          BEGIN 
          BFDATAC[P4] := CHR(GENSUP);       _ PUT RC INTO SM           ?
          BFLCD       := P4;                _ SET LCD IN BUFFER        ?
          END; _ IF REQUEST ? 
        END; _ TCN ?
  
      D8CHC:                                _ CHANGE TERMINAL          ?
        BEGIN                               _   CHARACTERISTICS        ?
        BFDATAC[P4] := CHR(BSTCLASS);       _ ADD TERMINAL CLASS       ?
        BFDATAC[P5] := CHR(BSPGLENGTH);     _ ADD PAGE LENGTH          ?
        BFDATAC[P6] := CHR(BSPGWIDTH);      _ ADD PAGE WIDTH           ?
        BFLCD       := P6;                  _ SET LCD IN SM BUFFER     ?
        END; _ CHC ?
  
      END; _ CASE ? 
    END; _ WITH ? 
END; _ PNNAMSM ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNCSSM                                           * 
*                                                                     * 
*        GENERATE A SERVICE MESSAGE TO CS                             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNCSSM GENERATES SERVICE MESSAGES TO CS                * 
*                                                                     * 
** INPUT -     PNSMGEN GLOBALS                                        * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMGEN - SERVICE MESSAGE GENERATOR                     *
*                                                                     * 
** OUTPUT -    GESMP POINTS TO SERVICE MESSAGE                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNCSSM; 
CONST 
      P     = 14;                           _ SM PORT PARAMETER        ?
      SUBP  = 15;                           _ SM SUBPORT PARAMETER     ?
      TT    = 16;                           _ SM TERMINAL TYPE PARAM   ?
      PS    = 14;                           _ PREVIOUS SUPERVISOR      ?
      PL    = 15;                           _ NS                       ?
      RI    = 16;                           _ REMOTE INDICATOR         ?
      VCW   = 11;                           _ WORD OFFSET FOR VERSION  ?
      VN    = 27;                           _ START OF NCF INFO        ?
      VNEND = 28;                           _ END BYTE POSITION OF SUP ?
      MTEN  = 20;                           _ START OF TERM NAME IN MSG?
      MEND  = 26;                           _ LCD FOR MSG TO OPERATOR  ?
VAR 
      I      : INTEGER;                     _ INDEX                    ?
      IPTR   : 'INTEGER;                    _ INTEGER POINTER          ?
      MRI    : INTEGER;                     _ REMOTE INDICATOR         ?
      TEWORD : B0OVERLAY;                   _ PORT CONVERSION OVERLAY  ?
      TETT   : NPTT;                        _ TERMINAL TYPE            ?
      TEPTR  : B0BUFPTR;                    _ BUFFER POINTER           ?
  
BEGIN 
PNSMBUFGET;                                 _ GET A BUFFER IF AVAILABLE?
IF GESMP " NIL                              _ PROCESS IF BUFFER        ?
THEN
  WITH GESMP' DO
  BEGIN 
  BFDATAC[DN] := CHR(CS);                   _ DN NODE IS CS            ?
  BFDATAC[SN] := CHR(CKLOCNODE);            _ LOCAL NPU IS SOURCE      ?
  CASE GENPFC OF                            _ CASE ON PFC              ?
  
  D8CNF:                                    _ CONFIGURE REQUEST        ?
  IF GENSFC.DHINT " D9RC
  THEN
    WITH GENPAR.BALCBP' DO                  _ USING POINTER TO LCB     ?
    BEGIN 
    BFDATAC[P3]    := CHR(BZLINO.BDPORT);   _ PORT NUMBER              ?
    BFDATAC[P4]    := CHR(0);               _ SUB-PORT ALWAYS ZERO     ?
    TETT.NPAUTO    := BZAUTO;               _ GET AUTO REC INDICATOR   ?
    TETT.NPTIPTYPE := BZTIPTYPE;            _ GET TIP TYPE             ?
    BFDATAC[P5]    := TETT.NPCHR;           _ TELL CS                  ?
    BFLCD          := P5;                   _ SET-UP LCD               ?
    IF BZAUTO                               _ IF AUTO REC LINE         ?
    THEN
      PBFCOPY (BZARPARAMS,                  _COPY AUTO REC BUFFER      ?
               BCCHAINS [DBUFLEN]); 
    END  _ IF SFC " RC ?
  ELSE   _    SFC = RC ?
    BEGIN 
    TEWORD := GENPAR; 
    WITH TEWORD.BABUFPTR'.BSTCB DO
      BEGIN 
      GENPAR.BALCBP := BSLCBP;
      WITH GENPAR.BALCBP' DO
        BEGIN 
        BFDATAC[P3] := CHR(BZLINO.BDPORT);
        BFDATAC[P4] := CHR(0);
        BFDATAC[P5] := CHR(BSCA); 
        BFDATAC[P6] := CHR(BSTA); 
        BFDATAC[P7] := CHR(BSDEVTYPE);
        BFDATAC[P8] := CHR(BZSUBTIP); 
        FOR I := 0 TO 7 DO
          BFDATAC[P9 + I] := BSTNAME[I];
        BFLCD       := P16; 
        END; _ WITH GENPAR.BALCBP' ?
      END; _ WITH TEWORD.BABUFPTR'.BSTCB ?
    END; _ IF SFC " RC  AND CASE D8CNF ?
  
  D8CDI:                                    _ COUNT DISABLED ELEMENTS  ?
  BEGIN 
  BFDATAC[P] := GENPAR.BALCHAR;             _ PORT NUMBER              ?
  BFDATAC[TT] := GENPAR.BA1CHAR;            _ COUNT OF ELEMENT(S)      ?
  BFDATAC[SUBP] := CHR(0);                  _ SUB-PORT ALWAYS ZERO     ?
  BFLCD := TT;                              _ SET-UP LCD               ?
  END; _ CASE D8CDI ? 
  
  D8SUP:                                    _ SUPERVISION REQUEST      ?
  BEGIN 
  IF CSPEND " GENPAR.BABUFPTR'.BRTYP1       _ IF SUP NOT STILL PENDING ?
                              .BRID 
  THEN                                      _ RELEASE THE BUFFER AND   ?
    BEGIN                                   _ EXIT                     ?
    PBREL1BF (GESMP,BEDBSIZE);
    GESMP := NIL;                           _ NO BUFFER TO DISPATCH    ?
    END _ CSPEND " BRID ? 
  ELSE                                      _ SUPERVISION STILL PENDING?
    BEGIN 
    TEPTR := PN1GTPTR (CSPEND,DELOCDN);     _ GET TYPE 1 TABLE         ?
    MRI := 1;                               _ DETERMINE WHETHER REMOTE ?
    IF TEPTR'.BRTYP1.BRLNKT = NLCOUPLER 
    THEN
      MRI := 0;                             _ OR LOCAL NPU             ?
    BFDATAC[DN] := CHR(CSPEND);             _ PUT NEW CS IN SM BUFFER  ?
    BFDATAC[PS] := CHR(GENSUP);             _ PREVIOUS SUPERVISOR      ?
    BFDATAC[PL] := CHR(NSLAST);             _ PREVIOUS *NS*            ?
    BFDATAC[RI] := CHR(MRI);                _ REMOTE INDICATOR         ?
    BFLCD := VNEND;                         _ SET-UP LCD               ?
    ADDR (CCPVER,IPTR);                     _ VERSION                  ?
    BIINT[VCW] := IPTR';                    _ OF CCP                   ?
    ADDR (CCPLEV,IPTR);                     _ LEVEL                    ?
    BIINT[VCW+1] := IPTR';                  _ OF CCP                   ?
    ADDR (CCPCYC,IPTR);                     _ CYCLE                    ?
    BIINT[VCW+2] := IPTR';                  _ OF CCP                   ?
    BFDATAC[VN] := NHNCFVER[1];             _ SM BUFFER                ?
    BFDATAC[VN+1] := NHNCFVER[2]; 
    END; _ ELSE CSPEND BRID ? 
  END; _ CASE D8SUP ? 
  
  D8ALM:                                    _ ALARM                    ?
  BEGIN 
  BFLCD := SFC;                             _ SET LAST CHARACTER DISP. ?
  BCCHAINS[DBUFLENGTH] := GENPAR.BABUFPTR;  _ CHAIN ALARM TO BUFFER    ?
  END; _ D8ALM ?
  
  D8MSG:                                    _ MESSAGE TO OPERATOR      ?
  BEGIN 
  WITH GENPAR.BABUFPTR'.
       BCCHAINS[QCHN]'.BSTCB DO             _ SET INDEX TO TCB         ?
    BEGIN 
    BFDATAC[P]    := CHR(BSLCBP'.BZLINO.    _ STORE PORT NUMBER        ?
                         BDPORT); 
    BFDATAC[SUBP] := CHR(0);                _ SUB-PORT ALWAYS ZERO     ?
    FOR I := 0 TO 6 DO                      _ STORE TERMINAL NAME      ?
      BFDATAC[MTEN + I] := BSTNAME[I];
    END; _WITH TCB POINTER? 
  BFLCD := MEND;                            _ SET UP LCD               ?
  BCCHAINS[DBUFLENGTH] := GENPAR.BABUFPTR;  _ CHAIN MESSAGE AS 2ND BFR ?
  GENPAR.BABUFPTR'.BCCHAINS[QCHN] := NIL;   _ CLEAR CHAIN WORD         ?
  END; _CASE D8MSG? 
  
  END; _ CASE ? 
  END; _ IF GESMP " NIL ? 
END; _ PROCEDURE PNCSSM ? 
_$J+? 
_ 
* * * *  S T A R T   P R O C E D U R E   P N N S S M
? 
PROCEDURE PNNSSM; 
  
CONST 
  P       = P3; 
  SP      = P4; 
  L       = P5; 
  LOADTYP = 2;
  
BEGIN 
IF NS " 0                                   _ IF NS AVAILABLE          ?
THEN                                        _ THEN OK TO PROCESS       ?
  BEGIN 
  PNSMBUFGET;                               _ GET A BUFFER             ?
  IF GESMP " NIL                            _ IF BUFFER GOTTEN         ?
  THEN
    WITH GESMP' DO                          _ USING BUFFER STRUCTURE   ?
    BEGIN 
    BFDATAC[DN] := CHR(NS);                 _ SET-UP DN AND SN         ?
    BFDATAC[SN] := CHR(CKLOCNODE);
  
    CASE GENPFC OF                          _ BRANCH ON PFC            ?
  
_ 
****  SET LOAD REQUEST FOR A REMOTE NPU TO *NS* 
? 
    D8NPU:  
    BEGIN 
    BFDATAC[P] := CHR(GENPAR.BALCBP'        _ SET-UP PORT NUMBER       ?
                     .BZLINO.BDPORT); 
    BFDATAC[SP] := CHR(0);                  _ SUB-PORT ALWAYS ZERO     ?
    BFDATAC[L] := CHR(LOADTYP);             _ LOAD TYPE                ?
    BFLCD := L;                             _ SET LAST POSITION        ?
    END; _ D8NPI ?
  
    END; _ CASE GENPFC PF ? 
    END; _ GESMP " NIL ?
  END; _ NS " NIL ? 
END; _ PROCEDURE PNNSSM ? 
_$J+? 
_ 
* * * *  PNSMGEN STARTS HERE
? 
BEGIN 
GESMP := NIL;                               _ CLEAR SM BUFFER PTR      ?
IF GENPFC @ GENAMMAX                        _ IF NAM PFC,              ?
THEN
  PNNAMSM                                   _ CALL NAM SM PROCESSOR    ?
ELSE
  IF GENPFC @ GENSMAX                       _ IF NS PFC,               ?
  THEN
    PNNSSM                                  _ CALL NS SM GENERATOR     ?
  ELSE
    PNCSSM;                                 _ CALL CS SM GENERATOR     ?
IF GESMP " NIL                              _ IF A SM HAS BEEN GEN#D   ?
THEN
  PBSWLE (GESMP);                           _DISPATCH THE SM TO BIP    ?
END; _ PNSMGEN ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNBWEPROC                                        * 
*                                                                     * 
*        BROADCAST WORK EVENT HANDLER                                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNBWEPROC IS ENTERED INDIRECTLY VIA THE D0BACTIVATE    * 
*              SVM WORKLIST TO SEND A HOST BROADCAST MESSAGE TO A     * 
*              CONSOLE.                                               * 
*              PNBWEPROC PROCESSES OFF THE BWE(S) BUILT BY PNSMMSG.   * 
*              TO PREVENT OVERLOADING THE NPU WITH HOST BROADCAST     * 
*              PROCESSING, ONLY ONE BWE IS PROCESSED EACH RUN TIME.   * 
*              THE MESSAGE BUFFER POINTED TO BY THE BWE CONTAINS A    * 
*              USE COUNT FIELD INDICATING HOW MANY CONSOLES ARE STILL * 
*              TO RECEIVE THE MESSAGE. THUS WHEN THE USE COUNT = 1    * 
*              THE MESSAGE BUFFER ITSELF IS USED FOR TRANSMISSION OF  * 
*              THE MESSAGE.                                           * 
*              IN THE CASE OF LOW BUFFER RESOURCES THE BWE IS NOT     * 
*              PROCESSED, BUT THE BROADCAST SEQUENCE IS MAINTAINED    * 
*                                                                     * 
** INPUT -     BROADCAST WORKLIST ENTRY (BWE)                         * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*                                                                     * 
** OUTPUT -    THE BROADCASTED MESSAGE IS QUEUED TO THE               * 
*              APPROPRIATE TCB.                                       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              1) PBBFAVAIL        CHECK FOR AVAILABILITY OF BUFFERS  * 
*              2) PBLSPUT          MAKE A WORKLIST ENTRY              * 
*              3) PBLSGET          GET A WORKLIST ENTRY               * 
*              4) PBFCOPY          COPY A BUFFER                      * 
*              5) PBDLTS           PASS BLOCK TO TIP                  * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*              2) PNSMTMR          SVM TIMING SERVICES                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNBWEPROC;
  
VAR 
      DATABFR : B0BUFPTR;                   _PTR TO MSG TO QUEUE TO TCB?
  
BEGIN 
_ 
****  THE BWE IS ONLY PROCESSED IF BUFFERS ARE NOT LOW
? 
IF PB1BFAVAIL (B0TH2LV) = FALSE             _CHECK IF LOW ON BUFFERS   ?
THEN
  BEGIN 
  DWXACTIVATE.CMSMLEY.CMTIMER := 2;         _CHECK AGAIN IN 2-3 SECONDS?
  PBLSPUT (DWXACTIVATE,                     _TIMER ENTRY - D0BACTIVATE ?
           BYWLCB[B0SMTMR]);
  END 
ELSE
  BEGIN 
  IF PBLSGET (DWWLENTRY,                    _GET NEXT BWE IF THERE     ?
             DYLISTCB[D6BRDCST]) = FALSE
  THEN
_ 
****  READY TO PROCESS NEXT BROADCAST WORKLIST ENTRY
? 
    BEGIN 
    B1BUFF := DWWLENTRY.CMSMLEY.CMBMSG;     _GET PTR TO MESSAGE BUFFER ?
_ 
****  IF MORE TERMINALS TO RECEIVE THIS MESSAGE THEN GET A NEW
****  BUFFER FOR THE MESSAGE, OTHERWISE USE THE MESSAGE BUFFER
? 
    WITH B1BUFF' DO                         _SET INDEX TO MSG BUFFER   ?
      BEGIN 
      BIINT[B9UC] := BIINT[B9UC] - 1;       _DECREMENT USE COUNTER     ?
      IF BIINT[B9UC] = 0                    _CHECK IF LAST USE OF MSG  ?
      THEN
        DATABFR := B1BUFF                   _YES USE THE MSG BUFFER    ?
      ELSE
        BEGIN                               _NO, COPY MSG TO NEW BUFFER?
        DATABFR := NIL;                     _CLEAR DESTINATION         ?
      PBFCOPY (B1BUFF, DATABFR);            _COPY THE MESSAGE          ?
      END;
      END; _WITH B1BUFF' DO?
    WITH DATABFR' DO                        _SET INDEX TO BUFFER USED  ?
      BEGIN 
      BFFCD    := DATA + 1;                 _SET FCD                   ?
      BFINTBLK := TRUE;                     _SET INTERNAL BLOCK FLAG   ?
      END; _WITH DATABFR' DO? 
  
    PBDLTS (DWWLENTRY.CMSMLEY.              _PASS MESSAGE TO TIP       ?
            CMCBP,DATABFR); 
_ 
****  IF MORE BWE THEN SEND D0BACTIVATE WORKLIST TO PROCESS THE NEXT ONE
? 
    IF DYLISTCB[D6BRDCST].BYCNT " 0         _STILL MORE TO PROCESS     ?
    THEN
      PBLSPUT (DWXACTIVATE,                 _REQUEUE D0BACTIVATE WL    ?
               BYWLCB[B0SMWL]); 
    END; _IF PBLSGET .... = FALSE ? 
  END; _IF PBBFAVAIL .... = FALSE ELSE? 
END; _PROCEDURE PNBWEPROC?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSWEPROC                                        * 
*                                                                     * 
*        STATUS WORK EVENT HANDLER                                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSWEPROC IS ENTERED INDIRECTLY VIA THE D0SACTIVATE    * 
*              SVM WORKLIST TO SEND AN UNSOLICITED STATUS REPORT SM   * 
*              OR A STATUS REQUEST NORMAL RESPONSE SM TO CS.          * 
*              PNSWEPROC PROCESSES OFF THE SWE(S) BUILT BY PNSMSTATUS * 
*              AND PNUSSM. TO PREVENT OVERLOADING THE NPU WITH STATUS * 
*              PROCESSING, ONLY ONE SWE IS PROCESSED EACH RUN TIME.   * 
*              USING THE SWE, PNSWEPROC CONSTRUCTS THE APPROPRIATE    * 
*              SERVICE MESSAGE AND DISPATCHES IT TO CS.               * 
*              IN CASES OF LOW BUFFER RESOURCES THE SWE IS NOT        * 
*              PROCESSED, BUT THE CORRECT SEQUENCE OF SM(S) IS ALWAYS * 
*              MAINTAINED.                                            * 
*              IN THE CASE OF LOSING CS PROCESSING IS DELAYED         * 
*              UNTIL A NEW CS IS FOUND.                               * 
*                                                                     * 
** INPUT -     STATUS WORKLIST ENTRY (SWE)                            * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*                                                                     * 
** OUTPUT -    ONE OF THE FOLLOWING UNSOLICITED STATUS REPORT SM:     * 
*              STU/NP/U!N    NPU STATUS                               * 
*              STU/LL/U!N    LOGICAL LINK STATUS                      * 
*              STU/LI/U!N    LINE STATUS                              * 
*              STU/TE/U!N    TERMINAL STATUS                          * 
*              STU/TR/U!N    TRUNK STATUS                             * 
*              STU/CP/U!N    COUPLER STATUS                           * 
*              STU/VC/U!N    SWITCHED VIRTUAL CIRCUIT STATUS          * 
*                                                                     * 
*              OR ONE OF THE FOLLOWING STATUS REQUEST NORMAL          * 
*              RESPONSE SM:                                           * 
*              NPS/NP/N      NPU                                      * 
*              LLS/NP/N      ALL LOGICAL LINKS ON NPU                 * 
*              LLS/LL/N      SINGLE LOGICAL LINK                      * 
*              LIS/NP/N      ALL LINES ON NPU                         * 
*              LIS/LI/N      SINGLE LINE                              * 
*              TES/NP/N      ALL TERMINALS ON NPU                     * 
*              TES/LL/N      ALL TERMINALS ON A LOGICAL LINK          * 
*              TES/LI/N      ALL TERMINALS ON A LINE                  * 
*              TES/TE/N      SINGLE TERMINAL                          * 
*              TRS/NP/N      ALL TRUNKS ON NPU                        * 
*              TRS/TR/N      SINGLE TRUNK                             * 
*              CPS/NP/N      ALL COUPLERS ON NPU                      * 
*              CPS/CP/N      SINGLE COUPLER                           * 
*              VCS/NP/N      ALL SVC ON NPU                           * 
*              VCS/LI/N      ALL SVC ON A LINE                        * 
*              VCS/VC/N      SINGLE SUB TIP SVC                       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              1) PBLSGET          GET A WORK LIST ENTRY              * 
*              2) PBBFAVAIL        CHECK FOR AVAILABILITY OF BUFFERS  * 
*              3) PBLSPUT          MAKE A WORK LIST ENTRY             * 
*              4) PBGET1BF         GET A BUFFER                       * 
*              5) PBSWLE           MAKE A WORKLIST ENTRY TO BIP       * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*                                                                     * 
** SPECIAL NOTE -                                                     * 
*              PNSWEPROC ASSUMES THAT THE LAST DATA CHARACTER IN THE  * 
*              STU/XX/U SM IS THE REASON CODE FOR REPORTING STATUS    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSWEPROC;
  
CONST 
      NPOV   = P3;                          _INDEXES FOR NPU STATUS    ?
      NPDP   = P6;
      NPGO   = P7;
      LLN1   = P3;                          _INDEXES FOR LL STATUS     ?
      LLN2   = P4;
      LLTL   = P5;
      LLRL   = P6;
      LLST   = P7;
      LIP    = P3;                          _INDEXES FOR LINE STATUS   ?
      LISP   = P4;
      LILT   = P5;
      LIST   = P6;
      LIPSN  = P7;
      TEP    = P3;                          _INDEXES FOR TERM STATUS   ?
      TESP   = P4;
      TEA1   = P5;
      TEA2   = P6;
      TEDT   = P7;
      TETN   = P9;
      TETC   = P16; 
      TEST   = P17; 
      TEHN   = P18; 
      TRP    = P3;                          _INDEXES FOR TRUNK STATUS  ?
      TRSP   = P4;
      TRLT   = P5;
      TRST   = P6;
      CPN1   = P3;                          _INDEXES FOR COUPLER STATUS?
      CPST   = P4;
      VCP    = P3;                          _INDEXES FOR SVC STATUS    ?
      VCSP   = P4;
      VCES   = P5;
      VCDS   = P6;
      VCAS   = P7;
      VCAN   = P9;
      VCSTIP = P16; 
  
VAR 
      LOWKCODE  : INTEGER;                  _COPY OF WORK CODE (SFC)   ?
      LOSTATUS  : INTEGER;                  _COPY OF STATUS TO REPORT  ?
      LOUNSOLIT : BOOLEAN;                  _COPY OF UNSOLICITED FLAG  ?
  
      STSBFR    : B0BUFPTR;                 _PTR TO SERVICE MESSAGE    ?
      GOSTATUS  : INTEGER;                  _NPU GO STATUS             ?
      I         : INTEGER;                  _GENERAL LOOP COUNTER      ?
      LOLCD     : ARRAY[BOOLEAN,D9NP..D9VC] _LCD OF SERVICE MESSAGE    ?
                    OF INTEGER; 
  
VALUE 
      LOLCD = (P7,P7,P7,P18,P6,P4,P16,      _NORMAL STATUS LCD         ?
               P9,P9,P9,P19,P7,P5,P17);     _UNSOLICITED STATUS LCD    ?
  
_ 
****  S T A R T   P R O C E D U R E   P N S W E P R O C 
? 
BEGIN 
_ 
****  IF WE HAVE LOST CS THEN WAIT TILL A CS IS SELECTED
? 
IF CS = 0                                   _CHECK IF CS NOT AVAILABLE ?
THEN
  BEGIN 
  DWXACTIVATE.CMSMLEY.CMTIMER := 2;         _CHECK AGAIN IN 2-3 SECONDS?
  PBLSPUT (DWXACTIVATE,                     _TIMER ENTRY - D0SACTIVATE ?
           BYWLCB[B0SMTMR]);
  END 
ELSE
_ 
****  THE SWE IS ONLY PROCESSED IF BUFFERS ARE NOT CRITICALLY LOW 
? 
  BEGIN 
  IF PB1BFAVAIL (B0THDIS) = FALSE             _CHECK IF LOW ON BUFFERS ?
  THEN
    BEGIN 
    DWXACTIVATE.CMSMLEY.CMTIMER := 1;       _WAKE UP TIME 1-2 SECONDS  ?
    PBLSPUT (DWXACTIVATE,                   _TIMER ENTRY - D0SACTIVATE ?
             BYWLCB[B0SMTMR]);
    END 
  ELSE
    BEGIN 
    IF PBLSGET (DWWLENTRY,                  _GET NEXT SWE IF THERE     ?
                DYLISTCB[D6STAT]) = FALSE 
    THEN
_ 
****  READY TO PROCESS NEXT STATUS WORKLIST ENTRY 
? 
      BEGIN 
      WITH DWWLENTRY.CMSMLEY DO             _EASY ACCESS TO SWE        ?
        BEGIN 
        LOWKCODE  := CMWKCODE;              _SAVE WORK CODE            ?
        LOSTATUS  := CMCNFST;               _SAVE STATUS TO BE REPORTED?
        LOUNSOLIT := CMUNSOLIT;             _SAVE UNSOLICITED FLAG     ?
  
        IF (LOWKCODE = D9RESPONSE) !        _CHECK IF RESPONSE OR      ?
          (((LOWKCODE = D9TE) !             _ STATUS REPORT FOR        ?
            (LOWKCODE = D9VC)) &            _ UNCONFIGURED SVC OR      ?
           (LOSTATUS = C7NOTCNF))           _      UNCONFIGURED TERM   ?
        THEN
          STSBFR := CMCBP                   _YES USE EXISTING BUFFER   ?
        ELSE
          STSBFR := PBGET1BF(BEDBSIZE);     _NO  GET BUFFER FOR STU SM ?
        END; _WITH DWWLENTRY.CMSMLEY DO?
  
      WITH STSBFR',DWWLENTRY.CMSMLEY DO     _SET INDEX TO SM BUFFER    ?
        BEGIN 
        CASE LOWKCODE OF                    _CASE OUT THE TYPE OF STAT ?
_ 
****  1 FORMAT NPU STATUS REPORT
? 
        D9NP: 
  
        BEGIN 
        FOR I := 0 TO 2 DO                       _STORE OVERLAY NAME   ?
          BFDATAC[NPOV+I] := CHR(0);
        BFDATAC[NPDP] := NHNDCB.NDDUMP[1];       _STORE DUMP PARAMETER ?
        GOSTATUS := 0;                           _INITIALIZE GO STATUS ?
        IF NHNPUGO                               _CHECK IF GO REQUIRED ?
        THEN
          BEGIN                                  _YES IT IS/WAS        ?
          GOSTATUS := GOSTATUS + 1;              _BUMP GO STATUS       ?
          IF NHGORCVD                            _CHECK IF GO RECEIVED ?
          THEN
            GOSTATUS := GOSTATUS + 1;            _YES BUMP GO STATUS   ?
          END; _IF NHNPUGO? 
        BFDATAC[NPGO] := CHR(GOSTATUS);          _STORE GO STATUS      ?
        END; _D9NP CASE?
_ 
****  2 FORMAT LOGICAL LINK STATUS REPORT 
? 
        D9LL: 
  
        WITH CMCBP'.BLLLCB.BLSPART DO            _SET INDEX TO LLCB    ?
          BEGIN 
          BFDATAC[LLN1] := CHR(BLDN);            _NODE 1               ?
          BFDATAC[LLN2] := CHR(BLSN);            _NODE 2               ?
          BFDATAC[LLTL] := CHR(1);               _ASSUME HOST-TERMINAL ?
          IF BLDNHST & BLSNHST                   _BUT IF HOST-HOST LINK?
          THEN
            BFDATAC[LLTL] := CHR(2);             _CHANGE IT            ?
          BFDATAC[LLRL] := CHR(CMDAT1);          _REGULATON LEVEL      ?
          IF LOUNSOLIT                           _BUT IF UNSOLICITED   ?
          THEN                                   _GET REGULATION LEVEL ?
            BFDATAC[LLRL] := CHR(BLTREG);        _FROM LOGICAL LINK    ?
          BFDATAC[LLST] := CHR(LOSTATUS);        _STORE STATUS         ?
          END; _WITH CMCBP'.BLLLCB.BLSPART D0?
_ 
**** 3 FORMAT LINE STATUS REPORT
? 
        D9LI: 
  
        WITH CMCBP'.BZZLCB DO                    _SET INDEX TO LCB     ?
          BEGIN 
          BFDATAC[LIP]  := CHR(BZLINO.BDPORT);   _STORE PORT           ?
          BFDATAC[LISP] := CHR(BZLINO.BDSUBPORT);_STORE SUBPORT        ?
          BFDATAC[LILT] := CHR(BZLTYP);          _STORE LINE TYPE      ?
          BFDATAC[LIST] := CHR(LOSTATUS);        _STORE STATUS         ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
          IF BZTIPTYPE = N1X25                   _CHECK IF X25 LINE    ?
          THEN
            BFDATAC[LIPSN] := CHR(BZSLCBPTR'.    _YES STORE XPORT TYPE ?
                                  BZXSLCB.BZTRANSTYPE)
          ELSE
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
            BFDATAC[LIPSN] := CHR(0);            _NO TRANSPORT TYPE N/A?
          END; _WITH CMCBP.BZZLCB DO? 
_ 
****  4 FORMAT TERMINAL STATUS REPORT 
? 
        D9TE: 
  
        BEGIN 
        BFDATAC[TEST] := CHR(LOSTATUS);          _STORE STATUS         ?
        IF LOSTATUS " C7NOTCNF                   _CHECK IF TCB EXISTS  ?
        THEN
          WITH CMCBP'.BSTCB DO                   _SET INDEX TO TCB     ?
            BEGIN 
            BFDATAC[TEP]  := CHR(BSLCBP'.BZLINO. _STORE PORT           ?
                                 BDPORT); 
            BFDATAC[TESP] := CHR(BSLCBP'.BZLINO. _STORE SUBPORT        ?
                                 BDSUBPORT);
            BFDATAC[TEA1] := CHR(BSCA);          _STORE ADDRESS 1      ?
            BFDATAC[TEA2] := CHR(BSTA);          _STORE ADDRESS 2      ?
            BFDATAC[TEDT] := CHR(BSDEVTYPE);     _STORE DEVICE TYPE    ?
            FOR I := 0 TO 6 DO                   _STORE TERMINAL NAME  ?
              BFDATAC[TETN+I] := BSTNAME[I];
            BFDATAC[TETC] := CHR(BSTCLASS);      _STORE TERMINAL CLASS ?
            IF LOUNSOLIT                         _CHECK IF UNSOLICITED ?
            THEN
              BFDATAC[TEHN] := CHR(BSHN)         _HOST NODE FROM TCB   ?
            ELSE
              BFDATAC[TEHN] := CHR(CMDAT1);      _HOST NODE FROM SWE   ?
            END; _WITH CMCBP'.BSTCB DO? 
        END; _D9TE CASE?
_ 
****  5 FORMAT TRUNK STATUS REPORT
? 
        D9TR: 
        BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
  
        WITH CMCBP'.TRKCB.TRLCBP' DO        _SET INDEX TO LCB FOR TRUNK?
          BEGIN 
          BFDATAC[TRP]  := CHR(BZLINO.BDPORT);   _STORE PORT           ?
          BFDATAC[TRSP] := CHR(1);          _PRESUME TRUNK PROCESSES A ?
                                            _LOAD REQUEST ; REPORT TRUE?
          IF BZTCBPTR'.TRKCB.TRIGNRLR       _IF THE TRUNK IGNORES A    ?
          THEN                              _A LOAD REQUEST THEN       ?
            BFDATAC[TRSP] := CHR(0);        _REPORT FALSE              ?
          BFDATAC[TRLT] := CHR(BZLTYP);          _STORE LINE TYPE      ?
          BFDATAC[TRST] := CHR(LOSTATUS);        _STORE STATUS         ?
          END; _WITH CMCBP'.TRKCB.TRLCBP' DO? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
        END; _D9TR? 
_ 
****  6 FORMAT COUPLER STATUS REPORT
? 
        D9CP: 
  
        BEGIN 
        BFDATAC[CPN1] := CHR(CMCBP'.BHCCB.BHLLCB'. _STORE ID OF CPLR   ?
                             BLLLCB.BLSPART.BLDN);
        BFDATAC[CPST] := CHR(LOSTATUS);            _STORE STATUS       ?
        END; _D9CP CASE?
_ 
****  7 FORMAT SVC STATUS REPORT
? 
        D9VC: 
  
        BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
        IF LOSTATUS " C7NOTCNF              _CHECK IF TCB EXISTS       ?
        THEN
          WITH CMCBP'.BSTCB DO              _SET INDEX TO GROUP TCB    ?
            BEGIN 
            BFDATAC[VCP]  := CHR(BSLCBP'.   _STORE PORT                ?
                                   BZLINO.BDPORT);
            BFDATAC[VCSP] := CHR(BSLCBP'.   _STORE SUB PORT            ?
                                   BZLINO.BDSUBPORT); 
            BFDATAC[VCES] := CHR(BSENSVC);  _STORE # OF ENABLED SVC'S  ?
            BFDATAC[VCDS] := CHR(BSDISVC);  _STORE # OF DISABLED SVC'S ?
            BFDATAC[VCAS] := CHR(BSACSVC);  _STORE # OF ACTIVE SVC'S   ?
            FOR I := 0 TO 6 DO              _STORE SVC ARCHETYPE NAME  ?
              BFDATAC[VCAN + I] := BSTNAME[I];
            FOR I := N0XPAD TO N0X2USR DO   _FIND SUB TIP TYPE         ?
              IF CMCBP = BSLCBP'.BZSLCBPTR'.BZXSLCB.BZGRPTCB[I] 
              THEN
                BFDATAC[VCSTIP] := CHR(I);  _STORE SUBTIP TYPE         ?
            END; _ WITH CMCBP'.BSTCB ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
        END; _D9VC CASE?
_ 
****  8 FORMAT STATUS REQUEST RESPONSE
? 
        D9RESPONSE: 
  
        BEGIN 
        PNREVERSE (STSBFR);                      _REVERSE DN,SN OF SM  ?
        GOTO 10;                                 _BYPASS REST OF SETUP ?
        END; _D9RESPONSE CASE?
  
        END; _CASE LOWKCODE OF? 
_ 
****  COMPLETE THE STATUS REPORT SERVICE MESSAGE
? 
        BFLCD := LOLCD[LOUNSOLIT,LOWKCODE]; _STORE LCD                 ?
        BFFCD := BLOCK;                     _STORE FCD                 ?
        BFDATAC[DN]   := CHR(CS);           _STORE DN  - CS            ?
        BFDATAC[SN]   := CHR(CKLOCNODE);    _STORE SN  - THIS NODE     ?
        BFDATAC[CN]   := CHR(0);            _STORE CN  - 0             ?
        BFDATAC[BTPT] := CHR(HTCMD + $80);  _STORE BT  - PRIORITY CMD  ?
        BFDATAC[PFC]  := CHR(D8STU);        _STORE PFC - STU           ?
        BFDATAC[SFC]  := CHR(LOWKCODE);     _STORE SFC - WORK CODE     ?
_ 
****  COMPLETE THE SERVICE MESSAGE AND SEND TO CS 
? 
        IF LOUNSOLIT                        _CHECK IF UNSOLICITED STAT ?
        THEN
          BFDATAC[BFLCD] := CHR(CMDATA)     _YES STORE REASON CODE     ?
        ELSE
10: 
          BFDATAC[SFC] :=                   _NO SET NORMAL RESPONSE    ?
            CHR(ORD(BFDATAC[SFC]) + $40); 
  
        PBSWLE (STSBFR);                    _DISPATCH SERVICE MESSAGE  ?
  
        END; _WITH STSBFR',DWWLENTRY.CMSMLEY DO?
_ 
****  IF MORE SWE THEN SEND D0SACTIVATE WORKLIST TO PROCESS THE NEXT ONE
? 
      IF DYLISTCB[D6STAT].BYCNT " 0         _STILL MORE TO PROCESS     ?
      THEN
        PBLSPUT (DWXACTIVATE,               _REQUEUE D0SACTIVATE WL    ?
                 BYWLCB[B0SMWL]); 
  
      END; _IF PBLSGET .... = FALSE ? 
    END; _IF PBBFAVAIL .... = FALSE ELSE? 
  END; _IF CS = 0 ELSE? 
END; _PROCEDURE PNSWEPROC?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                  PNNWEPROC                                          * 
*                                                                     * 
*        NOTIFY WORK EVENT PROCESSOR
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNNWEPROC IS EITHER ENTERED DIRECTLY BY PNNOTIFY       * 
*              OR IS ENTERED INDIRECTLY VIA THE D0NACTIVATE           * 
*              SVM WORKLIST TO SEND A CANNED OR SEMI-CANNED MESSAGE   * 
*              (INCLUDING THE H.A.D.) TO A CONSOLE.                   * 
*              PNNWEPROC PROCESSES OFF THE NWE(S) BUILT BY PNNOTIFY.  * 
*              TO PREVENT OVERLOADING THE NPU WITH MESSAGE GENERATION * 
*              ONLY ONE NWE IS PROCESSED EACH RUN TIME.               * 
*              IN CASES OF LOW BUFFER RESOURCES THE NWE IS NOT        * 
*              IMMEDATELY PROCESSED BUT THE MESSAGE SEQUENCE IS       * 
*              ALWAYS MAINTAINED.                                     * 
*                                                                     * 
** INPUT -     NOTIFY WORKLIST ENTRY (NWE)                            * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*              2) PNNOTIFY         SEND MESSAGE TO TERMINAL           * 
*                                                                     * 
** OUTPUT -    THE MESSAGE IS QUEUED TO THE APPROPRIATE TCB           * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              1) PBGET1BF         GET A BUFFER                       * 
*              2) PBBFAVAIL        CHECK FOR AVAILABILITY OF BUFFERS  * 
*              3) PBLSPUT          MAKE A WORK LIST ENTRY             * 
*              4) PBLSGET          GET A WORK LIST ENTRY              * 
*              5) PNGTLLCB         PERFORM DN, SN LOOKUP              * 
*              6) PBDLTS           PASS MESSAGE TO TIP                * 
*              7) PNCLOAD          LOAD A CANNED MESSAGE              * 
*              8) PNACCHOST        CHECK ANY HOST ACCESSIBLE          * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*              2) PNSMTMR          SVM TIMING SERVICES                * 
*                                                                     * 
** INTERNAL SUBROUTINES -                                             * 
*              1) PN2ENDBUF        END BUFFER AND GET A NEW ONE       * 
*              2) PN2SNUM          CONVERT AND STORE A NUMBER         * 
*              3) PN2SCHR          STORE CHARACTER OR ITS MNEUMONIC   * 
*              4) PN2SWORD         STORE A WORD                       * 
*                                                                     * 
** SPECIAL NOTE -                                                     * 
*              IN ORDER TO REDUCE SPACE AND PROCESSOR TIME,           * 
*              PNNWEPROC, WHERE EVER POSSIBLE, USES WORD RATHER       * 
*              THAN CHARACTER REFERENCING.                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNNWEPROC;
  
CONST 
      H3FIRST    = H2HNCONN;                _FIRST ENTRY CANNED MSG TBL?
      H3LAST     = H2INPDISC;               _LAST ENTRY CANNED MSG TBL ?
      H3NOHAD    = H2INPDISC;               _ENTRIES BELOW RECEIVE HAD ?
      H1FSTWD    = 4;                       _FIRST DATA WORD OF BUFFER ?
      H1LSTWD    = 63;                      _LAST DATA WORD OF BUFFER  ?
      H1ENHD     = 1;                       _ENTER HD TRAILER INDEX    ?
      H1ENHN     = 2;                       _ENTER HN TRAILER INDEX    ?
      H1ENIN     = 3;                       _ENTER INPUT TRAILER INDEX ?
      H1READ     = 4;                       _READY FOR INPUT TRAILER   ?
      H1TRMD     = 5                        _TERM DISC BY NOP TRAILER  ?
      H1HCIN     = 6;                       _CONNECTING TO HOST TRAILER?
      H1NTLR     = H1HCIN;                  _NUMBER OF TRAILER MSGS    ?
      H1LTCHARS  = 35;                      _LENGTH OF CHARACTERISTCS  ?
      H1LMESSAGE = 9;                       _LENGTH OF INFORMATIVE MSG ?
      H1L0HDR    = 19 
      H1L1HDR    = 17;                      _LENGTH OF H.A.D. HDR 1    ?
      H1L2HDR    = 13;                      _LENGTH OF H.A.D. HDR 2    ?
      H1LENTRY   = 20;                      _LENGTH OF H.A.D. ENTRY    ?
      H1LSPACE   = 1;                       _LENGTH OF SPACE FILL      ?
      H1LBELL     = 1;                      _LENGTH OF BELL MESSAGE    ?
      H1LTRAILER = 16;                      _LENGTH OF TRAILER MESSAGES?
      H1LTR2     = 17;                      _LENGTH 2ND TRL FOR SELECT ?
      H1LCTMSG   = 14;                      _LENGTH OF CNTRL MSG       ?
      H1LUP      = 7;                       _LENGTH OF UP MESSAGE      ?
      H1LDOWN    = 7;                       _LENGTH OF DOWN MESSAGE    ?
  
VAR 
      H1FIRST   : B0BUFPTR;                 _PTR TO FIRST BUFFER       ?
      H1HCB     : B0BUFPTR;                 _PTR TO HOST CONTROL BLOCK ?
      H1LLCB    : B0BUFPTR;                 _PTR TO LLCB               ?
      H1NODE    : INTEGER;                  _HOST NODE NUMBER          ?
      H1SGL     : INTEGER;                  _ASCII US + SINGLE SPACE FE?
      H1DBL     : INTEGER;                  _ASCII US + DOUBLE SPACE FE?
      H1SPST    : INTEGER;                  _ASCII US + SINGLE POST    ?
      H1SEL     : INTEGER;                  _ S - SELECTED INDICATOR   ?
      H1ATT      : INTEGER;                 _ A - ATTEMPTING INDICATOR ?
      H1CON     : INTEGER;                  _ C - CONNECTED INDICATOR  ?
      IC        : INTEGER;                  _CHAR INDEX INTO BUFFER    ?
      NUMBER    : INTEGER;                  _NUMBER TO CONVERT + STORE ?
      SPECIAL   : INTEGER;                  _CHARACTER TO STORE IN BFR ?
      K         : INTEGER;                  _TRAILER INDEX             ?
      K1        : INTEGER;                  _TRAILER INDEX             ?
      H1BELL     : INTEGER;                 _BELL                      ?
      H1HADON   : BOOLEAN;                  _TEMP FLAG FOR HAD DISPLAY ?
      H1TCH     : ARRAY[1..H1LTCHARS]       _TERMINAL CHARACTERISTICS  ?
                    OF INTEGER; 
      H1MSG     : ARRAY[H3FIRST..H3LAST,    _INFORMATIVE MESSAGES      ?
                        1..H1LMESSAGE]
                    OF INTEGER; 
      H1HDR0     : ARRAY[1..H1LENTRY] 
                     OF INTEGER;
      H1HDR1     : ARRAY[1..H1L1HDR]
                     OF INTEGER;
      H1HDR2     : ARRAY[1..H1L2HDR]
                     OF INTEGER;
      H1CTMSG    : ARRAY[1..H1LCTMSG] 
                     OF INTEGER;
      H1SPC     : ARRAY[1..H1LSPACE]        _H.A.D. ENTRY SPACE FILL   ?
                    OF INTEGER; 
      H1TLR     : ARRAY[1..H1NTLR,          _TRAILER MESSAGES          ?
                        1..H1LTRAILER]
                    OF INTEGER; 
      H1TRL2     : ARRAY [1..H1LTR2]        _SECOND TRAILER FOR SELECT ?
                     OF INTEGER;
      H1TRLINDEX : ARRAY[H2HNCONN..H2HNAVAIL] 
                     OF INTEGER;
      H1CTL     : PACKED ARRAY[0..31,1..4]  _CHARACTER MNEUMONICS      ?
                    OF CHAR;
      H1UP       : ARRAY[1..H1LUP]
                     OF INTEGER;
      H1DOWN     : ARRAY[1..H1LDOWN]
                     OF INTEGER;
  
VALUE 
      H1SGL  = $1F20; 
      H1DBL  = $1F30; 
      H1SPST = $1F2E; 
      H1SEL  = (# S#);
      H1ATT  = (# A#);
      H1CON  = (# C#);
  
      H1BELL = $0700; 
  
      H1TCH = (#TC#,$3D00,0,
               #,BS=#,0,0,$002C,#CN#,$3D00,0,0, 
               #,AB=#,0,0,$002C,#B1#,$3D00,0,0, 
               #,B2=#,0,0,$002C,#EL#,$3D00,0,0, 
               #,EB=#,0,0); 
  
      H1MSG = (#HOST CONNECTED    #,
               #NO HOST SELECTED  #,
               #NO HOST AVAILABLE #,
               #HOST UNAVAILABLE  #,
               #HOST BUSY         #,
               #HOST DISCONNECTED #,
               #HOST AVAILABLE    #,
               #NO HOST CONNECTED #,
               #RECONFIGURING     #,
               #INPUT DISCARDED.. #); 
  
      H1CTMSG = (#  CONTROL CHARACTER=      #,$1F20); 
  
      H1HDR0 = (#NPU NODE=    TERMINAL NAME=         #,$1F20);
      H1HDR1 = (#HOST    NODE  SELECTED/   STATUS#,$1F20);
      H1HDR2 = (#              CONNECTED #,$1F20);
  
      H1SPC  = (#  #);
  
      H1TLR  = (#ENTER      HD TO SEE HOST STATUS#, 
                #ENTER      HN=NODE NUMBER OR  #,$1F20, 
                #ENTER INPUT TO CONNECT TO HOST  #, 
                #READY FOR INPUT                 #, 
                #TERMINAL DISABLED BY NOP        #, 
                #CONNECTING TO SELECTED HOST     #);
  
      H1TRL2 = (#           HS=NAME TO SELECT HOST #);
  
      H1UP   = (#AVAILABLE     #);
  
      H1DOWN = (#NOT AVAILABLE #);
  
      H1TRLINDEX = (H1READ,H1ENHN,H1ENHD,H1ENHD,H1ENHD,H1ENIN,H1ENIN);
  
      H1CTL = (#(N/A(SOH(STX(ETX(EOT(ENQ(ACK(BEL#,
               #( BS( HT( LF( VT( FF( CR( SO( SI#,
               #(DLE(DC1(DC2(DC3(DC4(NAK(SYN(ETB#,
               #(CAN( EM(SUB(ESC( FS( GS( RS( US#); 
  
_ 
** PROCEDURE NAME - P N 2 E N D B U F 
* 
** OVERVIEW       - THIS PROCEDURE ENDS THE OLD (CURRENT) BUFFER, 
*                   GETS A NEW BUFFER, SETS IT UP AND CHAINS IT TO
*                   THE OLD BUFFER. 
? 
PROCEDURE PN2ENDBUF;
  
BEGIN 
WITH B1LBF' DO                              _SET INDEX TO CURRENT BFR  ?
  BEGIN 
  BFLCD := B1IW * 2 - 3;                    _SET LCD OF CURRENT BFR    ?
  BCCHAINS[DBUFLENGTH] :=                   _GET AND CHAIN A NEW BFR   ?
    PBGET1BF (BEDBSIZE);
  B1LBF := BCCHAINS[DBUFLENGTH];            _CURRENT BFR = NEW BFR     ?
  END; _WITH B1LBF' DO? 
  
B1LBF'.BFFCD := H1FSTWD * 2 - 2;            _SET FCD OF NEW BUFFER     ?
B1IW         := H1FSTWD;                    _INITIALIZE WORD INDEX     ?
  
END; _PROCEDURE PN2ENDBUF?
_ 
** PROCEDURE NAME - P N 2 S N U M 
* 
** OVERVIEW       - THIS PROCEDURE CONVERTS THE VARIABLE - NUMBER 
*                   INTO A MAXIMUM OF 3 ASCII CHARACTERS WHICH ARE
*                   STORED INTO THE CURRENT BUFFER AT THE CURRENT 
*                   CHARACTER POSITION. ON EXIT THE CURRENT CHARACTER 
*                   INDEX WILL BE 7 MORE THAN ON ENTRY
? 
PROCEDURE PN2SNUM;
  
VAR 
      L : INTEGER;                          _LOOP VARIABLE             ?
  
BEGIN 
FOR L := IC+2 DOWNTO IC DO                  _FOR ALL POSSIBLE CHARS    ?
  BEGIN 
  B1LBF'.BFDATAC[L] :=                      _STORE NEXT CHARACTER      ?
    CHR(NUMBER MOD 10 + $30); 
  NUMBER := NUMBER DIV 10;                  _NUMBER FOR NEXT CHARACTER ?
  IF NUMBER = 0                             _CHECK SIGNIFICANT CHR LEFT?
  THEN
    GOTO 10;                                _NO EXIT CONVERSION        ?
  END; _FOR L := IC+2 DOWNTO IC DO? 
10: 
IC := IC + 7;                               _UPDATE CHARACTER INDEX    ?
END; _PROCEDURE PN2SNUM?
_ 
** PROCEDURE NAME - P N 2 S C H R 
* 
** OVERVIEW       - THIS PROCEDURE INSPECTS THE VARIABLE - SPECIAL
*                   GIVEN THE CURRENT BUFFER AND CHARACTER POSITION THE 
*                   PROCEDURE EITHER STORES THE CHARACTER AT (IC + 4) 
*                   OR STORES THE MNEUMONIC IF THE CHARACTER IS NOT 
*                   PRINTABLE. IN EITHER CASE, ON EXIT THE CURRENT
*                   CHARACTER INDEX WILL BE 9 MORE THAN ON ENTRY. 
? 
PROCEDURE PN2SCHR;
  
VAR 
      L : INTEGER;                          _LOOP VARIABLE             ?
  
BEGIN 
WITH B1LBF' DO                              _SET INDEX TO CURRENT BFR  ?
  BEGIN 
  IF SPECIAL \ $20                          _CHECK IF PRINTABLE CHAR   ?
  THEN
    BEGIN                                   _YES IT IS                 ?
    IC := IC + 4;                           _ADJUST CHARACTER INDEX    ?
    BFDATAC[IC] := CHR(SPECIAL);            _STORE CHARACTER INTO BFR  ?
    END 
  ELSE
    BEGIN                                   _NO IT IS NOT PRINTABLE    ?
    FOR L := 1 TO 4 DO                      _FOR EACH CHAR OF MNEUMONIC?
      BEGIN 
      BFDATAC[IC] := H1CTL[SPECIAL,L];      _STORE CHARACTER INTO BFR  ?
      IC          := IC + 1;                _BUMP CHARACTER INDEX      ?
      END;
    BFDATAC[IC] := #)#                      _ADD CLOSING PARANTHESIS   ?
    END; _IF SPECIAL \ $20 ELSE?
  IC := IC + 5;                             _UPDATE CHARACTER INDEX    ?
  END; _WITH B1LBF' DO? 
END; _PROCEDURE PN2SCHR?
_ 
** PROCEDURE NAME - P N 2 S W O R D 
* 
** OVERVIEW       - THIS PROCEDURE STORES THE PASSED PARAMETER
*                   INTO THE CURRENT BUFFER AT THE CURRENT WORD 
*                   INDEX AND BUMPS THE CURRENT WORD INDEX
? 
PROCEDURE PN2SWORD (WORD : INTEGER);
  
BEGIN 
B1LBF'.BIINT[B1IW] := WORD;                 _STORE WORD INTO BUFFER    ?
B1IW               := B1IW + 1;             _BUMP WORD INDEX           ?
END; _PROCEDURE PN2SWORD? 
_$J+? 
_ 
****  S T A R T   P R O C E D U R E   P N N W E P R O C 
? 
BEGIN 
_ 
****  THE NWE IS ONLY PROCESSED IF BUFFERS ARE NOT CRITICALLY LOW 
? 
IF PB1BFAVAIL (B0TH2LV) = FALSE             _CHECK IF LOW ON BUFFERS   ?
THEN
  BEGIN                                     _YES WE ARE                ?
  DWXACTIVATE.CMSMLEY.CMTIMER := 1;         _WAKE ME UP IN 1-2 SECONDS ?
  PBLSPUT (DWXACTIVATE,                     _PUT WL IN DELAY QUEUE     ?
           BYWLCB[B0SMTMR]);
  END _IF PBBFAVAIL .... = FALSE? 
ELSE
  BEGIN 
  IF PBLSGET (DWWLENTRY,                    _GET NEXT NWE IF THERE     ?
              DYLISTCB[D6NOTIFY]) = FALSE 
  THEN
_ 
****  READY TO PROCESS NEXT NOTIFY WORKLIST ENTRY 
? 
    BEGIN 
    H1FIRST := PBGET1BF (BEDBSIZE);         _GET FIRST BUFFER          ?
    B1LBF   := H1FIRST;                     _CURRENT BUFFER = THE FIRST?
    WITH H1FIRST' DO                        _SET INDEX TO FIRST BUFFER ?
      BEGIN 
      BFFCD    := DBC + 1;                  _SET FCD                   ?
      BFINTBLK := TRUE;                     _SET INTERNAL BLOCK FLAG   ?
      B1IW     := CN / 2 + 1;               _INITIALIZE WORD INDEX     ?
      PN2SWORD (HTMSG);                     _SET BT  - MSG             ?
      PN2SWORD (I9FSS);                     _SET DBC - CONSOLE, FE,IVT ?
                                            _SET FE  - SINGLE SPACE    ?
      END; _WITH H1FIRST' DO? 
    WITH DWWLENTRY.CMSMLEY,                 _EASY ACCESS TO NWE        ?
         CMCBP'.BSTCB DO                    _SET INDEX TO TCB          ?
      BEGIN 
_ 
****  STORE MESSAGE INTO BUFFER IF REQUIRED 
? 
      IF CMNMSG = H2BELL
      THEN
        PNCLOAD (H1BELL,H1LBELL)            _SEND A BELL AND A NULL    ?
      ELSE
      IF CMNMSG = H2TMLCHARS                _TERMINAL CHARACTERISTICS  ?
      THEN
_ 
****  M1   TERMINAL CHARACTERISTICS MESSAGE 
? 
        BEGIN 
        PNCLOAD (H1TCH,H1LTCHARS);          _LOAD TML CHARACTERISTICS  ?
        IC := DBC + 5;                      _INITIALIZE CHARACTER INDEX?
        NUMBER := BSTCLASS; 
        PN2SNUM;                            _STORE TERMINAL CLASS      ?
        IF NUMBER < N0HASP                  _IF ASYNC TERMINAL         ?
        THEN
          SPECIAL := BSBSCHAR               _THEN USE THE BSBSCHAR     ?
        ELSE
          SPECIAL := 0;                     _ELSE  USE N/A             ?
        PN2SCHR;                            _STORE BACKSPACE CHARACTER ?
        SPECIAL := BSCANCHAR; 
        PN2SCHR;                            _STORE CANCEL INPUT CHAR   ?
        IF NUMBER < N0HASP                  _IF ASYNC TERMINAL         ?
        THEN
          SPECIAL := BSABTBLK               _THEN USE THE BSBSCHAR     ?
        ELSE
          SPECIAL := 0;                     _ELSE  USE N/A             ?
        PN2SCHR;                            _STORE ABORT BLOCK CHAR    ?
        SPECIAL := BSUSR1;
        PN2SCHR;                            _STORE USER BREAK 1 CHAR   ?
        SPECIAL := BSUSR2;
        PN2SCHR;                            _STORE USER BREAK 2 CHAR   ?
        SPECIAL := BSELCHAR;
        PN2SCHR;                            _STORE END OF LINE CHAR    ?
        SPECIAL := BSEBCHAR;
        PN2SCHR;                            _STORE END OF BLOCK CHAR   ?
        END _IF CMNMSG = H2TMLCHARS?
      ELSE
_ 
****  M2  OTHER INFORMATIVE MESSAGES
? 
      IF CMNMSG \ H3NOHAD                   _DONT NEED HAD DISPLAY     ?
      THEN
        PNCLOAD (H1MSG [CMNMSG,1],          _LOAD INFORMATIVE MSG      ?
                 H1LMESSAGE)
      ELSE
        BEGIN 
        K1 := CMNMSG;                       _USE LOCAL VARIABLE CHEAPER?
      H1HADON := FALSE; 
_ 
****  M2.1   DETERMINE INFORMATIVE MESSAGE
? 
        K := H2NHNAVAIL;                    _PRESET - NO HOST AVAILABLE?
        IF PNACCHOST (0)                    _IF AT LEAST ONE HOST AVAIL?
        THEN
          BEGIN                             _SOME HOST(S) ARE AVAILBLE ?
          K := H2NHNSELECT;                 _PRESET - NO HOST SELECTED ?
          IF BSSHN " 0
          THEN
            BEGIN 
            K := H2HNCONN;                  _PRESET - HOST CONNECTED   ?
            IF BSHN = 0 
            THEN
              BEGIN 
              K := H2HNAVAIL;               _PRESET - HOST AVAILABLE   ?
              H1LLCB := PNGTLLCB(CKLOCNODE, 
                                 BSSHN);    _GET SELECTED HOST         ?
              IF H1LLCB'.BLLLCB.BLSPART.
                   BLCNFST < C7ENABLED      _IF NOT AVAILABLE          ?
              THEN
                K := H2HNUNAVAIL;           _PRESET - HOST UNAVAILABLE ?
              END; _BSHN = 0? 
            END; _BSSHN " 0?
          END; _PNACCHOST = TRUE? 
        CMNMSG := K;                        _SET FOR CORRECT TRAILER   ?
        IF K1 " H2HADONLY                   _IF NOT HAD ONLY MSG       ?
        THEN
          K := K1                           _MAINTAIN CORRECT HDR MSG  ?
        ELSE
          H1HADON := TRUE;                  _FORCE HAD DISPLAY         ?
_ 
****  M2.2   NOW INSERT APPROPRIATE HEADER MESSAGE
? 
        PNCLOAD (H1MSG[K,1],                _LOAD MESSAGE INTO BUFFER  ?
                 H1LMESSAGE); 
        PNCLOAD (H1CTMSG,H1LCTMSG);         _AND CONTROL CHARACTER     ?
        SPECIAL := BSCNTRLCHAR;             _GET CONTROL CHARACTER     ?
        IC := B1IW * 2 - (10);              _CHARACTER OFFSET          ?
        PN2SCHR;                            _STORE IT OR ITS MNEUMONIC ?
_ 
****  STORE H.A.D. AND/OR TRAILER INTO BUFFER(S) IF REQUIRED
? 
        IF H1HADON                          _IF CONSOLE SHOULD RECEIVE ?
        THEN                                _HAD DISPLAY THIS TIME     ?
          BEGIN 
_ 
****  H0   H.A.D. NPU NODE AND TERMINAL NAME
? 
          PNCLOAD (H1HDR0,H1L0HDR);         _LOAD HEADER 0 INTO BFR    ?
          B1IW := B1IW - 5;                 _RESET B1IW FOR NAME INSERT?
          PNCLOAD (BSTNAME,4);              _LOAD TERMINAL NAME        ?
          B1IW := B1IW +1;
          IC := B1IW * 2 - 31;              _SET IC FOR NODE INSERT    ?
          NUMBER := CKLOCNODE;              _CONVERT LOCAL NODE NUMBER ?
          PN2SNUM;
          PN2ENDBUF;                        _TIME FOR A NEW BUFFER     ?
_ 
****  H1   H.A.D. COLUMN HEADERS
? 
          PNCLOAD (H1HDR1,H1L1HDR);         _LOAD HEADER 1 INTO BFR    ?
          PNCLOAD (H1HDR2,H1L2HDR);         _LOAD HEADER 2 INTO BFR    ?
_ 
****  H2   H.A.D. HOST NAME / HOST NODE / STATUS ENTRIES
? 
          H1HCB     := DEHOSTABLE;          _GET PTR TO FIRST HCB      ?
  
          WHILE H1HCB'.BRTYP3.              _STILL MORE HCBS TO PROCESS?
                       BRLAST " BREND DO
            BEGIN 
            IF B1IW + H1LENTRY > H1LSTWD    _CHECK IF ENTRY WILL FIT   ?
            THEN
              PN2ENDBUF;                    _NO, GET A NEW BUFFER      ?
_ 
****  H2.1 HOST NAME
? 
            PNCLOAD (H1HCB'.BRTYP3,4);      _LOAD HOST NAME INTO BUFFER?
_ 
****  H2.2 HOST NODE
? 
            IC := B1IW * 2 - 2;             _CALCULATE CHARACTER INDEX ?
            FOR K := 1 TO 8 DO
              PNCLOAD (H1SPC,H1LSPACE);     _CLEAR SPACE IN BUFFER     ?
            H1NODE := H1HCB'.BRTYP3.        _PICK UP HOST NODE NUMBER  ?
                             BRNODE;
            NUMBER := H1NODE; 
            PN2SNUM;                        _STORE HOST NODE INTO BFR  ?
_ 
****  H2.3 STATUS 
? 
            K := B1IW;                      _SAVE WORD OFFSET          ?
            B1IW := B1IW - 4; 
            IF H1NODE = BSSHN               _CHECK IF SELECTED NODE    ?
            THEN
              BEGIN 
              PN2SWORD (H1SEL);             _INDICATE SELECTED NODE    ?
              IF BSACON                     _AUTO-CONNECT CONSOLE      ?
              THEN
                IF BSHN = 0                 _NOT CONNECTED YET         ?
                THEN
                  PN2SWORD (H1ATT);         _INDICATE ATTEMPTED NODE   ?
              END;
            IF H1NODE = BSHN                _CHECK IF CONNECTED NODE   ?
            THEN
              PN2SWORD (H1CON);             _INDICATE CONNECTED NODE   ?
            B1IW := K;                      _RESTORE CORRECT INDEX     ?
            H1LLCB := PNGTLLCB (CKLOCNODE,  _GET LLCB FOR THIS NODE    ?
                                H1NODE);
            IF H1LLCB'.BLLLCB.BLSPART.      _CHECK IF ENABLED OR ACTIVE?
                       BLCNFST \ C7ENABLED
            THEN
              PNCLOAD (H1UP,H1LUP)          _INDICATE HOST NODE IS UP  ?
            ELSE
              PNCLOAD (H1DOWN,H1LDOWN);     _INDICATE HOST NODE ID DOWN?
            PN2SWORD (H1SGL);               _STORE SINGLE SPACE FE     ?
            H1HCB := H1HCB + 5;             _ADVANCE TO NEXT HCB       ?
            END; _WHILE H1HCB'.BRTYP3.BRLAST " BREND DO?
  
          END; _IF BSHADON? 
_ 
****  T1    TRAILER MESSAGE 
? 
        IF B1IW + H1LTRAILER \ H1LSTWD      _CHECK IF TRAILER WILL FIT ?
        THEN
          PN2ENDBUF;                        _NO, GET A NEW BUFFER      ?
_ 
****  T1.1 STORE THE TRAILER MESSAGE INTO THE BUFFER
? 
        IF BSCNFST = C7DISABLED             _TERMINAL DISABLED         ?
        THEN
          K := H1TRMD                       _INFORM USER GOODBYE       ?
        ELSE
          BEGIN 
          K := H1TRLINDEX [CMNMSG];         _GET CORRECT TRAILER MSG   ?
          IF K = H1ENIN                     _IF TRAILER IS ENTER INPUT ?
          THEN                              _BUT THE CONNECTION WILL BE?
            IF (BSSTATE = D4IPREQ) !        _TRIGGERED THEN CHANGE THE ?
               (BSHCIN = TRUE)              _TRAILER TO                ?
            THEN                            _CONNECTING TO SELECTED    ?
              K := H1HCIN;                  _HOST                      ?
          END; _ ELSE TERMINAL NOT DISABLED ? 
        PNCLOAD (H1TLR[K,1],H1LTRAILER);    _LOAD TRAILER INTO BUFFER  ?
        IF K < H1ENIN                       _IF (CT) CHARACTER IN MSG  ?
        THEN
          BEGIN 
          IC := B1IW * 2 - 28;              _ADJUST OFFSET TO STORE    ?
          SPECIAL := BSCNTRLCHAR;           _CONTROL CHARACTER         ?
          PN2SCHR;                          _STORE IT OR ITS MNNEUMONIC?
          IF K = H1ENHN 
          THEN                              _TRAILER TO SELECT A HOST  ?
            BEGIN 
            IF B1IW + H1LTR2 \ H1LSTWD      _CHECK IF SECOND LINE FITS ?
            THEN
              PN2ENDBUF;                    _NO GET A NEW BUFFER       ?
            PNCLOAD (H1TRL2, H1LTR2);       _LOAD SECOND TRAILER LINE  ?
            IC := B1IW * 2 - 30;            _CALCULATE CHARACTER INDEX ?
            PN2SCHR;                        _STORE CONTROL CHARACTER   ?
          END; _ IF K = H1ENHN ?
        END; _ IF K < H1ENIN ?
  
        END; _IF CMNMSG < H3NOHAD?
_ 
****  COMPLETE THE OUTPUT BUFFERS AND ROUTE TO TERMINAL 
? 
      PN2SWORD (H1SPST);                    _POSITION CURSOR NEXT LINE ?
      B1LBF'.BFLCD := B1IW * 2 - 3;         _SET LCD OF FINAL BUFFER   ?
  
      PBDLTS (CMCBP,H1FIRST);               _PASS MESSAGE TO TIP       ?
      END; _WITH DWWLENTRY.CMSMLEY, 
                 CMCBP'.BSTCB DO? 
_ 
****  IF MORE NWE THEN SEND D0NACTIVATE WORKLIST TO PROCESS THE NEXT ONE
? 
    IF DYLISTCB[D6NOTIFY].BYCNT " 0         _STILL MORE TO PROCESS     ?
    THEN
      PBLSPUT (DWXACTIVATE,                 _REQUEUE D0NACTIVATE WL    ?
               BYWLCB[B0SMWL]); 
    END; _IF PBLSGET ....?
  END; _IF PBBFAVAIL .... = FALSE ELSE? 
END; _PROCEDURE PNNWEPROC?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                   PNINITERR                                         * 
*                                                                     * 
*      INITIALIZATION/ALARM  WORK EVENT HANDLER                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNINITERR IS ENTERED INDIRECTLY VIA THE D0IACTIVATE    * 
*              SVM WORKLIST TO SEND ALARMS TO CS.                     * 
*              INITIALIZATION USES *PNINITERR* TO GENERATE THE        * 
*              ALARM(S)/ERROR MESSAGES THAT ARE FOUND DURING          * 
*              MLIA INITIALIZATION - BECAUSE CS IS NOT YET AVAILABLE. * 
*              THE BASE SYSTEM MAKES WORKLIST ENTRIES TO *PNINITERR*  * 
*              SO THAT THE STANDARD *PNCEFILE* ALARM MESSAGES         * 
*              DO NOT HAVE TO RESIDE IN *GLOBL$* BUT CAN BE PAGED.    * 
*              ONLY ONE IWE IS PROCESSED EACH RUN TIME, TO PREVENT    * 
*              OVERLOADING THE NPU.                                   * 
*              IN THE CASE OF LOW BUFFERS OR LACK OF CS *PNINITERR*   * 
*              MAKES A WORKLIST TO THE SVM TIMER *PNSMTMR* TO WAKE UP * 
*              *PNINITERR*.                                           * 
*                                                                     * 
** INPUT -     INITIALIZATION WORKLIST ENTRY *IWE*                    * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              - PIMLIA                MLIA INITIALIZATION            * 
*              - PNCKTENB              SVM CHECK DISABLED TERMINAL(S) * 
*              - PNCEFILE              CE ERROR MSG PROCESSOR         * 
*                                                                     * 
** OUTPUT -    ALARM MESSAGE FORMATTED AND ROUTED TO *BIP*            * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              -                                                      * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              -                                                      * 
** INTERNAL SUBROUTINES -                                             * 
*              - PN2CNVASCII           CONVERT HEX TO ASCII           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNINITERR;
  
CONST 
      P          = P3;                      _LOCATION OF PORT NUMBER   ?
      SP         = P4;                      _LOCATION OF SUB-PORT NO.  ?
      ALM2       = 5;                       _ALARM 2                   ?
      BGNALM     = 9;                       _START OF ALARM TEXT IN BFR?
      LCLAOR     = 17;                      _LENGTH OF CLA OUT-OF RANGE?
      LDUPCLA    = 16;                      _LENGTH OF DUPLICATE CLAMSG?
      LTESDISA   = 23;                      _LENGTH OF TERMINALS DISBLD?
      LMALM      = 9;                       _LENGTH OF MAINTENANCE MSG ?
      LALM123    = 10;                      _LENGTH OF ALARM 1 2 3     ?
  
VAR 
      I          : INTEGER;                 _LOOP CONTROL              ?
      ALMTYP     : INTEGER;                 _ALARM TYPE                ?
      ALMNO      : INTEGER;                 _ALARM NUMBER              ?
      ALMEC      : B0OVERLAY;               _ERROR CODE                ?
      ALMPORT    : B0OVERLAY;               _PORT NUMBER               ?
      ALMDATA    : ARRAY [1..6] OF
                   PACKED RECORD
                     APRM1 : B08BITS;       _INDEX OF PARAMETER 1      ?
                     APRM2 : B08BITS;       _INDEX OF PARAMETER 2      ?
                   END; 
      MSCLAOR    : PACKED ARRAY[1..LCLAOR]
                     OF INTEGER;
      MSDUPCLA   : PACKED ARRAY[1..LDUPCLA] 
                     OF INTEGER;
      MSTESDISA  : PACKED ARRAY[1..LTESDISA]
                     OF INTEGER;
      MSMALM     : PACKED ARRAY[1..LMALM] 
                     OF INTEGER;
      MSALM123   : PACKED ARRAY[1..3, 
                                1..LALM123] 
                     OF INTEGER;
  
VALUE 
      ALMDATA    = ($0030,
                    $002D,
                    $0000,
                    $3127,
                    $2E00,
                    $342A); 
      MSCLAOR    = (#OUT OF RANGE CLA TURNED ON PORT=XX#);
      MSDUPCLA   = (#DUPLICATE CLA DETECTED, PORT=XX #);
      MSTESDISA  = (#MUST ENABLE TERM TO PREVENT LINE DISC/DISABLE #);
      MSMALM     = (#MAINTENANCE ALARM #);
      MSALM123   = (#PORT=XX, ERROR=XX   #, 
                    #MLIA, ERROR=XX      #, 
                    #COUPLER XX, ERROR=XX#);
  
_ 
**  PROCEDURE  NAME - P N 2 C N V A S C I I 
* 
**  OVERVIEW        - THIS PROCEDURE STORES THE PASSED PARAMETER
*                     INTO THE ALARM BUFFER - CONVERTING IT TO
*                     ASCII BEFORE STORING IT.
? 
PROCEDURE PN2CNVASCII (LOC : INTEGER; DATA : B0OVERLAY);
  
BEGIN 
IF LOC " 0                                  _STORE IF LOCATION NON-ZERO?
THEN
  BEGIN 
  B1LBF'.BFDATAC[LOC] :=
         JMCNVTO[DATA.BAHEX.B0H3];
  B1LBF'.BFDATAC[LOC + 1] :=                _CONVERT AND STORE         ?
         JMCNVTO[DATA.BAHEX.B0H4];
  END; _ IF LOC " 0 ? 
END; _ PROCEDURE PN2CNVASCII ?
_$J+? 
_ 
****  S T A R T  P R O C E D U R E  P N I N I T E R R 
? 
BEGIN 
_ 
****  THE IWE IS ONLY PROCESSED IF CS PRESENT AND NO REGULATION 
? 
IF (NPUREG " 3) !                           _IF NOT HIGHEST BUFFER LVL ?
   (CS = 0)                                 _OR CS NOT PRESENT         ?
THEN
  BEGIN                                     _GO ON SVM TIMER THREAD    ?
  DWXACTIVATE.CMSMLEY.CMTIMER := 2;         _FOR 2 SECONDS             ?
  PBLSPUT (DWXACTIVATE,BYWLCB[B0SMTMR]);    _MAKE THE WORKLIST         ?
  END _ NPUREG " 3 OR CS = 0 ?
ELSE
  BEGIN 
  IF PBLSGET (DWWLENTRY,                    _GET NEXT IWE IF THERE     ?
              DYLISTCB[D6INIT]) = FALSE 
  THEN
_ 
****  READY TO PROCESS NEXT ALARM WORKLIST ENTRY
? 
    BEGIN 
    WITH DWWLENTRY.CMSMLEY DO               _USING IWE STRUCTURE       ?
      BEGIN                                 _GET VALUES TO LOCAL VAR(S)?
      ALMTYP := CMDATA;                     _ALARM TYPE                ?
      ALMNO  := CMWKCODE;                   _ALARM NUMBER IF D5ALMMSG  ?
      ALMEC.BAINT  := CMPRM3;               _ERROR CODE                ?
      ALMPORT.BAINT := CMPRM2;              _PORT NUMBER               ?
      END; _ WITH DWWLENTRY... ?
    B1IW := BGNALM;                         _SET UP GLOBAL START OF BFR?
    B1LBF := PBGET1BF (BEDBSIZE);           _GET BUFFER FOR ALARM      ?
    CASE ALMTYP OF                          _CASE OUT THE TYPE OF ALARM?
  
  
    D5CLAOR:                                _CLA OUT OF RANGE          ?
    PNCLOAD (MSCLAOR,LCLAOR); 
  
  
    D5DUPCLA:                               _DUPLICATE CLA             ?
    PNCLOAD (MSDUPCLA,LDUPCLA); 
  
  
    D5TESDISA:                              _TERMINALS WILL BE DISABLED?
    PNCLOAD (MSTESDISA,LTESDISA); 
  
  
    D5ALMMSG:                               _ALARM 1/2 OR 3            ?
    BEGIN 
    PNCLOAD (MSMALM,LMALM);                 _LOAD MAINITENANCE PORTION ?
    PNCLOAD (MSALM123[ALMNO,1],LALM123);    _PORT/MLIA OR COUPLER      ?
    ALMTYP := ALMTYP + ALMNO - 1; 
    END;
  
    END; _ CASE ALMTYP OF ? 
_ 
****  CONVERT HEX VALUE(S) TO ASCII AND COMPLETE THE MESSAGE
? 
    PN2CNVASCII (ALMDATA[ALMTYP].APRM1, 
                 ALMEC);                    _PASS LOC/DATA TO STORE    ?
    PN2CNVASCII (ALMDATA[ALMTYP].APRM2, 
                 ALMPORT);
    WITH B1LBF' DO                          _USING POINTER TO ALARM BFR?
      BEGIN 
      BFDATAC[DN] := CHR(CS);               _SEND TO CS                ?
      BFDATAC[SN] := CHR(CKLOCNODE);
      BIINT[BTPT/2+1] := HTCMD+$80; 
      BIINT[SFC/2+1] := D8ALM*256 + D9OP; 
      BIINT[SP/2+1] := 0; 
      IF ALMTYP > D5CLAOR                   _DETERMINE IF PORT SHOULD  ?
      THEN                                  _BE NONZERO                ?
        IF ALMTYP < ALM2
        THEN
          BFDATAC[P] := ALMPORT.BARCHAR;
      BFLCD := ((B1IW-1)*2) - 1;
      END; _ WITH B1LBF ? 
    PBSWLE (B1LBF);                         _SEND TO BIP               ?
_ 
****  RE-ACTIVATE *PNINITERR* IF MORE IWE(S) AND EXIT 
? 
    IF DYLISTCB[D6INIT].BYCNT " 0           _IF MORE IWE THEN          ?
    THEN
      PBLSPUT (DWXACTIVATE,                 _MAKE IWE BACK TO OURSELVES?
               BYWLCB[B0SMWL]); 
    END; _DWWLENTRY... = FALSE ?
  END; _ELSE NPUREG = 3 AND CS " 0 ?
END; _PROCEDURE PNINITERR ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNLINK                                           * 
*                                                                     * 
*        LINK EVENT WORKLIST HANDLER                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE CONTROLS THE PROCESSING OF REGULATION  * 
*               CHANGES. EXTERNAL STIMULI CONSIST OF WORKLIST(S) THAT * 
*               REFLECT THE CHANGE IN REGULATION FOR THE RUNNING NPU, * 
*               WORKLIST(S) FROM *PNLINE* THAT REFLECT AVAILIBILITY OR* 
*               UNAVAILIBILITY OF A TRUNK AND WORKLIST(S) FROM THE    * 
*               *HIP* THAT REFLECT COUPLER REGULATION FROM *PIP*.     * 
*               PNLINK TRANSLATES THESE NODAL REGULATION LEVEL CHANGES* 
*               INTO LOGICAL LINK REGULATION CHANGES AND MAKES W/L(S) * 
*               BACK TO ITSELF FOR EACH LOGICAL LINK AFFECTED. THIS   * 
*               DELAYED GENERATION METHOD IS EMPLOYED SINCE NODAL     * 
*               REGULATION CHANGES CAN CAUSE NUMEROUS LOGICAL LINK    * 
*               CHANGES.                                              * 
*                                                                     * 
** INPUT -      ALL INPUT IS IN THE FORM OF WORKLIST(S)               * 
*               - CPLR  COUPLER REGULATION                            * 
*               - TRNK  TRUNK UP OR DOWN                              * 
*               - NPU   NPU REGULATION                                * 
*               - LOGL  REGULATION FOR ONE LOGICAL LINK               * 
*                                                                     * 
** OUTPUT -     LOGICAL LINK(S) POSTED WITH CORRECT REGULATION        * 
*                                                                     * 
** LEVEL 2 SUBROUTINES -                                              * 
*               - PN2LNKDWNUP  - PROCESS REGULATION CHANGES (UP/DOWN) * 
*                                AGAINST CONNECTION DIRECTORIES.      * 
*               - PN2FLFNPU    - FIND LOGICAL LINKS TO FOREIGN NPU(S) * 
*               - PN2FNNPU     - FIND NEIGHBOR (THRU TRUNKS) NPU(S)   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*               - PNCNDLT      - REMOVE TCB FROM CONECTION DIRECTORY  * 
*               - PBLSPUT      - MAKE WORKLIST ENTRY                  * 
*               - PNNOTIFY     - NOTIFY TERMINAL USER                 * 
*               - PNGLNKWL     - GENERATE *LOGL* WORKLIST             * 
*               - PNGTLLCB     - FIND LOGICAL LINK                    * 
*               - PNCSUPCHG    - CHECK SUPERVISION CHANGE             * 
*               - PN1SRCH      - GET TYPE 1 POINTER                   * 
*               - PBMIN        - GET MINIMUM VALUE                    * 
*               - PNGREGLL     - GENERATE REG/LL SVM MESSAGE          * 
*               - PNUSSM       - MAKES STU WORKLIST                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNLINK; 
  
VAR 
  SNREG    : B0OVERLAY; 
  SNPTR    : B0BUFPTR;
  I        : INTEGER; 
  SNID     : INTEGER; 
  SNWC     : INTEGER; 
  CPLRPTR  : B0BUFPTR;
  PTR      : B0BUFPTR;
  REVERSE  : BOOLEAN; 
  DOWN     : BOOLEAN; 
  UP       : BOOLEAN; 
  LNKCNFST : ARRAY [FALSE..TRUE] OF INTEGER;
  
VALUE 
  LNKCNFST = (C7ENABLED,C7DOWN);
  
_$J+? 
_ 
** PROCEDURE NAME - P N 2 L N K D W N U P 
* 
** OVERVIEW       - THIS PROCEDURE TAKES THE APPROPRIATE ACTIONS
*                   CONNECTION DIRECTORIES WHEN THE LOGICAL LINK COMES
*                   UP OR GOES DOWN. TCB(S) ARE REMOVED FROM THE CONNECTION 
*                   DIRECTORY AND A MESSAGE IS GENERATED WHEN THE LINK
*                   GOES DOWN. AN AVAILIBILITY MESSAGE OR CONNECTION
*                   ATTEMPT IS INITIATED WHEN THE LINK COMES UP.
* 
** INPUT(S)       - PARAMTER(S) ARE PASSED VIA LEVEL 1 VARIABLES. 
*                   SNPTR - POINTER TO LOGICAL LINK 
* 
** EXTERNAL SUBROUTINES - 
*                 - ADDR - GET ADDRESS
*                 - PNCNDLT - REMOVE FORM CONNECTION DIRECTORY
*                 - PNNOTIFY - CANNED MESSAGE TO TERMINAL USER
*                 - PBLSPUT - MAKE WORKLIST ENTRY 
* 
? 
PROCEDURE PN2LNKDWNUP;
  
VAR 
  I       : INTEGER;
  MSGINDX : INTEGER;
  LCBPTR  : BZLCBP; 
  TCBPTR  : B0BUFPTR; 
  LOCWLCB : BWWORKLIST; 
  
BEGIN 
WITH LOCWLCB.CMSMLEY DO 
  BEGIN 
  CMWKCODE := D0TCB;                        _ INITIALIZE LOCAL WL      ?
_ 
****  SEARCH ALL LINES - LOOKING FOR TCB(S) ON THIS LOCICAL LINK
? 
  FOR I := C0NPBL+1 TO C4LCBS DO            _ SEARCH ALL LINE(S)       ?
    BEGIN 
    ADDR (CGLCBP'[I],LCBPTR);               _ GET LCB ADDRESS          ?
    IF LCBPTR'.BZDIAG = FALSE               _ IF NOT RUNNING DIAG.     ?
    THEN
      BEGIN 
      TCBPTR := LCBPTR'.BZTCBPTR;           _ GET CHAIN OF TCB(S)      ?
      IF TCBPTR " NIL                       _ IF TCB(S) EXIST THEN     ?
      THEN
        REPEAT
        WITH TCBPTR'.BSTCB DO 
          BEGIN 
          MSGINDX := 0;                     _ CLEAR PNNOTIFY INDICATOR ?
          IF SNPTR'.BLLLCB.BLSPART          _ IF LINK GOING DOWN       ?
               .BLTREG = 0
          THEN
_ 
****  LINK WENT DOWN - SEE IF TCB ON THIS LOGICAL LINK
? 
            BEGIN 
            IF SNPTR'.BLLLCB.BLSPART.BLSN   _ AND USING THIS LINK      ?
                                   = BSHN 
            THEN
              BEGIN 
              PNCNDLT (TCBPTR);             _ DELINK THE CONNECTION    ?
              MSGINDX := H2HNDISC;          _ HOST DISCONNECTED        ?
              END _ BLSN = BSHN ? 
            ELSE _ BLSN " BSHN ?
              BEGIN 
              IF BSHN = 0                   _ IF NOT CONNECTED         ?
              THEN                          _ AND SELECTED HOST NODE   ?
                IF SNPTR'.BLLLCB.BLSPART    _ EQUAL LINK NODE          ?
                         .BLSN = BSSHN
                THEN
                  IF SNPTR'.BLLLCB.BLSPART. _ SEND NO MESSAGE IF LLCB  ?
                     BLCNFST " C7DISABLED 
                  THEN                      _ CURRENTLY DISABLED       ?
                    MSGINDX := H2HNUNAVAIL; _ HOST UNAVAILABLE         ?
              END; _ ELSE BLSN " BSHN ? 
            END _ BLTREG = 0 ?              _ LINK GOING DOWN          ?
_ 
****  LINK JUST CAME UP -- SEE IF TCB STILL SELECTED TO THIS HOST 
****  AND GENERATE CONNECTION ATTEMPT OR AVAILIBILITY MESSAGE 
? 
          ELSE _ LINK COMING UP ? 
            BEGIN 
            IF SNPTR'.BLLLCB.BLSPART.BLSN   _ IF LINK STILL SELECTED   ?
                                   = BSSHN
            THEN
              BEGIN 
              IF BSCNFST = C7ENABLED        _ AND TERMINAL ENABLED     ?
              THEN
                BEGIN 
                IF BSACON = FALSE           _ AND NOT AUTO CONNECT     ?
                THEN
                 MSGINDX := H2HNAVAIL       _ HOST NOW AVAILABLE       ?
                ELSE _ BSACON = TRUE ?
                  BEGIN 
                  CMDATA := D5CONN;         _ FIRE OFF A CONNECTION    ?
                  CMPTR := TCBPTR;
                  PBLSPUT (LOCWLCB,         _ TO SERVICE MODULE        ?
                          BYWLCB[B0SMWL]);
                  END; _ ELSE BSACON ?
                END; _ BSCNFST = C7ENABLED ?
              END; _ BLSN = BSSHN ? 
            END; _ ELSE LINK COMING UP ?
          IF BSDEVTYPE = N1CON              _ IF CONSOLE DEVICE        ?
          THEN                              _ AND                      ?
            IF MSGINDX " 0                  _ MESSAGE TO BE SENT       ?
            THEN
              PNNOTIFY (-MSGINDX,TCBPTR);   _ NOTIFY TERMINAL USER     ?
          TCBPTR := BSCHAIN;                _ GET NEXT TCB ON LINE     ?
          END; _ WITH TCBPTR'.BSTCB ? 
        UNTIL TCBPTR = NIL;                 _ SEARCH ALL TCB(S) ON LINE?
      END; _ FOR I := C0NPBL+1 TO C4LCBS ?
    END; _ BZDIAG = FALSE ? 
  END; _ WITH LOCWLCB.CMSMLEY... ?
END; _ PROCEDURE PN2LNKDWNUP ?
_ 
** PROCEDURE NAME - P N 2 F L F N P U 
* 
** OVERVIEW       - THIS PROCEDURE FIND(S) LOGICAL LINKS GIVEN A TRUNK
*                   CONTROL BLOCK. *LOGL* WORKLISTS ARE MADE BACK TO
*                   *PNLINK* FOR EACH LOGICAL LINK FOUND. 
* 
** INPUT(S)       - PARAMETERS ARE PASSED VIA LEVEL 1 VARIABLES 
*                   SNPTR - POINTER TO TRUNK CONTROL BLOCK
*                   SNID  - NODE ID ELEMENT CAUSING REGULATION CHANGE 
*                   REVERSE - FLAG TO INDICATE REVERSING OF DN-SN 
* 
** EXTERNAL SUBROUTINES - 
*                 - PNGLNKWL - MAKE *LOGL* WORKLIST ENTRY 
*                 - PNGTLLCB - GET LOGICAL LINK GIVEN DN SN 
? 
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
PROCEDURE PN2FLFNPU;
  
VAR 
  I : INTEGER;
  J : INTEGER;
  REM : ARRAY [1..3] OF INTEGER;
  
BEGIN 
  WITH SNPTR'.TRKCB DO                      _ USING TRUNK CB GET       ?
    BEGIN                                   _ NODE ID(S) ON OTHER END  ?
    REM[1] := TRTNID;                       _ NPU NODE DN              ?
    REM[2] := TRHN1ID;                      _ REMOTE HOST              ?
    REM[3] := TRHN2ID;                      _ REMOTE HOST              ?
    END; _ WITH SNPTR'.. ?
_ 
****  SEE IF A LOGICAL LINK EXIST(S) THRU THE TRUNK AND IF
****  SO GENERATE *LOGL* WORKLIST BACK TO *PNLINK*
? 
  FOR I := 1 TO 3 DO                        _ MAX. POSSIBILITES        ?
    BEGIN 
    PTR := PNGTLLCB (SNID,REM[I]);          _ GET LLCB                 ?
    IF PTR " NIL                            _ IF LLCB EXISTS           ?
    THEN
      BEGIN 
      IF REVERSE = FALSE                    _ IF NOT SWAPPING DN SN    ?
      THEN                                  _ THEN SET LINK REGULATION ?
        PTR'.BLLLCB.BLSPART.BLREG := 0;     _ TO DOWN                  ?
      PNGLNKWL (PTR,REVERSE);               _ LLCB ADDRESS             ?
      END;
    END; _ FOR ?
_ 
****  IF REGULATION CHANGE CAUSED BY LOCAL NPU - SEE IF LOGICAL 
****  LINKS EXIST ON THE COUPLER THAT COME THRU THE TRUNK 
? 
  IF SNID = CKLOCNODE                       _ CONTINUE IF LOCAL NPU    ?
  THEN
    BEGIN 
    FOR I := 1 TO C0NCPLR DO                _ CHECK ALL COUPLERS       ?
      BEGIN 
      PTR := GCLLCB[I];                     _ ADDRESS OF LLCB CHAIN    ?
      WHILE (PTR " NIL) DO                  _ SEARCH TIL END           ?
      WITH PTR'.BLLLCB.BLSPART DO 
        BEGIN 
        FOR J := 1 TO 3 DO                  _ FIND MATCH ON REMOTE IDS ?
          BEGIN 
          IF REM[J] = BLSN                  _ IF SOURCE NODE GOES      ?
          THEN                              _ THRU THE TRUNK - SEND    ?
            BEGIN                           _ REGULATION LEVEL         ?
            IF REVERSE = FALSE              _ IF NOT SWAPPING DN SN    ?
            THEN
              BEGIN 
              BLCS  := FALSE;               _ TRUNK WENT DOWN NOT USING?
              BLNS  := FALSE;               _ *NS* OR *CS* ANY MORE    ?
              BLREG := 0;                   _ LINK REGULATION IS DOWN  ?
              END;
            PNGLNKWL (PTR,REVERSE);         _ GENERATE LINK WL         ?
            END; _ REM[J] = BLSN ?
          END; _ FOR ?
        PTR := BLCHAIN;                     _ FOLLOW THE THREAD        ?
        END; _ WHILE ?
      END; _ FOR ?
    END; _ SNID = CKLOCNODE ? 
END; _ PROCEDURE PN2FLFNPU ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
_ 
** PROCDEDURE NAME - P N 2 F N N P U
* 
** OVERVIEW        - THIS PROCEDURE SEARCHS THE *DELOCDN* TABLE LOOKING 
*                    FOR FOREIGN NPU(S) I.E. THRU TRUNKS. 
* 
** INPUT(S)        - NONE 
* 
** LEVEL 2 SUBROUTINES -
*                  - PN2FLFNPU - FIND LOGICAL LINKS TO FOREIGN NPU(S) 
* 
? 
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
PROCEDURE PN2FNNPU; 
  
VAR 
  PTR : B0BUFPTR; 
  
BEGIN 
  REVERSE := TRUE;                          _ REVERSE DN-SN            ?
  PTR := DELOCDN;                           _ DN NODE TABLE            ?
  REPEAT
    IF PTR'.BRTYP1.BRTYPE = NNTERMINAL      _ IF TERMINAL NODE         ?
    THEN
      IF PTR'.BRTYP1.BRLNKT = NLTRUNK       _ AND LINK THRU TRUNK      ?
      THEN
        BEGIN 
        SNPTR := PTR'.BRTYP1.BRPTR;         _ SET-UP POINTER           ?
        PN2FLFNPU;                          _ FIND LOGICAL LINKS       ?
        END;
    PTR := PTR + 2;                         _ KEEP SEARCHING           ?
  UNTIL PTR'.BRTYP1 = BREND;
END; _ PROCEDURE PN2FNNPU ? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
_$J+? 
_ 
****  S T A R T   P R O C E D U R E   P N L I N K 
? 
BEGIN 
WITH BWWLENTRY[OPS].CMSMLEY DO              _ OPS LEVEL ARRAY          ?
  BEGIN                                     _ MOVE FIELDS TO LOCAL     ?
  SNPTR := CMPTR;                           _ VARIABLES - POINTER      ?
  SNREG.BAINT := CMREG;                     _ REGULATION LEVEL         ?
  SNWC := CMLTYP;                           _ TYPE OF D0LINK EVENT     ?
  REVERSE := CMSWAP;                        _ ONLY USED BY LOGL WL     ?
  END; _ WITH BWWLENTRY..?
  
CASE SNWC OF                                _ BRANCH ON TYPE           ?
  
_ 
****  0. COUPLER REGULATION CHANGE RECEIVED 
? 
  CPLR:                                     _ COUPLER REGULATION       ?
  WITH SNPTR'.BHCCB DO                      _ USING COUPLER CB         ?
  BEGIN                                     _ CHANGE RECEIVED          ?
  REVERSE := FALSE;                         _ DO NOT REVERSE DN-SN     ?
  SNID := BHLLCB'.BLLLCB.BLSPART.BLDN;      _ GET COUPLER DN           ?
  PTR := GCLLCB[1];                         _ ASSUME COUPLER ONE       ?
  IF BHLLCB = PTR                           _ IF NOT - MUST BE         ?
  THEN                                      _ SECOND COUPLER           ?
    PTR := GCLLCB[2]; 
_ 
****  IF SECOND COUPLER EXISTS - SEE IF HOST-HOST LOGICAL LINK
? 
  WHILE PTR " NIL DO                        _ COUPLER                  ?
  WITH PTR'.BLLLCB.BLSPART DO               _ USING LLCB(S)            ?
    BEGIN                                   _ FIND HOST-HOST LLCB      ?
    IF SNID = BLSN                          _ IF CORRECT LLCB          ?
    THEN                                    _ SEND OUT WORKLIST        ?
      BEGIN 
      BLREG := SNREG.BACPOW.BAREG;          _ POST REGULATION LEVEL    ?
      PNGLNKWL (PTR,REVERSE);               _ BUILD LINK INTERNAL WL   ?
      END; _ BLSN = SNID ?
    PTR := BLCHAIN;                         _ CHAIN TO NEXT LLCB       ?
    END; _ WHILE ?
_ 
****  IF COUPLER JUST CAME UP -- NOTIFY HOST OF REGULATION LEVEL
****  FOR ALL LOGICAL LINKS ON COUPLER CONTROL BLOCK. 
? 
  IF BHCPLREG = 0                           _ IF HOST JUST CAME UP     ?
  THEN                                      _ THEN SEND REG/LL(S) FOR  ?
    BEGIN                                   _ ALL LLCB(S) ON COUPLER   ?
    PTR := BHLLCB;                          _ POINTER TO LLCB CHAIN    ?
    WHILE PTR " NIL DO                      _ FOLLOW THE THREAD        ?
      BEGIN 
      PNGLNKWL (PTR,REVERSE);               _ GENERATE INTERNAL WL     ?
      PTR := PTR'.BLLLCB.BLSPART.BLCHAIN;   _ FOLLOW THE THREAD        ?
      END; _ WHILE ?
    END; _ BHCPLREG = 0 ? 
  BHCPLREG := SNREG.BACPOW.BAREG;           _ UPDATE COUPLER REGULATION?
_ 
****  IF TERMINAL-COUPLER LOGICAL LINK EXISTS - POST IT AND THEN
****  NOTIFY FOREIGN NPU(S) ABOUT COUPLER REGULATION. 
? 
  PTR := PNGTLLCB (CKLOCNODE,SNID);         _ SEE IF TERMINAL-HOST     ?
  IF PTR " NIL                              _ LLCB EXISTS              ?
  THEN                                      _ POST REGULATION LEVEL    ?
    BEGIN                                   _ TO LLCB                  ?
    PTR'.BLLLCB.BLSPART.BLREG :=            _ POST LINK REGULATION     ?
                  SNREG.BACPOW.BAREG; 
    PNGLNKWL (PTR,REVERSE);                 _ GENERATE LINK WL         ?
    END; _ PTR " NIL ?
  PN2FNNPU;                                 _ SEND REG/LL TO OTHER NPU ?
  PNCSUPCHG (SNID,SNREG);                   _ SEE IF SUPERVISION CHG   ?
  END; _ CASE CPLR ?
  
_ 
****  1. TRUNK AVAILIBILITY OR UNAVAILIBILITY - CAUSES REGULATION 
? 
  TRNK:                                     _ TRUNK WENT DOWN/UP       ?
  BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
  WITH SNPTR'.TRKCB DO
    BEGIN 
    REVERSE := TRCNFST \ C7ENABLED;         _ REVERSE IF TRUNK CAME UP ?
    SNID := CKLOCNODE;                      _ SET SOURCE AS LOCAL NPU  ?
    PN2FLFNPU;                              _ FIND LINKS TO FOREIGN NPU?
    IF REVERSE = FALSE                      _ IF TRUNK WENT DOWN       ?
    THEN
      BEGIN                                 _ CHECK LNPU-RHN LLCB(S)   ?
      SNREG.BAINT := 0;                     _ SET REGULATION DOWN      ?
      PNCSUPCHG (TRHN1ID,SNREG);            _ CHECK SUPERVISION CHG    ?
      PNCSUPCHG (TRHN2ID,SNREG);            _ CHECK SUPERVISION CHG    ?
      END; _ REVERSE = FALSE ?
    END; _ WITH SNPTR'.TRKCB ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
  END; _ CASE TRNK ?
  
_ 
****  2. LOCAL NPU REGULATION CHANGE
? 
  NPU:                                      _ NPU REGULATION CHG       ?
  BEGIN                                     _ CURRENT LEVEL PROCESS IT ?
  SNID := CKLOCNODE;
  PN2FNNPU;                                 _ REG/LL TO OTHER NPU(S)   ?
  REVERSE := FALSE;                         _ DO NOT REVERSE DN SN     ?
  FOR I := 1 TO C0NCPLR DO                  _ DO BOTH COUPLERS         ?
    BEGIN 
    PTR := GCLLCB[I];                       _ POINTER TO COUPLER LLCB  ?
    WHILE PTR " NIL DO                      _ WHILE LLCB(S) EXIST      ?
    WITH PTR'.BLLLCB.BLSPART DO             _ USING LLCB TYPE          ?
      BEGIN 
      IF CKLOCNODE = BLSN                   _ IF SOURCE NODE LOCAL     ?
      THEN                                  _ THEN POST REGULATION     ?
        BLREG := NPUREG;
      PNGLNKWL (PTR,REVERSE);               _ GENERATE LINK WL ENTRY   ?
      PTR := BLCHAIN;                       _ FOLLOW THE THREAD        ?
      END; _ WHILE ?
    END; _ FOR ?
  END; _ CASE NPU ? 
  
_ 
**** 3. LOGICAL LINK REGULATION - INTERNALLY GENERATED BY *PNLINK*
? 
  LOGL:                                     _ GENERATED BY PNGLNKWL    ?
  BEGIN                                     _ INTERNAL TYPE(S)         ?
  WITH SNPTR'.BLLLCB.BLSPART DO             _ LLCB FOR LINK            ?
    BEGIN 
    CPLRPTR := PN1SRCH (BLDN,DELOCDN);      _ GET COUPLER CB           ?
    PTR := PN1SRCH (BLSN,DELOCDN);          _ GET TRUNK CB             ?
    IF BLCDS                                _ IF CONNECTION DIR.       ?
    THEN
      SNREG.BAINT := NPUREG                 _ USE NPU REGULATION       ?
    ELSE
      BEGIN 
      SNREG.BAINT := CPLRPTR'.BHCCB         _ GET COUPLER REG. LEVEL   ?
                  .BHCPREG.BACPREG.BACPRL;
      SNREG.BAINT := PBMIN (SNREG.BAINT,    _ USE MINIMUN REG          ?
                            NPUREG);
      END; _ NOT BLCDS ?
    IF REVERSE                              _ IF SWAPPING DN-SN        ?
    THEN                                    _ MAKE SURE THE TRUNK      ?
      BEGIN                                 _ IS UP                    ?
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
      IF PTR'.TRKCB.TRCNFST = C7ACTIVE      _ IF ACTIVE OK             ?
      THEN
        BEGIN 
        IF BLCNFST = C7DISABLED 
        THEN                                _ IS DISABLED              ?
          SNREG.BAINT := 0; 
        PNGREGLL (SNPTR,SNREG,REVERSE);     _ LAUNCH REG/LL            ?
        END; _ TRCNFST = C7ACTIVE ? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
      END _ IF REVERSE ?
    ELSE _ NOT REVERSE ?
      BEGIN 
      IF (BLCDS) ! ((NOT BLCDS) &           _ IF TERMINAL NODE OR      ?
         (SNREG.BAINT " 0))                 _ NOT TERMINAL NODE AND    ?
      THEN                                  _ REGULATION .NE. 0        ?
        BEGIN                               _ OK HOST IS UP            ?
        DOWN := BLREG = 0;                  _ USE LOCAL VARIABLES      ?
        UP := BLTREG = 0;                   _ MORE EFFICIENT           ?
        IF BLCNFST " C7DISABLED             _ ONLY POST REGULATION     ?
        THEN                                _ IF LINK NOT DISABLED     ?
          BLTREG := PBMIN (NPUREG,BLREG);   _ POST NEW REGULATION      ?
        SNREG.BAINT := BLTREG;              _ FOR PNGREGLL             ?
        IF NOT (DOWN ! UP)                  _ BOTH FALSE               ?
        THEN                                _ THEN JUST SEND REG/LL    ?
          BEGIN 
          IF BLCDS = FALSE                  _ IF NOT CONNECTION DIR.   ?
          THEN                              _ THEN OK TO SEND REG/LL   ?
            PNGREGLL (SNPTR,SNREG,REVERSE); _ LAUNCH REG/LL            ?
          END _ IF NOT (DOWN ! UP) ?
        ELSE _ DOWN OR UP ? 
          BEGIN 
          IF BLCNFST " C7DISABLED           _ IF LINK NOT DISABLED     ?
          THEN
            BEGIN 
            IF BLCNFST " LNKCNFST[DOWN]     _ AND CHANGE IN STATUS     ?
            THEN
              BEGIN                         _ POST NEW STATUS          ?
              BLCNFST := LNKCNFST[DOWN];
              PNUSSM (BLCNFST,0,D9LL,SNPTR);
              END; _ BLCNFST " LNKCNFST[DOWN] ? 
            END; _ BLCNFST " C7DISABLED ? 
          IF BLCDS                          _ IF CONNECTION DIRECTORY  ?
          THEN
            BEGIN 
            IF NOT (DOWN & UP)              _ IF CHANGE IN REGULATION  ?
            THEN
              PN2LNKDWNUP;                  _ PROCESS LINK UP OR DOWN  ?
            END 
          ELSE
            PNGREGLL (SNPTR,SNREG,REVERSE); _ JUST SEND REG/LL SVM     ?
          END; _ ELSE DOWN OR UP ?
        END; _ HOST UP ?
      END; _ ELSE NOT REVERSE ? 
    END; _ WITH SNPTR'... ? 
  END; _ CASE LOGL ?
  
  END; _ CASE SNWC ?
END; _ PROCEDURE PNLINK ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNLINE                                           * 
*                                                                     * 
*        LINE EVENT WORKLIST HANDLER                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE CONTROLS THE PROCESSING OF ALL LINE    * 
*               EVENTS. EXTERNAL STIMULI CONSIST OF WORKLIST(S) THAT  * 
*               REFLECT THE CHANGE IN STATUS OF A LINE.               * 
*               WORKLISTS ARE RECEIVED FROM LINE INITIALIZER *PTLINIT** 
*               AND TIPS, INCLUDING THE *LIP*.                        * 
*               *PNLINE* DETERMINES WHAT APPROPRIATE ACTION IS        * 
*               REQUIRED BASED ON THE *CMDATA* PORTION OF THE *D0LINE** 
*               WORKCODE. UNSOLICITED STATUS MESSAGES ARE GENERATED   * 
*               TO *PNUSSM* TO REPORT CHANGES IN LINE/TRUNK STATUS.   * 
*                                                                     * 
** INPUT    -   ALL INPUT IS IN THE FORM OF WORLISTS WITH *CMDATA*    * 
*               INDICATING THE TYPE OF STATUS -                       * 
*                - D5OPER - USED TO INDICATE THAT LINE IS OPERATIONAL * 
*                           *PNLINE* WILL REQUEST A CONFIGURATION     * 
*                           SERVICE MESSAGE BE GENERATED IF *CS* IS   * 
*                           AVAILABLE AND CHANGE THE LINE STATUS TO   * 
*                           *C7ACTIVE*.                               * 
*                - D5DISA - *PNLINE* WILL DETERMINE WHETHER TO LEAVE  * 
*                           THE LINE *C7DISABLED* OR RETURN IT TO THE * 
*                           LINE INITIALIZER IF A LINE DISCONNECT IS  * 
*                           REQUESTED, *BZSMDISC* SET TRUE.           * 
*                - D5DOWN - ACTION DEPENDS ON WHETHER LINE INITIALIZER* 
*                           OR A TIP IS CONTROLLING THE LINE. IF      * 
*                           *PTLINIT* IS IN CONTROL THEN A STATUS     * 
*                           MESSAGE IS ONLY ISSUED. IF HOWEVER A TIP  * 
*                           IS CONTROLLING THE LINE THEN *PNSMBLINDWN** 
*                           IS CALLED TO ORDERLY BRING THE LINE DOWN  * 
*                                                                     * 
** OUTPUT -     UNSOLICICTED STATUS MESSAGE(S)                        * 
*               WORKLIST TO *PNLINK* IF STATUS ON A TRUNK             * 
*               WORKLIST TO *PTLINIT* TO ENABLE A LINE                * 
*               CALL TO *PNSMGEN* TO BUILD A CNF/TE SERVICE MESSAGE   * 
*                                                                     * 
** LEVEL 2 SUBROUTINE -                                               * 
*               - PN2USSM - GENERATE A UNSOLICITED STATUS MESSAGE     * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*               - PNUSSM - GENERATE A UNSOLICITED STATUS WORKLIST     * 
*               - ADDR   - GET ADDRESS                                * 
*               - PBLSPUT - MAKE WORKLIST ENTRY                       * 
*               - PBRELZRO - RELEASE POSSIBLE AUTO-REC BUFFER         * 
*               - PBLLRMOVE - REMOVE LINE FROM ACTIVE TIMER SCAN      * 
*               - PNSMBLINDWN - BRING THE LINE DOWN                   * 
*               - PNDLTCB - DELETE TCB(S) ATTACHED TO THE LINE        * 
*               - PBXFER - TRANSFER TO *PNSMGEN* TO BUILD CNF/TE      * 
*                                                                     * 
** SPECIAL NOTE -                                                     * 
*               THIS PROCEDURE CONTAINS *IF DEF,HLIP CODE.            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNLINE; 
  
VAR 
  LCBPTR   : B0BUFPTR;
  TCBPTR   : B0BUFPTR;
  NEWCNFST : C7CNFST; 
  OLDCNFST : C7CNFST; 
  CNFARRAY : ARRAY[D5OPER..D5INOP] OF C7CNFST;
VALUE 
  CNFARRAY = (C7ENABLED, C7DUMMY, C7DISABLED, C7DOWN);
_ 
** PROCEDURE NAME - P N 2 U S S M 
* 
** OVERVIEW       - THIS PROCEDURE CHECKS IF THERE IS A CHANGE IN 
*                   LINE STATUS AND CALL(S) *PNUSSM* TO GENERATE
*                   AND UNSOLICITED STATUS SERVICE MESSAGE. 
? 
PROCEDURE PN2USSM;
  
BEGIN 
IF LCBPTR'.BZZLCB.BZCNFST " NEWCNFST        _ IF CHANGE IN STATUS      ?
THEN
  BEGIN 
  LCBPTR'.BZZLCB.BZCNFST := NEWCNFST;       _ POST NEW STATUS          ?
  PNUSSM (NEWCNFST,0,D9LI,LCBPTR);          _ GENERATE LINE STATUS     ?
  END; _ BZCNFST " NEWCNFST ? 
END; _ PROCEDURE PN2USSM ?
_ 
****  S T A R T   P R O C E D U R E   P N L I N E 
? 
BEGIN 
WITH BWWLENTRY[OPS].CMSMLEY DO
  BEGIN 
  ADDR(CGLCBP'[CMLINO.BDPORT],LCBPTR);
  NEWCNFST := CNFARRAY[CMDATA];             _ GET NEW LINE STATUS      ?
  IF NEWCNFST = C7DUMMY                     _ IF DUMMY CHANGE THEN     ?
  THEN
    GOTO 99;                                _ EXIT IMMEDIATELY         ?
  TCBPTR := LCBPTR'.BZZLCB.BZTCBPTR;        _ GET POINTER TO TCB(S)    ?
  IF LCBPTR'.BZZLCB.BZTIPTYP = N0HDLC       _ IF TRUNK                 ?
  THEN
    BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
    OLDCNFST := LCBPTR'.BZZLCB.BZCNFST;     _ SAVE PREVIOUS STATUS     ?
    LCBPTR'.BZZLCB.BZCNFST := NEWCNFST;     _ POST NEW STATUS          ?
    IF OLDCNFST " C7DISABLED                _ NO CHANGE IF TRUNK DISA. ?
    THEN
      IF OLDCNFST " NEWCNFST                _ IF ACTUAL CHANGE         ?
      THEN
        BEGIN 
        PNUSSM (NEWCNFST,0,D9TR,TCBPTR);    _ GENERATE STATUS          ?
        TCBPTR'.TRKCB.TRCNFST := NEWCNFST;  _ CHANGE TRUNK STATUS      ?
        END;
    IF NEWCNFST = C7ENABLED                 _ IF TRUNK CAME UP         ?
    THEN                                    _ MAKE ACTIVE              ?
      BEGIN 
      LCBPTR'.BZZLCB.BZCNFST := C7ACTIVE; 
      TCBPTR'.TRKCB.TRCNFST := C7ACTIVE;
      END;
    CMWKCODE := D0LINK;                     _ LINK EVENT WORKCODE      ?
    CMLTYPE := TRNK;                        _ TRUNK EVENT              ?
    CMPTR := TCBPTR;                        _ PASS TRUNK CB POINTER    ?
    PBLSPUT (BWWLENTRY[OPS],                _ LAUNCH WORKCODE          ?
             BYWLCB[B0SMWL]);               _ TO SERVICE MODULE        ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
    END _ BZTIPTYPE = N0HDLC ?
  ELSE _ BZTIPTYPE " N0HDLC ? 
    BEGIN 
    WITH LCBPTR'.BZZLCB DO                  _ USING LCB STRUCTURE      ?
      CASE  NEWCNFST OF 
  
      C7DISABLED: 
      BEGIN 
      BZSMCNTRL := FALSE;                   _ CLEAR SVM CONTROL FLAG   ?
      BZCNFPEND := FALSE;                   _ AND CONFIG. PENDING      ?
      PBRELZRO (BZARPARAMS,BEDBSIZE);       _ AND AUTO-REC BUFFER      ?
      IF BZSMDISC                           _ IF SVM DISCONNECT        ?
      THEN
        BEGIN 
        BZCNFST  := C7ENABLED;              _ CHANGE TO ENABLED STATUS ?
        CMWKCODE := A0SMEN;                 _ ENABLE THE LINE          ?
        CMLINO := BZLINO;                   _ PASS LINE NUMBER         ?
        PBLSPUT (BWWLENTRY[OPS],            _ GIVE LINE TO LINE        ?
                 BYWLCB[B0LIWL]);           _ INITIALIZER              ?
        END _ BZSMDISC ?
      ELSE
        BEGIN                               _ LEAVE LINE DISABLED      ?
        PBLLRMOVE (BZLINO);                 _ REMOVE FROM LINE TIMER   ?
        PN2USSM;                            _ GENERATE STATUS MESSAGE  ?
        END; _ ELSE BZSMDISC = FALSE ?
      BZSMDISC := FALSE;                    _ CLEAR DISCONNECT FLAG    ?
      END; _ CASE C7DISABLED ?
  
      C7DOWN: 
      BEGIN 
      IF BZSMCNTRL = FALSE                  _ IF SVM NOT CONTROLLING   ?
      THEN                                  _ THE LINE                 ?
        BEGIN                               _ THEN TAKE CONTROL        ?
        IF BZTIPTYPE = N0LINIT              _ IF OWNER IS LINE INIT    ?
        THEN
          PN2USSM                           _ GENERATE STATUS          ?
        ELSE
          BEGIN 
          BZCNFST   := C7DOWN;              _ CHANGE LINE STATUS       ?
          BZSMCNTRL := TRUE;                _ SVM CONTROLLING LINE     ?
          BZSMDISC  := TRUE;                _ DISCONNECT LINE          ?
          PNSMBLINDWN (LCBPTR,DAHARD);      _ KNOCK LINE DOWN          ?
          END; _ ELSE BZTIPTYPE " N0LINIT ? 
        END; _ BZSMCNTRL = FALSE ?
      END; _ CASE C7DOWN ?
  
      C7ENABLED:  
      BEGIN 
      IF BZSMCNTRL = FALSE                  _ IF SVM NOT CONTROLLING   ?
      THEN
        BEGIN 
        IF BZCNFPEND = FALSE                _ IF CONFIGURATION NOT     ?
        THEN                                _ CURRENTLY PENDING        ?
          BEGIN 
          BZCNFPEND := TRUE;                _ SET IT PENDING           ?
          IF BZTIPTYPE " N1X25              _ CHECK IF NON-X25         ?
          THEN
            WHILE BZTCBPTR " NIL            _ DELETE ALL               ?
            DO
              PNDLTCB (BZTCBPTR);            _ ATTACHED TCBS           ?
          BZCNFST := C7ACTIVE;              _ SET LIN ACTIVE           ?
          IF BZAUTO                         _ IF AUTO-REC LINE         ?
          THEN                              _ GET TIP BUFFER           ?
            BZARPARAMS := CMPTR;
          IF CS " 0                         _ IF CS PRESENT            ?
          THEN
            BEGIN 
            GENPFC := D8CNF;                _ LAUNCH CONFIGURATION     ?
            GENSFC.DHINT := D9TE;           _ REQUEST                  ?
            GENSUP := CS;                   _ PASSING CS               ?
            GENPAR.BALCBP := LCBPTR;        _ LINE POINTER             ?
            WITH BRTNJUMP[C1PNSMGEN] DO 
              PBXFER (JENTADDR,JPAGEVAL); 
            END; _ CS " 0 ? 
          END; _ BZCNFPEND = FALSE ?
        END; _ BZSMCNTRL = FALSE ?
      END; _ CASE C7ENABLED ? 
  
      END; _ CASE OF NEWCNFST ? 
    END;  _ IF LINE ? 
99: 
  END; _ WITH BWWLENTRY[OPS].CMSMLEY ?
END; _ PROCEDURE PNLINE ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNCNTMR                                          * 
*                                                                     * 
*        MAKE A CONNECTION TRIGGER TIMEOUT                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNCNTMR MAKES A TIMER ENTRY FOR A CONNECTION TRIGGER.  * 
*                                                                     * 
** INPUT -     TCB ADDRESS                                            * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNCONNECT     - ESTABLISH A TCB CONNECTION             * 
*              PNICNABNORMAL - PROCESS ABNORMAL RESPONSE TO CONNECTION REQUEST^*
*                                                                     * 
** OUTPUT -                                                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBLSPUT - MAKE A WORKLIST ENTRY                        * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNCNTMR (TIME : INTEGER;TCBPTR : B0BUFPTR); 
  
BEGIN 
IF TCBPTR'.BSTCB.BSCNTIMER = FALSE          _DEFENSIVE CODE            ?
THEN
  IF TCBPTR'.BSTCB.BSDELTCB = FALSE         _AND TCB NOT BEING DELETED ?
  THEN
    BEGIN 
    WITH DWWLENTRY.CMSMLEY DO               _DELAYED WORKLIST AREA     ?
      BEGIN 
      CMTIMER  := TIME;                     _SET TIMER FIELD           ?
      CMWKCODE := D0TCONNECT;               _SET WORKCODE - TRY AGAIN  ?
      CMPOINT  := TCBPTR;                   _SET POINTER - TCB ADDRESS ?
      PBLSPUT (DWWLENTRY,BYWLCB[B0SMTMR]);  _PUT WORKLIST INTO TIMER Q ?
      TCBPTR'.BSTCB.BSCNTIMER := TRUE;      _SET TIMER ACTIVE          ?
      END; _WITH DWWLENTRY.CMSMLEY DO?
    END; _BSDELTCB = FALSE? 
END; _PROCEDURE PNCNTMR?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PN2GTCN                                          * 
*                                                                     * 
*        FIND FIRST/LAST AVAILABLE ID IN TYPE 2 CN TABLE              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  THIS ROUTINE FINDS THE FIRST OR LAST AVAILABLE ID IN A * 
*              TYPE 2 CN TABLE DEPENDING ON WHETHER THE DN OR SN IS   * 
*              HIGHER.                                                * 
*                                                                     * 
** INPUT -     AN LLCB ADDRESS.                                       * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNCNINIT          INITIATE TCB CONNECTION              * 
*              PNX25CON          INITIATE X25 CONNECTION              * 
*                                                                     * 
** OUTPUT -    1ST AVAILABLE ID IN TABLE; $FFFF IF TABLE IS FULL.     * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
** NOTES -     BECAUSE EACH ID LEVEL CAN RANGE FROM 0 TO $F, BUT      * 
*              TABLE INDICES MUST RANGE FROM 1 TO $10, AN OFFSET MUST * 
*              BE USED TO CALCULATE THE ID.  A CN OF 0 IS NEVER       * 
*              RETURNED; THE LOWEST CN IS 1.                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PN2GTCN (LLCB : B0BUFPTR) : INTEGER; 
  
CONST 
      G7FULL   = $FFFF;                     _RESULT RETURNED IF FULL   ?
      G7LOW1ST = $01;                       _LOWEST 1ST LEVEL INDEX    ?
      G7SIZE   = J0T2SZE;                   _SIZE OF BUFFER FOR ENTRIES?
  
VAR 
      G7IND1   : INTEGER;                   _1ST LEVEL INDEX           ?
      G7IND2   : INTEGER;                   _2ND LEVEL INDEX           ?
      G7LMT1   : INTEGER;                   _LIMIT OF 1ST LEVEL SEARCH ?
      G7LMT2   : INTEGER;                   _LIMIT OF 2ND LEVEL SEARCH ?
      G7INCR   : INTEGER;                   _INDEX INCREMENT           ?
      G7ID     : INTEGER;                   _SAVED UPPER 4 BITS OF ID  ?
      G7LVL2P  : B0BUFPTR;                  _POINTER TO 2ND LEVEL ENTRY?
      G7HIGH   : BOOLEAN;                   _RETURN HIGH ID INDICATOR  ?
      G7LOW    : BOOLEAN;                   _RETURN LOW ID INDICATOR   ?
      G7FIRST  : BOOLEAN;                   _1ST 1ST LEVEL INDICATOR   ?
      G7DFTBL  : ARRAY[BOOLEAN] OF INTEGER; _DEFAULT IDS RETURNED      ?
      G7ST1TBL : ARRAY[BOOLEAN] OF INTEGER; _INITIAL 1ST LEVEL INDEXES ?
      G7ST2TBL : ARRAY[BOOLEAN,             _INITIAL 2ND LEVEL INDEXES ?
                       BOOLEAN] OF INTEGER; 
      G7INCTBL : ARRAY[BOOLEAN] OF INTEGER; _INCREMENTS FOR INDEXES    ?
  
VALUE 
      G7DFTBL  = ($01,$FF); 
      G7ST1TBL = ($01,$10); 
      G7ST2TBL = ($01,$02,
                  $10,$10); 
      G7INCTBL = (1,-1);
  
BEGIN 
PN2GTCN := G7FULL;                          _RETURN FULL BY DEFAULT    ?
WITH LLCB'.BLLLCB.BLSPART DO                _SET INDEX TO LLCB         ?
  BEGIN 
  G7HIGH := BLDN < BLSN;                    _(RE)SET HIGH/LOW FLAGS    ?
  G7LOW  := NOT G7HIGH; 
_ 
****  IF CONNECTION DIRECTORY DOES NOT EXIST THEN RETURN DEFAULT ID 
? 
  IF BLCONDIR = NIL                         _CHECK CN DIRECTORY ABSENT ?
  THEN
    BEGIN                                   _YES IT IS                 ?
    PN2GTCN := G7DFTBL[G7HIGH];             _RETURN DEFAULT ID VALUE   ?
    GOTO 10;                                _EXIT ANY MORE SEARCHING   ?
    END;
_ 
****  START FIRST LEVEL SEARCH LOOP 
? 
  G7INCR  := G7INCTBL[G7HIGH];              _SET UP INDEX INCREMENT    ?
  G7IND1  := G7ST1TBL[G7HIGH];              _INITIALIZE 1ST LEVEL INDEX?
  G7LMT1  := G7ST1TBL[G7LOW] + G7INCR;      _LIMIT OF 1ST LEVEL SEARCH ?
  REPEAT
    G7FIRST := G7IND1 = G7LOW1ST;           _(RE)SET 1ST 1ST LEVEL FLAG?
    G7ID    := (G7IND1 - 1) * G7SIZE;       _SAVE UPPER 4 BITS OF ID   ?
    G7LVL2P := BLCONDIR'.BCCHAINS[G7IND1];  _GET PTR TO 2ND LEVEL ENTRY?
    IF G7LVL2P = NIL                        _CHECK IF NO 2ND LVL ENTRY ?
    THEN
      BEGIN 
      PN2GTCN := G7ID - 1 +                 _CALCULATE ID TO RETURN    ?
                 G7ST2TBL[G7HIGH,G7FIRST];
      GOTO 10;                              _EXIT ANY MORE SEARCHING   ?
      END;
_ 
****  START SECOND LEVEL SEARCH LOOP
? 
    G7IND2 := G7ST2TBL[G7HIGH,G7FIRST];     _INITIALIZE 2ND LEVEL INDEX?
    G7LMT2 := G7ST2TBL[G7LOW,G7FIRST] +     _LIMIT OF 2ND LEVEL SEARCH ?
              G7INCR; 
    REPEAT
      IF G7LVL2P'.BCCHAINS[G7IND2] = NIL    _CHECK IF FREE ENTRY       ?
      THEN
        BEGIN 
        PN2GTCN := G7ID + G7IND2 - 1;       _CALCULATE ID TO RETURN    ?
        GOTO 10;                            _EXIT ANY MORE SEARCHING   ?
        END;
  
      G7IND2 := G7IND2 + G7INCR;            _SET NEW 2ND LEVEL INDEX   ?
    UNTIL G7IND2 = G7LMT2;                  _CHECK IF MORE 2ND LEVELS  ?
  
    G7IND1 := G7IND1 + G7INCR;              _SET NEW 1ST LEVEL INDEX   ?
  UNTIL G7IND1 = G7LMT1;                    _CHECK IF MORE 1ST LEVELS  ?
  
  END; _WITH LLCB'.BLLLCB.BLSPART DO? 
10: 
END; _FUNCTION PN2GTCN? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNCNINIT                                         * 
*                                                                     * 
*        INITIATE TCB CONNECTION                                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNCNINIT INITIATES A CONNECTION BETWEEN A TCB AND ITS  * 
*              SELECTED HOST, IF POSSIBLE.                            * 
*              IF THE CONNECTION IS POSSIBLE THEN AN INITIATE         * 
*              TERMINAL CONNECTION REQUEST IS SENT TO THE SELECTED    * 
*              HOST NODE.                                             * 
*              THERE ARE TWO TYPES OF REASONS FOR A CONNECTION NOT    * 
*              BEING POSSIBLE - EITHER BECAUSE OF THE LOGICAL LINK    * 
*              OR BECAUSE OF INTERNAL TIMING WINDOWS. IN THE MORE     * 
*              USUAL CASES THE NON-AUTO CONNECT CONSOLE IS INFORMED   * 
*              OF THE PARTICULAR REASON AND AN AUTO- CONNECT          * 
*              CONSOLE OR PASSIVE DEVICE IS PLACED ON A TIMER THREAD  * 
*              TO ALLOW A RETRY OF THE CONNECTION ATTEMPT             * 
*                                                                     * 
** INPUT -     TCB ADDRESS                                            * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              1) PNTCB            PROCESS TCB EVENT                  * 
*              2) PNSMICN          ICN SERVICE MESSAGE PROCESSOR      * 
*                                                                     * 
** OUTPUT -    ONE OF THE FOLLOWING                                   * 
*              1) ICN/TE/R SERVICE MESSAGE UPLINE TO NAM              * 
*              2) NO HOST SELECTED MESSAGE ( + H.A.D. ) TO USER       * 
*              3) HOST INACCESSIBLE MESSAGE ( + H.A.D. ) TO USER      * 
*              4) CONNECTION RETRY TIMER ENTRY                        * 
*              5) NOTHING AT ALL                                      * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              1) PNGTLLCB         PERFORM DN, SN LOOKUP              * 
*              2) PN2GTCN          FIND AVAILABLE CONNECTION NUMBER   * 
*              3) PN2ADD           ADD ENTRY TO TYPE 2 TABLE          * 
*              4) PBXFER           TO CALL PNSMGEN                    * 
*              5) PNCNTMR          MAKE A CONNECTION TRIGGER TIMEOUT  * 
*              6) PNNOTIFY         SEND MESSAGE TO TERMINAL           * 
*                                                                     * 
** INTERNAL SUBROUTINE -                                              * 
*              1) PN2CONNECT       ATTEMPT A CONNECTION INITIATION    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNCNINIT (COTCB : B0BUFPTR);
  
CONST 
      COPTIME = 30;                         _RETRY TIME FOR PASSIVE TML?
      COATIME = 4;                          _RETRY TIME FOR AUTOCONNECT?
  
VAR 
      COLLCB : B0BUFPTR;                    _POINTER TO LLCB           ?
      COCN   : INTEGER;                     _CONNECTION NUMBER         ?
      K      : INTEGER;                     _WORK INTEGER              ?
  
_$J+? 
_ 
************************************************************************
*                                                                      *
** PROCEDURE NAME - P N 2 C O N N E C T                                *
*                                                                      *
** OVERVIEW       - THIS PROCEDURE ATTEMPTS A CONNECTION INITIATION    *
*                   FOR A TERMINAL. IF POSSIBLE THEN THE ICN/TE/R SM   *
*                   IS SENT UPLINE TO THE SELECTED HOST NODE.          *
*                   IF NOT POSSIBLE THEN FOR THE NON-AUTO CONNECT      *
*                   USER THE USER IS NOTIFIED OTHERWISE THE CONNECTION *
*                   ATTEMPT IS DELAYED AND ATTEMPTED AGAIN AT A        *
*                   LATER TIME                                         *
*                                                                      *
************************************************************************
? 
  
PROCEDURE PN2CONNECT; 
  
BEGIN 
WITH COTCB'.BSTCB DO                        _SET INDEX TO TCB          ?
  BEGIN 
  COLLCB := PNGTLLCB (CKLOCNODE,BSSHN);     _GET LLCB FOR SELECTED NODE?
  WITH COLLCB'.BLLLCB.BLSPART DO            _SET INDEX TO LLCB         ?
    BEGIN 
    COCN := PN2GTCN (COLLCB);               _GET POSS CONNECTION NUMBER?
    IF (COCN " $FFFF) &                     _CHECK FREE CONNECTION NUMB?
       (BLCNFST \ C7ENABLED)                _AND LOGICAL LINK STATUS IS?
    THEN                                    _ENABLED OR ACTIVE         ?
_ 
****  CONNECTION INITIATE REQUEST POSSIBLE
****  1. ADD TCB TO CONNECTION DIRECTORY AND UPDATE LL STATUS 
****  2. UPDATE TCB INFORMATION CONCERNING CONNECTION 
****  3. SEND INITIATE TERMINAL CONNECTION REQUEST TO NAM 
? 
      BEGIN 
      PN2ADD (COCN,BLCONDIR,COTCB);         _PUT TCB IN CN DIRECTORY   ?
      BLCOUNT := BLCOUNT + 1;               _BUMP NR OF CONNECTIONS    ?
      BLCNFST := C7ACTIVE;                  _LL STATUS IS ACTIVE       ?
  
      BSCNFST := C7ACTIVE;                  _TCB STATUS IS ALSO ACTIVE ?
      BSSTATE := D4IPREQ;                   _STATE INIT REQ BY PROCESS ?
      BSHN    := BSSHN;                     _STORE CONNECTED HOST NODE ?
      BSCN    := COCN;                      _STORE CONNECTION NUMBER   ?
      BSLLCB  := COLLCB;                    _STORE LLCB ADDRESS        ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
      IF BSLCBP'.BZTIPTYPE = N1X25          _ IF X25 TIPTYPE           ?
      THEN
        IF BSXTOCON                         _ IF CONNECT TIMEOUT PENDNG?
        THEN
          PNXRMOVWLE(COTCB);                _ REMOVE WLE FROM SVM QUEUE?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
  
      GENPFC          := D8ICN;             _SET PFC FOR ICN/TE/R SM   ?
      GENSFC.DHINT    := D9TE;              _SET SFC                   ?
      GENPAR.BABUFPTR := COTCB;             _SET TCB ADDRESS           ?
      WITH BRTNJUMP[C1PNSMGEN] DO           _SEND SM VIA PNSMGEN       ?
        PBXFER (JENTADDR,JPAGEVAL); 
  
      END _IF CONNECTION POSSIBLE?
    ELSE
_ 
****  NOT POSSIBLE TO INITIATE CONNECTION, PROCESS THE CONDITIONS 
? 
      BEGIN 
      IF BSDEVTYPE = N1CON                  _CHECK IF CONSOLE DEVICE   ?
      THEN
        BEGIN                               _YES CHECK IF AUTO-CONNECT ?
        IF BSACON 
        THEN
          BEGIN 
            PNCNTMR (COATIME,COTCB);        _TRY TRY AGAIN             ?
            IF BWWLENTRY[OPS].CMSMLEY.
                         CMWKCODE = D0TCB   _AND IF THIS WAS TRIGGERED ?
            THEN                            _BY A DOTCB WORKLIST ENTRY ?
              PNNOTIFY (H2HNUNAVAIL,COTCB); _THEN NOTIFY THE CONSOLE   ?
          END 
        ELSE
          BEGIN 
          K := H2NHNAVAIL;                  _PRESET TO NO HOST AVAIL   ?
          IF PNACCHOST(0) 
          THEN
            K := H2HNUNAVAIL;               _THIS HOST NOT AVAILBLE    ?
          PNNOTIFY (K,COTCB);               _ HOST UNAVAILABLE         ?
          END; _BSACON = FALSE? 
        END 
      ELSE
        IF BLCNFST \ C7ENABLED              _NO  CHECK LINK IS STILL UP?
        THEN
          PNCNTMR (COPTIME,COTCB);          _     YES RETRY AGAIN LATER?
  
      END; _IF CONNECTION POSSIBLE ELSE?
    END; _WITH COLLCB'.BLLLCB.BLSPART DO? 
  END; _WITH COTCB'.BSTCB DO? 
END; _PROCEDURE PN2CONNECT? 
_$J+? 
_ 
****  S T A R T   P R O C E D U R E   P N C N I N I T 
? 
BEGIN 
WITH COTCB'.BSTCB DO                        _SET INDEX TO TCB          ?
  BEGIN 
  BSHCIN := FALSE;                          _CLEAR CONNECT TRIGGER FLAG?
  IF BSCNFST = C7ENABLED                    _CHECK STATUS IS ENABLED   ?
  THEN
   IF BSRCNFPEND = FALSE                    _ IF NOT RECONFIGURING TERM?
   THEN 
    BEGIN 
    IF BSSTATE = D4IPOSS                    _CHECK STATE CON POSSIBLE  ?
    THEN
      BEGIN 
      IF BSDEVTYPE = N1CON                  _CONSOLE OR PASSIVE DEVICE ?
      THEN
_ 
****  ATTEMPT CONNECTION INITIATION FOR CONSOLE DEVICE
? 
        BEGIN 
        IF BSSHN = 0                        _CHECK A HOST SELECTED     ?
        THEN
          PNNOTIFY (H2NHNSEL,COTCB)         _TELL USER TO SELECT       ?
        ELSE
          BEGIN                             _BEFORE INITIATING A CONSOL?
          IF BSLCBP'.BZTIPTYPE " N1X25      _THAT HAS PASSIVE DEVICES  ?
          THEN                              _WE MUST CHECK THE PASSIVE ?
            BEGIN                           _DEVICES TO MAKE SURE THEY ?
            COLLCB := BSCHAIN;              _ARE NOT CONNECTED AND     ?
            WHILE COLLCB " NIL DO           _THEY FOLLOW THE CONSOLE   ?
             BEGIN                          _WHEN IT RECONNECTS        ?
             IF COLLCB'.BSTCB.BSCONSOLE = COTCB 
             THEN 
              IF COLLCB'.BSTCB.BSCNFST = C7ACTIVE 
              THEN
                BEGIN                       _ELSE WE WILL MAKE THE     ?
                PNCNTMR(COPTIME,COLLCB);    _CONSOLE WAIT TILL THEN    ?
                END;
             COLLCB := COLLCB'.BSTCB.BSCHAIN; _NEXT DEVICE ON TCB CHAIN?
             END; _ WHILE .. ?              _IF ALL TCBS PASS THEN     ?
            END; _ NOT AN X25 TCB ? 
          PN2CONNECT;                       _ATTEMPT CONNECTION        ?
          END; _ BSSHN " 0 ?
        END 
      ELSE
_ 
****  ATTEMPT CONNECTION INITIATION FOR PASSIVE DEVICE
? 
        BEGIN 
        IF BSCONSOLE'.BSTCB.                _CHECK CONNECTION OF OWNING?
           BSSTATE = D4ICONF                _CONSOLE IS CONFIRMED      ?
        THEN
          BEGIN 
          BSSHN := BSCONSOLE'.BSTCB.BSHN;   _CONNECTION ATTEMPT IS TO  ?
          PN2CONNECT;                       _HOST OF THE OWNING CONSOLE?
          END;
        END;
_ 
****  PROCESS OR IGNORE ANY OTHER CONDITIONS
? 
      END _IF BSSTATE = D4IPOSS?
    ELSE
      BEGIN                                 _CANNOT ATTEMPT CONNECTION ?
      IF BSDEVTYPE " N1CON                  _CHECK IF PASSIVE DEVICE   ?
      THEN
        PNCNTMR (COPTIME,COTCB);            _RETRY CONNECTION ATTEMPT  ?
      END;
    END _ BSRCNFPEND = FALSE ?
   ELSE _ BSRCNFPEND = TRUE ? 
    BEGIN 
    IF BSDEVTYPE = N1CON                    _SHIP CONSOLES HAD AS A    ?
    THEN
      PNNOTIFY (H2RECONFIG,COTCB);          _DIAGNOSTIC                ?
    END; _ ELSE BSRCNFPEND AND BSSTATE = C7ENABLED ?
  END; _WITH COTCB'.BSTCB DO? 
END; _PROCEDURE PNCNINIT? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNDISCONNECT                                     * 
*                                                                     * 
*        PERFORM TCB DISCONNECT                                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNDISCONNECT REQUESTS CONNECTION TERMINATION ON AN     * 
*              AN ESTABLISHED CONNECTION, AND #REMEMBERS# A DISCONNECT* 
*              IF RECEIVED ON A CONNECTION CURRENTLY IN THE PROCESS   * 
*              OF BEING INITIATED.                                    * 
*                                                                     * 
** INPUT -     TCB                                                    * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNTCB      - PROCESS TCB EVENT                         * 
*              PNCNDELINK - DELINK CONNECTION                         * 
*                                                                     * 
** OUTPUT -    TCB STATE CHANGE                                       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBXFER - TRANSFER CONTROL TO PNSMGEN TO BUILD AN       * 
*                       UPLINE SERVICE MESSAGE                        * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNDISCONNECT(TCBPTR : B0BUFPTR);
CONST 
  XRC    = P4;                              _ RC POSITION IN SM BUFFER ?
BEGIN 
WITH TCBPTR'.BSTCB DO                       _ WITH TCB                 ?
  CASE BSSTATE OF 
    D4IPREQ:                                _ INIT REQUESTED BY PROCESS?
      BSSTATE := D4TPEND;                   _ STATE = TERM PENDING     ?
  
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******?
*IF DEF,X25 
    D4ILREQ:                                _ INIT REQUESTED BY LINK   ?
      BEGIN 
      WITH DWWLENTRY.CMSMLEY DO 
        BEGIN 
        CMPOINT  := PBGET1BF(BEDBSIZE);     _ GET BUFFER FOR SM        ?
        CMWKCODE := D0X25;
        CMDATA   := D5ICAA; 
        CMPTR    := BSLCCBPTR;              _ LCCB POINTER             ?
        CMPOINT'.BIINT[1] := $0F0C;         _ UPLINE SM LENGTH         ?
        CMPOINT'.BFDATAC[XRC] := CHR(BSRC); _ PLACE RC IN BUFFER       ?
        PBLSPUT(DWWLENTRY,BYWLCB[B0SMWL]);
        END;  _ WITH DWWLENTRY.CMSMLEY  ? 
      END;
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
  
    D4ICONF:  
      BEGIN 
      GENPFC          := D8TCN;             _ GET PFC                  ?
      GENSFC.DHINT    := D9TA;              _ DUMMY SFC                ?
      GENSUP          := BSRC + 8;          _ GET RESPONSE CODE        ?
      GENPAR.BABUFPTR := TCBPTR;            _ GET TCB POINTER          ?
      WITH BRTNJUMP[C1PNSMGEN] DO           _ SEND TERMINATE REQUEST   ?
        PBXFER(JENTADDR, JPAGEVAL);         _ VIA SM GENERATOR         ?
      BSSTATE := D4TPREQ;                   _ TERM REQUESTED BY PROCESS?
      END;
    D4IPOSS:                                _THIS IS A SPECIAL CASE    ?
      BEGIN 
      IF BSCNFST = C7ENABLED                _IF THE TERMINAL IS STILL  ?
      THEN                                  _ENABLED AND AN HC IVT CMD ?
        IF BSHCIN = TRUE                    _HAS BEEN ENTERED WITH NO  ?
        THEN                                _CONNECTION ESTABLISHED    ?
          WITH DWWLENTRY.CMSMLEY DO         _THEN SHIP OURSELVES A     ?
            BEGIN                           _WORKLIST TO               ?
            CMWKCODE := D0TCB;              _INITIATE THE CONNECTION   ?
            CMDATA   := D5CONN; 
            CMPTR    := TCBPTR; 
            PBLSPUT (DWWLENTRY,BYWLCB[B0SMWL]); 
            END; _WITH DWWLENTRY.CMSMLEY ?
      END;                                  _END SPECIAL CASE          ?
    END;  _ CASE BSSTATE OF  ?
END; _ PNDISCONNECT ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNDLTCB                                          * 
*                                                                     * 
*        DELETE TCB                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNDLTCB DELETES A TCB AND RETURNS THE BUFFER(S) TO THE * 
*              FREE BUFFER POOL.  IT ALSO DECREMENTS THE TCB COUNT IN * 
*              THE LCB, AND CHANGES LCB CONFIGURE STATE IF LAST TCB   * 
*              IS DELETED.  THE ADDRESS OF THE NEXT CHAINED TCB IS    * 
*              RETURNED IN THE CALLING PARAMETER.                     * 
*                                                                     * 
** INPUT -     TCB TO BE DELETED                                      * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
               PNTCB - PROCESS TCB EVENT                              * 
*                                                                     * 
** OUTPUT -    TCB BUFFER RETURNED TO BUFFER POOL                     * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              ADDR     - GET ADDRESS OF A MODULE                     * 
*              PBREL1BF - RELEASE A BUFFER                            * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNDLTCB(VAR TCB : B0BUFPTR);
  
VAR 
      I         : INTEGER;                  _LOOP COUNTER              ?
      J         : INTEGER;                  _LOOP COUNTER              ?
      LSGOT     : BOOLEAN;                  _PBLSGET RESULT            ?
      X         : B0BUFPTR;                 _LOCAL TCB FRAGMENT PTR    ?
      LCBPTR    : BZLCBP;                   _LOCAL LINE POINTER        ?
      DTBUFSIZE : BECTPTR;                  _TCB BUF CONTROL BLK PTR   ?
      TCBLNTH   : INTEGER;                  _LENGTH OF TCB             ?
      TCBPTR    : B0BUFPTR;                 _POINTER TO TCB            ?
      PREV      : B0BUFPTR;                 _CHAIN VARIABLES           ?
      CURR      : B0BUFPTR;                 _CHAIN VARIABLES           ?
      SMPTR     : B0BUFPTR;                 _VALUES FOR POSSIBLE RECON ?
      OLDHCIN   : BOOLEAN;                  _VALUES FOR POSSIBLE RECON ?
      OLDSHN    : INTEGER;                  _VALUES FOR POSSIBLE RECON ?
      OLDBSCODE  : INTEGER;                 _VALUES FOR POSSIBLE RECON ?
      OLBSCA     : INTEGER;                 _VALUES FOR POSSIBLE RECON ?
      OLDBSTA    : INTEGER;                 _VALUES FOR POSSIBLE RECON ?
      LCD       : INTEGER;                  _TEMP POINTER TO LCD       ?
      FRAG      : B0BUFSIZES;               _FRAGMENTED BUF SIZE INDEX ?
      TABLE     : ARRAY[1..8] OF B0BUFSIZES;_INDEX OF BUFFER SIZES     ?
VALUE 
      TABLE = (B0S0,B0S1,B0S1,B0S2,B0S2,B0S2,B0S2,B0S3);
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PN2RCCHAIN                                        *
*                                                                     * 
*        PROCESS CHAIN OF CNF/RC SVM MESSAGES FROM CS                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PN2RCCHAIN DEALS WITH TCBS BEING RECONFIGURED.         * 
*              IF A TCB IS BEING RECONFIGURED IT WILL HAVE BEEN       * 
*              PROCESSED BY PNRCNF WHICH SHIPS A CNF/RECON MSG TO CS. * 
*              WHEN CS RESPONDS THE MESSAGE IS ADDED TO THE CHAIN AND * 
*              A A0SMDLTCB WILL BE SHIPPED TO THE TIP IF BSRCNFP IS   * 
*              TRUE AND BSCNFST IS ENABLED OR ACTIVE.                 * 
*              WHEN THE TIP RESPONDS THE SELECTED HOST NODE AND BSCHIN* 
*              FLAGS WILL BE APPENDED TO THE RECONFIGURATION MESSAGE  * 
*              IN AN APPROPRIATE FORMAT IF APPLICABLE.  THE OLD TCB   * 
*              WILL BE RELEASED, THE NEW TCB BUILT, AND A WORK LIST   * 
*              WILL BE SHIPPED TO THE TIP.                            * 
*                                                                     * 
** INPUT -     B0BUFPTR OF CNF/RECON RESPONSE FROM CS                 * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNDLTCB     - PROCESS DELETION OF TCB                  * 
*                                                                     * 
** OUTPUT -    TCB BUILT AND WORKLIST ENTRY WILL BE SENT TO TIP       * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED :                                        * 
*               1)                                                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PN2RCCHAIN; 
_ 
** PROCEDURE NAME  - P N 3 R C D E L
* 
** OVERVIEW        - THIS PROCEDURE REMOVES THE MSG FROM THE CHAIN
* 
** INPUT           - SMPTR POINTS TO MSG TO REMOVE FROM CHAIN 
* 
** OUTPUT          - UPDATED CHAIN OF CS RESPONSES
? 
PROCEDURE PN3RCDEL; 
BEGIN 
CURR := SMPTR;                              _IF MSG TO DELETE IS AT    ?
IF CURR = RCNFHEAD                          _HEAD OF CHAIN             ?
THEN                                        _THEN                      ?
  BEGIN                                     _RESET RCNFHEAD POINTER    ?
  RCNFHEAD := RCNFHEAD'.BCCHAINS[QCHN]; 
  IF RCNFHEAD = NIL                         _IF THIS IS THE ONLY ENTRY ?
  THEN                                      _THEN CLEAR                ?
    RCNFTAIL := NIL;                        _THE TAIL POINTER          ?
  END 
ELSE                                        _ELSE THE MSG MAY BE IN THE?
  IF RCNFHEAD " NIL                         _CHAIN IF THERES A CHAIN   ?
  THEN
    BEGIN 
    PREV := RCNFHEAD;                       _SAVE POINTER TO MSG       ?
    LSGOT := TRUE;
    REPEAT
      IF PREV'.BCCHAINS[QCHN] = CURR        _THAT POINTS TO MSG TO BE  ?
      THEN
        LSGOT := FALSE
      ELSE
        IF PREV'.BCCHAINS[QCHN] = NIL       _DELETED.  IT WILL CHAIN TO?
        THEN
          LSGOT := FALSE
        ELSE
          PREV := PREV'.BCCHAINS[QCHN]; 
    UNTIL LSGOT = FALSE;
  
    IF PREV'.BCCHAINS[QCHN] = CURR          _IF WE FOUND THE MSG       ?
    THEN                                    _RECHAIN IT                ?
      PREV'.BCCHAINS[QCHN]
        := CURR'.BCCHAINS[QCHN];
  
    END; _ ELSE CURR NOT = RCNFHEAD ? 
END; _ PROCEDURE PN3RCDEL ? 
_$J+? 
_ 
****     S T A R T   P R O C E D U R E   P N 2 R C C H A I N
? 
BEGIN 
PN3RCDEL;                                   _REMOVE MSG FROM CHAIN     ?
    IF LCBPTR'.BZAUTO                       _IF THIS IS AN AUTOREC LINE?
    THEN                                    _THEN SPECIAL CASE CODE SET?
      BEGIN                                 _AND SUBTIP                ?
      SMPTR'.BFDATAC[CSET] := CHR(OLDBSCODE);         _CURRENT CODE SET?
      SMPTR'.BFDATAC[STIP] := CHR(LCBPTR'.BZSUBTIP) ; _ AND SUBTIP     ?
      END; _ IF BZAUTO ?
SMPTR'.BFDATAC[CA] := CHR(OLBSCA);          _STORE CLUSTER AND TERMINAL?
SMPTR'.BFDATAC[TA] := CHR(OLDBSTA);         _ADDRESSES IN CONFIG MSG   ?
IF OLDHCIN                                  _SPECIAL CASE RECONFIGURE  ?
THEN                                        _WHILE SWITCHING HOSTS     ?
  IF OLDSHN " 0                             _DEFEND AGAINST HOST NODE 0?
  THEN
    BEGIN 
    CURR := SMPTR;                          _FIND END OF CNF/RC MSG    ?
    WHILE CURR'.BCCHAINS[DBUFLENGTH] " NIL
      DO CURR := CURR'.BCCHAIN[DBUFLENGTH]; 
    IF CURR'.BFLCD > J1LST64 - 4            _IF BUFFER HAS NO ROOM FOR ?
    THEN                                    _TWO EXTRA PARAMETERS      ?
      BEGIN                                 _GET ANOTHER BUFFER        ?
      PREV := CURR;                         _AND                       ?
      CURR := PBGET1BF (BEDBSIZE);          _CHAIN IT TO EXISTING      ?
      PREV'.BCCHAINS[DBUFLENGTH] := CURR;   _BUFFER                    ?
      CURR'.BFLCD := DN;                    _PRESET BUFFER EMPTY       ?
      CURR'.BFFCD := DN;
      END;
    LCD := CURR'.BFLCD; 
    CURR'.BFDATAC[LCD + 1] := CHR(FNAUTOC); _FN FOR AUTOCON            ?
    CURR'.BFDATAC[LCD + 2] := CHR(1);       _FV EQUAL TRUE             ?
    CURR'.BFDATAC[LCD + 3] := CHR(FNSHN);   _FN FOR SELECTED HOST NODE ?
    CURR'.BFDATAC[LCD + 4] := CHR(OLDSHN);  _FV FROM OLD TCB AT POINT  ?
    CURR'.BFLCD := CURR'.BFLCD + 4;         _IN TIME OF RECON RESET LCD?
    END; _ IF OLDHCIN AND SHN NOT = 0 ? 
PNSMTECNF (SMPTR);                          _GO GET THAT NEW TCB       ?
END; _ PROCEDURE PN2RCCHAIN ? 
_ 
** PROCEDURE NAME  - P N 2 R C F I N D T C B
* 
** OVERVIEW        - WHEN PROCESSING THE A0DELTCB WORK LIST ENTRY FROM
*                    THE TIP THIS PROCEDURE WILL FIND THE CNF/RC IN THE 
*                    CHAIN BY TERMINAL NAME 
* 
** INPUT           - X IS THE ADDRESS OF THE TERMINAL CONTROL BLOCK 
* 
** OUTPUT          - SMPTR WILL BE SET TO THE APPROPRIATE CS RESPONSE 
*                    IF ANY 
? 
PROCEDURE PN2RCFINDTCB; 
CONST    TN = 20;                           _OFFSET IN SVMMSG TO NAME  ?
BEGIN 
SMPTR := NIL;                               _ASSUME MSG WONT BE FOUND  ?
CURR := RCNFHEAD;                           _START SEARCH AT TOP       ?
REPEAT
  IF CURR " NIL                             _IF LINE MATCH FOUND       ?
  THEN
    BEGIN                                   _CHECK TERMINAL NAME CHAR  ?
    I := 0; 
    REPEAT
      IF CURR'.BFDATA[TN+I] =               _IF ENTIRE NAME MATCHES    ?
         X'.BSTCB.BSTNAME[I]
      THEN
        I := I + 1                          _I GOES TO 7               ?
      ELSE
        I := -1;
    UNTIL (I < 0) ! (I > 6);
    IF I > 6
    THEN
      BEGIN                                 _AND                       ?
      SMPTR := CURR;                        _SMPTR RETURNS MATCHING MSG?
      CURR := NIL;                          _SETS COMPLETION CONDITION ?
      END                                   _ELSE                      ?
    ELSE
      CURR := CURR'.BCCHAINS[QCHN];         _TEST NEXT MSG IN THE CHAIN?
    END;
UNTIL CURR = NIL; 
END; _ PROCEDURE PN2RCFINDTCB ? 
_$J+? 
_ 
****  S T A R T   P R O C E D U R E   P N D L T C B 
? 
BEGIN 
IF TCB " NIL                                _IF TCB EXISTS             ?
THEN
  BEGIN 
  LCBPTR := TCB'.BSTCB.BSLCBP;              _GET LINE POINTER          ?
  WITH TCB'.BSTCB,                          _WITH TCB, AND             ?
       LCBPTR' DO                           _ITS LCB,                  ?
    BEGIN 
    BZTCBCNT := BZTCBCNT - 1;               _DECREMENT LINE#S TCB COUNT?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******?
*IF DEF,X25 
    IF BZTIPTYPE = N1X25                    _ IF X25 LINE              ?
    THEN
      BEGIN 
      IF BSLCCBPTR " NIL                    _ IF LCCB CONNECTED        ?
      THEN
        BEGIN 
        X := BZSLCBPTR'.BZXSLCB.BZGRPTCB    _ ORIGINAL TCB POINTER     ?
                        [BSLCCBPTR'.LCCB.LCCNTYPE]; 
        X'.BSTCB.BSACSVC :=                 _ DECREMENT LCCB COUNT     ?
                X'.BSTCB.BSACSVC - 1; 
        X'.BSTCB.BSENSVC :=                 _ INCREMENT ENABLED SVC CNT?
                X'.BSTCB.BSENSVC + 1; 
  
        BSLCCBPTR'.LCCB.LCTCBPTR := NIL;    _ CLEAR POINTER IN LCCB    ?
        BSLCCBPTR                := NIL;    _ CLEAR POINTER IN TCB     ?
        END;
      IF BSXTOCON                           _IF CONNECT TIMEOUT PENDING?
      THEN
        PNXRMOVWLE(TCB);                    _REMOVE WLE FROM SVM QUEUE ?
      END  _ IF BZTIPTYPE = N1X25  ?
    ELSE
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
      IF (BZTCBCNT = 0) &                   _AND NO MORE TCBS ON LINE  ?
         (BZCNFST  = C7ACTIVE)              _AND LINE WAS ACTIVE       ?
      THEN
        BZCNFST := C7ENABLED;               _CHANGE LINE TO ENABLED    ?
_ 
* * * *   REMOVE TCB FROM STATUS, NOTIFY AND BROADCAST QUEUES 
? 
    FOR I := D6STAT TO D6BRDCST DO          _FOR STATUS AND BROADCAST  ?
      BEGIN 
      FOR J := DYLISTCB[I].BYCNT DOWNTO 1 DO  _FOR ALL ENTRIES IN QUEUE?
        WITH DWWLENTRY.CMSMLEY DO 
          BEGIN 
          LSGOT := PBLSGET (DWWLENTRY,      _GET NEXT WORK ENTRY       ?
                            DYLISTCB[I]); 
          IF CMCBP = TCB                    _CHECK IF TCB MATCH        ?
          THEN
            BEGIN                           _YES WLE FOR THIS TCB      ?
            IF I = D6BRDCST                 _CHECK IF BROADCAST        ?
            THEN
              WITH CMBMSG' DO               _SET INDEX TO MESSAGE      ?
                IF BIINT[B9UC] = 1          _CHECK IF LAST USE OF MSG  ?
                THEN
                  PBREL1BF(CMBMSG,BEDBSIZE)      _YES RELEASE THE MSG  ?
                ELSE
                  BIINT[B9UC] := BIINT[B9UC] - 1;   _NO DECREMENT COUNT?
            END _IF CMCBP = TCB?
          ELSE                              _WLE NOT FOR THIS TCB      ?
            PBLSPUT (DWWLENTRY,             _JUST REQUEUE THE WLE      ?
                     DYLISTCB[I]);
          END; _WITH DWWLENTRY.CMSMLEY DO?
      END; _FOR I := D6STAT TO D6BRDCST DO? 
    PBPURGEQUE (TCB,K4BOTH);                _PURGE BOTH QUEUE          ?
    X   := TCB;                             _POINTER TO TCB            ?
    TCB := BSCHAIN;                         _RETURN NEXT TCB IN CHAIN  ?
    SMPTR := NIL;                           _SMPTR WILL POINT TO RECON ?
    IF BSRCNFPEND                           _RESPONSE FROM CS IF THIS  ?
    THEN                                    _TCB IS BEING RECONFIGURED ?
      BEGIN                                 _SAVE SELECTED HOST NODE   ?
      OLDHCIN := BSHCIN;                    _AND SWITCHING AUTO CON    ?
      OLDSHN  := BSSHN;                     _INFORMATION IF IT WAS SET ?
      OLDBSCODE := BSCODE;                  _SAVE OLD CODE SET IF AUTO ?
      OLBSCA  := BSCA;                      _ SAVE CLUSTER ADDRESS     ?
      OLDBSTA := BSTA;                      _ SAVE TERMINAL ADDRESS    ?
      PN2RCFINDTCB;                         _GO FIND CS RESPONSE IF ANY?
      END;
_ 
* * * *  RELEASE TCB BUFFER LOGIC 
? 
    TCBLNTH := TCBLENGTH[BJTIPTYPT[BZTIPTYPE].BJTCBSIZE]; 
    TCBPTR  := X;                           _POINTER TO TCB            ?
    REPEAT
    BEGIN 
      FRAG   := TABLE[TCBLNTH DIV 8];       _INDEX OF BUFF FRAG TO REL ?
      X'.BCCHAINS[BUFLENGTH[FRAG]] := NIL;  _CLEAR BUFFER CHAIN ADDR   ?
      ADDR(BECTLBK[FRAG],DTBUFSIZE);        _BUFFER CONTROL BLOCK PTR  ?
      PBREL1BF (X,DTBUFSIZE);               _RELEASE BUFFER            ?
      TCBLNTH := TCBLNTH - BUFLENGTH[FRAG]; _CALCULATE REMAINING LENGTH?
      X       := TCBPTR + BUFLENGTH[FRAG];  _POINTER TO NEXT FRAGMENT  ?
      TCBPTR  := X;                         _ANOTHER PTR TO NEXT FRAG  ?
    END;
    UNTIL TCBLNTH = 0;                      _UNTIL ALL FRAGS RELEASED  ?
    IF SMPTR " NIL                          _IF THIS TCB WAS BEING     ?
    THEN                                    _RECONFIGURED THEN GO DO SO?
      PN2RCCHAIN; 
_ 
* * * *  CHECK IF WE ARE TO NOTIFY THE TIP THAT LINE IS DISABLED
? 
    IF BZTCBCNT = 0                         _IF NO TCB(S) ON THE LINE  ?
    THEN
      BEGIN 
      IF BZCNFPEND = FALSE                  _AND CONFIGURATION NOT     ?
      THEN                                  _PENDING                   ?
        BEGIN 
        IF BZSMCNTRL                        _AND SVM CONTROLLING LINE  ?
        THEN
          BEGIN 
          WITH DWWLENTRY.CMSMLEY DO         _USING WORKLIST ARRAY      ?
            BEGIN                           _LINE INITIALIZER          ?
            CMWKCODE := A0SMDA;             _DISABLE THE LINE          ?
            CMLINO := BZLINO;               _PASS LINE NUMBER          ?
            PBPUTYP (DWWLENTRY);            _PASS WORKLIST TO TIP      ?
            END; _ WITH DWWLENTRY... ?
          END; _ BZSMCNTRL ?
        END; _ BZCNFPEND ?
      END; _ BZTCBPTR = NIL ? 
    END; _ WITH TCB,LCB ? 
  END;
END; _ PNDLTCB ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNCNDLT                                          * 
*                                                                     * 
*        DELETE CONNECTION TABLE ENTRY                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  IF THE TCB HAS A NON NIL LLCB AND NON ZERO CONNECTION  * 
*              NUMBER, THEN THE ENTRY FOR THAT CN IS REMOVED FROM THE * 
*              LLCB#S CONNECTION DIRECTORY.  IF LAST CONNECTION, THE  * 
*              LLCB STATE IS CHANGED TO ENABLED.                      * 
*                                                                     * 
** INPUT -     TCB                                                    * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
               PNCNDELINK - DELINK CONNECTION                         * 
*                                                                     * 
** OUTPUT -    A LOGICAL CONNECTION IS DELETED                        * 
*              TCB FIELDS BSCN AND BSLLCB ARE CLEARED                 * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PN2DLT       - DELETE CONNECTION DIRECTORY ENTRY       * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNCNDLT (TCBPTR : B0BUFPTR);
  
VAR 
      DLPTR : B0BUFPTR; 
  
BEGIN 
WITH TCBPTR'.BSTCB DO                       _ WITH TCB                 ?
  BEGIN 
  IF NOT ((BSLLCB = NIL) !                  _ IF LLCB EXISTS, AND      ?
          (BSCN = 0))                       _  CN " 0                  ?
  THEN
    WITH BSLLCB'.BLLLCB.BLSPART DO          _ WITH LLCB,               ?
      BEGIN 
      DLPTR := PN2DLT(BSCN,BLCONDIR);       _ DELETE CN DIRECTORY ENTRY?
      BLCOUNT := BLCOUNT - 1;               _MAINTAIN NR OF CONNECTIONS?
      IF BLCONDIR = NIL                     _ IF CONNECTION DRCTY EMPTY?
      THEN
        IF BLCNFST = C7ACTIVE               _ IF LLCB STATE ACTIVE     ?
        THEN
          BLCNFST := C7ENABLED;             _ SET LLCB STATE ENABLED   ?
      END; _ IF CONNECTION DIRECTORY NOT EMPTY ?
  BSCN      := 0;                           _ CLEAR CN IN TCB          ?
  BSHN      := 0;                           _ CLEAR HOST NODE IN TCB   ?
  BSSTATE   := D4IPOSS;                     _ RESET CONNECTION STATE   ?
  BSTRSTATE := BTINITIAL;                   _ RESET TRANSMITTER STATE  ?
  BSRSTATE  := BRINITIAL;                   _ RESET RECEIVER STATE     ?
  BSLLCB := NIL;                            _ CLEAR TCB LLCB PTR       ?
  IF BSCNFST = C7ACTIVE                     _ IF TCB CNF STATE ACTIVE  ?
  THEN
    BSCNFST := C7ENABLED;                   _ SET CNF STATE ENABLED    ?
  IF BSLCBP'.BZRECON                        _IF THIS TCB WAS ON A RECON?
  THEN                                      _LINE THEN                 ?
    BEGIN 
    IF BSCNFST " C7DOWN                     _IF TERMINAL IS NOT DOWN   ?
    THEN
      PNRCTCB(TCBPTR);                      _RECONFIGURE THE TCB       ?
    END 
  ELSE
    IF BSHCIN                               _IF TCBS BEING SWITCHED TO ?
    THEN                                    _A NEW HOST VIA IVT CMD    ?
      BEGIN 
      IF BSCNFST " C7DISABLED               _AND IT IS NOT DISABLED    ?
      THEN
        WITH DWWLENTRY.CMSMLEY DO 
        BEGIN 
        CMWKCODE := D0TCB;                  _SEND OURSELVES A WORKLIST ?
        CMDATA   := D5CONN;                 _ENTRY TO CONNECT UP TO    ?
        CMPTR    := TCBPTR;                 _NEW HOST                  ?
        PBLSPUT (DWWLENTRY, 
                 BYWLCB[B0SMWL]); 
        END; _ WITH DWWLENTRY... ?
      END; _ IF BSHCIN ?
_ 
****  IF TCB DELETE FLAG SET - NOTIFY THE TIP 
? 
  WITH BWWLENTRY[OPS].CMSMLEY DO
    BEGIN 
    CMLINO := BSLCBP'.BZLINO;               _ SET-UP WORKLIST FOR TIP  ?
    CMPTR := TCBPTR;
    CMDATA := D5FREE;                       _ SET FOR A0TIP WORKCODE   ?
    CMWKCODE := A0TIP;
    IF BSDELTCB                             _ IF DELETING TCB          ?
    THEN
      BEGIN 
      CMWKCODE := A0SMDLTCB;                _ CHANGE WORKCODE          ?
      PBPUTYP (BWWLENTRY[OPS]);             _ NOTIFY THE TIP           ?
      END _ BSDELTCB ?
    ELSE
      BEGIN                                 _ PURGE QUEUES UP AND DOWN ?
      PBPURGEQUE (TCBPTR,K4BOTH); 
      IF BSDEVTYPE " N1CON                  _ IF NOT A CONSOLE DEVICE  ?
      THEN                                  _ PURGE DOWN-LINE QUEUE    ?
        BEGIN 
        IF (BSDEVTYPE = N1XAA) !            _ IF A-A CONNECTION        ?
           (BSDEVTYPE = N1AA) 
        THEN
          BEGIN 
          CMWKCODE := A0SMDLTCB;            _WORKCODE = DELETE TCB     ?
          BSDELTCB := TRUE;                 _SET DELETING TCB          ?
          END;
                                            _ IF NOT A-A CONNECTION    ?
        PBPUTYP (BWWLENTRY[OPS])            _ *A0TIP* D5FREE TO TIP    ?
        END 
      ELSE
        BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
        IF BSLCBP'.BZTIPTYPE = N1X25        _ IF X.25 CONSOLE DEVICE   ?
        THEN
          PNXCKCON(TCBPTR);                 _ CHECK X.25 TML CONNECTION?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
        END;
      END; _ ELSE BSDELTCB = FALSE ?
    END; _ WITH BWWLENTRY[OPS]... ? 
_ 
****  MAKE PERIODIC CHECK TO SEE IF LINE SHOULD BE DISCONNECTED 
? 
  ADDR (BSLCBP',DLPTR);                     _ GET LCB POINTER          ?
  PNTCKCON (DLPTR);                         _ CHECK IF TCB(S) CONNECTED?
  END; _ WITH TCB ? 
END; _ PNCNDLT ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNCNDELINK                                       * 
*                                                                     * 
*        DELINK A CONNECTION                                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  THE CONNECTION NUMBER IS DELETED FROM THE CONNECTION   * 
*              DIRECTORY AND THE TCB IS DISASSOCIATED FROM THE LLCB.  * 
*              AN INDICATOR IS SENT TO THE HOST-NODE-AVAILABILITY-    * 
*              DISPLAY GENERATOR (HNAD).  THE TERMINATION PROCESS FOR * 
*              ASSOCIATED BATCH DEVICES IS INITIATED.                 * 
*                                                                     * 
** INPUT -     TCB TO BE DELINKED                                     * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNTCB    - TCB EVENT WORKLIST PROCESSOR                * 
*              PNSMTCN  - TERMINATE CONNECTION SM PROCESSOR           * 
*              PNCNTERM - TERMINATE CONNECTION PROCESSOR              * 
*                                                                     * 
** OUTPUT -    HOST-OVERLOAD-IND TO HNAD GENERATOR                    * 
*              DISCONNECTED-IND TO HNAD GENERATOR                     * 
*              TCB TO USER DISCONNECT                                 * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PNHNAD       - GENERATE HNAD                           * 
*              PNDISCONNECT - USER DISCONNECT                         * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNCNDELINK(TCBPTR : B0BUFPTR);
CONST 
VAR 
      DLPTR   : B0BUFPTR;                   _ LOCAL CHAIN POINTER      ?
      DLRESP  : INTEGER;                    _ HNAD RESPONSE            ?
_ 
* * * *  START OF PNCNDELINK
? 
BEGIN 
WITH TCBPTR'.BSTCB DO                       _ WITH TCB                 ?
  IF BSCNFS = C7DOWN                        _ IF TCB IS DOWN           ?
  THEN
    PNCNDLT (TCBPTR)                        _ DELETE THE CONNECTION    ?
  ELSE                                      _ IF TCB IS NOT DOWN       ?
    CASE BSSTATE OF                         _ IF STATE IS              ?
      D4IPREQ,                              _ INIT REQUESTED BY PROCESS?
      D4ILREQ,                              _ INIT REQUESTED BY LINK   ?
      D4TPEND,                              _ TERM PENDING             ?
      D4TPREQ,                              _ TERM REQUESTED BY PROCESS?
      D4TLREQ:                              _ TERM REQUESTED BY LINK   ?
        BEGIN 
        PNCNDLT (TCBPTR);                   _ DELETE THE CONNECTION    ?
        IF (BSDEVTYPE = N1CON)              _ IF CONSOLE DEVICE        ?
        THEN
          BEGIN 
          IF NOT BSACON                     _ IF NOT AUTO CONNECT      ?
          THEN
            BEGIN 
            IF BSSTATE = D4IPREQ            _ IF INIT REQ BY PROCESS,  ?
            THEN
              DLRESP := H2HNBUSY            _  HOST BUSY MESSAGE       ?
            ELSE                            _ ELSE,                    ?
              DLRESP := H2HNDISC;           _ HOST DISCONNECTED        ?
            PNNOTIFY(DLRESP,TCBPTR);        _ SEND RESPONSE TO TERM    ?
            END; _ IF NON AUTO CONNECT CONSOLE ?
          DLPTR   := BSCHAIN;               _ POINT TO NEXT CHAINED TCB?
          WHILE DLPTR " NIL DO              _ WHILE NOT AT END OF CHAIN?
            BEGIN 
            IF (DLPTR'.BSTCB.BSCONSOLE      _ IF PASSIVE DEVICE FOUND  ?
              = TCBPTR) & 
            (DLPTR'.BSTCB.BSSTATE " D4IPOSS)_ WHICH HAS NOT BEEN       ?
            THEN                            _ DISCONNECTED,            ?
              BEGIN 
              DLPTR'.BSTCB.BSRC :=          _ PUT TERM RC INTO TCB     ?
                                 DAPASS;
              PNDISCONNECT(DLPTR);          _ DISCONNECT IT            ?
              END; _ IF PASSIVE DEVICE FOUND ?
            DLPTR := DLPTR'.BSTCB.BSCHAIN;  _ CHAIN TO NEXT TCB        ?
            END; _ WHILE DLPTR ?
          END; _ IF CONSOLE ? 
        END; _ BSSTATES ? 
      END; _ CASE BSSTATE ? 
END; _PNCNDELINK ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNCNTERM                                         * 
*                                                                     * 
*        TERMINATE TCB CONNECTION                                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNCNTERM TERMINATES A CONNECTION AFTER A #TERM# HAS    * 
*              BEEN RECEIVED FROM THE HOST.                           * 
*                                                                     * 
** INPUT -     TCB                                                    * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNTCB - PROCESS TCB WORK EVENT                         * 
*                                                                     * 
** OUTPUT -    TCN/TA/N TO SERVICE MESSAGE GENERATOR                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PNCNDELINK - DELINK A CONNECTION                       * 
*              PBXFER     - TRANSFER CONTROL TO PNSMGEN TO BUILD AN   * 
*                           UPLINE SERVICE MESSAGE                     *
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNCNTERM(TCBPTR : B0BUFPTR);
VAR 
BEGIN 
WITH TCBPTR'.BSTCB DO                       _ WITH TCB                 ?
  CASE BSSTATE OF                           _ CASE ON CONNECTION STATE ?
    D4TPREQ:                                _ TERM REQUESTED BY PROCESS?
      BSSTATE := D4TLREQ;                   _ TERM REQUESTED BY LINK   ?
    D4TLREQ,                                _ TERM REQUESTED BY LINK   ?
    D4TCOLL:                                _ TERM COLLISION           ?
      BEGIN 
      GENPFC          := D8TCN;             _ GET PFC                  ?
      GENSFC.DHSFC    := D9TA;              _ DUMMY SFC                ?
      GENSFC.DHRTYPE  := SMNORM;            _ PUT TYPE INTO SFC        ?
      GENPAR.BABUFPTR := TCBPTR;            _ GET TCB POINTER          ?
      WITH BRTNJUMP[C1PNSMGEN] DO           _ SEND TERMINATE REQUEST   ?
        PBXFER(JENTADDR, JPAGEVAL);         _ VIA SM GENERATOR         ?
      IF BSSTATE = D4TCOLL                  _ IF TERM COLLISION        ?
      THEN
        BSSTATE := D4TPREQ                  _ TERM REQUESTED BY PROCESS?
      ELSE                                  _ OTHERWISE,               ?
        BEGIN 
        PNCNDELINK(TCBPTR);                 _ DELINK THE CONNECTION    ?
        IF (BSDEVTYPE > N1CON) &            _ IF PASSIVE DEVICE        ?
           (BSDEVTYPE < N1XAA)
        THEN
          PNCNINIT (TCBPTR);                _ RE-INITIATE CONNECTION   ?
        END;                                _ ON PASSIVE DEVICES       ?
      END;
    END; _ CASE ? 
END; _ PNCNTERM ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNDNTCB                                          * 
*                                                                     * 
*        BRING A TCB DOWN                                             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNDNTCB BRINGS DOWN A TCB AFTER THE TIP HAS DETECTED   * 
*              A TERMINAL FAILURE.                                    * 
*                                                                     * 
** INPUT -     TCB TO BE BROUGHT DOWN                                 * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNTCB - PROCESS TCB WORK EVENT                         * 
*                                                                     * 
** OUTPUT -    DISCONNECT FOR CONNECTED TCB, ELSE DOWNLINE QUEUE      * 
*              PURGED.                                                * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PNDISCONNECT - PERFORM TCB DISCONNECT                  * 
*              PBPURGEQUE   - PURGE DATA QUEUES                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNDNTCB (TCBPTR : B0BUFPTR);
  
VAR 
      OLDSTATE : INTEGER;                   _CURRENT TCB STATE         ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
      PTR1     : B0BUFPTR;                  _TEMPORARY POINTER 1       ?
      PTR2     : B0BUFPTR;                  _TEMPORARY POINTER 2       ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
  
BEGIN 
OLDSTATE := TCBPTR'.BSTCB.BSCNFST;          _PICK UP CURRENT TCB STATE ?
IF OLDSTATE \ C7ENABLED                     _CURRENTLY ENABLED / ACTIVE?
THEN
  BEGIN 
  TCBPTR'.BSTCB.BSCNFST := C7DOWN;          _MARK TCB DOWN             ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
  IF TCBPTR'.BSTCB.BSLCBP'.BZTIPTYPE
                           = N1X25          _SPECIAL CASE X25          ?
  THEN
    BEGIN 
    TCBPTR'.BSTCB.BSRC     := DACLEAR;      _X25 CLEAR REQUEST/RESTART ?
    IF OLDSTATE = C7ACTIVE                  _IF CONNECTION ASSIGNED    ?
    THEN
      BEGIN 
      TCBPTR'.BSTCB.BSDELTCB := TRUE; 
      PNDISCONNECT (TCBPTR);                _INITIATE DISCONNECT       ?
      END 
    ELSE
      BEGIN 
      IF NOT TCBPTR'.BSTCB.BSCNTIMER        _IF TCB NOT ON SVM TIMER   ?
      THEN                                  _AND WE HAVE NOT ALREADY   ?
        IF NOT TCBPTR'.BSTCB.BSDELTCB       _SHIPPED AN A0DELTCB       ?
        THEN                                _TO THE TIP THEN           ?
          WITH DWWLENTRY.CMSMLEY DO         _SVM WORKLIST ARRAY        ?
            BEGIN 
            CMWKCODE := A0SMDLTCB;          _TELL TIP WE ARE DELETING  ?
            CMLINO   := TCBPTR'.BSTCB.      _PASS LINE NUMBER          ?
                        BSLCBP'.BZLINO; 
            CMPTR    := TCBPTR;             _TCB TO BE DELETED         ?
            PBPUTYP (DWWLENTRY);            _NOTIFY X25                ?
            END; _ WITH DWWLENTRY... ?
      TCBPTR'.BSTCB.BSDELTCB := TRUE;       _MARK TCB TO BE DELETED    ?
      END; _ ELSE OLDSTATE " C7ACTIVE ? 
    IF TCBPTR'.BSTCB.BSLCCBPTR " NIL        _IF THERE IS AN LCCB       ?
    THEN WITH TCBPTR'.BSTCB.BSLCCBPTR'.LCCB DO
      BEGIN 
      PTR1 := LCDPQR;                       _PACKET QUEUE IN LCCB      ?
      WHILE PTR1 " NIL DO                   _PURGE DOWNLINE DATA QUEUE ?
        BEGIN 
        PTR2 := PTR1'.BCCHAINS[QCHN];       _SAVE NEXT PACKET POINTER  ?
        PBRELZRO (PTR1, BEDBSIZE);          _RELEASE A PACKET          ?
        PTR1 := PTR2;                       _UPDATE PACKET POINTER     ?
        END;  _WHILE PTR1 " NIL ? 
      LCDPQR    := NIL;                     _CLEAR QUEUE PTR           ?
      LCDFRGCNT := 0;                       _CLEAR PACKET COUNT        ?
      END _ IF BSLCCB " NIL ? 
    END _ BZTIPTYPE = N1X25 ? 
  ELSE
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
    BEGIN 
    IF OLDSTATE = C7ACTIVE                  _TCB HAS A CONNECTION      ?
    THEN
      BEGIN 
      TCBPTR'.BSTCB.BSRC := DAHARD;         _REASON HARDWARE FAILURE   ?
      PNDISCONNECT (TCBPTR);                _DISCONNECT THE TCB        ?
      END;
    END;
  PBPURGEQUE (TCBPTR, K4DWNLN);             _PURGE DOWNLINE DATA QUEUE ?
  END;
END; _PROCEDURE PNDNTCB?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNUPTCB                                          * 
*                                                                     * 
*        BRING A TCB UP                                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNUPTCB BRINGS UP A TCB AFTER THE TIP HAS RECOVERED    * 
*              THE TERMINAL.                                          * 
*                                                                     * 
** INPUT -     TCB TO BE BROUGHT UP                                   * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNTCB - PROCESS TCB WORK EVENT                         * 
*                                                                     * 
** OUTPUT -    CONNECTION ATTEMPT FOR AUTO-CONNECT / PASSSIVE DEVICES * 
*              HOST AVAILABILITY DISPLAY FOR NON AUTO-CONNECT         * 
*              CONSOLES.                                              * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PNCNINIT - INITIATE TCB CONNECTION                     * 
*              PNNOTIFY - SEND MESSAGE TO TERMINAL                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNUPTCB (TCBPTR : B0BUFPTR);
  
BEGIN 
IF TCBPTR'.BSTCB.BSDELTCB = FALSE           _NOT TO BE DELETED         ?
THEN
  IF TCBPTR'.BSTCB.BSCNFST " C7DISABLED     _AND NOT DISABLED          ?
  THEN
    BEGIN 
    TCBPTR'.BSTCB.BSCNFST := C7ENABLED;     _TCB IN ENABLED STATE      ?
    IF TCBPTR'.BSTCB.BSDEVTYPE = N1CON      _CONSOLE DEVICE            ?
    THEN
      BEGIN 
      IF TCBPTR'.BSTCB.BSACON               _AUTO-CONNECT DEVICE       ?
      THEN
        PNCNINIT (TCBPTR)                   _INITIATE TCB CONNECTION   ?
      ELSE
        PNNOTIFY (H2HADONLY, TCBPTR);       _SEND HOST AVAILABILITY DSP?
      END 
    ELSE
      PNCNINIT (TCBPTR);                    _ATTEMPT TCB CONNECTION    ?
    END;
END; _PROCEDURE PNUPTCB?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNRCTCB                                          * 
*                                                                     * 
*        RECONFIGURE A TCB                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNRCTCB SHIPS A CNF/RC SVM MSG IN TWO CASES            * 
*              1) IF A TCB IS NOT CONNECTED TO A HOST AND THE IVT CMD * 
*              IS ENTERED                                             * 
*              2) IF A LINE IS DEFINED IN THE NCF WITH RC=Y AND A     * 
*              TCB ON THAT LINE IS DISCONNECTED FROM A HOST.          * 
*                                                                     * 
** INPUT -     TCB TO BE RECONFIGURED                                 * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNTCB  - PROCESS TCB WORK EVENT                        * 
*              PNCNDL - PROCESS CONNECTION DELETE                     * 
*                                                                     * 
** OUTPUT -    CNF/RC SHIPPED TO HOST                                 * 
*              DIAGNOSTIC MSY BE SHIPPED TO TERMINAL                  * 
*              A0SMDLTCB MAY BE SHIPPED TO TIP                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED :                                        * 
*               1) PBXFER TO PNSMGEN                                  * 
*               2) PNNOTIFY TO SHIP DIAGNOSTIC                        * 
*               3) PBLSPUT TO SHIP WORKLIST ENTRY A0SMDLTCB           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNRCTCB (TCBPTR : B0BUFPTR);
  
_   ******  CAUTION  - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
CONST 
      XBZWORD = 10;                         _BSXBZ DISPLACEMENT IN TCB ?
      SHNWORD = 17;                         _BSSHN DISPLACEMENT IN TCB ?
      UBZWORD = 19;                         _BSUBZ DISPLACEMENT IN TCB ?
      XWEWORD = 24;                         _BSXWEP DISPLACEMENT IN TCB?
      ISYWORD = 25;                         _BSISYNC DISPLACEMNT IN TCB?
  
VAR 
      GROUPTCB : B0BUFPTR;                  _POINTER TO GROUPTCB       ?
      I        : INTEGER;                   _COUNTER FOR DO LOOP       ?
*ENDIF
_  ******  CAUTION HIDDEN *ENDIF FOR X25  ******  ? 
  
BEGIN 
WITH TCBPTR'.BSTCB DO 
  BEGIN 
  IF BSCN = 0                               _IF TCB NOT CONNECTED      ?
  THEN
    BEGIN                                   _AND RECONFIGURE IS NOT    ?
    IF BSRCNFPEND = FALSE                   _ALREADY PENDING           ?
    THEN
_   ******  CAUTION  - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
      IF BSLCBP'.BZTIPTYPE = N1X25          _IF X25 LINE AND           ?
      THEN
        BEGIN 
        IF BSDEVTYPE = N1CON                _IF THIS IS A CONSOLE      ?
        THEN
          BEGIN                             _THEN FIND THE X25 GROUPTCB?
          GROUPTCB := BSLCBP'.BZSLCBPTR'.   _AND RECONFIGURE FROM IT   ?
                         BZXSLCB.BZGRPTCB 
               [BSLCCBPTR'.LCCB.LCCNTYPE];
          BSACON  :=                        _RESTORE THE AUTOCON FIELD ?
            GROUPTCB'.BSTCB.BSACON; 
          BSIPRI   :=                       _RESTORE THE PRIORITY FLD  ?
            GROUPTCB'.BSTCB.BSIPRI; 
          BSTCLASS :=                       _RESTORE THE TERMINAL CLASS?
            GROUPTCB'.BSTCB.BSTCLASS; 
          TCBPTR'.BIINT [XBZWORD] :=        _RESTORE THE BSXBZ AND     ?
                 GROUPTCB'.BIINT[XBZWORD];  _OTHER FIELDS IN THIS WORD ?
          TCBPTR'.BIINT [SHNWORD] :=        _RESTORE THE SELECTED HOST ?
                 GROUPTCB'.BIINT[SHNWORD];  _AND OTHER FIELDS          ?
          TCBPTR'.BIINT [UBZWORD] :=        _RESTORE THE UBZ AND       ?
                 GROUPTCB'.BIINT[UBZWORD];  _OTHER FIELDS IN THIS WORD ?
          TCBPTR'.BIINT [XWEWORD] :=        _RESTORE BSXWEPAY AND      ?
                 GROUPTCB'.BIINT[XWEWORD];  _OTHER FIELDS IN THIS WORD ?
          TCBPTR'.BIINT [ISYWORD] :=        _RESTORE THE BSISYNC AND   ?
                 GROUPTCB'.BIINT[ISYWORD];  _OTHER FIELDS IN THIS WORD ?
          FOR I := 1 TO 10 DO               _RESET THE IVT PORTION OF  ?
              BSX25IVT[I] :=                _TCB USING THE GROUP TCB   ?
                GROUPTCB'.BSTCB.BSX25IVT[I];
          IF BSHCIN ! BSACON                _IF TCBS BEING SWITCHED TO ?
          THEN                              _A NEW HOST VIA IVT CMD    ?
            IF BSCNFST " C7DISABLED         _OR IT IS AN AUTOCON TCB   ?
            THEN                            _AND IT IS NOT DISABLED    ?
              WITH DWWLENTRY.CMSMLEY DO 
              BEGIN 
              CMWKCODE := D0TCB;            _SEND OURSELVES A WORKLIST ?
              CMDATA   := D5CONN;           _ENTRY TO CONNECT UP TO    ?
              CMPTR    := TCBPTR;           _NEW HOST                  ?
              PBLSPUT (DWWLENTRY, 
                       BYWLCB[B0SMWL]); 
              END; _ WITH DWWLENTRY ? 
          GOTO 100;                         _EXIT PDQ                  ?
          END; _ X25 CONSOLE SPECIAL CASE ? 
        END _ X25 LINE ?
      ELSE
*ENDIF
_  ******  CAUTION HIDDEN *ENDIF FOR X25  ******  ? 
        IF CS " 0                           _IF CS IS AVAILABLE        ?
        THEN                                _THEN BUILD A CNF/RC       ?
          BEGIN                             _SEVICE MESSAGE TO CS      ?
          GENPFC         := D8CNF;
          GENSFC.DHINT   := D9RC; 
          GENSUP         := CS; 
          GENPAR.BALCBP  := TCBPTR;         _POINTER TO RECONFIG TCB   ?
          BSRCNFPEND     := TRUE;           _MARK THE TCB AS RECONFIG  ?
          WITH BRTNJUMP[C1PNSMGEN] DO       _GO BUILD THE SVM MSG      ?
            PBXFER (JENTADDR,JPAGEVAL); 
          GOTO 100;                         _AND EXIT PDQ              ?
          END  _ CS AVAILABLE ? 
        ELSE                                _IF NO CS AVAILABLE THEN   ?
          GOTO 90;                          _SEND HAD                  ?
  
    IF BSDEVTYPE = N1CON                    _IF CONSOLE ALREADY        ?
    THEN                                    _RECONFIGURING THEN        ?
      PNNOTIFY (H2RECONFIG,TCBPTR);         _SEND INFORMATIVE MSG      ?
    END _ BSCN = 0 ?
  ELSE
90: 
    IF BSDEVTYPE = N1CON                    _SEND CONSOLES A HAD       ?
    THEN                                    _DISPLAY                   ?
      PNNOTIFY (H2HADONLY,TCBPTR);
100:  
  END; _ WITH TCBPTR'.BSTCB ? 
END; _ PROCEDURE PNRCTCB ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNTCB                                            * 
*                                                                     * 
*        TCB WORKLIST EVENT HANDLER                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNTCB CALLS THE APPROPRIATE TCB PROCESS BASED ON       * 
*              CMDATA IN THE WORKLIST ENTRY.                          * 
*                                                                     * 
** INPUT -     C0TCB WORKLIST ENTRY                                   * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMWL - SVM WORKLIST PROCESSOR                        * 
*                                                                     * 
** OUTPUT -    TCB                                                    * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PNCNINIT     - INITIATE CONNECTION                     * 
*              PNDISCONNECT - REQUEST CONNECTION TERMINATION          * 
*              PNDLTCB      - DELETE TCB                              * 
*              PNCNDELINK   - DELINK CONNECTION                       * 
*              PNCNTERM     - TERMINATE CONNECTION                    * 
*              PNDNTCB      - BRING A TCB DOWN                        * 
*              PNUPTCB      - BRING A TCB UP                          * 
*              PNRCTCB      - RECONFIGURE A TCB                       * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNTCB;
BEGIN 
WITH BWWLENTRY[OPS],CMSMLEY DO              _ WITH SVM WORKLIST ENTRY  ?
  CASE CMDATA OF                            _ CASE DATA TYPE           ?
    D5CONN:                                 _ INITIATE CONNECTION      ?
      PNCNINIT(CMPTR);
    D5TERM:                                 _ TERMINATE CONNECTION     ?
      PNCNTERM(CMPTR);
    D5DELE:                                 _ DELETE TCB               ?
      PNDLTCB(CMPTR); 
    D5DELK:                                 _ DELINK CONNECTION        ?
      PNCNDELINK(CMPTR);
    D5DISC:                                 _ USER DISCONNECT          ?
      BEGIN 
      CMPTR'.BSTCB.BSRC := CMRC;            _ SAVE REASON CODE IN TCB  ?
      PNDISCONNECT(CMPTR);
      END;
    D5DOWN:                                 _ TCB FAILED               ?
      PNDNTCB(CMPTR); 
    D5UP:                                   _ TCB RECOVERED            ?
      PNUPTCB(CMPTR); 
    D5RECON:                                _ TCB TO BE RECONFIGURED   ?
      PNRCTCB(CMPTR); 
  END; _ CASE ? 
END; _ PNTCB ?
_$J+? 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******?
*IF DEF,X25 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                       PNX25CON                                      * 
*                                                                     * 
*             CONNECTION.THRU.X25 WORKLIST HANDLER                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNX25CON PROCESSES  CONNECTION INITIATION THRU X25.    * 
*              (CMWKCODE = D0X25)                                     * 
*                                                                     * 
** INPUT -     FOR CMDATA = D5ICXR                                    * 
*              A-A CALL REQUEST COMES THRU X25 CONNECTION.            * 
*              CMPOINT POINTS A BUFFER OF INCOMING CONNECTION REQUEST * 
*              PACKET.                                                * 
*              CMPTR POINTS LCCB.                                     * 
*                                                                     * 
*              FOR CMDATA = D5ICAN                                    * 
*              OUTBOUND CALL REQUEST IS ACCEPTED BY X25 CONNECTION.   * 
*              CMPOINT POINTS A BUFFER FOR USE BY SVM                 * 
*              CMPTR POINTS LCCB.                                     * 
*                                                                     * 
*              FOR CMDATA = D5ICAA                                    * 
*              OUTBOUND CALL REQUEST IS REJECTED BY X25 CONNECTION OR * 
*              BY X25TIP.                                             * 
*              CMPOINT POINTS A BUFFER IN WHICH ERROR REASON CODE IS  * 
*              PLACED AT CHARACTER POSITION XRC.                      * 
*              CMPTR POINTS LCCB.                                     * 
*                                                                     * 
*              FOR CMDATA = D5ICNR                                    * 
*              PAD INCOMING CALL IS RECEIVED.                         * 
*              CMPTR POINTS LCCB.                                     * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMWL - SVM WORKLIST PROESSOR                         * 
*                                                                     * 
** OUTPUT -    A SERVICE MESSAGE TO NAM :                             * 
*              ICN/EX/R FOR D5ICXR                                    * 
*              ICN/AP/N FOR D5ICAN                                    * 
*              ICN/AP/A FOR D5ICAA                                    * 
*              A WORKLIST ENTRY TO X25TIP :                           * 
*              A0TIP/D5ICNN                                           * 
*              A0TIP/D5ICNA                                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBGET1BF  - GET A BUFFER                               * 
*              PBFCOPY   - COPY A BUFFER                              * 
*              PBRELCHN  - RELEASE A BUFFER                           * 
*              PNGTLLCB  - GET LLCB                                   * 
*              PN2ADD    - PUT TCB PTR IN CN DIRECTORY                * 
*              PNREVERSE - SWITCH DN/SN                               * 
*              PNDLTCB   - DELETE TCB                                 * 
*              PN2DLT    - DELETE TCB PTR FROM CN DIRECTORY           * 
*              PBSWLE    - SEND A MESSAGE                             * 
*              PBPUTYP   - NOTIFY TCB                                 * 
*                                                                     * 
** NOTE -                                                             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNX25CON; 
  
CONST 
  XCN      = P3;                            _ CN POSITION IN GIVEN SM  ?
  XRC      = P4;                            _ RC POSITION IN GIVEN SM  ?
  SMA12    = P20;                           _ ADDRESS IN INBOUND SM    ?
  SMPORT   = P15;                           _ PORT FIELD IN INBOUND SM ?
  SMSNODE  = P16;                           _ S-NODE IN INBOUND SM     ?
  SMDNODE  = P17;                           _ D-NODE IN INBOUND SM     ?
  
VAR 
  TMP   : INTEGER;                          _ TEMPORARY INTEGER        ?
  AARC  : INTEGER;                          _ ERROR REASON CODE        ?
  X2LCB : BZLCBP;                           _ LCB POINTER              ?
  X3TCB : B0BUFPTR;                         _ TCB POINTER              ?
  X3LCCB : B0BUFPTR;                        _ LCCB POINTER             ?
  ICLLCB : B0BUFPTR;                        _ LLCB POINTER             ?
  MSGPTR : B0BUFPTR;                        _ MESSAGE POINTER          ?
  SFDATA : INTEGER;                         _ SFC CODE                 ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                   PNLNKTCB - LEVEL 2 PROCEDURE                      * 
*                                                                     * 
*                  ASSIGN A VALID TCB FOR A CONNECTION                * 
*                  INPUTS :                                           * 
*                          X3LCCB   :  LCCB POINTER                   * 
*                                                                     * 
*                  OUTPUTS:                                           * 
*                          X2LCB    : LCB POINTER                     * 
*                          X3TCB    : TCB POINTER (IF FOUND)          * 
*                          ICLLCB   : LLCB POINTER                    * 
*                          AARC     : ERROR REASON CODE               * 
*                          LCCB/TCB ARE LINKED                        * 
*                          AARC IS ZERO IF TCB IS ASSIGNED            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNLNKTCB; 
  
VAR 
      ICINT     : INTEGER;                  _FOR LOOP COUNTER, AND TEMP?
      ICTCBSIZE : INTEGER;                  _SIZE OF TCB               ?
      ICSIZE    : B0TCBSIZES; 
      ICGRPTCB  : B0BUFPTR;                 _ORIGINAL TCB POINTER      ?
      X2SLCB    : B0BUFPTR;                 _SUBLCB POINTER            ?
      X3DNODE   : INTEGER;                  _HOST NODE                 ?
      XAWORK    : B0OVERLAY;                _ TEMPORARY                ?
  
BEGIN 
AARC := X0RNBR;                             _NOT ENOUGH BUFFER FOR TCB ?
IF PB1BFAVAIL(B0THCT)                       _CHECK FOR TCB BUFFER      ?
THEN
  BEGIN 
  ICINT      := X3LCCB'.LCCB.LCCNTYPE;      _CONNECTION TYPE FROM LCCB ?
  X2LCB      := X3LCCB'.LCCB.LCLCBPTR;
  X2SLCB     := X2LCB'.BZSLCBPTR; 
  ICGRPTCB   := X2SLCB'.BZXSLCB.            _ORIGINAL TCB FOR THIS     ?
                           BZGRPTCB[ICINT]; _ CONNECTION TYPE          ?
  AARC := X0RSNR;                           _X.25 SUBTIP NOT AVAILABLE ?
  IF ICGRPTCB " NIL                         _ORIGINAL TCB AVAILABLE    ?
  THEN
    BEGIN 
    AARC := X0RNLR;                         _X.25 SUBTIP NOT AVAILABLE ?
    IF ICGRPTCB'.BSTCB.BSENSVC > 0          _ CHECK FOR AVAILABLE LCCB ?
    THEN
      BEGIN 
        AARC := 0;                          _CLEAR ERROR CODE          ?
_ 
* * * *  CHECK FOR HOST NODE IF INCOMING PACKET ON A - A
? 
        X3DNODE := 0;                       _DNODE ONLY FOR A-A        ?
        IF ICINT = N0XAPPL                  _A - A CONNECTION          ?
        THEN
          BEGIN 
          X3DNODE := X3LCCB'.LCCB.LCHNODE;  _HOST NODE FROM LCCB       ?
          ICLLCB  := PNGTLLCB(CKLOCNODE,    _LOOK FOR LOGICAL LINK     ?
                                  X3DNODE); _ CONTROL BLOCK            ?
          IF ICLLCB = NIL                   _LLCB NOT FOUND            ?
          THEN
            BEGIN 
            AARC := X0RRHU;                 _REMOTE HOST NOT KNOWN     ?
            END 
          ELSE
            IF ICLLCB'.BLLLCB.BLSPART.      _CHECK FOR LOGICAL LINK    ?
                        BLCNFST < C7ENABLED _ STATUS                   ?
            THEN
              BEGIN 
              AARC := X0RLLR;               _CCP LOGICAL LINK          ?
                                            _ REGULATION < ENABRED     ?
              END;
          END; _IF A-A AND INCOMING PACKET                           ?
        IF AARC = 0                         _ NO ERROR FOUND           ?
        THEN
          BEGIN 
          X3TCB := PNGETCB(X2LCB);          _GET TCB BUFFER            ?
          ICGRPTCB'.BSTCB.BSACSVC :=        _INCREMENT ACTIVE LCCB     ?
               ICGRPTCB'.BSTCB.BSACSVC + 1; _ COUNT                    ?
          ICGRPTCB'.BSTCB.BSENSVC :=        _DECREMENT ENABLED SVC CNT ?
               ICGRPTCB'.BSTCB.BSENSVC - 1; 
          ICSIZE    := BJTIPTYPT[X2LCB'.BZTIPTYPE].BJTCBSIZE; 
          ICTCBSIZE := TCBLENGTH[ICSIZE]; 
          FOR ICINT := 1 TO ICTCBSIZE DO    _COPY FIELDS FROM ORGTCB TO?
            X3TCB'.BIINT[ICINT] :=          _ REAL TCB                 ?
                    ICGRPTCB'.BIINT[ICINT]; 
          FOR ICINT := 1 TO PADMAX DO       _CLEAR PAD PAR FIELDS      ?
            X3TCB'.BSTCB.BSPADPAR[ICINT] := 0;
_ 
* * * *  COMPLETE TERMINAL NAME AND INCREASE TCB COUNT
? 
          XAWORK.BAINT            := X3LCCB'.LCCB.LCHN; 
          X3TCB'.BSTCB.BSTNAME[5] := JMCNVTO[XAWORK.BAHEX.B0H3];
          X3TCB'.BSTCB.BSTNAME[6] := JMCNVTO[XAWORK.BAHEX.B0H4];
          X2LCB'.BZTCBCNT         := X2LCB'.BZTCBCNT + 1; 
          X3TCB'.BSTCB.BSCONSOLE  := X3TCB; 
          X3TCB'.BSTCB.BSCHAIN    :=
                           X2LCB'.BZTCBPTR; _CHAIN NEW TCB INTO        ?
          X2LCB'.BZTCBPTR         := X3TCB; _ ACTIVE TCB CHAIN         ?
_ 
* * * *  LINK LCCB AND TCB
? 
          X3TCB'.BSTCB.BSLCCBPTR := X3LCCB; _LCCB LINK FROM TCB        ?
          X3LCCB'.LCCB.LCTCBPTR  := X3TCB;  _TCB LINK FROM LCCB        ?
          X3TCB'.BSTCB.BSHN      := X3DNODE; _PLACE HOST NODE IN TCB   ?
  
          END; _IF AARC = 0                                            ?
      END _ IF BSENSVC > 0 ?
    ELSE
      IF ICINT = N0XPAD                     _IF X.25 PAD SUBTIP        ?
      THEN                                  _INCREMENT CONNECTIONS     ?
        X2LCB'.BZSTIC.BZRP := X2LCB'.       _ REJECTED                 ?
                                   BZSTIC.BZRP + 1
      ELSE
        IF ICINT = N0XAPPL                  _IF A-A SUBTIP             ?
        THEN                                _INCREMENT CONNECTIONS     ?
          X2LCB'.BZSTIC.BZRA := X2LCB'.     _ REJECTED                 ?
                                     BZSTIC.BZRA + 1; 
    END; _ GROUP TCB AVAILABLE                                         ?
  END; _IF ENOUGH BUFFER FOR TCB                                       ?
  IF AARC " 0                               _IF CONNECTION REJECTED    ?
  THEN
    PBRELZRO(X3LCCB'.LCCB.LCACCTPTR,BEDBSIZE);_PAD ACCOUNTING BUFFER   ?
  
END; _ PROCEDURE PNLNKTCB                                              ?
_$J+? 
_ 
* * * *   START OF PNX25CON 
? 
  
BEGIN 
WITH BWWLENTRY[OPS].CMSMLEY DO              _ WITH IMMEDIATE ARRAY     ?
  BEGIN 
  MSGPTR := CMPOINT;                        _ SAVE MESSAGE POINTER     ?
  SFDATA := CMDATA;                         _ SAVE SFC CODE            ?
  IF SFDATA = D5ICXR                        _IF INBOUND A-A CALL REQ.  ?
  THEN
    BEGIN 
    X3TCB := PBGET1BF(BEDBSIZE);            _GET BUFFER FOR SM SET UP  ?
    X3TCB'.BFFCD := SMA12;                  _SET FCB FOR DESTINATION   ?
    PBFCOPY(MSGPTR,X3TCB);                  _COPY INFORMATION          ?
    PBRELCHN(MSGPTR,BEDBSIZE);              _RELEASE ORIGINAL BUFFER   ?
    MSGPTR := X3TCB;                        _POINTER TO NEW BUFFER     ?
    END; _ IF SFDATA = D5ICXR ? 
  
  X3LCCB := CMPTR;                          _ SET LCCB POINTER         ?
  X3TCB  := X3LCCB'.LCCB.LCTCBPTR;          _SET TCB PTR IF APPROPRIATE?
  WITH MSGPTR' DO                           _ WITH BUFFER POINTER      ?
    CASE SFDATA OF
  
    D5ICAN:                                 _ OUTBOUND A-A CALL ACCEPTD?
      BEGIN 
      IF X3TCB'.BSTCB.BSSTATE " D4ILREQ     _ IF ICN/AP RESPONSE       ?
      THEN                                  _ NOT PENDING              ?
        PBRELZRO(MSGPTR,BEDBSIZE)           _ RELEASE BUFFER           ?
      ELSE
        BEGIN 
        X3TCB'.BSTCB.BSSTATE := D4ICONF;    _ CONNECTION CONFIRMED     ?
        BFDATAC[SFC] := CHR(D9AP + $40);    _ NORMAL RESPONSE          ?
  
10: 
        BFDATAC[DN]  := CHR(X3TCB'.BSTCB.BSHN); _ DN FROM TCB          ?
        BFDATAC[SN]  := CHR(CKLOCNODE);        _ SOURCE THIS NPU       ?
        BIINT[BTPT/2 + 1] := HTCMD + $80;      _ CN AND BTPT           ?
        BFDATAC[PFC] := CHR(D8ICN);            _ SET PFC               ?
        BFDATAC[XCN] := CHR(X3TCB'.BSTCB.BSCN); _ CN FROM TCB          ?
        BFFCD        := BLOCK;                 _ SET FCB               ?
        PBSWLE(MSGPTR);                     _ SEND MESSAGE             ?
        IF SFDATA = D5ICAN                  _ IF A-A CALL ACCEPTED     ?
        THEN
          BEGIN 
          B1FLGWD.KTBLKT := HTRINIT;        _ SET FLAG WORD FOR INITR  ?
          PBULTS(X3TCB,NIL,B1FLGWD);        _ SEND UP AN INITR BLOCK   ?
          END;
        END; _IF BSSTATE = D4ILREQ ?
      END;
  
    D5ICAA:                                 _ OUTBOUND A-A CALL REJECTD?
      BEGIN 
      IF X3TCB'.BSTCB.BSSTATE = D4ILREQ     _IF ICN/AP RESPONSE PENDING?
      THEN
        BEGIN 
        BFDATAC[SFC] := CHR(D9AP + $80);    _ ICN/AP/A RESPONSE        ?
        BFDATAC[DN]  := CHR(X3TCB'.BSTCB.BSHN); _ DN FROM TCB          ?
        BFDATAC[SN]  := CHR(CKLOCNODE);        _ SOURCE THIS NPU       ?
        BIINT[BTPT/2 + 1] := HTCMD + $80;      _ CN AND BTPT           ?
        BFDATAC[PFC] := CHR(D8ICN);            _ SET PFC               ?
        BFDATAC[XCN] := CHR(X3TCB'.BSTCB.BSCN); _ CN FROM TCB          ?
        BFFCD        := BLOCK;                 _ SET FCB               ?
        PBSWLE(MSGPTR);                     _ SEND MESSAGE             ?
        PNCNDELINK(X3TCB);                  _ DELINK CONNECTION        ?
        END 
      ELSE
        PBRELZRO(MSGPTR,BEDBSIZE);          _ RELEASE BUFFER           ?
      END;  _ CASE OF D5ICAA ?
  
    D5ICNR:                                 _ INCOMING PAD CONNECTION  ?
      BEGIN 
      PNLNKTCB;                             _ ASSING TCB               ?
      IF AARC = 0                           _ IF NO ERROR FOUND        ?
      THEN
        CMDATA := D5ICNN                    _ REQUEST ACCEPTED         ?
      ELSE
        CMDATA := D5ICNA;                   _ REQUEST REJECTED         ?
  
20: 
      CMRC := AARC;                         _ SEND A0TIP/D5ICNN, ETC.  ?
      CMWKCODE := A0TIP;
      PBLSPUT(BWWLENTRY[OPS],BYWLCB[B0X25TIP]);  _ NOTIFY TIP          ?
      END;  _ CASE OF D5ICNR ?
  
    D5ICXR:                                 _ INCOMING A-A CONNECTION  ?
      BEGIN 
      PNLNKTCB;                             _ ASSIGN TCB               ?
      IF AARC = 0 
      THEN
        WITH X3TCB'.BSTCB DO
          BEGIN 
          AARC := X0RNP ;                   _ NO PATH AVAILABLE        ?
          TMP  := PN2GTCN(ICLLCB);          _ GET CONNECTION NUMBER    ?
          IF TMP " $FFFF
          THEN
            BEGIN 
            PN2ADD(TMP, ICLLCB'.BLLLCB.BLSPART.BLCONDIR, X3TCB);
                                            _PUT TCB IN CN DIRECTORY   ?
            ICLLCB'.BLLLCB.BLSPART.BLCOUNT :=   _BUMP NR OF CONNECTIONS?
               ICLLCB'.BLLLCB.BLSPART.BLCOUNT + 1;
            ICLLCB'.BLLLCB.BLSPART.BLCNFST := C7ACTIVE; 
                                            _ SET LLCB ACTIVE          ?
            BSCN    := TMP;                 _ SET CN IN TCB            ?
            BSLLCB  := ICLLCB;              _ SET LLCB POINTER IN TCB  ?
            BSCNFST := C7ACTIVE;            _ SET TCB CONN ACTIVE      ?
            BSSTATE := D4IPREQ;             _ SET PROC CONN PENDING    ?
            AARC    := 0;                   _ SET NO ERROR             ?
            BFDATAC[SMPORT]  := CHR(X2LCB'.BZLINO.BDPORT);_ PORT IN SM ?
            BFDATAC[SFC]     := CHR(D9EX);  _ SET SFC TO EX REQUEST    ?
            BFDATAC[SMSNODE] := CHR(CKLOCNODE);  _ PLACE SNODE IN SM   ?
            BFDATAC[SMDNODE] := CHR(BSHN);  _ PLACE DNODE IN SM        ?
            GOTO 10;                        _SEND SM                   ?
            END;  _ IF TMP " $FFFF     ?
          END;    _ WITH X3TCB'.BSTCB  ?
      IF AARC " 0                           _ IF ERROR FOUND           ?
      THEN
        BEGIN 
        PBRELZRO(MSGPTR, BEDBSIZE);         _ RELEASE BUFFER           ?
        CMDATA := D5ICXA;                   _INCOMING A-A CALL REJECTED?
        GOTO 20;                            _ NOTIFY TIP               ?
        END;
      END;     _ CASE OF D5ICXR    ?
    END;       _ CASE SFDATA OF    ?
  END;         _ WITH BWWLENTRY[OPS].CMSMLEY ?
END;           _ PROCEDURE PNX25CON ? 
_$J+? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMENB                                          * 
*                                                                     * 
*         PROCESS ENABLE/DISABLE SERVICE MESSAGES                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - PNSMENB IS ENTERED WHEN A ENABLE/DISABLE SERVICE MESSAGE* 
*             REQUEST IS RECEIVED. THIS PROCEDURE CONTROLS THE        * 
*             THE ENABLING/DISABLING OF: LOGICAL LINKS, LINES,        * 
*             TERMINALS, TRUNKS, AND SWITCHED VIRTUAL CIRCUITS(SVC).  * 
*             THIS PROCEDURE ALSO CONTAINS LOGIC TO ENABLE ALL:       * 
*             LOGICAL LINKS, LINES, TERMINALS AND TRUNKS THAT ARE     * 
*             CURRENTLY DISABLED.                                     * 
*             STATUS WORKLIST ENTRIES ARE BUILT AND WILL BE SERIALLY  * 
*             PROCESSED BY PNSWEPROC.                                 * 
*             IN CASE OF A *CS* MISMATCH, THE SERVICE MESSAGE IS      * 
*             IGNORED AND NOT PROCESSED.                              * 
*                                                                     * 
** INPUT -    A DOWNLINE ENABLE/DISABLE SERVICE MESSAGE WITH ONE OF   * 
*             THE FOLLOWING PFC/SFC REQUEST:                          * 
*             ENB/LL/R      ENABLE LOGICAL LINK(S)                    * 
*             DIB/LL/R      DISABLE LOGICAL LINK                      * 
*             ENB/LI/R      ENABLE LINE(S)                            * 
*             DIB/LI/R      DISABLE LINE                              * 
*             ENB/TE/R      ENABLE TERMINAL(S)                        * 
*             DIB/TE/R      DISABLE TERMINAL                          * 
*             ENB/TR/R      ENABLE TRUNK(S)                           * 
*             DIB/TR/R      DISABLE TRUNK                             * 
*             ENB/VC/R      ENABLE VIRTUAL CIRCUIT                    * 
*             DIB/VC/R      DISABLE VIRTUAL CIRCUIT                   * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*             - PNSMWL      SVM WORKLIST PROCESSOR                    * 
*                                                                     * 
** OUTPUT -   *SWE* ENTRIES TO *PNSWEPROC*                            * 
*             *A0SMEN*/*A0SMDA* WORKLIST TO TIPS/LIP/LINE INITIALIZER * 
*             *LOGL* WORKLIST ENTRIES TO *PNLINK*                     * 
*                                                                     * 
** LEVEL 2 SUBROUTINES -                                              * 
*             - PN2USTAT  - GENERATE STATUS WORKLIST ENTRIES          * 
*             - PN2DIAGCHK - CHECK FOR ON-LINE DIAGNOSTICS            * 
*             - PN2STAT - VALIDATE STATUS CHANGE                      * 
*             - PN2LLCHK - PROCESS ALL DISABLED LOGICAL LINKS         * 
*             - PN2PSTLL - POST LOGICAL LINKS                         * 
*             - PN2D9TE - ENABLE/DISABLE TERMINAL(S)                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*             - PNUSSM - MAKE STATUS WORKLIST                         * 
*             - PNGLNKWL - MAKE LINK WORKLIST                         * 
*             - PNTCKENB - CHECK IF ALL TERMINALS DISABLED            * 
*             - PBLSPUT - MAKE WORKLIST ENTRY                         * 
*             - PBLLENTR - ADD LINE TO ACTIVE TIMER                   * 
*             - PNSMBLINDWN - DISABLE LINE                            * 
*             - PBPUTYP - MAKE WORKLIST TO TIP                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMENB (SMPTR : B0BUFPTR); 
  
LABEL 
  999;
  
CONST 
  P        = 14;                            _ PORT NUMBER              ?
  N2       = 15;                            _ NODE ID *D9LL*           ?
  TN       = 20;                            _ TERMINAL NAME            ?
  LRCNORM  =  0;   _ NO EXTENUATING CIRCUMSTANCES                      ?
  LRCNOOCS =  4;   _ CANNOT DISABLE TRUNK BECAUSE NO OTHER CS          ?
                   _ ACCESSIBLE (TRUNK STATUS)                         ?
  LRCRIPNP =  5;   _ REQUIRED INTERFACE PROCESSOR NOT PRESENT          ?
                   _ (TIP, LIP, HIP : LINE, TRUNK, COUPLER STATUS)     ?
  LRCDIAG  =  7;   _ CE DIAGNOSTICS IN PROGRESS                        ?
                   _ (LINE, TRUNK STATUS)                              ?
  LRCUNACT =  8;   _ UNACTIONED COMMAND (ELEMENT ALREADY IN            ?
                   _ DESIRED STATE, OR IS A NOT CONFIGURED             ?
                   _ TERMINAL)                                         ?
  LRCNUMSVC=  9;   _ COULD NOT ENABLE/DISABLE NUMBER OF SVCS           ?
                   _ REQUESTED                                         ?
  LRCSNCON = 10;   _ SVC ARCHETYPE DEFINITION NOT CONFIGURED           ?
  VCAN     = P9;                            _ SVC ARCHETYPE NAME       ?
  VCNC     = P5;                            _ # OF SVC'S TO BE ENABLED ?
  
VAR 
  LSFC     : INTEGER;                       _ SFC                      ?
  LRC      : INTEGER;                       _ REASON CODE              ?
  LCNFST   : INTEGER;                       _ DEVICE STATUS            ?
  LPTR     : B0BUFPTR;                      _ POINTER TO DEVICE        ?
  LPORT    : INTEGER;                       _ PORT NUMBER              ?
  LN2      : INTEGER;                       _ NODE ID  - ONLY *D9LL*   ?
  LTN      : INTEGER;                       _ TERMINAL NAME            ?
  LCOUNT   : INTEGER;                       _ COUNT OF ENABLED DEVICES ?
  LDUMMY   : INTEGER;                       _ DUMMY FOR FUNCTION CALLS ?
  LLINE    : B0LINO;                        _ LINE NUMBER              ?
  I        : INTEGER;                       _ LOOP CONTROL             ?
  ISTART   : INTEGER;                       _ LOOP CONTROL             ?
  ISTOP    : INTEGER;                       _ LOOP CONTROL             ?
  LLCBP    : B0BUFPTR;                      _ GENERAL STRUCTURE POINTER?
  LENB     : BOOLEAN;                       _ ENABLE/DISABLE FLAG      ?
  LLCB1    : BOOLEAN;                       _ LLCB EXISTS              ?
  LLCB2    : BOOLEAN;                       _ LLCB EXISTS              ?
  LREVERSE : BOOLEAN;                       _ REVERSE DN-SN IN LLCB    ?
  LWK      : ARRAY [BOOLEAN] OF INTEGER;    _ DISABLE/ENABLE WORKCODE  ?
  
VALUE 
  LWK      = (A0SMDA,A0SMEN); 
  
_ 
** PROCEDURE NAME - P N 2 U S T A T 
* 
** OVERVIEW       - THIS PROCEDURE CALLS *PNUSSM* TO MAKE A STATUS
*                   WORKLIST ENTRY BACK TO THE SERVICE MODULE.
* 
** INPUT(S)       - PARAMETER(S) ARE PASSED VIA LEVEL 1 VARIABLES 
*                   LCNFST - NEW CONFIGURATION STATE
*                   LRC    - REASON CODE
*                   LSFC   - TYPE OF UNSOLICIATED STATUS DEVICE 
*                   LPTR   - POINTER TO APPROPRIATE STRUCTURE 
? 
PROCEDURE PN2USTAT; 
  
VAR 
  LLPTR : B0BUFPTR; 
  
BEGIN 
LLPTR := LPTR;                              _ GET POINTER TO LOCAL     ?
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******? 
*IF DEF,HLIP
IF LSFC = D9TR                              _ IF REPORTING ON TRUNK    ?
THEN
  BEGIN 
  LLPTR := LPTR'.BZZLCB.BZTCBPTR;           _ PASS TRUNK POINTER       ?
  LLPTR'.TRKCB.TRCNFST := LCNFST;           _ CHANGE TRUNK STATUS      ?
  END;
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
PNUSSM (LCNFST,LRC,LSFC,LLPTR); 
END; _ PROCEDURE PN2USTAT ? 
  
_ 
** FUNCTION NAME - P N 2 D I A G C H K
* 
** OVERVIEW      - THIS FUNCTION CHECK(S) TO SEE IF ON-LINE DIAGNOSTICS 
*                  ARE RUNNING ON A TRUNK OR LINE.
** INPUT(S)      - PARAMETER(S) ARE PASSED VIA LEVEL 1 VARIABLES
*                  LPTR - LINE POINTER
*                  LPORT - PORT NUMBER
* 
** LEVEL 2 SUBROUTINES
*                - PN2USTAT - MAKE STATUS WORKLIST
* 
** SPECIAL NOTE  - THIS FUNCTION DOES NOT ALWAYS RETURN TO IT'S CALLER. 
? 
FUNCTION PN2DIAGCHK (LDUMMY : INTEGER): BOOLEAN;
  
BEGIN 
PN2DIAGCHK := FALSE;                        _ SET FALSE RETURN VALUE   ?
IF LPTR'.BZZLCB.BZDIAG                      _ IF DIAGNOSTICS RUNNING   ?
THEN
  BEGIN 
  PN2DIAGCHK := TRUE;                       _ RETURN TRUE              ?
  IF LPORT " 0                              _ IF SVM MSG HAS PORT      ?
  THEN
    BEGIN 
    LRC := LRCDIAG;                         _ APPROPRIATE REASON CODE  ?
    PN2USTAT; 
    GOTO EXIT 999;
    END;
  END; _ BZDIAG ? 
END; _ FUNCTION PN2DIAGCHK ?
_ 
** FUNCTION NAME - P N 2 S T A T
* 
** OVERVIEW      - THIS FUNCTION DETERMINES WHETHER A STATUS CHANGE 
*                  IF ALLOWED.
** INPUT         - PARAMETER(S) ARE PASSED VIA LEVEL 1 VARIABLES
*                  LCNFST - CURRENT CONFIGURATION STATUS
*                  LENB   - BOOLEAN TO INDICATE ENABLE/DISABLE COMMAND
*                  LPTR   - STRUCTURE POINTER 
*                  LSFC   - TYPE OF STRUCTURE (LLCB/LCB/TCB/TRUNK)
? 
FUNCTION PN2STAT (LDUMMY : INTEGER): BOOLEAN; 
  
VAR 
  LSTAT : ARRAY [BOOLEAN] OF INTEGER; 
  
VALUE 
  LSTAT = (C7DISABLED,C7ENABLED); 
  
BEGIN 
PN2STAT := FALSE;                           _ STATUS CHANGE NOT ALLOWED?
LRC     := LRCUNACT;
IF LCNFST " LSTAT[LENB] 
THEN
  BEGIN 
  LRC := LRCRIPNP;
  IF LCNFST " C7NOTCNF
  THEN
    BEGIN 
    IF LENB 
    THEN
      BEGIN 
      LRC := LRCUNACT;
      IF LCNFST = C7DISABLED
      THEN
        BEGIN 
10: 
        LRC := LRCNORM; 
        LCNFST := LSTAT[LENB];
        PN2STAT := TRUE;
        END; _ LCNFST = C7DISABLED ?
      END 
    ELSE
      GOTO 10;
    END; _ LCNFST " C7NOTCNF ?
  END; _ LCNFST " LSTAT[LENB] ? 
END; _ FUNCTION PN2STAT ? 
_ 
** PROCEDURE NAME - P N 2 L L C H K 
* 
** OVERVIEW       - THIS PROCEDURE CONTROL(S) THE ENABLING OF ALL 
*                   DISABLED LOGICAL LINK CONTROL BLOCK.
* 
** INPUT          - PARAMETERS ARE PASSED VIA LEVEL 1 VARIABLES.
*                   LPTR - POINTER TO LLCB
* 
** LEVEL 2 SUBROUTINES
*                 - PN2STAT - CHECK IF CORRECT STATUS 
*                 - PN2USTAT - GENERATE UNSOLICITED STATUS
* 
** EXTERNAL SUBROUTINE
*                 - PNGLNKWL - GENERATE LOGICAL LINK WORKLIST 
? 
PROCEDURE PN2LLCHK; 
  
BEGIN 
LCNFST := LPTR'.BLLLCB.BLSPART.BLCNFST;     _ CURRENT LLCB STATUS      ?
IF PN2STAT (LDUMMY)                         _ IF STATUS CHANGE ALLOWED ?
THEN
  BEGIN 
  LPTR'.BLLLCB.BLSPART.BLCNFST := C7ENABLED;
  LCOUNT := LCOUNT + 1;                     _ COUNT LLCBS ENABLED      ?
  PN2USTAT;                                 _ GENERATE STATUS WORKLIST ?
  PNGLNKWL (LPTR,FALSE);                    _ GENERATE LOGICAL LINK W/C?
  END; _ IF PN2STAT ? 
END; _ PROCEDURE PN2LLCHK ? 
_ 
** PROCEDURE NAME - P N 2 P S T L L 
* 
** OVERVIEW       - THIS PROCEDURE TO CALLED TO ENABLE/DISABLE A
*                   SPECIFIC LOGICAL LINK CONTROL BLOCK 
* 
** INPUT          - NODES ID'S OF THE LLCB
*                   LEVEL 1 VARIABLES 
* 
** LEVEL 2 SUBROUTINES
*                 - PN2STAT - CHECK CONFIGURATION STATUS
* 
** EXTERNAL SUBROUTINES 
*                 - PNGLNKWL - GENERATE LOGICAL LINK WORKLIST 
? 
PROCEDURE PN2PSTLL (NODE1,NODE2 : INTEGER); 
  
BEGIN 
LPTR := PNGTLLCB (NODE1,NODE2);             _ GET LLCB                 ?
IF LPTR " NIL                               _ IF VALID - PROCESS       ?
THEN
  BEGIN 
  LCNFST := LPTR'.BLLLCB.BLSPART.BLCNFST;   _ CURRENT STATUS           ?
  IF PN2STAT (LDUMMY)                       _ IF VALID STATUS CHANGE   ?
  THEN
    BEGIN 
    LPTR'.BLLLCB.BLSPART.BLCNFST := LCNFST; _ CHANGE STATUS            ?
    IF LENB = FALSE                         _ IF DISABLING LLCB        ?
    THEN
      LPTR'.BLLLCB.BLSPART.BLTREG := 0;     _ MAKE ZERO REGULATION     ?
    PNGLNKWL (LPTR,FALSE);                  _ MAKE *D0LINK* WORKCODE   ?
    IF LREVERSE                             _ IF OTHER LLCB DOES       ?
    THEN                                    _ NOT EXIST                ?
      PNGLNKWL (LPTR,LREVERSE);             _ REVERSE THIS ONE         ?
    END; _ IF PN2STAT ? 
  PN2USTAT;                                 _ GENERATE STATUS WORKLIST ?
  END; _ LPTR " NIL ? 
END; _ PROCEDURE PN2PSTLL ? 
_ 
** PROCEDURE PN2D9TE - P N 2 D 9 T E
* 
** OVERVIEW          - THIS PROCEDURE ENABLES/DISABLES TERMINAL(S). 
* 
** INPUT(S)          - PARAMETERS ARE PASSED VIA LEVEL 1 VARIABLES
*                      LPTR - POINTER TO TCB TO BE ENABLED/DISABLED 
*                      LENB - FLAG WORD FOR ENABLE
* 
** LEVEL 2 SUBROUTINES
*                    - PN2STAT - CHECK TERMINAL CONFIGURATION STATUS
* 
** EXTERNAL SUBROUTINES 
*                    - PNTCKENB - CHECK IF ALL TERMINALS ARE DISABLED 
*                    - PBLSPUT  - MAKE WORKLIST ENTRY 
? 
PROCEDURE PN2D9TE;
  
VAR 
  LTCBDATA : ARRAY [BOOLEAN] OF INTEGER;
  
VALUE 
  LTCBDATA = (D5DISC,D5CONN); 
  
BEGIN 
WITH LPTR'.BSTCB DO                         _ USING TCB STRUCTURE      ?
  BEGIN 
  ADDR (BSLCBP',LLCBP);                     _ GET LINE ADDRESS         ?
  LCNFST := BSCNFST;                        _ CURRENT CONFIGURATION    ?
  IF LLCBP'.BZZLCB.BZTIPTYPE " N1X25        _ DO NOT PROCESS X25 TCB(S)?
  THEN
    BEGIN 
    IF PN2STAT (LDUMMY)                     _ IF VALID STATUS CHANGE   ?
    THEN
      BEGIN 
      BSCNFST := LCNFST;                    _ CHANGE STATUS            ?
      LLCBP'.BZZLCB.BZWTCENB :=             _ BUMP CONTENTION COUNTER  ?
            LLCBP'.BZZLCB.BZWTCENB + 1; 
      PNTCKENB (LLCBP);                     _ CHECK ALL TCB(S) DISABLED?
      DWWLENTRY.CMSMLEY.CMWKCODE := D0TCB;  _ TCB EVENT                ?
      DWWLENTRY.CMSMLEY.CMDATA :=           _ CONNECT OR DISCONNECT    ?
                        LTCBDATA[LENB]; 
      DWWLENTRY.CMSMLEY.CMRC  := DADISA;    _ REASON CODE              ?
      DWWLENTRY.CMSMLEY.CMPTR := LPTR;      _ TCB POINTER              ?
      IF LENB = FALSE                       _ IF DISABLING TCB         ?
      THEN
        BEGIN 
        PBLSPUT (DWWLENTRY, 
                 BYWLCB [B0SMWL]);          _D5DISC TO SVM             ?
        IF BSDEVTYPE = N1CON                _CONSOLE DEVICE            ?
        THEN
          PNNOTIFY (H2HADONLY, LPTR);       _NOTIFY DISABLED STATUS    ?
        END 
      ELSE
_ 
****  PROCESS ENABLE TCB
? 
        BEGIN 
        IF BSDEVTYPE = N1CON                _ IF CONSOLE DEVICE        ?
        THEN
          BEGIN 
          IF LLCBP'.BZZLCB.BZCNFST \        _ AND LINE ENABLED/ACTIVE  ?
                           C7ENABLED
          THEN
            BEGIN 
            IF BSACON                       _ AND IF AUTO CONNECT      ?
            THEN                            _ INITIATE CONNECTION      ?
              PBLSPUT (DWWLENTRY, 
                       BYWLCB[B0SMWL])      _ D5CONN TO SVM            ?
            ELSE
              PNNOTIFY (H2HADONLY,LPTR);    _ SEND H.A.D. ONLY         ?
            END; _ BZCNFST \ C7ENABLED ?
          END _ BSDEVTYPE = N1CON ? 
        ELSE
          BEGIN 
          IF BSDEVTYPE < N1XAA              _ IF PASSIVE DEVICE        ?
          THEN                              _ THEN ATTEMPT TO INITIATE ?
            PBLSPUT (DWWLENTRY,             _ A CONNECTION             ?
                     BYWLCB[B0SMWL]); 
          END; _ ELSE BSDEVTYPE " N1CON ? 
        END; _ ELSE LENB = FALSE ?
      LCOUNT := LCOUNT + 1;                 _ COUNT TCB(S) PROCESSED   ?
      END; _ IF PN2STAT ? 
    END; _ BZTIPTYPE " N1X25 ?
  END; _ WITH LPTR'.BSCTB ? 
END; _ PROCEDURE PN2D9TE ?
_$J+? 
_ 
****   S T A R T   P R O C E D U R E   P N S M E N B
? 
BEGIN 
WITH SMPTR' DO                              _ USING MESSAGE POINTER    ?
  BEGIN 
  LSFC  := ORD(BFDATAC[SFC]);               _ GET SECONDARY FUNCTION   ?
  LPORT := ORD(BFDATAC[P]);                 _ POSSIBLE PORT NUMBER     ?
  LN2   := ORD(BFDATAC[N2]);                _ ONLY FOR LOGICAL LINKS   ?
  LTN   := ORD(BFDATAC[TN]);                _ ONLY FOR TERMINAL(S)     ?
  LENB  := BFDATAC[PFC] = CHR(D8ENB);       _ SET COMMAND FLAG         ?
  I     := ORD(BFDATAC[SN]);                _ GET SOURCE NODE          ?
  END; _ WITH SMPTR ? 
IF I = CS                                   _ ONLY PROCESS IF FROM *CS*?
THEN
  BEGIN 
_ 
****  INITIALIZE SOME LOCAL VARIABLES 
? 
  ISTART := C0NPBL + 1;                     _ USED BY *D9LI* AND *D9TE*?
  ISTOP  := C4LCBS;                         _ DITTO                    ?
  IF LSFC = D9TR                            _ BUT IF ENB/DIB TRUNKS    ?
  THEN
    BEGIN 
    ISTART := 1;                            _ RE-ADJUST VALUES         ?
    ISTOP  := C0NPBL;                       _ STOP AT LAST TRUNK       ?
    END; _ LSFC = D9TR ?
  IF LPORT " 0                              _ CHG. VALUES IF VALID PORT?
  THEN                                      _ NUMBER INPUT             ?
    BEGIN 
    ISTART := LPORT;
    ISTOP  := LPORT;                        _ ONLY DOING 1 PORT/TRUNK  ?
    END;
  LCOUNT := 0;                              _ COUNT OF WORKLISTS MADE  ?
  LLINE.BDPORT := LPORT;
  
  CASE LSFC OF                              _ CASE ON PHYSCIAL ELEMENT ?
  
_ 
****  PROCESS LOGICAL LINK ENABLE/DISABLE 
? 
    D9LL: 
    BEGIN 
    IF LPORT = 0                            _ MULTIPLE  ENABLED LLCB(S)?
    THEN
      BEGIN 
      FOR I := 1 TO C0NCPLR DO              _ SEARCH BOTH COUPLERS     ?
        BEGIN 
        LPTR := GCLLCB[I];                  _ POINTER TO COUPLER LLCB  ?
        WHILE LPTR " NIL DO                 _ SEARCH ALL LLCB(S)       ?
          BEGIN 
          PN2LLCHK;                         _ CHECK FOR DISABLED LLCB  ?
          LPTR := LPTR'.BLLLCB.BLSPART.BLCHAIN; 
          END; _ WHILE LPTR " NIL ? 
        END; _ FOR I... ? 
      LLCBP := DELOCDN;                     _ POINTER TO NODE TABLE    ?
_ 
****  LOOK FOR ALL CONECTION DIRECTORY LLCB(S)
? 
      REPEAT
        WITH LLCBP'.BRTYP1 DO               _ POINTER TO NODE STRUCTURE?
          BEGIN 
          LPTR := PNGTLLCB (CKLOCNODE,BRID);
          IF LPTR " NIL                     _ IF TERMINAL HOST LLCB    ?
          THEN
            BEGIN 
            PN2LLCHK;                       _ SEE IF DISABLED          ?
            IF LRC = LRCNORM                _ IF LLCB WAS DISABLED     ?
            THEN
              IF BRLNKT " NLCOUPLER         _ AND NOT COUPLER LLCB     ?
              THEN
                PNGLNKWL (LPTR,TRUE);       _ REVERSE DN-SN            ?
            END; _ IF LPTR " NIL ?
          END; _ WITH LLCBP'.BRTYP1 ? 
        LLCBP := LLCBP + 2; 
      UNTIL LLCBP'.BRTYP1 = BREND;          _ SEARCH ALL NODE ID(S)    ?
      END _ LPORT = 0 ? 
_ 
****  SERVICE MESSAGE CONTAINS LLCB NODE ID'S 
? 
    ELSE
      BEGIN 
      LREVERSE := TRUE;                     _ FIND IF BOTH LLCBS EXIT  ?
      LLCB1 := PNGTLLCB(LPORT,LN2) " NIL; 
      LLCB2 := PNGTLLCB(LN2,LPORT) " NIL; 
      IF LLCB1 = LLCB2                      _ IF BOTH PRESENT          ?
      THEN                                  _ DO NOT REVERSE DN-SN     ?
        LREVERSE := FALSE;
      PN2PSTLL (LPORT,LN2);                 _ POST LLCB(S)             ?
      PN2PSTLL (LN2,LPORT); 
      END; _ ELSE LPORT " 0 ? 
    END; _ CASE D9LL ?
_ 
****  PROCESS LINE OR TRUNK ENABLE/DISABLE
? 
    D9LI, 
    D9TR: 
    BEGIN 
    FOR I := ISTART TO ISTOP DO             _ PROCESS ONE OR ALL       ?
      BEGIN 
      ADDR (CGLCBP'[I],LPTR);               _ GET ADDRESS OF LINE      ?
      WITH LPTR'.BZZLCB DO                  _ USING LINE STRUCTURE     ?
        BEGIN 
        LCNFST := BZCNFST;                  _ GET CURRENT CONFIGURATION?
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
        IF (ORD(SMPTR'.BFDATAC[P4])=1)      _IF THIS IS A LOAD FLAG CMD?
        THEN                                _THEN                      ?
          IF LSFC = D9TR                    _MAKE SURE THIS IS A TRUNK ?
          THEN
            BEGIN 
            BZTCBPTR'.TRKCB.TRIGNRLR :=     _SET THE IGNORE LOAD FLAG  ?
              NOT LENB;                     _TO NEGATION OF SERVICE MSG?
            IF NOT LENB 
            THEN                            _IF DISABLING LOAD OVER THE?
              BEGIN                         _TRUNK THEN                ?
              LRC := 0;                     _FORCE LRC SETTING AND     ?
              GOTO 100;                     _SKIP TO RETURN STATUS ONLY?
              END;
            END; _ LOAD FLAG COMMAND ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
        IF PN2DIAGCHK (LDUMMY) = FALSE      _ IF DIAGNOSTICS ACTIVE    ?
        THEN
          BEGIN 
          IF PN2STAT (LDUMMY)               _ IF CURRENT STATUS OK     ?
          THEN                              _ TO BE CHANGED            ?
            BEGIN 
            WITH DWWLENTRY.CMSMLEY DO 
              BEGIN 
              CMWKCODE := LWK[LENB];        _ *A0SMEN* OR *AOSMDA*     ?
              CMLINO   := BZLINO;           _ SETUP LINE/TRUNK NUMBER  ?
              END; _ WITH DWWLENTRY... ?
            IF NHNPUGO = NHGORCVD           _ IF GO REQUIRED AND RCVD  ?
            THEN
              BEGIN 
              IF LENB                       _ IF ENABLE COMMAND        ?
              THEN
_ 
****  PROCESS ENABLE LINE OR TRUNK COMMAND
? 
                BEGIN 
                IF LSFC = D9TR              _ IF ENABLING A TRUNK      ?
                THEN
                  PBPUTYP (DWWLENTRY)       _ SEND TO *LIP*            ?
                ELSE
                  IF BZSMCNTL               _IF SM COMMAND IN PROCESS  ?
                  THEN
                    BZSMDISC := TRUE        _CAUSE REENABLE OF LINE    ?
                  ELSE                      _BRING IT UP NOW           ?
                  BEGIN 
                  PBLSPUT (DWWLENTRY,       _ ELSE SEND LINE TO        ?
                           BYWLCB[B0LIWL]); _ LINE INITIALIZER         ?
                  PBLLENTR (BZLINO);        _ ADD TO ACTIVE LINE TIMER ?
                  END;
                LCOUNT := LCOUNT + 1;       _ COUNT LINES ENABLED      ?
                END _ IF LENB ? 
              ELSE
_ 
****  PROCESS DISABLE LINE OR TRUNK COMMAND 
? 
                BEGIN 
                IF LSFC = D9LI              _ IF DISABLING A LINE      ?
                THEN
                  BEGIN 
                  BZSMDISC := FALSE;        _ CLEAR SVM DISCONNECT     ?
                  BZWTCENB := BZWTCENB + 1; _ BUMP CONTENTION          ?
                  BZWTCCON := BZWTCCON + 1; _ COUNTER(S)               ?
                  IF BZSMCNTRL = FALSE      _ IF SVM NOT CONTROLLING   ?
                  THEN                      _ THE LINE                 ?
                    BEGIN 
                    BZSMCNTRL := TRUE;      _ TAKE CONTROL OF LINE     ?
                    PNSMBLINDWN (LPTR,DADISA); _ DISABLE THE LINE      ?
                    END;
                  END _ LSFC = D9LI ? 
                ELSE
_ 
****  BEFORE WE CAN DISABLE A TRUNK - SEE IF TRUNK IS LAST AVAILABLE
****  PATH TO SUPERVISION. IF SO ABORT THE DISABLE. 
? 
                  BEGIN 
                  LDUMMY := 0;              _ CLEAR *CS* COUNT         ?
                  LLCBP  := DESUPDN;        _ SEARCH SUPERVISION TABLE ?
                  REPEAT
                    IF LLCBP'.BRTYP1.BRCSAV _ COUNT NUMBER OF *CS*     ?
                    THEN
                      LDUMMY := LDUMMY + 1; 
                    LLCBP := LLCBP + 2;     _ GET NEXT ENTRY           ?
                  UNTIL LLCBP'.BRTYP1 = BREND;
                  LLCBP := PN1SRCH (CS,DESUPDN);
                  IF (LDUMMY > 1) !         _ IF MORE THAN 1 *CS*      ?
                     (BZTCBPTR " LLCBP)     _ OR NOT THRU THIS TRUNK   ?
                  THEN
                    PBPUTYP (DWWLENTRY)     _ SEND *A0SMDA* TO *LIP*   ?
                  ELSE
                    BEGIN 
                    LRC := LRCNOOCS;        _ REASON CODE              ?
                    LCNFST := BZCNFST;      _ RESTORE CURRENT STATUS   ?
                    END;
                  END; _ ELSE LSFC = D9TR ? 
                END; _ ELSE LENB = FALSE ?
              END; _ NHNPUGO = NHGORCVD ? 
            BZCNFST := LCNFST;              _ CHANGE LINE/TRUNK STATUS ?
            PN2USTAT;                       _ SEND STATUS              ?
            END _ IF PN2STAT ?
          ELSE
            BEGIN 
            IF LPORT " 0                    _ IF ATTEMPTING SPECIFIC   ?
            THEN                            _ PORT                     ?
100:  
              PN2USTAT;                     _ REPORT REASON            ?
            END; _ ELSE IF PN2STAT ?
          END; _ BZDIAG = FALSE ? 
        END; _ WITH LPTR'.BZZLCB ?
      END; _ FOR I... ? 
    END; _ CASE D9LI OR D9TR ?
  
_ 
****  PROCESS TERMINAL ENABLE/DISABLE 
? 
    D9TE: 
    BEGIN 
    IF LTN " 0                              _ IF TERMINAL NAME INPUT   ?
    THEN
      BEGIN                                 _ FIND SPECIFIC TERMINAL   ?
      LRC := LRCUNACT;                      _ IN CASE TE NOT FOUND     ?
      LPTR := PNFNDTCB (LLINE,SMPTR,TN);    _ LINE NUMBER AND MESSAGE  ?
      IF LPTR = NIL                         _ IF NO TCB                ?
      THEN
        BEGIN 
998:  
        LCNFST := C7NOTCNF;                 _ TERMINAL NOT CONF.       ?
        LPTR   := SMPTR;                    _ USE CURRENT BUFFER       ?
        PN2USTAT;                           _ REPORT STATUS            ?
        SMPTR  := NIL;                      _ DO NOT RELEASE BUFFER    ?
        GOTO 999;                           _ EXIT ASAP                ?
        END;
      PN2D9TE;                              _ PROCESS THE COMMAND      ?
      PN2USTAT;                             _ GENERATE STATUS WORKLIST ?
      END _ LTN " 0 ? 
    ELSE _ LTN = 0 ?
      BEGIN 
      LPORT := 0; 
      FOR I := ISTART TO ISTOP DO 
        BEGIN 
        ADDR (CGLCBP'[I],LLCBP);            _ GET LINE POINTER         ?
        IF LLCBP'.BZZLCB.BZTCBCNT " 0       _ IF TCB(S) ON THE LINE    ?
        THEN                                _ THEN CHECK THEM          ?
          BEGIN 
          LPTR := LLCBP'.BZZLCB.BZTCBPTR;   _ GET FIRST TCB            ?
          WHILE LPTR " NIL DO               _ PROCESS ALL TCB(S)       ?
            BEGIN 
            PN2D9TE;
            IF LRC = LRCNORM                _ IF TCB PROCESSED         ?
            THEN
              PN2USTAT;                     _ GENERATE STATUS WORKLIST ?
            LPTR := LPTR'.BSTCB.BSCHAIN;    _ GET NEXT TCB             ?
            END; _ WHILE ?
          END; _ BZTCBCNT " 0 ? 
        END; _ FOR I... ? 
      END; _ ELSE LTN = 0 ? 
    END; _ CASE D9TE ?
_ 
****  PROCESS SVC ENABLE/DISABLE
? 
    D9VC: 
    BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
    LRC := LRCSNCON;                        _ IN CASE SVC NOT CONFIGUR ?
    LPTR := PNFNDSVC(LLINE,SMPTR,VCAN);     _ FIND TCB FOR THIS SVC AN ?
    IF LPTR " NIL                           _ IF ARCHETYPE CONFIGURED  ?
    THEN
      BEGIN 
      WITH LPTR'.BSTCB DO                   _ USING THE GROUP TCB      ?
        BEGIN 
        LCNFST := BSCNFST;                  _ CURRENT CONFIGURATION    ?
        LRC := LRCNUMSVC;                   _ COULD NOT EN/DI # REQUEST?
        I := ORD(SMPTR'.BFDATAC[VCNC]);     _ # OF SVC'S TO EN/DI      ?
        IF LENB                             _ IF ENABLE COMMAND        ?
        THEN
_ 
****  PROCESS ENABLE SVC COMMAND
? 
          BEGIN 
          IF BSDISVC " 0                    _ IF ABLE TO ENABLE ANYMORE?
          THEN
            BEGIN 
            LRC := LRCNORM;                 _ ABLE TO PROCESS COMMAND  ?
            IF BSDISVC @ I                  _ LESSER TO BE ENABLED     ?
            THEN
              BEGIN 
              BSENSVC := BSENSVC + BSDISVC; _ ENABLE NUM OF DISABLED   ?
              BSDISVC := 0; 
              END 
            ELSE
              BEGIN 
              BSENSVC := BSENSVC + I;       _ ENABLE NUM REQUESTED     ?
              BSDISVC := BSDISVC - I; 
              END;
            END; _ BSDISVC " 0 ?
          END _ LENB = TRUE ? 
        ELSE
_ 
****  PROCESS DISABLE SVC COMMAND 
? 
          BEGIN 
          IF BSENSVC " 0                    _ IF ABLE TO DISABLE ANY   ?
          THEN
            BEGIN 
            LRC := LRCNORM;                 _ ABLE TO PROCESS COMMAND  ?
            IF BSENSVC @ I                  _ LESSER TO BE DISABLED    ?
            THEN
              BEGIN 
              BSDISVC := BSDISVC + BSENSVC; _ DISABLE NUM OF ENABLED   ?
              BSENSVC := 0; 
              END 
            ELSE
              BEGIN 
              BSDISVC := BSDISVC + I;       _ DISABLE NUM REQUESTED    ?
              BSENSVC := BSENSVC - I; 
              END;
            END; _ BSENSVC " 0 ?
          END; _ LENB = FALSE ? 
        END; _ WITH LPTR ?
      END _ LPTR " 0 ?
    ELSE                                    _ SVC ARCHETYPE NOT DEFINED?
      GOTO 998;                             _ NO GROUP TCB, EXIT       ?
    PN2USTAT;                               _ GENERATE STATUS WORKLIST ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
    END; _ CASE D9VC ?
  
    END; _ CASE OF LSFC ? 
  
  IF LPORT = 0                              _ IF MULTIPLE ENABLES      ?
  THEN
    BEGIN                                   _ SEND COUNT TO *CS*       ?
    GENPFC       := D8CDI;                  _ COUNT DISABLED ELEMENTS  ?
    GENSFC.DHINT := LSFC;                   _ TYPE OF DISABLED ELEMENTS?
    GENPAR.BAINT := LCOUNT;                 _ COUNT                    ?
    GENSUP       := CS;                     _ *CS* NODE                ?
    WITH BRTNJUMP[C1PNSMGEN] DO             _ CALL PNSMGEN TO LAUNCH   ?
      PBXFER (JENTADDR,JPAGEVAL);           _ SERVICE MESSAGE          ?
    END; _ LPORT = 0 ?
  END; _ I = CS ? 
999:  
PBRELZRO (SMPTR,BEDBSIZE);                  _ RELEASE SERVICE MSG      ?
END; _ PROCEDURE PNSMENB ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMMSG                                          * 
*                                                                     * 
*        PROCESS HOST BROADCAST SERVICE MESSAGE                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMMSG IS ENTERED WHEN A HOST BROADCAST SM IS         * 
*              RECEIVED. THE REQUEST MAY BE TO BROADCAST A MESSAGE    * 
*              TO ALL CONSOLES ON THE NPU, ON A LOGICAL LINK,ON A     * 
*              LINE, OR TO A SPECIFIC CONSOLE.                        * 
*              PNSMMSG VALIDATES THE HOST BROADCAST SM AND BUILDS     * 
*              BROADCAST WORKLIST ENTRIES, BWE(S) TO BE SERIALLY      * 
*              PROCESSED BY PNBWEPROC. THE BWE CONTAINS A POINTER     * 
*              TO THE CONSOLE TCB AND THE BROADCAST MESSAGE BUFFER    * 
*              THE DISTRIBUTION OF THE SAME MESSAGE TO MULTIPLE       * 
*              CONSOLES IS CONTROLLED BY A USE COUNT FIELD IN THE     * 
*              MESSAGE BUFFER.                                        * 
*              PNSMMSG ALSO SENDS THE RESPONSE SM (NORMAL OR ABNORMAL)* 
*              UPLINE TO CS.                                          * 
*              IN THE CASE OF A CS MISMATCH, THE REQUEST IS STILL     * 
*              PROCESSED BUT THE RESPONSE SM IS NOT ISSUED.           * 
*              IN CASE OF LOW BUFFER RESOURCES, THE SVM WORKLIST WILL * 
*              BE REQUEUED TO ENSURE LATER PROCESSING.                * 
*                                                                     * 
** INPUT -     A DOWNLINE HOST BROADCAST SM WITH ONE OF THE FOLLOWING * 
*              PFC/SFC REQUESTS :                                     * 
*              MSG/NP/R      ALL CONSOLES ON NPU                      * 
*              MSG/LL/R      ALL CONSOLES ON A LOGICAL LINK           * 
*              MSG/LI/R      ALL CONSOLES ON A LINE                   * 
*              MSG/TE/R      SINGLE CONSOLE                           * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*                                                                     * 
** OUTPUT -    1) BWE(S) FOR RECEIVING CONSOLES IF ANY.               * 
*              2) A NORMAL OR ABNORMAL RESPONSE SM TO THE CS WHICH    * 
*                 MADE THE REQUEST.                                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              1) PBLSPUT          MAKE A WORKLIST ENTRY              * 
*              2) PBBFAVAIL        CHECK FOR AVAILABILITY OF BUFFERS  * 
*              3) PBGET1BF         GET A BUFFER                       * 
*              4) PNGTLLCB         PERFORM DN, SN LOOKUP              * 
*              5) PN2SRCH          SEARCH TYPE 2 TABLE                * 
*              6) PNFNDTCB         FIND MATCHING TCB                  * 
*              7) PNREVERSE        REVERSE DN, SN OF SM               * 
*              8) PBSWLE           MAKE A WORKLIST ENTRY TO BIP       * 
*              9) PBREL1BF         RELEASE A BUFFER                   * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*              2) PNBWEPROC        BROADCAST WORK EVENT PROCESSOR     * 
*                                                                     * 
** INTERNAL SUBROUTINES -                                             * 
*              1) PN2BWLE          BUILD BWE IF ENABLED/ACTIVE CONSOLE* 
*              2) PN2BRDALLINE     PROCESS ALL TERMINALS ON A LINE    * 
*                                                                     * 
** SPECIAL NOTE -                                                     * 
*              IF TWO OR MORE BROADCAST REQUESTS ARE OUTSTANDING FROM * 
*              CS THEN IT IS POSSIBLE IN CASES OF LOW BUFFER RESOURCES* 
*              TO PROCESS THE REQUESTS OUT OF SEQUENCE.               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMMSG (SMPTR : B0BUFPTR); 
  
CONST 
      LLN1 = P3;                            _INDEXES INTO MSG/LL SM    ?
      LLN2 = P4;
      LLTL = P5;
      LLRL = P6;
      LLST = P7;
      LIP  = P3;                            _INDEXES INTO MSG/LI SM    ?
      LISP = P4;
      LILT = P5;
      LIST = P6;
      TEP  = P3;                            _INDEXES INTO MSG/TE SM    ?
      TESP = P4;
      TEA1 = P5;
      TEA2 = P6;
      TEDT = P7;
      TETN = P9;
      TETC = P16; 
      TEST = P17; 
      TEHN = P18; 
  
VAR 
      BWECNT   : INTEGER;                   _BWE COUNTER               ?
      SMSFC    : INTEGER;                   _SFC OF THE SM             ?
      SMLI     : INTEGER;                   _LINE (PORT) NUMBER        ?
      I        : INTEGER;                   _GENERAL LOOP COUNTER      ?
      MSGBFR   : B0BUFPTR;                  _PTR TO MESSAGE BUFFER     ?
      LLCB     : B0BUFPTR;                  _PTR TO LL CONTROL BLOCK   ?
      TCB      : B0BUFPTR;                  _PTR TO TCB                ?
      SMPSP    : B0LINO;                    _LINE (PORT/SUBPORT)       ?
      ABNORMAL : BOOLEAN;                   _ABNORMAL RESPONSE FLAG    ?
      WLBUILT  : BOOLEAN;                   _BWE BUILT FLAG            ?
      TXTFCD,                               _START OF TEXT IN SM       ?
      ABNLCD   : ARRAY[D9NP..D9TE]          _LCD OF ABNORMAL RESPONSES ?
                   OF INTEGER;
  
VALUE 
      TXTFCD = (P3,P5,P5,P9); 
      ABNLCD = (0,P7,P6,P18); 
  
_ 
** PROCEDURE NAME - P N 2 B W L E 
* 
** OVERVIEW       - THIS PROCEDURE CHECKS IF THE BROADCAST MESSAGE
*                   CAN BE SENT TO THE CURRENT TERMINAL AND IF SO 
*                   IT BUILDS THE BWE AND SETS THE VARIABLE WLBUILT 
*                   TO TRUE 
? 
PROCEDURE PN2BWLE;
  
BEGIN 
WITH TCB'.BSTCB DO                          _SET INDEX TO TCB          ?
  BEGIN 
  WLBUILT := FALSE;                         _SET NO WORKLIST BUILT     ?
  IF BSDEVTYPE = N1CON                      _CHECK IF A CONSOLE DEVICE ?
  THEN
    IF BSCNFST \ C7ENABLED                  _WITH ENABLED OR ACTIVE STS?
    THEN
      IF BSLOCK = FALSE                     _AND NOT LOCKING OUT MSGS  ?
      THEN
        BEGIN                               _OKAY TO BROADCAST MESSAGE ?
        DWWLENTRY.CMSMLEY.CMCBP := TCB;     _STORE TCB PTR IN BWE      ?
        PBLSPUT (DWWLENTRY,                 _BUILD BWE FOR CONSOLE     ?
                 DYLISTCB[D6BRDCST]); 
        BWECNT  := BWECNT + 1;              _BUMP BWE COUNTER          ?
        WLBUILT := TRUE;                    _SET WORKLIST BUILT FLAG   ?
        END; _IF OKAY TO BUILD BWE? 
  END; _WITH TCB'.BSTCB DO? 
END; _PROCEDURE PN2BWLE?
_ 
** PROCEDURE NAME - P N 2 B R D A L L I N E 
* 
** OVERVIEW       - THIS PROCEDURE CALLS PN2BWLE FOR EACH TERMINAL
*                   ON THE CURRENT LINE 
? 
PROCEDURE PN2BRDALLINE; 
  
BEGIN 
TCB := CGLCBP'[SMLI].BZTCBPTR;              _GET PTR TO FIRST TCB      ?
WHILE TCB " NIL DO                          _STILL MORE TCBS           ?
  BEGIN 
  PN2BWLE;                                  _MAYBE BUILD BWE FOR TERM  ?
  TCB := TCB'.BSTCB.BSCHAIN;                _GET PTR TO NEXT TCB       ?
  END; _WHILE TCB " NIL?
END; _PROCEDURE PN2BRDALLINE? 
_$J+? 
_ 
****  S T A R T   P R O C E D U R E   P N S M M S G 
? 
BEGIN 
_ 
****  SINCE THE CONTENTS OF THE BROADCAST MESSAGE MAY AFFECT THE
****  TERMINAL USER THE CHECK FOR LOW ON BUFFERS IS MADE FOR HIGH 
****  PRIORITY DATA AS TERMINALS OF THAT CLASS MAY STILL BE BEING 
****  SERVICED
? 
IF PB1BFAVAIL (B0TH2LV) = FALSE             _CHECK IF LOW ON BUFFERS   ?
THEN
  BEGIN 
  BWWLENTRY[OPS].CMSMLEY.CMTIMER := 1;      _TRY AGAIN IN 1-2 SECONDS  ?
  PBLSPUT (BWWLENTRY[OPS],                  _TIMER ENTRY FOR D0SM      ?
           BYWLCB[B0SMTMR]);
  END 
ELSE
_ 
****  PROCESS BROADCAST MESSAGE REQUEST 
? 
  BEGIN 
  MSGBFR := PBGET1BF (BEDBSIZE);            _GET A BUFFER FOR MESSAGE  ?
                                            _SET STATIC BWE FIELD      ?
  DWWLENTRY.CMSMLEY.CMBMSG := MSGBFR;       _PTR TO MESSAGE BUFFER     ?
  
  ABNORMAL := FALSE;                        _CLEAR ABNORMAL FLAG       ?
  BWECNT   := 0;                            _CLEAR BWE COUNTER         ?
  
  WITH SMPTR' DO                            _SET INDEX TO SERVICE MSG  ?
    BEGIN 
    SMSFC := ORD(BFDATAC[SFC]);             _EXTRACT THE SFC OF SM     ?
    CASE SMSFC OF                           _CASE OUT THE SFC          ?
_ 
****  1  MESSAGE TO ALL CONSOLES ON NPU 
? 
      D9NP: 
  
      BEGIN 
      FOR SMLI := (C0NPBL + 1) TO C4LCBS DO _FOR EACH LINE ON NPU      ?
        IF CGLCBP'[SMLI].BZCNFST = C7ACTIVE _CHECK IF ACTIVE LINE      ?
        THEN
          PN2BRDALLINE;                     _PROCESS ALL TERMS ON LINE ?
      END; _D9NP CASE?
_ 
****  2  MESSAGE TO ALL CONSOLES ON A LOGICAL LINK
? 
      D9LL: 
  
      BEGIN 
      LLCB := PNGTLLCB(ORD(BFDATAC[LLN2]),  _GET PTR TO LLCB           ?
                       ORD(BFDATAC[LLN1])); 
      IF LLCB " NIL                         _CHECK IF LLCB EXISTS      ?
      THEN
        WITH LLCB'.BLLLCB.BLSPART DO        _YES SET INDEX TO LLCB     ?
          BEGIN 
          IF (BLCNFST = C7ACTIVE) &         _CHECK IF LOG LINK ACTIVE  ?
              BLCDS                         _         WITH TERMINALS   ?
          THEN
            BEGIN 
            FOR I := 1 TO 255 DO            _FOR EACH POSSIBLE CN NUMB ?
              BEGIN 
              TCB := PN2SRCH (I,BLCONDIR);  _GET PTR TO TCB            ?
              IF TCB " NIL                  _CHECK IF TCB EXISTS       ?
              THEN                          _YES IT DOES               ?
                PN2BWLE;                    _MAYBE BUILD BWE FOR TERM  ?
              END; _FOR I := 1 TO 255 DO? 
            END _IF (BLCNFST = C7ACTIVE) & BLCDS? 
          ELSE
            BEGIN                           _NO LOG LINK IS NOT ACTIVE ?
            ABNORMAL := TRUE;               _SET ABNORMAL FLAG         ?
            IF BLDNHST & BLSNHST            _CHECK IF HOST/HOST LOG LNK?
            THEN
              BFDATAC[LLTL] := CHR(2)       _YES LOG LNK TYPE IS H/H   ?
            ELSE
              BFDATAC[LLTL] := CHR(1);      _NO  LOG LNK TYPE IS H/T   ?
            BFDATAC[LLRL] := CHR(BLTREG);   _STORE REGULATION LEVEL    ?
            BFDATAC[LLST] := CHR(BLCNFST);  _STORE CONFIGURATION STATUS?
            END; _IF BLCNFST = C7ACTIVE ELSE? 
          END; _WITH LLCB'.BLLLCB.BLSPART DO? 
      END; _D9LL CASE?
_ 
****  3  MESSAGE TO ALL CONSOLES ON A LINE
? 
      D9LI: 
  
      BEGIN 
      SMLI := ORD(BFDATAC[LIP]);            _GET LINE (PORT) FROM SM   ?
      IF SMLI > C0NPBL THEN                 _CHECK IF LINE IN RANGE    ?
      IF SMLI @ C4LCBS
      THEN
        WITH CGLCBP'[SMLI] DO               _YES SET INDEX TO LCB      ?
          BEGIN 
          IF BZCNFST = C7ACTIVE             _CHECK IF LINE ACTIVE      ?
          THEN
            PN2BRDALLINE                    _YES PROCESS ALL TERMS     ?
          ELSE
            BEGIN                           _NO LINE IS NOT ACTIVE     ?
            ABNORMAL := TRUE;               _SET ABNORMAL FLAG         ?
            BFDATAC[LILT] := CHR(BZLTYP);   _STORE LINE TYPE           ?
            BFDATAC[LIST] := CHR(BZCNFST);  _STORE CONFIGURATION STATUS?
            END; _IF BZCNFST = C7ACTIVE?
          END; _WITH CGLCBP'[SMLI] DO?
      END; _D9LI CASE?
_ 
****  4  MESSAGE TO A SINGLE CONSOLE
? 
      D9TE: 
  
      BEGIN 
      SMPSP.BDLINO :=                       _GET LINE (PORT/SUBPORT)   ?
          ORD(BFDATAC[TEP]) * $100
        + ORD(BFDATAC[TESP]); 
      TCB := PNFNDTCB (SMPSP,SMPTR,TETN);   _GET PTR TO MATCHING TCB   ?
      IF TCB " NIL                          _CHECK IF TCB EXISTS       ?
      THEN
        BEGIN                               _YES IT DOES               ?
        PN2BWLE;                            _MAYBE BUILD BWE FOR TCB   ?
        IF WLBUILT = FALSE                  _CHECK IF BWE NOT BUILT    ?
        THEN                                _NO A BWE WAS NOT BUILT    ?
          WITH TCB'.BSTCB DO                _SET INDEX TO TCB          ?
            BEGIN 
            ABNORMAL := TRUE;               _SET ABNORMAL FLAG         ?
            BFDATAC[TEA1] := CHR(BSCA);     _STORE ADDRESS 1           ?
            BFDATAC[TEA2] := CHR(BSTA);     _STORE ADDRESS 2           ?
            BFDATAC[TEDT] := CHR(BSDEVTYPE);_STORE DEVICE TYPE         ?
            BFDATAC[TETC] := CHR(BSTCLASS); _STORE TERMINAL CLASS      ?
            BFDATAC[TEST] := CHR(BSCNFST);  _STORE CONFIGURATION STATUS?
            BFDATAC[TEHN] := CHR(BSHN);     _STORE HOST NODE           ?
            END; _WITH TCB'.BSTCB DO? 
        END _IF TCB " NIL?
      ELSE
        BEGIN                               _NO TCB DOES NOT EXIST     ?
        ABNORMAL := TRUE;                   _SET ABNORMAL FLAG         ?
        BFDATAC[TETC] := CHR(0);            _STORE TC - UNKNOWN        ?
        BFDATAC[TEHN] := CHR(0);            _STORE HN - UNKNOWN        ?
        BFDATAC[TEST] := CHR(C7NOTCNF);     _STORE ST - NOT CONFIGURED ?
        END; _IF TCB " NIL ELSE?
      END; _D9TE CASE?
  
      END; _CASE SMSFC OF?
_ 
****  COPY TEXT FROM SERVICE MESSAGE TO MESSAGE BUFFER
? 
    BFFCD := TXTFCD [SMSFC];                _SET START OF SOURCE       ?
    MSGBFR'.BFFCD := DATA + 2;              _SET FCD OF MSG BUFFER     ?
    PBFCOPY (SMPTR, MSGBFR);                _COPY TEXT TO MSG BUFFER   ?
    BFFCD := DN;                            _RESET SOURCE FCD          ?
_ 
****  FORMAT AND SEND RESPONSE SERVICE MESSAGE TO CS
? 
    IF CS = ORD(BFDATAC[SN])                _CHECK IF CS IS STILL ALIVE?
    THEN
      BEGIN                                 _YES IT IS                 ?
      PNREVERSE (SMPTR);                    _REVERSE DN, SN OF SM      ?
      IF ABNORMAL                           _CKECK IF ABNORMAL         ?
      THEN
        BEGIN                               _YES IT IS ABNORMAL        ?
        BFLCD := ABNLCD[SMSFC];             _ADJUST LCD OF SM          ?
        BFDATAC[SFC] := CHR(SMSFC + $80);   _SET ABNORMAL RESPONSE BIT ?
        END _IF ABNORMAL? 
      ELSE                                  _NO IT IS NORMAL           ?
        BEGIN 
        BFLCD := SFC;                       _ADJUST LCD OF SVM         ?
        BFDATAC[SFC] := CHR(SMSFC + $40);   _SET NORMAL RESPONSE BIT   ?
        END; _ELSE NOT ABNORMAL?
  
      PBSWLE (SMPTR);                       _DISPATCH RESPONSE SM      ?
  
      END _IF CS = ORD(BFDATAC[SN])?
    ELSE                                    _NO OLD CS NOT AVAILABLE   ?
      PBREL1BF (SMPTR,BEDBSIZE);            _RELEASE THE ORIGINAL SM   ?
  
    END; _WITH SMPTR' DO? 
_ 
****  COMPLETE THE MESSAGE BUFFER AND SEND A D0BACTIVATE WORKLIST TO
****  THE SERVICE MODULE TO KICK OFF THE BROADCAST WORK EVENT 
****  PROCESSOR 
? 
  IF BWECNT = 0                             _CHECK IF NO BWE(S) MADE   ?
  THEN
    PBREL1BF (MSGBFR,BEDBSIZE)              _RELEASE THE MESSAGE BUFFER?
  ELSE
    BEGIN                                   _THERE WERE BWE(S) MADE    ?
    WITH MSGBFR' DO                         _SET INDEX TO MESSAGE BUF  ?
      BEGIN 
      BFFCD          := BLOCK;              _SET FCD - BLOCK           ?
      BIINT[B9UC]    := BWECNT;             _STORE USE COUNTER         ?
      BFDATAC[BTPT]  := CHR(HTMSG);         _SET BT  - MSG             ?
      BFDATAC[DBC]   := CHR($00);           _SET DBC - CONS, FE ,IVT   ?
      BFDATAC[DBC+1] := CHR(I9PSS);         _SET FE  - SINGLE SPACE PP ?
      END; _WITH MSGBFR' DO?
  
    WITH BWWLENTRY[OPS].CMSMLEY DO          _OPS INTERMEDIATE ARRAY    ?
      BEGIN 
      CMWKCODE := D0BACTIVATE;              _WAKE UP WORK CODE         ?
      PBLSPUT (BWWLENTRY[OPS],              _QUEUE WORKLIST TO SVM     ?
               BYWLCB[B0SMWL]); 
      END; _WITH BWWLENTRY[OPS].CMSMLEY DO? 
    END; _IF BWECNT = 0 ELSE? 
  END; _IF PBBFAVAIL .... = FALSE ELSE? 
END; _PROCEDURE PNSMMSG?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMOLD                                          * 
*                                                                     * 
*        REPLACE                                                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMOLD HANDLES THE RECEIPT OF ONLINE DIAGNOSTIC       * 
*              SERVICES MESSAGES FROM *CS* AND THE NPU CONSOLE DRIVER.* 
*              THIS ROUTINE WILL RETURN AN ABNORMAL REPLY IF CCP IS   * 
*              NOT CONFIGURED WITH ONLINE DIAGNOSTIC CODE.            * 
*              ASIDE FROM THE INITIATION REQUEST SERVICE MESSAGE, ALL * 
*              SERVICE MESSAGES ARE VECTORED TO THE ONLINE DIAGNOSTIC * 
*              CODE, WHICH VALIDATES MESSAGE CONTENT AND FORMATS      * 
*              RESPONSES TO *CS* OR THE CONSOLE DRIVER.               * 
*                                                                     * 
** INPUT    -  SERVICE MESSAGES                                       * 
*                OLD/IN - REQUEST ONLINE DIAGNOSTICS FROM *CS*        * 
*                OLD/DT - ONLINE DIAGNOSTICS DATA FROM *CS*           * 
*                OLD/TM - TERMINATE ONLINE DIAGNOSTICS FROM *CS*      * 
*                OLD/NP - COMMUNICATION MECHANISM FOR PASSING INFO    * 
*                         FROM CONSOLE INPUT TO ONLINE DIAGNOSTIC CODE* 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMWL -   TO PROCESS SERVICE MESSAGES FROM *CS*       * 
*              CNSLINPT - ROUTINE IN CONSOLE DRIVER - OLD MESSAGES    * 
*                         ARE ROUTED FROM THE CONSOLE DRIVER TO THE   * 
*                         ONLINE DIAGNOSTICS CODE THROUGH THE SERVICE * 
*                         MODULE WITH AN INTERNAL SFC OF *D9NP*.      * 
*                                                                     * 
** OUTPUT -    SERVICE MESSAGE RESPONSE(S) TO *CS*                    * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              - PBXFER - TRANSFER TO *PDSTTR* - ONLINE DIAGNOSTICS   * 
*              - PBSWLE - SWITCH MESSAGE TO *BIP*                     * 
*              - PNREVERSE - REVERSE DN AND SN OF SERVICE MESSAGE     * 
*                                                                     * 
** SPECIAL NOTE -                                                     * 
*              THIS ROUTINE CONTAINS *DEF CODE                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMOLD(SMPTR  :  B0BUFPTR);
  
VAR 
  BFSFC : INTEGER;
  
BEGIN 
  WITH SMPTR' DO
  BEGIN 
  BFSFC := ORD(BFDATAC[SFC]); 
_  ******  CAUTION - HIDDEN *IF DEF,OLDSYS  ******  ? 
*IF DEF,OLDSYS
  IF 0 = BYWLCB[B0DGWL].BYPRADDR            _IF OLD NOT AVAILABLE      ?
  THEN
    BEGIN 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR ONLINE DIAGNOSTICS  ******  ?
    BFDATAC[SFC] := CHR(BFSFC+$80);         _ABNORMAL RESPONSE         ?
_  ******  CAUTION - HIDDEN *IF DEF,OLDSYS  ******  ? 
*IF DEF,OLDSYS
    END 
  ELSE                                      _ELSE                      ?
    BEGIN 
    IF D9IN = BFSFC                         _FOR OLD/IN                ?
    THEN
      BFDATAC[SFC] := CHR(D9IN+$40)         _NORMAL RESPONSE           ?
    ELSE                                    _OTHERWISE                 ?
      BEGIN 
      B1BUFF := SMPTR;
      WITH BRTNJUMP[C1PDSTTR] DO            _CALL PDSTTR               ?
        PBXFER(JENTADDR,JPAGEVAL);
      END;  _ELSE ? 
    END;  _ELSE ? 
  END;  _WITH SMPTR'  ? 
  IF D9TM = BFSFC 
  THEN
    PBREL1BF(SMPTR,BEDBSIZE)                _NO MSG FOR OLD/TM         ?
  ELSE                                      _FOR OLD/IN OR OLD/DT      ?
  IF D9NP " BFSFC THEN                      _IF NOT FROM CONSOLE       ?
    BEGIN 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR ONLINE DIAGNOSTICS  ******  ?
    PNREVERSE(SMPTR);                       _SWITCH DN/SN              ?
    PBSWLE(SMPTR);                          _SEND MESSAGE              ?
    END;  _ELSE  ?
END; _ PROCEDURE PNSMOLD ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMREG                                          * 
*                                                                     * 
*        POST RECEIVED REGULATION SERVICE MESSAGES (REG/LL)           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMREG HANDLES THE RECEIPT OF REG/LL REGULATION       * 
*              SERVICE MESSAGES GENERATED BY OTHER NPU(S) IN THE      * 
*              NETWORK. THE LOGICAL LINK CONTROL BLOCK IS POSTED      * 
*              WITH THE LINK REGULATION LEVEL, A LINK WORKLIST IS     * 
*              GENERATED TO *PNLINK* TO ANALYZE THE EFFECTIVE LOGICAL * 
*              LINK REGULATION LEVEL AND A SUPERVISION CHECK IS       * 
*              PERFORMED.                                             * 
*                                                                     * 
** INPUT -     REG/LL SERVICE MESSAGE                                 * 
*                                                                     * 
** OUTPUT -    *LOGL* LINK WORKLIST GENERATED TO *PNLINK*             * 
*              *BLREG* - THE LINK REGULATION LEVEL POSTED IN THE      * 
*                        LOGICAL LINK CONTROL BLOCK                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS-                                          * 
*                - PNGTLLCB           GET LLCB ADDRESS                * 
*                - PNGLNKWL           GENERATE A LINK WORKLIST        * 
*                - PNCSUPCHG          CHECK SUPERVISION CHANGE        * 
*              WORKLIST ENTRIES MADE TO-                              * 
*                - PNLINK             PROCESS LLCB REGULATION CHANGE  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMREG (SMPTR : B0BUFPTR); 
  
CONST 
  REG  = 14;                                _ BYTE - REGULATION LEVEL  ?
  LLDN = 15;                                _ BYTE - LLCB DN           ?
  LLSN = 16;                                _ BYTE - LLCB SN           ?
  LCS  = 17;                                _ BYTE - CS NODE           ?
  LNS  = 18;                                _ BYTE - NS NODE           ?
  
VAR 
  DNID  : INTEGER;
  SNID  : INTEGER;
  SNREG : B0OVERLAY;
  PTR   : B0BUFPTR; 
  LLCS  : INTEGER;
  LLNS  : INTEGER;
  
BEGIN 
WITH SMPTR' DO
_ 
****  GET REG/LL CONTENTS TO LOCAL VARIABLES
? 
  BEGIN 
  DNID := ORD(BFDATAC[LLDN]);               _ LOGICAL DN NODE          ?
  SNID := ORD(BFDATAC[LLSN]);               _ LOGICAL SN NODE          ?
  LLCS := ORD(BFDATAC[LCS]);                _ NODE ID OF CS            ?
  LLNS := ORD(BFDATAC[LNS]);                _ NODE ID OF NS            ?
  SNREG.BA1CHAR := BFDATAC[REG];            _ REGULATION LEVEL         ?
  END; _ WITH SMPTR ? 
PTR := PNGTLLCB (DNID,SNID);                _ GET LOGICAL LINK CB      ?
IF PTR " NIL                                _ IF LINK EXISTS           ?
THEN
_ 
****  POST RECEIVED REGULATION LEVEL AND CHECK SUPERVISION CHANGE 
? 
  BEGIN 
  WITH PTR'.BLLLCB.BLSPART DO 
    BEGIN 
    BLREG := SNREG.BACPOW.BAREG;            _ POST REGULATION LEVEL    ?
    PNGLNKWL (PTR,FALSE);                   _ GENERATE LINK WL ENTRY   ?
    PNCSUPCHG (SNID,SNREG);                 _ CHECK SUPERVISION CHG    ?
    BLCS := LLCS = DNID;                    _ SET CS BEING USED        ?
    BLNS := LLNS = DNID;                    _ SET NS BEING USED        ?
    END; _ WITH PTR'.BLLLCB.BLSPART ? 
  END; _ PTR " NIL ?
PBRELZRO (SMPTR,BEDBSIZE);                  _ DISCARD THE BUFFER       ?
END; _ PROCEDURE PNSMREG ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNGETCB                                          * 
*                                                                     * 
*        GET A TCB BUFFER OF THE PROPER SIZE                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNGETCB GETS A BUFFER LARGE ENOUGH FOR THE REQUIRED    * 
*              TCB AND RELEASES ANY UNUSED BUFFER-SIZED FRAGMENTS     * 
*              BACK TO THE FREE BUFFER POOL.                          * 
*                                                                     * 
** INPUT -     LCB ADDRESS                                            * 
*              TIP TYPE TABLE                                         * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMCONF - CONFIGURE SERVICE MESSAGE HANDLER           * 
*                                                                     * 
** OUTPUT -    TCB ADDRESS                                            * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              ADDR  - GET AN ADDRESS                                 * 
*              PBCLR - CLEAR A BUFFER                                 * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PNGETCB _(LCBPTR : BZLCBP): B0BUFPTR ?;
VAR 
       TCBPTR  : B0BUFPTR;                  _TCB POINTER               ?
       SVMCTL  : BECTPTR;                   _BUFFER CONTROL BLK PTR    ?
       TCBSIZE : B0TCBSIZES;                _SIZE OF TCB               ?
       PTR1    : B0BUFPTR;                  _POINTER TO FRAGMENT       ?
       PTR2    : B0BUFPTR;                  _POINTER TO FRAGMENT       ?
       EXTRA   : INTEGER;                   _AMOUNT OF EXTRA BUFF SPACE?
       FRAG    : B0BUFSIZES;                _SIZE INDEX FOR BUFF FRAG  ?
       TABLE   : ARRAY[1..3] OF B0BUFSIZES; _INDEX OF BUFFER SIZES     ?
VALUE 
       TABLE   = (B0S0,B0S1,B0S0);
BEGIN 
TCBSIZE := BJTIPTYPT[LCBPTR'.BZTIPTYPE]     _SIZE OF TCB FROM TIP TYPE ?
                    .BJTCBSIZE;             _ TABLE                    ?
IF TCBSIZE @ B0TS3                          _IF TCB  FITS INTO 32 WORDS?
    THEN                                    _THEN                      ?
  ADDR(BECTLBK[B0S2],SVMCTL)                _ADDRESS 32 WORD BUFFER    ?
ELSE                                        _ELSE                      ?
  ADDR(BECTLBK[B0S3],SVMCTL);               _ADDRESS OF 64 WORD BUFFER ?
TCBPTR := PBGET1BF(SVMCTL);                 _GET INITIAL TCB BUFFER    ?
PBCLR(TCBPTR,SVMCTL'.BEMSK.BAINT + 1);      _CLEAR BUFFER              ?
_ 
     *****  FRAGMENT AND RELEASE ANY EXTRA BUFFER SPACE  *****
? 
EXTRA  := SVMCTL'.BEMSK.BAINT + 1           _CALCULATE EXTRA BUFF SPACE?
                    - TCBLENGTH[TCBSIZE]; 
PTR1    := TCBPTR + SVMCTL'.BEMSK.          _POINTER TO FRAG TO RELEASE?
                     BAINT + 1 - EXTRA; 
PTR2    := PTR1;                            _ANOTHER POINTER TO FRAG   ?
WHILE EXTRA " 0 DO
BEGIN 
  FRAG := TABLE[EXTRA DIV 8];               _INDEX INTO BUFLENGTH      ?
  ADDR(BECTLBK[FRAG],SVMCTL);               _ADDR OF CONTROL BLOCK     ?
  PBREL1BF(PTR1,SVMCTL);                    _RELEASE BUFFER            ?
  EXTRA := EXTRA-BUFLENGTH[FRAG];           _RECALCULATE EXTRA LENGTH  ?
  PTR1  := PTR2 + BUFLENGTH[FRAG];          _POINTER TO NEXT FRAGMENT  ?
  PTR2  := PTR1;                            _ANOTHER PTR TO NEXT FRAG  ?
END;
PNGETCB := TCBPTR;                          _SET FUNCTION TO TCB ADDRES?
END; _ PNGETCB ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMTECNF
*                                                                     * 
*        CONFIGURE SERVICE MESSAGE HANDLER                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMTECNF PROCESSES CONFIGURE TERMINAL SERVICE MESSAGES
*              RESPONSES IF THE LINE IS STILL UP.                     * 
*              NORMAL RESPONSE ACTION IS TO GET A TCB, PUT THE DEFAULT* 
*              VALUES INTO IT, THEN PROCESS THE FN/FV PAIRS FROM THE  * 
*              SERVICE MESSAGE.                                       * 
*              THE ABNORMAL RESPONSE AND THE CONFIGURE ERROR CONDITION* 
*              CAUSE A DISABLE LINE WORKLIST ENTRY TO BE MADE TO THE  * 
*              TIP, ANY AUTO RECOGNITION AND QUEUED TCB BUFFERS TO BE * 
*              RELEASED, THE LINE CONFIGURE STATE TO BECOME DISABLED  * 
*              (NONACTIVE), AND THE CONFIGURE PENDING FLAG TO BE RESET* 
*                                                                     * 
** INPUT -     CNF/TE SERVICE MESSAGE                                 * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMCNF      - CONFIGURE PFC PROCESSOR 
*              PNDLTCB      - DELETE TCB PROCESSOR
*                                                                     * 
** OUTPUT -    INITIALIZED TCB                                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              ADDR     - PUT ADDRESS INTO VARIABLE                   * 
*              PNGETCB  - GET A NEW TCB                               * 
*              PBXFER   - CALL A PAGED ROUTINE                        * 
*              PBPUTYP  - MAKE WORKLIST ENTRY TO TIP                  * 
*              PNTCKENB - CHECK FOR ALL TERMINALS DISABLED            * 
*              PNTCKCON - CHECK IF TERMINAL(S) CONNECTED TO HOST      * 
*              PNSMBLINDWN - DISABLE THE LINE                         * 
*              PBRELZRO - RELEASE BUFFER CHAIN                        * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMTECNF(VAR SMPTR:B0BUFPTR);
  
CONST 
  TFENAB  = 0;                              _ ENABLED STATUS           ?
  P       = 14;                             _ PORT NUMBER              ?
  DT      = 18;                             _ DEVICE TYPE              ?
  TN      = 20;                             _ TERMINAL NAME            ?
  TC      = 27;                             _ TERMINAL CLASS           ?
  ST      = 28;                             _ TERMINAL STATUS          ?
  LAST    = 29;                             _ LAST CNF/TE ON LINE      ?
  TCFN    = 34;                             _ FIELD NUMBER FOR TC      ?
  LRC     = 2;                              _ REASON CODE FOR DISABLE  ?
  
VAR 
  TFSFC   : DHSFCTYPE;                      _ SFC OVERLAY              ?
  TFLCB   : BZLCBP;                         _ LOCAL LCB POINTER        ?
  I       : INTEGER;                        _ LOOP CONTROL             ?
  LASTCNF : BOOLEAN;                        _ LAST CNF/TE RECEIVED     ?
  TFTC    : INTEGER;                        _ TEMP. CELL FOR TC        ?
  TFDT    : INTEGER;                        _ TEMP. CELL FOR DEVICE TYP?
  TFTIPT  : INTEGER;                        _ TEMP. CELL FOR TIP TYPE  ?
  TFPTR   : B0BUFPTR;                       _ LOCAL BUFFER POINTER     ?
  TFPOINT : B0BUFPTR;                       _ LOCAL BUFFER POINTER     ?
  TSCTB1  : ARRAY [N1ASYNC..N13270] OF INTEGER; 
  TSCTB2  : ARRAY [N1ASYNC..N13270] OF INTEGER; 
  TCTBL1  : ARRAY [N1ASYNC..N1BSC] OF INTEGER;
  TCTBL2  : ARRAY [N1ASYNC..N1BSC] OF INTEGER;
  
VALUE 
  TSCTB1  = (SCAN2741,SCMD4A,SCHPOST,SCXPAD,SCB2780,
             0,0,0,0,0,0,0,0,0,SCB3270);
  TSCTB2  = (SCA2741,SCMD4C,SCHPRE,SCXUSER,SCB3780);
  TCTBL1  = (N0M33,N0200UT,N0HASP,N0M33,N02780);
  TCTBL2  = (N02741,N0714,N0HPRE,N0M33,N03780); 
_ 
** PROCEDURE NAME - P N 2 T E L L T I P 
* 
** OVERVIEW       - THIS PROCEDURE IS CALLED TO CALL THE TIP(S) TCB 
*                   INITIALIZATION EXTENSION -- IF ANY -- AND TO GENERATE 
*                   AN *A0SMTCB* WORKCODE TO THE TIP. 
* 
** INPUT          - TFLCB - LINE CONTROL BLOCK
*                   B1TCB - TERMINAL CONTROL BLOCK
? 
PROCEDURE PN2TELLTIP; 
  
BEGIN 
IF BJTIPTYPE[TFTIPT].BJTCBEINIT " 0         _ IF TIP HAS A TCB         ?
THEN                                        _ INITIALIZATION ROUTINE   ?
  PBXFER(BJTIPTYPE[TFTIPT].BJTCBEINIT,      _ CALL IT                  ?
         BJTIPTYPE[TFTIPT].BJTCBPINIT); 
_ 
****  SEND *A0SMTCB* WORKCODE TO TIP
? 
WITH DWWLENTRY.CMSMLEY DO 
  BEGIN 
  CMWKCODE := A0SMTCB;
  CMLINO   := TFLCB'.BZLINO;                _ PASSING LINE NUMBER      ?
  CMPTR    := B1TCB;                        _ AND TCB POINTER          ?
  PBPUTYP (DWWLENTRY);
  END; _ WITH DWWLENTRY... ?
END; _ PROCEDURE PN2TELLTIP ? 
_ 
** PROCEDURE NAME - P N 2 A C O N 
* 
** OVERVIEW       - THIS PROCEDURE IS CALLED TO SEND A DOTCB/D5CONN 
*                   WORKLIST ENTRY TO THE SERVICE MODULE IF THE NEW TCB IS
*                   AN AUTOCON CONSOLE OTHERWISE IT WILL NOTIFY A CONSOLE 
*                   WITH A HOST AVAILABILITY DISPLAY
* 
** INPUT          - B1TCB - TERMINAL CONTROL BLOCK
* 
? 
PROCEDURE PN2ACON;
BEGIN 
IF B1TCB'.BSTCB.BSDEVTYPE = N1CON 
THEN
  IF B1TCB'.BSTCB.BSACON  _ IF AUTO - CONNECT        ?
  THEN
_ 
****  SEND CONECTION WORKCODE TO SVM FOR AUTO-CONNECT TERMINAL(S) 
? 
    BEGIN 
    WITH DWWLENTRY.CMSMLEY DO 
      BEGIN 
      CMWKCODE := D0TCB;
      CMDATA   := D5CONN; 
      CMPTR    := B1TCB;
      PBLSPUT (DWWLENTRY,BYWLCB[B0SMWL]); 
      END; _ WITH DWWLENTRY... ?
    END 
  ELSE
    PNNOTIFY (-H2HADONLY,B1TCB);
END; _PROCEDURE PN2ACON ? 
_ 
****  S T A R T    P R O C E D U R E   P N S M T E C N F
? 
BEGIN 
WITH SMPTR' DO
  BEGIN 
      ADDR(CGLCBP'[ORD(BFDATAC[P])],TFLCB); 
      TFSFC.DHCHAR := BFDATAC[SFC];         _ SEE IF ABNORMAL REPLY    ?
      IF TFSFC.DHRTYPE = SMNORMAL           _ IF NORMAL RESPONSE       ?
      THEN
_ 
****  GET A TCB AND START STUFFING PARAMETERS INTO IT 
? 
        BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
        IF TFLCB'.BZTIPTYPE = N1X25         _ IF X25 GET 64 BUFFER     ?
        THEN
          BEGIN 
          D0CB := PBGET1BF (BEDBSIZE);
          PBCLR (D0CB,DBUFLENGTH);
          D0CB'.BSTCB.BSPADPAR[1] := $FFFF; _DEFAULT PAD PAR OPTION    ?
          END 
        ELSE
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
          D0CB := PNGETCB (TFLCB);
        WITH D0CB'.BSTCB DO 
          BEGIN 
          BSLCBP    := TFLCB;               _ LCB POINTER INTO TCB     ?
          TFLCB'.BZSUBTIP := ORD(BFDATAC[STIP]);
          TFTIPT    := TFLCB'.BZTIPTYPE;    _ GET TIP TYPE             ?
          BSSECHAR := TSCTB1[TFTIPT];       _DEFAULT SECURITY CHARACTER?
          IF TFLCB'.BZSUBTIP > 1            _ SUB-TIP .GT. 1           ?
          THEN
            BSSECHAR := TSCTB2[TFTIPT];     _ USE SECOND TABLE         ?
          BSCONSOLE := D0CB;                _ ASSUME CONSOLE DEVICE    ?
          BSDEVTYPE := ORD(BFDATAC[DT]);    _ DEVICE TYPE              ?
          IF BSDEVTYPE > N1CON              _ IF NOT CONSOLE           ?
          THEN
            IF BSDEVTYPE < N1XAA            _ AND LESS THAN A TO A     ?
            THEN
              BSBATCH := TRUE;              _ THEN MUST BE BATCH       ?
          BSCODE    := ORD(BFDATAC[CSET]);  _ CODE SET                 ?
          BSCA      := ORD(BFDATAC[CA]);    _ CLUSTER ADDRESS          ?
          BSTA      := ORD(BFDATAC[TA]);    _ TERMINAL ADDRESS         ?
          BSCNFST   := C7DISABLED;          _ ASSUME DISABLED          ?
          IF ORD(BFDATAC[ST]) = TFENAB      _ BUT IF ENABLED           ?
          THEN
            BSCNFST := C7ENABLED;           _ CHANGE IT                ?
          FOR I := 0 TO 6 DO                _ MOVE IN TERMINAL         ?
            BSTNAME[I] := BFDATAC[TN+I];    _ NAME                     ?
          LASTCNF := BFDATAC[LAST] " CHR(0);
          TFTC    := ORD(BFDATAC[TC]);
_ 
****  IF TERMINAL CLASS ZERO - MOVE IN DEFAULT TERMINAL CLASS.
? 
          IF TFTC = 0                       _ IF NO TERMINAL CLASS     ?
          THEN
            BEGIN 
            TFTC   := TCTBL1[TFTIPT];       _ GET DEFAULT TERMINAL CL  ?
            IF TFLCB'.BZSUBTIP > 1          _ BUT IF SUB-TIP .GT. 1    ?
            THEN
              TFTC := TCTBL2[TFTIPT];       _ USE SECOND TABLE         ?
            END; _ TFTC = 0 ? 
_ 
****  MOVE TERMINAL CLASS INTO CNF/TE BUFFER AND LET *PNCONFIGURE*
****  PROCESS IT AS A TERMINAL CLASS CHANGE.
? 
          BFDATAC[LAST]   := CHR(TCFN);     _ FIELD NUMBER             ?
          BFDATAC[LAST+1] := CHR(TFTC);     _ TERMINAL CLASS           ?
          BSTCLASS        := TFTC;          _ PLACE VALID TC IN TCB    ?
          BFFCD           := LAST;          _ ADVANCE FCD              ?
          D0IVT           := FALSE;         _ REAL BUFFER PRESENT      ?
          D0BFR           := SMPTR;         _ BUFFER POINTER           ?
_ 
****  IF CNF/TE CONTAINS MORE THAN 1 BUFFER - ADJUST FOR *PNCONFIGURE*
? 
          TFPTR           := SMPTR; 
          WHILE TFPTR'.BCCHAINS[DBUFLENGTH] " NIL DO
            BEGIN 
            I            := TFPTR'.BFLCD;   _ GET CURRENT LCD          ?
            TFPTR'.BFLCD := I - 1;          _ DECREMENT LCD            ?
            TFTC         := ORD(TFPTR'.BFDATAC[I]); 
            TFPTR        := TFPTR'.BCCHAINS[DBUFLENGTH];
            I            := TFPTR'.BFFCD;   _ GET NEXT BUFFER FCD      ?
            TFPTR'.BFFCD := I-1;            _ AND INCREMENT IT         ?
            TFPTR'.BFDATAC[I-1] := CHR(TFTC); 
            END; _ WHILE LOOP ? 
          D0FDT           := D0TCBFDT;      _ TCB FIELD DESC. TBL      ?
          TFDT            := BSDEVTYPE;     _ DEVICE TO TEMP CELL      ?
          IF TFDT > N1PLOT                  _ IF A TO A DEVICE         ?
          THEN
            TFDT := N1CON;                  _ USE CONSOLE ACTION TBL   ?
          D0AT := BJTIPTYPE[TFTIPT] 
                    .BJJAT[TFDT]; 
          PBXFER (BRTNJUMP[C1PNCONF].JENTADDR,
                  BRTNJUMP[C1PNCONF].JPAGEVAL); 
          END; _ D0CB'.BSTCB ?
        IF CONFIGOK = D3AC                  _ IF NO ERROR(S)           ?
        THEN
_ 
****  NO ERROR(S) AFTER *PNCONFIGURE* - CONTINUE TO PROCESS 
? 
          BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
          IF TFTIPT = N1X25                 _ BUT IF X25 LINE          ?
          THEN
            BEGIN 
            D0CB'.BSTCB.BSDISVC :=          _NUMBER OF DISABLED SVC'S  ?
                 D0CB'.BSTCB.BSNOSVC - D0CB'.BSTCB.BSENSVC; 
            TFLCB'.BZSLCBPTR'.BZXSLCB.
              BZGRPTCB[TFLCB'.BZSUBTIP] := D0CB 
            END 
          ELSE
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
_ 
****  BUMP TCB COUNT AND CHAIN TCB(S) TO *BZTCBPTR* 
? 
            BEGIN 
            TFLCB'.BZTCBCNT := TFLCB'.BZTCBCNT + 1; 
            IF TFLCB'.BZTCBCNT = 1          _ IF FIRST TCB             ?
            THEN
              TFLCB'.BZTCBPTR := D0CB 
            ELSE
              WITH D0CB'.BSTCB DO           _ USING CURRENT TCB        ?
              IF BSDEVTYPE = N1CON        _ IF JUST CREATED A CONSOLE?
              THEN                        _ THEN PUT IT AT THE TOP OF?
                BEGIN                     _ LCB-TCB CHAIN            ?
                BSCHAIN := TFLCB'.BZTCBPTR; 
                TFLCB'.BZTCBPTR := D0CB;  _ AND POINT ALL NON CONSOLE?
                TFPTR := BSCHAIN;         _ DEVICES ON THIS CLUSTER  ?
                REPEAT                    _ TO THIS CONSOLE          ?
                  IF TFPTR'.BSTCB.BSDEVTYPE " N1CON 
                  THEN
                    IF TFPTR'.BSTCB.BSCA = BSCA 
                    THEN
                     IF TFPTR'.BSTCB.BSCONSOLE = NIL _NO CONSOLE     ?
                      THEN TFPTR'.BSTCB.BSCONSOLE := D0CB;
                  TFPTR := TFPTR'.BSTCB.BSCHAIN;
                UNTIL TFPTR = NIL;
                END _ IF BSDEVTYPE = N1CON ?
              ELSE
                BEGIN 
                TFPTR := TFLCB'.BZTCBPTR;   _ GET FIRST TCB ON LINE    ?
                REPEAT
                  TFPOINT := TFPTR; 
                  IF TFPTR'.BSTCB.BSDEVTYPE = N1CON 
                  THEN
                    IF TFPTR'.BSTCB.BSCA = BSCA 
                    THEN                    _ CLUSTER ADDRESS MATCH(S) ?
                      IF BSDEVTYPE " N1CON
                      THEN
                        BSCONSOLE := TFPTR; _ INSERT CONSOLE ADDRESS   ?
                  TFPTR := TFPTR'.BSTCB.BSCHAIN;
                UNTIL TFPTR = NIL;
                TFPOINT'.BSTCB.BSCHAIN := D0CB; 
                END; _ WITH D0CB'.BSTCB ? 
            END;  _ TFTIPT = N1X25 ?
          IF LASTCNF                        _ IF LAST TERMINAL ON LINE ?
          THEN
            BEGIN 
            TFLCB'.BZCNFPEND := FALSE;      _ CLEAR CNF/TE PENDING     ?
            PBRELZRO (TFLCB'.BZARPARMS,BEDBSIZE); 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
            IF TFTIPT = N1X25               _ SPECIAL CASE X25 TCB(S)  ?
            THEN
              BEGIN 
              FOR I := N0XPAD TO N0X2USR DO _ CHECK FOR ALL SUB-TIPS(S)?
                BEGIN 
                B1TCB := TFLCB'.BZSLCBPTR'. 
                         BZXSLCB.BZGRPTCB[I]; 
                IF B1TCB " NIL              _ IF GROUP CONFIGURE       ?
                THEN
                  PN2TELLTIP;               _ TELL TIP ABOUT TCB       ?
                END; _ FOR ?
              END 
            ELSE
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
_ 
****  NON-X25 TCB(S) BUILT - CHECK FOR AUTO-CONNECT 
? 
              IF BWWLENTRY[OPS].CMSMLEY.CMWKCODE = D0TCB
              THEN                          _ IF RECONFIGURING THEN    ?
                BEGIN 
                B1TCB := D0CB;              _ SET UP B1TCB AND PROCESS ?
                PN2TELLTIP;                 _ AND INITIALIZE THE       ?
                PN2ACON;                    _ THE CONSOLE              ?
                END _ CMWKCODE = D0TCB ?
              ELSE
                BEGIN 
                B1TCB := TFLCB'.BZTCBPTR;   _ GET FIRST TCB ON LINE    ?
                REPEAT
                  PN2TELLTIP;               _ BUILD *A0SMTCB* WORKCODE ?
                  PN2ACON;                  _ AND PROCESS NEW CONSOLES ?
                  B1TCB := B1TCB'.BSTCB.BSCHAIN;
                UNTIL B1TCB = NIL;          _ DO ALL TCBS IN CHAIN     ?
                END;
_ 
****  CHECK IF ALL TERMINALS ARE DISABLED AND SEE IF CONNECTED TO HOST
? 
            ADDR (TFLCB',TFPTR);            _ ADDRESS OF LCB           ?
            PNTCKENB (TFPTR);               _ SEE IF ALL TCBS DISABLED ?
            PNTCKCON (TFPTR);               _ SEE IF CONNECTED TO  HOST?
            END; _ LASTCNF ?
          GOTO 999;                         _ EXIT PDQ                 ?
          END  _ CONFIGOK = D3AC ?
        ELSE
          BEGIN 
          IF TFLCB'.BZTIPTYPE  = N1X25      _ IF X25 - RELEASE BUFFER  ?
          THEN
            PBREL1BF (D0CB,BEDBSIZE)
          ELSE
            BEGIN                           _ ELSE LET *PNDLTCB* DO IT ?
            TFLCB'.BZTCBCNT := TFLCB'.      _ BUMP TCB COUNT           ?
                   BZTCBCNT + 1;
            PNDLTCB (D0CB);                 _ RELEASE THE TCB          ?
            END;
          END; _ ELSE CONFIGOK " D3AC ? 
        END; _ TFSFC.DHRTYPE = SMNORMAL ? 
_ 
****  ERROR OCCURRED - DELETE TCB(S) / DISABLE THE LINE 
? 
      WITH TFLCB' DO                        _ USING LINE POINTER       ?
        BEGIN 
        BZSMDISC := FALSE;                  _ LEAVE LINE DISABLED      ?
        IF BZSMCNTRL = FALSE                _ IF SVM NOT CONTROLLING   ?
        THEN
          BEGIN 
          BZSMCNTRL := TRUE;                _ SVM CONTROLLING LINE     ?
          ADDR (TFLCB',TFPTR);              _ DEFEAT TYPE CHECKING     ?
          PNSMBLINDWN (TFPTR,DAUSER);       _ BRING LINE DOWN          ?
          END; _ BZSMCNTRL = FALSE ?
        BZCNFST := C7DISABLED;              _ SET LINE DISABLED        ?
        PNUSSM (C7DISABLED,LRC,D9LI,TFPTR); _ GENERATE STATUS MESSAGE  ?
        END; _ WITH TFLCB' ?
  END; _ WITH SMPTR' ?
999:  
PBRELZRO (SMPTR,BEDBSIZE);                  _ RELEASE SVM MSG BUFFER   ?
END; _ PROCEDURE PNSMTECNF? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMCNF                                          * 
*                                                                     * 
*        PROCESS SFC OF CONFIGURE SERVICE MESSAGE                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMCNF PROCESSES THE SFC OF A CONFIGURE TERMINAL      * 
*              SERVICE MESSAGE.  IF THE SERVICE MESSAGE IS A CNF/TE   * 
*              MESSAGE IT WILL BE PROCESSED IMMEDIATELY.  IF THE      * 
*              MESSAGE IS A CNF/RECON MESSAGE A A0SMDLTCB WORKLIST    * 
*              ENTRY MAY BE SHIPPED TO THE TIP.                       * 
*                                                                     * 
** INPUT -     POINTER TO SERVICE MESSAGE                             * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMWL - SERVICE MODULE MESSAGE HANDLER                * 
*                                                                     * 
** OUTPUT -    PNMSTECNF CALLED IF CNF/TE                             * 
*              SERVICE MESSAGE SAVED ON CHAIN IF CNF/RECON AND        * 
*              A0SMDLTCB MAY BE SHIPPED TO TIP                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED :                                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMCNF(SMPTR:B0BUFPTR);
CONST P = 14;                               _ PORT NUMBER              ?
VAR 
  TFSFC : DHSFCTYPE;                        _SFC OVERLAY               ?
  TFLCB : BZLCBP;                           _LOCAL LCB POINTER         ?
_ 
** PROCEDURE NAME  - P N 2 S M R C N F
* 
** OVERVIEW        - THIS PROCEDURE PROCESSES CNF/RC MSGS FROM CS 
*                  FIND TCB 
*                  IF FOUND 
*                      IF BSCNFST IS ENABLED
*                          IF BSRCNFPEND
*                              SAVE MSG ON CHAIN
*                              SHIP A0DELTCB WLE TO TIP 
*                  ELSE RELEASE THE MSG 
? 
PROCEDURE PN2SMRCNF;
CONST TN = 20;                              _TERMINAL NAME             ?
VAR    I : INTEGER; 
BEGIN 
D0CB := TFLCB'.BZTCBPTR;
IF D0CB " NIL 
THEN
  REPEAT
    I := 0; 
    REPEAT
      IF SMPTR'.BFDATA[TN+I] =              _IF ENTIRE NAME MATCHES    ?
         D0CB'.BSTCB.BSTNAME[I] 
      THEN
        I := I + 1                          _I GOES TO 7               ?
      ELSE
        I := -1;
    UNTIL (I < 0) ! (I > 6);
    IF I < 0                                _IF I < 0 THEN GO TO NEXT  ?
    THEN                                    _TCB IN CHAIN              ?
      D0CB := D0CB'.BSTCB.BSCHAIN 
    ELSE _ I > 6 ?                          _IS THE TCB FOR THE CS MSG ?
      BEGIN 
      IF D0CB'.BSTCB.BSCNFST \ C7ENABLED    _ENABLED AND STILL PENDING ?
      THEN                                  _RECONFIGURATION AND NOT   ?
        IF D0CB'.BSTCB.BSRCNFPEND           _BEING DELETED             ?
        THEN
          IF D0CB'.BSTCB.BSDELTCB = FALSE 
          THEN
            WITH DWWLENTRY.CMSMLEY DO 
            BEGIN 
            D0CB'.BSTCB.BSDELTCB := TRUE;   _ MARK DELETE SENT TO TIP  ?
            CMWKCODE := A0SMDLTCB;          _SEND THE TIP A WORKLIST   ?
            CMLINO   := TFLCB'.BZLINO;      _ENTRY TO TO DELETE THE OLD?
            CMPTR    := D0CB;               _TCB AND WAIT FOR CS       ?
            PBPUTYP (DWWLENTRY);
  
            IF RCNFHEAD = NIL               _IF THE CHAIN IS EMPTY     ?
            THEN                            _THIS MSG HEADS THE CHAIN  ?
              RCNFHEAD := SMPTR 
            ELSE                            _ELSE IT ADDS TO TAIL      ?
              RCNFTAIL'.BCCHAINS[QCHN]
                := SMPTR; 
            RCNFTAIL := SMPTR;              _IT ALWAYS BECOMES NEW TAIL?
            RCNFTAIL'.BCCHAINS[QCHN] := NIL; _ MARK END OF CHAIN       ?
  
            END; _ BSDELTCB = FALSE ? 
      D0CB := NIL;                          _THIS KNOCKS US OUT OF LOOP?
      END; _ ELSE I > 6 ? 
  UNTIL D0CB = NIL; 
IF RCNFTAIL " SMPTR                         _IF CS MSG IS NOT ON CHAIN ?
THEN
  PBRELZRO (SMPTR,BEDBSIZE);                _RELEASE THE MSG           ?
END; _ PROCEDURE PN2SMRCNF ?
_ 
****  S T A R T    P R O C E D U R E   P N S M C N F
? 
BEGIN 
WITH SMPTR' DO
  IF CS = ORD(BFDATAC[SN])
  THEN
    BEGIN 
    ADDR(CGLCBP'[ORD(BFDATAC[P])],TFLCB); 
    IF TFLCB'.BZCNFST \ C7ENABLED           _IF CS MATCH AND LINE STILL?
    THEN                                    _ENABLED OR ACTIVE         ?
     IF TFLCB'.BZSMDISC = FALSE             _AND NOT BEING DISCONNECTED?
     THEN 
      BEGIN 
      TFSFC.DHCHAR := BFDATAC[SFC]; 
      IF TFSFC.DHSFC = D9TE 
      THEN
        IF TFLCB'.BZCNFPEND                 _IF CONFIG STILL PENDING   ?
        THEN                                _PROCESS CONFIG/TE MSG     ?
          BEGIN 
          PNSMTECNF (SMPTR);
          GOTO 10;                          _AND DONT RELEASE THE MSG  ?
          END; _ D9TE ? 
      IF TFSFC.DHSFC = D9RC                 _PROCESS CNF/RC MSG        ?
      THEN
        BEGIN 
        PN2SMRCNF;
        GOTO 10;                            _AND DONT RELEASE THE MSG  ?
        END; _ D9RC ? 
      END; _ BZCNFST = C7ACTIVE ? 
    END; _ CS = BFDATAC[SN] ? 
PBRELZRO (SMPTR,BEDBSIZE);                  _RELEASE THE MESSAGE       ?
10:                                         _LABEL USED TO AVOID RELBUF?
  
END; _ PROCEDURE PNSMCNF ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMICN                                          * 
*                                                                     * 
*        INITIATE CONNECTION SERVICE MESSAGE HANDLER                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  CONNECTION REQUESTS HAVE NOT YET BEEN DEFINED          * 
*              BUT WILL BE INCLUDED IN R6 ADD-ONS.                    * 
*              A NORMAL INITIATE CONNECTION RESPONSE SM CAUSES        * 
*              THE DATA TRANSMISSION CHANNEL FOR THE CONNECTION       * 
*              TO BE CLEARED, THEN OPENED FOR FURTHER DATA, AND       * 
*              THE CONNECTION INITIATION OF ALL PASSIVE DEVICES       * 
*              ASSOCIATED WITH AN INITIATED CONSOLE.  AN              * 
*              ABNORMAL INITIATE CONNECTION RESPONSE CAUSES THE       * 
*              CONNECTION TO BE DELETED, AND A TIMEOUT TO BE STARTED  * 
*              FOR AN AUTO-CONNECT OR PASSIVE DEVICE.                 * 
*                                                                     * 
** INPUT    -  ICN SM                                                 * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMWL       - SVM WORKLIST PROCESSOR                  * 
*                                                                     * 
** OUTPUT   -                                                         * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PNRELZRO    - RELEASE A CHAIN OF BUFFERS               * 
*              PNGTLLCB    - GET AN LLCB                              * 
*              PNGTCB      - GET A TCB                                * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMICN(SMPTR : B0BUFPTR);
VAR 
      ICSFC  : DHSFCTYPE;                   _ LOCAL SFC TYPE           ?
      ICLLCB : B0BUFPTR;                    _ LOCAL LLCB POINTER       ?
      ICTCB  : B0BUFPTR;                    _ LOCAL TCB POINTER        ?
      ICPTR  : B0BUFPTR;                    _ LOCAL CHAIN POINTER      ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNICNORMAL - LEVEL 2 PROCEDURE                   * 
*                                                                     * 
*        PROCESS ICN NORMAL RESPONSE SERVICE MESSAGE                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  THIS PROCEDURE PROCESSES ICN NORMAL RESPONSE SERVICE   * 
*              MESSAGES.                                              * 
*                                                                     * 
** INPUT -     ICN NORMAL RESPONSE SM                                 * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMICN - ICN SERVICE MESSAGE PROCESSOR                * 
*                                                                     * 
** OUTPUT -    INITR-BLOCK-DESCRIPTOR                                 * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBXFER   - TRANSFER CONTROL TO PNSMGEN TO BUILD AN     * 
*                         UPLINE SERVICE MESSAGE                      * 
*              PNCNINIT - INITIATE A CONNECTION                       * 
*              PGULTS   - GENERATE AN UPLINE BLOCK                    * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNICNORMAL; 
BEGIN 
WITH ICTCB'.BSTCB DO
  BEGIN 
  IF BSSTATE = D4IPREQ                      _ IF INIT REQUESTED        ?
  THEN                                      _ BY PROCESS,              ?
    BEGIN 
    BSSTATE := D4ICONF;                     _ SET STATE TO CONFIRMED   ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******?
*IF DEF,X25 
    IF ICSFC.DHSFC = D9EX                   _IF A-A CONNECTION RESPONSE?
    THEN
      BEGIN 
      WITH BWWLENTRY[OPS].CMSMLEY DO
        BEGIN 
        CMWKCODE := A0TIP;
        CMDATA   := D5ICXN; 
        CMPTR    := BSLCCBPTR;
        PBLSPUT(BWWLENTRY[OPS],BYWLCB[B0X25TIP]); 
        SMPTR    := NIL;                    _MESSAGE IS SENT TO X25 TIP?
        END;
      END; _ IF D9EX  ? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
    B1FLGWD.KTBLKT := HTRINIT;              _ SET FLAG WORD FOR INITR  ?
    PBULTS(ICTCB,NIL,B1FLGWD);              _ SEND UP AN INITR BLOCK   ?
    IF BSDEVTYPE = N1CON                    _ IF THIS IS A CONSOLE     ?
    THEN
      BEGIN 
      ICPTR  := BSCHAIN;                    _ CHAIN TO PASSIVE DEVICES ?
      WHILE ICPTR " NIL DO                  _ FOR ALL CHAINED TCBS,    ?
        BEGIN 
        IF ICPTR'.BSTCB.BSCONSOLE = ICTCB   _ IF CLUSTER ADDRESS MATCH ?
        THEN
          PNCNINIT(ICPTR);                  _ INITIATE CONNECTION      ?
        ICPTR := ICPTR'.BSTCB.BSCHAIN;      _ CHAIN TO NEXT TCB        ?
        END; _ WHILE ICPTR ?
      END; _ IF DEVICE IS A CONSOLE ? 
    END  _ IF INIT REQUESTED BY PROCESS ? 
  ELSE
    IF BSSTATE = D4TPEND                    _ IF STATE = TERMINATION   ?
    THEN                                    _ PENDING,                 ?
      BEGIN                                 _ SET STATE = TERM         ?
      BSSTATE         := D4TPREQ;           _ REQUESTED BY PROCESS     ?
      GENPFC          := D8TCN;             _ GET PFC                  ?
      GENSFC.DHINT    := D9TA;              _ DUMMY SFC                ?
      GENSUP          := BSRC + 8;          _ GET RESPONSE CODE        ?
      GENPAR.BABUFPTR := ICTCB;             _ GET TCB POINTER          ?
      WITH BRTNJUMP[C1PNSMGEN] DO           _ SEND TERMINATE REQUEST   ?
        PBXFER(JENTADDR, JPAGEVAL);         _ VIA SM GENERATOR         ?
      END;
  END; _ NORMAL RESPONSE ?
END; _ PNICNORMAL ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNICNABNORMAL - LEVEL 2 PROCEDURE                * 
*                                                                     * 
*        PROCESS ICN ABNORMAL RESPONSE SERVICE MESSAGE                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNICNABNORMAL PROCESSES ICN ABNORMAL RESPONSE SERVICE  * 
*              MESSAGES.                                              * 
*                                                                     * 
** INPUT -     ICN NORMAL RESPONSE SERVICE MESSAGE                    * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMICN - ICN SERVICE MESSAGE PROCESSOR                * 
*                                                                     * 
** OUTPUT -                                                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PNCNDELINK - DELINK A CONNECTION                       * 
*              PBCNTMR    - MAKE A CONNECTION TIMER ENTRY             * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNICNABNORMAL;
CONST 
  XRC   = P4;                               _ POSITION OF RC IN SM BUFF?
BEGIN 
WITH ICTCB'.BSTCB DO                        _ WITH TCB                 ?
  BEGIN 
  IF (BSSTATE = D4IPREQ) !                  _ IF INIT REQUESTED BY     ?
                                            _ PROCESS, OR              ?
     (BSSTATE = D4TPEND)                    _ TERMINATION PENDING      ?
  THEN
    BEGIN 
    IF BSACON                               _ IF AUTO CONNECT          ?
      ! ((BSDEVTYPE " N1CON)                _ OR PASSIVE DEVICE        ?
       & (BSDEVTYPE " N1AA ))               _ OR NOT A - A             ?
    THEN
      PNCNTMR(30,ICTCB);                    _ RETRY CONNECT TIMEOUT    ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******?
*IF DEF,X25 
    IF ICSFC.DHSFC = D9EX 
    THEN
      BSDIAG := ORD(SMPTR'.BFDATAC[XRC]);   _ PLACE DIAG CODE IN TCB   ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
    PNCNDELINK(ICTCB);                      _ DELINK CONNECTION        ?
    END;
  END; _ WITH TCB ? 
END; _ PNICNABNORMAL ?
_$J+? 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******?
*IF DEF,X25 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                 PNICNREQ - LEVEL 2 PROCEDURE                        * 
*                                                                     * 
*               PROCESS ICN/AP/R SERVICE MESSAGE                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - PNICNREQ PROCESSES ICN/AP/R SERVICE MESSAGE.            * 
*                                                                     * 
** INPUT -    ICTCB IS PTR VALUE IN CN DIRECTORY                      * 
*             CMPOINT POINTS SM BUFFER.                               * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*             PNSMICN   - ICN SERVICE MESSAGE PROCESSOR               * 
*                                                                     * 
** OUTPUT -   THE A0TIP/D5ICAR WORKLIST ENTRY WITH THE ICN/AP/R       * 
*             BLOCK AND THE LOGICAL CHANNEL CONTROL BLOCK (LCCB)      * 
*             IS GENERATED TO X.25 TIP IF THE FOLLOWING CONDITIONS    * 
*             ARE SATISFIED, OTHERWISE THE ICN/AP/A WITH AN ERROR     * 
*             CODE IS GENERATED TO THE REQUESTER.                     * 
*                                                                     * 
*                      CONDITIONS                ERROR CODES          * 
*             -----------------------------     -------------         * 
*              X.25 TIP EXISTS                     X0RIRN             * 
*              CONNECTION NUMBER AVAILABLE         X0RNPO             * 
*              REQUEST IS ON X.25 LINE             X0RIPN             * 
*              X.25 LINE OPERATIONAL               X0RPLN             * 
*              LOGICAL NUMBER AVAILABLE            X0RNCA             * 
*              BUFFER AVAILABLE FOR TCB            X0RNBL             * 
*              A-A SUBTIP AVAILABLE                X0RSNS             * 
*              ACTIVE SVC AVAILABLE                X0RNLL             * 
*              LOGICAL LINK ACTIVE                 X0RLLC             * 
*                                                                     * 
** EXTERNAM SUBROUTINE -                                              * 
*             PN2ADD    - MAKE CN DIRECTORY IN USE                    * 
*             PBPUTYP   - NOTIFY TIP                                  * 
*             PNREVERSE - SWITCH DN/SN                                * 
*             PNSWLE    - SEND A MESSAGE                              * 
*             PBLCBP    - FIND ADDRESS OF LCB USING LINE NUMBER       * 
*             PN5SRCH   - FIND ADDRESS OF LCCB USING LOGICAL          * 
*                         CHANNEL NUMBER                              * 
*                                                                     * 
** NOTE -                                                             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNICNREQ; 
  
CONST 
      ICCN    = $E;                         _POSITION OF CN IN SM BUFF ?
      ICRC    = $F;                         _POSITION OF RC IN SM BUFF ?
      ICPORT  = $1A;                        _POSITION OF LINE NUMBER   ?
      ICSNODE = $1B;                        _POSITION OF HOST NODE     ?
                                            _ IN SM BUFFER             ?
      X3READY = 1;                          _X.25 PACKET LEVEL READY   ?
                                            _ STATE                    ?
  
VAR 
      XAWORK     : B0OVERLAY;               _OVERLAY WORKING AREA      ?
      X2LCB      : BZLCBP;                  _X.25 LCB POINTER          ?
      X2SLCB     : B0BUFPTR;                _X.25 SUB-LCB POINTER      ?
      X3LCCB     : B0BUFPTR;                _X.25 LCCB POINTER         ?
      ICGRPTCB   : B0BUFPTR;                _A-A SUBTIP GROUP TCB PTR  ?
      X3SVCNT    : INTEGER;                 _NUMBER OF SVC COUNT       ?
      X3LCHN     : INTEGER;                 _NUMBER OF PVC COUNT AND   ?
                                            _ TOTAL VC COUNT           ?
      ICVAL      : INTEGER;                 _WORKING AREA              ?
      ICTCBSIZE  : INTEGER;                 _SIZE OF X.25 TCB          ?
      AARC       : INTEGER;                 _ERROR RC IF NON-ZERO      ?
      ICSIZE     : B0TCBSIZE;               _SIZR OF TCB               ?
  
BEGIN 
WITH SMPTR' DO                              _WITH SM                   ?
  BEGIN 
  AARC := X0RIRN;                           _INVALID REQUEST (NO TIP)  ?
  IF BYWLCB[B0X25TIP].BYPRADDR " 0          _IF X25TIP AVAILABLE       ?
  THEN
    BEGIN 
    AARC := X0RNPO;                         _NO PATH AVAILABLE         ?
    IF ICTCB = NIL                          _CN ENTRY IS FREE          ?
    THEN
      BEGIN 
      XAWORK.BAINT         := 0;            _SAVE LINE NUMBER HERE     ?
      XAWORK.BALINO.BDPORT :=               _GET LINE NUMBER FROM      ?
                     ORD(BFDATAC[ICPORT]);  _ ICN/AP/R BLOCK           ?
      PBLCBP (XAWORK.BAINT, X2LCB);         _GET LCB POINTER           ?
      AARC := X0RIPN;                       _ILLEGAL PORT NUMBER IN    ?
                                            _ OUTCALL REQUEST PACKET   ?
      IF X2LCB'.BZSVTIPTYPE = N1X25         _MAKE SURE THIS IS X25 LINE?
      THEN
        BEGIN 
        X2SLCB := X2LCB'.BZSLCBPTR;         _GET SUB-LCB POINTER       ?
        AARC   := X0RPLN;                   _X.25 LINE NOT OPERATIONAL ?
  
        WITH X2SLCB'.BZXSLCB DO 
  
        BEGIN 
        IF BZPKLUP                          _X.25 PACKET LEVEL ACTIVE  ?
        THEN                                _ (MEANS X.25 LINK IS      ?
         BEGIN                              _  ESTABLISHED)            ?
         IF BZDCES = FALSE                  _IF DCE NOT RESTARTING     ?
         THEN 
          BEGIN 
          AARC    := X0RNCA;                _NO CONNECTION AVAILABLE   ?
          X3LCHN  := BZLPVC + BZLSVC;       _GET HIGHEST CHANNEL NUMBER?
          X3SVCNT := BZLSVC;                _SVC COUNT                 ?
          IF BZLCN " 0                      _IF ONEWAY LCN SPECIFIED   ?
          THEN
            X3SVCNT := X3LCHN - BZLCN + 1;  _BZLCN IS THE LOWEST LIMIT ?
          ICVAL   := -1;                    _SEARCH DOWNWARDS          ?
  
          IF BZDCE                          _IF DCE                    ?
          THEN
            BEGIN 
            X3LCHN := BZLPVC + 1;           _GET LOWEST SVC            ?
            IF BZLCN " 0                    _IF ONEWAY LCN SPECIFIED   ?
            THEN
              X3SVCNT := BZLCN - BZLPVC;    _BZLCN IS THE HIGHEST LIMIT?
            ICVAL := 1;                     _SEARCH UPWARDS            ?
            END;        _ IF BZDCE ?
          IF X3SVCNT > 0
          THEN
          BEGIN 
_ 
* * * *  LOOK FOR AVAILABLE CHANNEL NUMBER FOR OUTCALL REQUEST
* * * *  GO THRU HIGHEST LOGICAL CHANNEL NUMBER IF DCE
* * * *  OTHERWISE GO THRU LOWEST SVC NUMBER
? 
          REPEAT
            PN5SRCH (XAWORK.BALINO,         _GET AVAILABLE LCCB WITH   ?
                     X3LCHN,                _ LINE NUMBER AND          ?
                     X3LCCB);               _ LOGICAL CHANNEL NUMBER   ?
            IF X3LCCB'.LCCB.LCPHPSTATE      _LOGICAL CHANNEL IS IN     ?
                                  = X3READY _ READY STATE              ?
            THEN
              IF X3LCCB'.LCCB.LCTCBPTR = NIL_LCCB NOT IN USE           ?
              THEN
                X3SVCNT := 0;               _ END LOOP (LCCB FOUND)    ?
  
            X3SVCNT := X3SVCNT - 1; 
            X3LCHN  := X3LCHN  + ICVAL;     _GET NEXT LCHN             ?
  
          UNTIL (X3SVCNT @ 0);
  
          IF X3SVCNT " 0                    _AVAILABLE LCCB FOUND      ?
          THEN
            BEGIN 
_ 
* * * *  ASSIGN A VALID TCB FOR A CONNECTION
? 
            AARC := X0RNBL;                 _NOT ENOUGH BUFFER -LOCAL  ?
  
            IF PB1BFAVAIL(B0THCT)           _CHECK FOR TCB BUFFER      ?
            THEN
              BEGIN 
              ICGRPTCB := BZGRPTCB[N0XAPPL]; _ORIGINAL TCB FOR THE TYPE?
              AARC     := X0RSNS;            _X.25 SUBTIP NOT AVAILABLE?
  
              IF ICGRPTCB " NIL             _ORIGINAL TCB AVAILABLE    ?
              THEN
                BEGIN 
                AARC := X0RNLL;             _NO CONNECTION AVAILABLE   ?
  
                IF ICGRPTCB'.BSTCB.BSENSVC > 0 _CHECK FOR AVAILABLE SVC?
                THEN
                  BEGIN 
                  AARC := 0;                _ NO ERROR FOUND           ?
                  IF ICLLCB'.BLLLCB.BLSPART._ CHECK FOR LOGICAL LINK   ?
                     BLCNFST < C7ENABLED    _ STATUS                   ?
                  THEN
                    AARC := X0RLLC; 
                  END _ IF BSENSVC > 0 ?
                ELSE                        _INCREMENT CONNECTIONS     ?
                  X2LCB'.BZSTIC.BZRA :=     _ REJECTED                 ?
                                   X2LCB'.BZSTIC.BZRA + 1;
                END;  _IF ICGRPTCB " NIL                               ?
              END;  _IF PB1BFAVAIL                                     ?
            END;  _IF X3SVCNT " NIL                                    ?
          END;  _IF X3SVCNT > 0                                        ?
          END;  _IF BZDCES = FALSE                                     ?
         END;  _IF BZPKLUP                                             ?
        END;  _WITH X2SLCB'.BZXSLCB                                    ?
  
        END;  _IF BZSVTIPTYPE = N1X25                                  ?
      END;  _IF ICTCB = NIL                                            ?
    END;  _IF X25TIP AVAILABLE                                         ?
_ 
* * * *  CHECK FOR ABNORMAL RESPONSE CODE 
? 
  IF AARC " 0                               _IF ANY ERROR FOUND        ?
  THEN
    BEGIN 
    BFDATAC[SFC]  := CHR(ICSFC.DHSFC+$80);  _SET SFC ABNORMAL          ?
    BFDATAC[ICRC] := CHR(AARC);             _SET ERROR REASON CODE     ?
    BFLCD         := ICRC;                  _SET LCD FOR RC DATA       ?
    PNREVERSE(SMPTR);                       _SWITCH DN/SN              ?
    PBSWLE(SMPTR);                          _SEND MESSAGE              ?
    END   _ IF AARC " 0                                                ?
  ELSE
    BEGIN 
_ 
* * * *  SET UP TCB AND LCCB FOR X.25 TIP 
? 
    X3LCCB'.LCCB.LCCNTYPE := N0XAPPL;       _SET X.25 SUBTIP           ?
                                            _ CONNETTION TYPE          ?
    ICTCB := PNGETCB(X2LCB);                _GET TCB BUFFER            ?
  
    ICGRPTCB'.BSTCB.BSACSVC :=              _INCREMENT ACTIVE LCCB     ?
               ICGRPTCB'.BSTCB.BSACSVC + 1; _ COUNT                    ?
    ICGRPTCB'.BSTCB.BSENSVC :=              _DECREMENT ENABLED SVC CNT ?
               ICGRPTCB'.BSTCB.BSENSVC - 1; 
  
    ICSIZE    := BJTIPTYPT[X2LCB'.BZTIPTYPE].BJTCBSIZE; 
    ICTCBSIZE := TCBLENGTH[ICSIZE]; 
    FOR ICVAL := 1 TO ICTCBSIZE DO          _COPY FIELDS FROM ORGTCB TO?
      ICTCB'.BIINT[ICVAL] :=                _ REAL TCB                 ?
                    ICGRPTCB'.BIINT[ICVAL]; 
  
_ 
* * * *  PLACE DEFAULT PACKET WINDOW SIZE AND DATA PACKET LENGTH IN LCCB
? 
    X3LCCB'.LCCB.LCW   := ICGRPTCB'.BSTCB.BSLCW;
    X3LCCB'.LCCB.LCDPL := X2SLCB'.BZXSLCB.BZPKTLNGTH; 
_ 
* * * *  COMPLETE TERMINAL NAME AND INCREASE TCB COUNT
? 
    XAWORK.BAINT            := X3LCCB'.LCCB.LCHN; 
    ICTCB'.BSTCB.BSTNAME[5] := JMCNVTO[XAWORK.BAHEX.B0H3];
    ICTCB'.BSTCB.BSTNAME[6] := JMCNVTO[XAWORK.BAHEX.B0H4];
    X2LCB'.BZTCBCNT         := X2LCB'.BZTCBCNT + 1; 
  
    PN2ADD(ORD(BFDATAC[ICCN]), ICLLCB'.BLLLCB.BLSPART.BLCONDIR, ICTCB); 
                                            _ MAKE CN ENTRY IN USE     ?
    ICLLCB'.BLLLCB.BLSPART.BLCOUNT :=       _BUMP NR OF CONNECTIONS    ?
      ICLLCB'.BLLLCB.BLSPART.BLCOUNT + 1; 
    ICLLCB'.BLLLCB.BLSPART.BLCNFST := C7ACTIVE; 
                                            _ SET LLCB ACTIVE          ?
    ICTCB'.BSTCB.BSLLCB     := ICLLCB;      _ SET LLCB POINTER IN TCB  ?
    ICTCB'.BSTCB.BSCONSOLE  := ICTCB; 
    ICTCB'.BSTCB.BSCHAIN    := X2LCB'.BZTCBPTR; 
                                            _CHAIN NEW TCB INTO        ?
    X2LCB'.BZTCBPTR         := ICTCB;       _ ACTIVE TCB CHAIN         ?
    ICTCB'.BSTCB.BSLCBP     := X2LCB;       _PLACE TCB PTR IN LCB      ?
    ICTCB'.BSTCB.BSCNFST    := C7ACTIVE;    _MAKE TCB ACTIVE           ?
    ICTCB'.BSTCB.BSSTATE    := D4ILREQ;     _MAKE LINK CONNECT PEND    ?
                                            _PLACE BSCN AND BSHN       ?
    ICTCB'.BSTCB.BSCN       := ORD(BFDATAC[ICCN]);
    ICTCB'.BSTCB.BSHN       := ORD(BFDATAC[ICSNODE]); 
_ 
* * * *  LINK LCCB AND TCB
? 
    ICTCB'.BSTCB.BSLCCBPTR := X3LCCB;       _LCCB LINK FROM TCB        ?
    X3LCCB'.LCCB.LCTCBPTR  := ICTCB;        _TCB LINK FROM LCCB        ?
    WITH BWWLENTRY[OPS].CMSMLEY DO          _ OPS IMMEDIATE ARRAY      ?
      BEGIN 
      CMWKCODE := A0TIP;                    _A-A WORKCODE              ?
      CMDATA   := D5ICAR;                   _OUTBOUND CONNECT REQUEST  ?
      CMPTR    := X3LCCB;                   _PASS LCCB POINTER         ?
     _CMPOINT IS ALREADY SET TO ICN/AP/R BLOCK                         ?
_ 
* * * *  MAKE WORKLIST ENTRY TO X.25 TIP
? 
      PBLSPUT (BWWLENTRY[OPS], BYWLCB[B0X25TIP]); 
      END;  _ WITH BWWLENTRY                                           ?
    END;  _ IF AARC " 0                                                ?
  SMPTR := NIL;                             _ DO NOT RELEASE SM BUFFER ?
  END;  _ WITH SMPTR                                                   ?
END;  _ PROCEDURE PNICNREQ                                             ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
_$J+? 
_ 
* * * *  START OF PNSMICN 
? 
BEGIN 
WITH SMPTR' DO                              _ WITH SM                  ?
  BEGIN 
  ICLLCB := PNGTLLCB(ORD(BFDATAC[DN]),      _ GET LLCB                 ?
                     ORD(BFDATAC[SN])); 
  IF ICLLCB " NIL                           _ IF LLCB  FOUND           ?
  THEN
    BEGIN 
    ICTCB := PN2SRCH (ORD(BFDATAC[P3]),     _ GET TCB                  ?
                      ICLLCB'.BLLLCB.BLSPART.BLCONDIR); 
    ICSFC.DHCHAR := BFDATAC[SFC];           _ GET SFC FROM BUFFER      ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******?
*IF DEF,X25 
    IF ICSFC.DHSFC = D9AP                   _ OUTBOUND A-A CONNECTION  ?
    THEN
      PNICNREQ                              _ PROCESS ICN/AP REQUEST   ?
    ELSE
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
      BEGIN 
      IF ICTCB " NIL                        _ IF TCB EXISTS            ?
      THEN
        BEGIN 
        CASE ICSFC.DHRTYPE OF               _ CASE SM TYPE             ?
          SMNORMAL:                         _ NORMAL RESPONSE          ?
            PNICNORMAL;                     _ PROCESS NORMAL RESPONSE  ?
          SMABNORMAL:                       _ ABNORMAL RESPONSE        ?
            PNICNABNORMAL;                  _ PROCESS ABNORMAL RESPONSE?
          SMREQUEST:                        _ REQUEST SM               ?
            BEGIN 
            ICTCB'.BSTCB.BSSTATE := D4ILREQ;  _ SET STATE = INIT       ?
                                            _ REQUESTED BY LINK        ?
            END;
          END; _ CASES ?
        END; _ IF ICTCB " NIL ? 
      END;   _ NORMAL TERMINAL CONNECTION PROCESSING  ? 
    END; _ IF ICLLCB " NIL ?
  PBRELZRO(SMPTR,BEDBSIZE);                 _ RELEASE SM BUFFER        ?
  END; _ WITH SMPTR' ?
END; _ PNSMICN ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMTCN                                          * 
*                                                                     * 
*        TERMINATE CONNECTION SERVICE MESSAGE HANDLER                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  A TERMINATE CONNECTION REQUEST SM CAUSES THE DATA      * 
*              TRANSMISSION CHANNEL FOR THE CONNECTION TO BE CLEARED  * 
*              AND CLOSED, AND AN INFORMATIVE MESSAGE TO BE           * 
*              TRANSMITTED TO A TERMINATED CONSOLE.  A TERMINATE      * 
*              CONNECTION RESPONSE SM CAUSES THE DELINKING OF THE     * 
*              CONNECTION, AND THE TERMINATION REQUESTS TO BE         * 
*              GENERATED FOR ALL PASSIVE DEVICES ASSOCIATED WITH A    * 
*              TERMINATED CONSOLE .  PROVISION IS MADE FOR COLLISIONS * 
*              BETWEEN TERMINATION REQUESTS ORIGINATING INDEPENDENTLY * 
*              FROM BOTH ENDS OF THE CONNECTION.                      * 
*                                                                     * 
** INPUT    -  TCN SM                                                 * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMWL       - SVM WORKLIST PROCESSOR                  * 
*                                                                     * 
** OUTPUT   -  TERM-BLOCK-DESCRIPTOR                                  * 
*              TCN/TE/N UPLINE SERVICE MESSAGE                        * 
*              CONNECTION-BROKEN-MSG TO TERMINAL                      * 
*                                                                     * 
**             EXTERNAL SUBROUTINES                                   * 
*              PNCNDELINK - DELINK A CONNECTION                       * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMTCN(SMPTR : B0BUFPTR);
VAR 
      TCSFC  : DHSFCTYPE;                   _ SFC                      ?
      TCLLCB : B0BUFPTR;                    _ LLCB POINTER             ?
      TCTCB  : B0BUFPTR;                    _ TCB POINTER              ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNTCNREQUEST - LEVEL 2 PROCEDURE                 * 
*                                                                     * 
*        PROCESS TCN REQUEST SERVICE MESSAGE                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNTCNREQUEST PROCESSES TCN REQUEST SERVICE MESSAGES    * 
*                                                                     * 
** INPUT -     TCN REQUEST SERVICE MESSAGE                            * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              PNSMTCN                                                * 
*                                                                     * 
** OUTPUT -    WORKLIST ENTRY TO SERVICE MODULE                       * 
*              WORK EVENT FOR BROADCAST PROCESSOR                     * 
*              UPLINE TERM BLOCK                                      * 
*              UPLINE TCN RESPONSE SERVICE MESSAGE                    * 
*                                                                     * 
**      EXTERNAL SUBROUTINES -                                        * 
*              PBLSPUT - MAKE A WORKLIST ENTRY                        * 
*              PGULTS  - SEND AN UPLINE BLOCK                         * 
*              ADDR    - PUT ADDRESS INTO A VARIABLE                  * 
*              PBXFER  - TRANSFER CONTROL TO PNSMGEN TO BUILD AN      * 
*                        UPLINE SERVICE MESSAGE                       * 
*                                                                     * 
** NOTES                                                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNTCNREQUEST; 
  
BEGIN 
WITH TCTCB'.BSTCB DO                        _ WITH TCB                 ?
  BEGIN 
  BSACON := FALSE;                          _CLEAR AUTO-CONNECT FLAG   ?
  CASE BSSTATE OF 
    D4ICONF:                                _ STATE = INIT CONFIRMED   ?
      BEGIN 
      BSSTATE := D4TLREQ;                   _ SET TERM REQ BY LINK     ?
      B1FLGWD.KTBLKT := HTTERM;             _ SET TCB FLAG WORD        ?
      PBULTS(TCTCB,NIL,B1FLGWD);            _ SEND UP A TERM BLOCK     ?
      END; _ IF BSSTATE = D4ICONF ? 
    D4TPREQ:                                _ TERM REQUEST BY PROCESS  ?
      BEGIN 
      BSSTATE := D4TCOLL;                   _ TERM COLLISION           ?
      B1FLGWD.KTBLKT := HTTERM;             _ FLAG WORD = TERM         ?
      PBULTS(TCTCB,NIL,B1FLGWD);            _ SEND AN UPLINE TERM BLOCK?
      END;
    D4TLREQ:                                _ TERM REQUESTED BY LINK   ?
      BEGIN 
      BSSTATE         := D4TPREQ;           _ TERM REQUESTED BY PROCESS?
      GENPFC          := D8TCN;             _ GET PFC                  ?
      GENSFC.DHSFC    := D9TA;              _ DUMMY SFC                ?
      GENSFC.DHRTYPE  := SMNORMAL;          _ NORMAL RESPONSE IN SFC   ?
      GENPAR.BABUFPTR := TCTCB;             _ GET TCB POINTER          ?
      WITH BRTNJUMP[C1PNSMGEN] DO           _ SEND TERMINATE REQUEST   ?
        PBXFER(JENTADDR, JPAGEVAL);         _ VIA SM GENERATOR         ?
      END;
    END; _ CASE ? 
  END; _ WITH TCTCB ? 
END; _ PNTCNREQUEST ? 
_$J+? 
_ 
* * * *  START OF PNSMTCN 
? 
BEGIN 
WITH SMPTR' DO                              _ WITH SM                  ?
  BEGIN 
  TCLLCB := PNGTLLCB(ORD(BFDATAC[DN]),      _ GET LLCB                 ?
                     ORD(BFDATAC[SN])); 
  IF TCLLCB " NIL                           _ IF LLCB  FOUND           ?
  THEN
    BEGIN 
    TCTCB := NIL;                           _ DEFAULT TCB PTR TO NIL   ?
    IF TCLLCB'.BLLLCB.BLSPART.BLCDS         _ CONNECTION DIRECTORY     ?
    THEN
      TCTCB := PN2SRCH (ORD(BFDATAC[P3]),   _ GET TCB ADDRESS          ?
               TCLLCB'.BLLLCB.BLSPART.BLCONDIR);
    IF TCTCB " NIL                          _ IF TCB EXISTS            ?
    THEN
      BEGIN 
      TCSFC.DHCHAR := BFDATAC[SFC];         _ GET SFC FROM BUFFER      ?
      WITH TCTCB'.BSTCB DO                  _ WITH TCB                 ?
        CASE TCSFC.DHRTYPE OF               _ CASE SM TYPE             ?
          SMNORMAL:                         _ NORMAL RESPONSE          ?
            CASE BSSTATE OF                 _ CASE CONNECTION STATE    ?
              D4TPREQ,                      _ TERM REQUESTED BY PROCESS?
              D4TLREQ:                      _ TERM REQUESTED BY LINK   ?
                BEGIN 
                PNCNDELINK(TCTCB);          _DELINK A CONNECTION       ?
                IF BSDEVTYPE = N1CON        _ON CONSOLE DEVICE         ?
                THEN                        _  AND                     ?
                  IF BSACON                 _AUTO CONNECT SET          ?
                  THEN
                    PNCNINIT(TCTCB);
                END;
              D4TCOLL:                      _ TERM COLLISION, SET STATE?
                BSSTATE := D4TLREQ;         _ TERM REQUESTED BY LINK   ?
              END; _ CASE ? 
          SMREQUEST:                        _ REQUEST SM               ?
            PNTCNREQUEST;                   _ PROCESS REQUEST SM       ?
        END; _ CASE ? 
      END; _ IF TCB " NIL ? 
    END; _ IF LLCB " NIL ?
  PBRELZERO(SMPTR,BEDBSIZE);                _ RELEASE SM BUFFER        ?
  END; _ WITH SMPTR ? 
END; _ PNSMTCN ?
*IF DEF,HLIP
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNNPUSM                                          * 
*                                                                     * 
*           PROCESS REMOTE DUMP/LOAD SERVICE MESSAGE (DATA)           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNNPUSM IS CALLED WHEN A NPU/DT OR NPU/IN SERVICE      * 
*              MESSAGE IS RECEIVED. THE NPU/DT SERVICE MESSAGE        * 
*              CONTAINS DUMP/LOAD DATA FOR A REMOTE NPU. THE MESSAGE  * 
*              IS ONLY PROCESSED IF THE TRUNK LOADING FLAG IS SET.    * 
*              PROCESSING OF THIS MESSAGE MERELY CONSISTS OF QUEUING  * 
*              THE MESSAGE TO THE TRUNK. A WORKLIST IS GENERATED TO   * 
*              THE *LIP* IF THE QUEUE WAS INITIALLY NIL.              * 
*              WHEN A NPU/IN SERVICE MESSAGE IS RECEIVED A TERMINATE  * 
*              DUMP/LOAD WORKLIST IS SENT TO THE *LIP*.               * 
*                                                                     * 
** INPUT -     POINTER THE THE SERVICE MESSAGE                        * 
*                                                                     * 
** OUTPUTS -   *IELDP* WORKLIST TO THE *LIP* WHEN A NPU/DT MESSAGE    * 
*                 IS RECEIVED AND THE QUEUE IS EMPTY.                 * 
*              *IELDT* WORKLIST TO THE *LIP* TO SIGNAL RECEIPT OF     * 
*                 THE NPU/IN TERMINATE MESSAGE.                       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS-                                          * 
*                - PBLSPUT              MAKE WORKLIST ENTRY           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNNPUSM (SMPTR : B0BUFPTR); 
  
CONST 
  P      = P3;                              _ PORT OFFSET IN MSG       ?
  
VAR 
  LP     : INTEGER;                         _ LOCAL VAR FOR PORT NUMBER?
  LSFC   : DHSFCTYPE;                       _ SFC OF NPU SERVICE MSG   ?
  TRKPTR : B0BUFPTR;                        _ TRUNK POINTER            ?
  
BEGIN 
LSFC.DHCHAR := SMPTR'.BFDATAC[SFC];         _ GET SFC TO LOCAL VARIABLE?
LP := ORD(SMPTR'.BFDATAC[P]);               _ PORT NUMBER TO LOCAL     ?
SMPTR'.BCCHAIN[QCHN] := NIL;                _ CLEAR QUEUE CHAIN        ?
ADDR (CGLCBP'[LP].BZTCBPTR',TRKPTR);        _ POINTER TO TRUNK CB      ?
BWWLENTRY[OPS].BWLIPPARAMS.IELINO           _ SET LINE NUMBER INTO     ?
              .BDPORT := LP;                _ POSSIBLE WORKLIST        ?
IF LSFC.DHSFC = D9IN                        _ IF TERMINATION SFC       ?
THEN                                        _ THEN NOTIFY LIP VIA      ?
_ 
****  PROCESS NPU/IN  -  SEND TERMINATE DUMP/LOAD TO *LIP*
? 
  BEGIN                                     _ WORKCODE                 ?
  BWWLENTRY[OPS].BWLIPPARAMS
                .IEWKCODE := IELDT;         _ TERMINATE DUMP/LOAD      ?
  PBLSPUT (BWWLENTRY[OPS],BYWLCB[B0HDLC]);  _ LAUNCH WORKCODE TO LIP   ?
  END _ DHSFC = D9IN ?
_ 
****  REMOTE DUMP/LOAD DATA RECEIVED FOR THE *LIP*
? 
ELSE _ DHSFC " D9IN ? 
  BEGIN 
  IF TRKPTR'.TRKCB.TRLOADFLG                _ IF TRUNK LOADING         ?
  THEN
    BEGIN 
    B1BUFF := TRKPTR'.TRKCB.TRUI;           _ SEE IF DATA QUEUED       ?
    IF B1BUFF = NIL                         _ IF NO - WAKE UP LIP      ?
    THEN
_ 
****  QUEUE WAS EMPTY - WAKE-UP *LIP* VIA WORKLIST
? 
      BEGIN 
      TRKPTR'.TRKCB.TRUI := SMPTR;          _ PUT ON LIP QUEUE         ?
      BWWLENTRY[OPS].BWLIPPARAMS.IEWKCODE 
                              := IELDP;     _ NOTIFY LIP VIA WORKCODE  ?
      PBLSPUT (BWWLENTRY[OPS],              _ LAUNCH WORKCODE TO LIP   ?
               BYWLCB[B0HDLC]); 
      END _ B1BUFF = NIL ?
_ 
****  DATA ALREADY QUEUED TO DUMP/LOAD CHAIN - JUST ADD THIS BUFFER 
? 
    ELSE _ B1BUFF " NIL ?                   _ BUFFER(S) QUEUED ALREADY ?
      BEGIN 
      WHILE B1BUFF'.BCCHAINS[QCHN] " NIL DO _ PLACE AT END OF QUEUE    ?
        B1BUFF := B1BUFF'.BCCHAINS[QCHN]; 
      B1BUFF'.BCCHAINS[QCHN] := SMPTR;
      END; _ ELSE B1BUFF " NIL ?
    SMPTR := NIL;                           _ CLEAR SVM MSG POINTER    ?
    END; _ TRLOADFLG ?
  END; _ ELSE DHSFC " D9IN ?
PBRELZRO (SMPTR,BEDBSIZE);                  _ RELEASE THE BUFFER       ?
END; _ PROCEDURE PNNPUSM ?
*ENDIF
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMNPI                                          * 
*                                                                     * 
*         PROCESS DUMP/RELOAD FLAG SERVICE MESSAGE                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  THIS PROCEDURE PROCESSES DUMP/RELOAD SERVICE MESSAGES  * 
*              FROM *CS*. DUMP SERVICE MESSAGE MERELY CHANGE THE LONG * 
*              TERM DUMP FLAG IN THE NPU WHILE RELOAD SERVICE MESSAGES* 
*              CHANGE THE RELOAD FLAG AND CAUSE THE NPU TO HALT.      * 
*                                                                     * 
** INPUT -     SERVICE MESSAGE FROM *CS*                              * 
*              SERVICE MESSAGE FROM *NIP* ON BLOCK PROTOCOL ERROR     * 
*              SERVICE MESSAGE FROM *PIP* ON BLOCK PROTOCOL ERROR     * 
*                                                                     * 
** OUTPUT -    NONE                                                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              - PNUSSM - GENERATE UNSOLICITED STATUS WORKLIST        * 
*              - PBHALT - HALT THE NPU                                * 
*              - PBRELZRO - RELEASE A BUFFER                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMNPI (SMPTR : B0BUFPTR); 
  
CONST 
  DP    = P3;                               _ INDEX FOR DUMP/RELOAD    ?
  DPCHG = 3;                                _ REASON CODE              ?
  
VAR 
  LDP   : CHAR;                             _ LOCAL VARIABLE           ?
  DPSFC : INTEGER;                          _ SFC OF SERVICE MESSAGE   ?
  
BEGIN 
LDP := SMPTR'.BFDATAC[DP];                  _ GET DUMP/RELOAD INDICATOR?
DPSFC := ORD (SMPTR'.BFDATAC[SFC]);         _ PICK UP THE SFC          ?
IF DPSFC = D9DO                             _ DUMP OPTION CHANGE       ?
THEN
_ 
****  PROCESS CHANGE OF DUMP FLAG 
? 
  BEGIN                                     _ STORE VALUE IN DUMP      ?
  NHNDCB.NDDUMP[1] := LDP;                  _ CONTROL BLOCK            ?
  NHNDCB.NDDUMP[2] := LDP;
  PNUSSM (0,DPCHG,D9NP,NIL);                _ GENERATE STU/NP          ?
  END _ SFC = D9DO ?
ELSE _ SFC " D9DO ?                         _ RELOAD NPU               ?
_ 
****  CHANGE THE RELOAD FLAG AND HALT THE NPU 
? 
  BEGIN 
  IF LDP " CHR(0)                           _ IF DUMP OPTION NONZERO   ?
  THEN                                      _ THEN STORE DUMP PARAMETER?
    BEGIN                                   _ INTO RELOAD CELL(S)      ?
    NHNDCB.NDRELOAD[1] := LDP;
    NHNDCB.NDRELOAD[2] := LDP;
    END; _ NDDUMP " CHR(0) ?
  IF DPSFC = D9PE                           _ BLOCK PROTOCOL ERROR PIP ?
  THEN                                      _ ABORT NPU , BPE IN BUFFER?
    PBHALT (J0PIPBPE) 
  ELSE
    IF DPSFC = D9NE                         _ BLOCK PROTOCOL ERROR NIP ?
    THEN                                    _ CHECK NAM DAYFILE / DUMP ?
      PBHALT (J0NIPBPE) 
    ELSE                                    _ FORCED RELOAD FROM CS    ?
      PBHALT (J0FLHLT);                     _ BRING NPU TO ITS KNEES   ?
  END; _ ELSE SFC " D9DO ?
PBRELZRO (SMPTR,BEDBSIZE);                  _ DISCARD SVM MSG BUFFER   ?
END; _ PROCEDURE PNSMNPI ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMSUP                                          * 
*                                                                     * 
*        PROCESS SUPERVISION SERVICE MESSAGE                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  THIS PROCEDURE PROCESSES RECEIPT OF A SUPERVISION      * 
*              RESPONSE SERVICE MESSAGE FROM *CS*. RESPONSES CAN BE   * 
*              EITHER ABNORMAL OR NORMAL -- SUP/GO OR SUP/IN. IF AN   * 
*              ABNORMAL RESPONSE IS RECEIVED THE NPU WILL NOT ATTEMPT * 
*              TO SEEK SUPERVISION FROM OTHER POSSIBLE NETWORK        * 
*              SUPERVISORS, BUT WILL HANG ON THIS *CS* - SENDING      * 
*              A SUP/IN EVERY 2 MINUTES UNTIL A NORMAL RESPONSE IS    * 
*              RECEIVED OR UNTIL THIS *CS* IS DROPPED BY THE OPERATOR * 
*              A NORMAL RESPONSE WILL TRIGGER THE NPU TO CHECK IF A   * 
*              MORE PREFERRED *CS* IS NOW AVAILABLE TO THE NETWORK.   * 
*              WHEN *CS* IS FINALLY CONFIRMED THE NPU WILL THEN ENABLE* 
*              ALL LINES ON THEN NPU.                                 * 
*                                                                     * 
** INPUT -     SERVICE MESSAGE(S) FROM *CS*                           * 
*              SUP/IN/N - NORMAL SUPERVISION                          * 
*              SUP/IN/A - ABNORMAL SUPERVISION                        * 
*              SUP/GO/N - GO RESPONSE                                 * 
*                                                                     * 
** OUTPUT -    SUP/GO SERVICE MESSAGE TO *CS* IF GO REQUIRED          * 
*              NPI/IN SERVICE MESSAGE BACK TO SVM IF SUP/IN/A RECEIVED* 
*                WITH A NONZERO LOAD REQUEST PARAMETER                * 
*                                                                     * 
** EXTERNAL SUBROUTINES-                                              * 
*              - PNENBLINES - ENABLE ALL NPU LINES                    * 
*              - PN1GTPTR   - GET POINTER TO TYPE 1 TABLE             * 
*              - PBLSPUT    - MAKE WORKLIST ENTRY                     * 
*              - PNCSUPCHG  - CHECK SUPERVISION CHANGE                * 
*              - PNREVERSE  - SWAP DN SN                              * 
*              - PBSWLE     - SEND SERVICE MESSAGE TO *BIP*           * 
*              - PBRELZRO   - RELEASE A BUFFER                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMSUP (SMPTR : B0BUFPTR); 
  
CONST 
  LR    = 14; 
  DP    = 15; 
  
VAR 
  LSN   : INTEGER;
  SNREG : B0OVERLAY;
  LSFC  : DHSFCTYPE;
  
BEGIN 
  WITH SMPTR' DO                            _ POINTER TO BUFFER        ?
  BEGIN 
  LSN := ORD(BFDATAC[SN]);                  _ GET NODE ID OF SENDER    ?
  LSFC.DHINT := ORD(BFDATAC[SFC]);          _ WHAT TYPE OF SUP MSG     ?
  IF LSFC.DHSFC = D9GO                      _ IF SUP/GO RECEIVED       ?
  THEN
    BEGIN 
    IF CS = LSN                             _ GO RECEIVED FROM CS      ?
    THEN                                    _ OK TO ACT ON             ?
      BEGIN 
      NHGORCVD := TRUE;                     _ SET GO RECEIVED FLAG     ?
      PNENBLINES (FALSE);                   _ ENABLE LINE(S)           ?
      END; _ CS = LSN ? 
    END _ LSFC = D9GO ? 
  ELSE _ LSFC " D9GO ?
_ 
****  SUP/IN RECEIVED - ONLY PROCESS IF *CS* STILL PENDING
? 
    BEGIN                                   _ DEFAULT - MUST BE D9IN   ?
    B1BUFF := PN1GTPTR (LSN,DELOCDN);       _ FIND NODE ID             ?
    IF CSPEND = LSN                         _ TABLE AND SEE IF SUP     ?
    THEN                                    _ OUTSTANDING              ?
      BEGIN                                 _ YES                      ?
      CSPEND := 0;                          _ CLEAR SUP PENDING        ?
      IF LSFC.DHRTYPE = SMABNORMAL
      THEN                                  _ ABNORMAL REPLY           ?
_ 
****  SUP/IN/A RECEIVED - IF NONZERO LOAD REQUEST PARAMETER SET 
****  CHANGE MESSAGE TO A NPI/IN MESSAGE ELSE GO ON 2 MINUTE TIMER
? 
        BEGIN 
        IF BFDATAC[LR] " CHR(0)             _ LOAD REQUEST NON-ZERO    ?
        THEN                                _ TREAT AS LOAD REQUEST    ?
          BEGIN 
          BFDATAC[PFC] := CHR(D8NPI);       _ LOAD REQUEST PFC         ?
          BFDATAC[LR] := BFDATAC[DP];       _ DUMP PARAMTER            ?
          PBLSPUT (BWWLENTRY[OPS],          _ PASS BUFFER ALONG        ?
                   BYWLCB[B0SMWL]); 
          SMPTR := NIL;                     _ DO NOT RELEASE BUFFER    ?
          END _ NON-ZERO LOAD REQUEST ? 
        ELSE _ LR = 0 ? 
          BEGIN 
          CSPEND := LSN;                    _ SUPERVISION PENDING      ?
          WITH DWWLENTRY.CMSMLEY DO 
            BEGIN 
            CMSMGEN := TRUE;                _ TIMER FOR *PNSMGEN*      ?
            CMREALTIMER := 127;             _ 127 SEC(S)               ?
            CMPRM1  := D8SUP;               _ REQUEST SUPERVISION      ?
            CMPRM2  := D9IN;
            CMPRM3  := CS;
            CMPRM4.BABUFPTR := B1BUFF;      _ POINTER TO TYPE 1 TBL    ?
            PBLSPUT (DWWLENTRY,BYWLCB[B0SMTMR]);
            END; _ WITH DWWLENTRY... ?
          END; _ ELSE LR = 0 ?
        END _ LSFC.DHRTYPE = SMABNORMAL ? 
      ELSE _ LSFC.DHRTYPE " SMABNORMAL ?
_ 
****  SUP/IN/N RECEIVED - CHECK FOR A MORE PREFERRED *CS* - IF
****  NONE FOUND SEE IF GO REQUIRED ELSE ENABLE LINES ON NPU. 
? 
        BEGIN 
        CS := LSN;                          _ SET NEW CS               ?
        SNREG.BABOOL.B0B2 := B1BUFF'        _ FORCE A SUPERVISION CHK  ?
                             .BRTYP1.BRCSAV;
        SNREG.BABOOL.B0B3 := B1BUFF'        _ WILL TRIGGER A SUP/IN    ?
                             .BRTYP1.BRNSAV;_ IF PREFERRED CS FOUND    ?
        PNCSUPCHG (LSN,SNREG);
        IF LSN = CS                         _ IF SAME CS THEN SEE IF   ?
        THEN                                _ GO REQUIRED              ?
          BEGIN 
          IF NHNPUGO = NHGORCVD             _ GO REQUIRED AND ALREADY  ?
          THEN                              _ RECEIVED                 ?
            PNENBLINES (FALSE)              _ ENABLE ALL LINE(S)       ?
          ELSE
            BEGIN 
            PNREVERSE (SMPTR);              _ REVERSE DN SN            ?
            BFDATAC[SFC] := CHR(D9GO);      _ GO                       ?
            BFLCD := SFC;                   _ SET UP LCD               ?
            PBSWLE (SMPTR);                 _ ROUTE THE BUFFER         ?
            SMPTR := NIL;                   _ DO NOT RELEASE BUFFER    ?
            END; _ GO REQUIRED ?
          END; _ LSN = CS ? 
        END; _ LSFC.DHRTYPE " SMABNORMAL ?
      END; _ IF B1BUFF'... ?
    END; _ LSFC = D9IN ?
  PBRELZRO (SMPTR,BEDBSIZE);                _ RELEASE THE MESSAGE      ?
  END; _ WITH SMPTR' ?
END; _ PROCEDURE PNSMSUP ?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMSTATUS                                       * 
*                                                                     * 
*        PROCESS STATUS REQUEST SERVICE MESSAGE                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMSTATUS IS ENTERED WHEN A STATUS REQUEST SM IS      * 
*              RECEIVED. THE STATUS REQUEST MAY BE ON THE FOLLOWING   * 
*              CLASS LEVELS, NAMELY, NPU, LOGICAL LINK(S), LINE(S)    * 
*              TERMINAL(S), TRUNK(S), COUPLER(S) AND SVC(S).          * 
*              EACH HIGHER CLASS STATUS REQUEST WILL INCLUDE ALL ITS  * 
*              LOWER CLASS SETS BEING GENERATED, AND IT IS AT THE END * 
*              OF THE LOWEST LEVEL THAT THE NORMAL RESPONSE TO THE    * 
*              STATUS REQUEST IS GENERATED TO SIGNIFY THE END OF THE  * 
*              STATUS REQUEST REPORT PROCESS.                         * 
*              PNSMSTATUS VALIDATES THE STATUS REQUEST SM AND BUILDS  * 
*              STATUS WORKLIST ENTRIES, SWE(S), TO BE SERIALLY        * 
*              PROCESSED BY PNSWEPROC. THE SWE SPECIFIES THE CLASS OF * 
*              UNSOLICITED STATUS REPORT TO BE GENERATED, AND THE     * 
*              FINAL SWE SPECIFIES THAT THE NORMAL RESPONSE TO THE    * 
*              STATUS REQUEST IS TO BE GENERATED.                     * 
*              IN CASE OF A CS MISMATCH, THE STATUS REQUEST IS        * 
*              IGNORED AND NOT PROCESSED                              * 
*              IN CASE OF LOW BUFFER RESOURCES, THE SVM WORKLIST WILL * 
*              BE REQUEUED TO ENSURE LATER PROCESSING                 * 
*                                                                     * 
** INPUT -     A DOWNLINE STATUS REQUEST SM WITH ONE OF THE FOLLOWING * 
*              PFC/SFC REQUESTS :                                     * 
*              NPS/NP/R      NPU                                      * 
*              LLS/NP/R      ALL LOGICAL LINKS ON NPU                 * 
*              LLS/LL/R      SINGLE LOGICAL LINK                      * 
*              LIS/NP/R      ALL LINES ON NPU                         * 
*              LIS/LI/R      SINGLE LINE                              * 
*              TES/NP/R      ALL TERMINALS ON NPU                     * 
*              TES/LL/R      ALL TERMINALS ON A LOGICAL LINK          * 
*              TES/LI/R      ALL TERMINALS ON A LINE                  * 
*              TES/TE/R      SINGLE TERMINAL                          * 
*              TRS/NP/R      ALL TRUNKS ON NPU                        * 
*              TRS/TR/R      SINGLE TRUNK                             * 
*              CPS/NP/R      ALL COUPLERS ON NPU                      * 
*              CPS/CP/R      SINGLE COUPLER                           * 
*              VCS/NP/R      ALL SVC ON NPU                           * 
*              VCS/LI/R      ALL SVC ON A LINE                        * 
*              VCS/VC/R      SINGLE SUB TIP SVC                       * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*                                                                     * 
** OUTPUT -    SWE(S) FOR APPROPRIATE UNSOLICITED STATUS REPORTS, AND * 
*              SWE    FOR STATUS REQUEST NORMAL RESPONSE              * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              1) PBBFAVAIL        CHECK FOR AVAILABILITY OF BUFFERS  * 
*              2) PBLSPUT          MAKE A WORK LIST ENTRY             * 
*              3) PN1SRCH          SEARCH TYPE 1 TABLE                * 
*              4) PN2SRCH          SEARCH TYPE 2 TABLE                * 
*              5) PNGTLLCB         PERFORM DN, SN LOOKUP              * 
*              6) PNFNDTCB         FIND MATCHING TCB                  * 
*              7) PBGET1BF         GET A BUFFER                       * 
*              8) PN1GTPTR         GET TYPE 1 ENTRY ADDRESS           * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*              2) PNSWEPROC        STATUS WORK EVENT PROCESSOR        * 
*                                                                     * 
** INTERNAL SUBROUTINES -                                             * 
*              1) PN2SWLE          BUILD APPROPRIATE SWE              * 
*              2) PN2CHECK         CHECK IF SWE REQUIRED              * 
*              3) PN2NPUSTATUS     BUILD SWE FOR NPU STATUS           * 
*              4) PN2LLSTATUS      BUILD SWE FOR LOGICAL LINK STATUS  * 
*              5) PN2LINESTATUS    BUILD SWE FOR LINE STATUS          * 
*              6) PN2VALIDLINE     CHECK IF LINE (PORT) VALID         * 
*              7) PN2ALLONLINE     PROCESS ALL TERMINALS ON A LINE    * 
*                                                                     * 
** SPECIAL NOTE -                                                     * 
*              IF TWO OR MORE STATUS REQUESTS ARE OUTSTANDING FROM CS * 
*              THEN IT IS POSSIBLE IN CASES OF LOW BUFFER RESOURCES   * 
*              TO PROCESS THE REQUESTS OUT OF SEQUENCE.               * 
*              HOWEVER THE SEQUENCE OF STATUS REPORT(S), AND THE      * 
*              NORMAL RESPONSE FOR A PARTICULAR STATUS REQUEST IS KEPT* 
*              INTACT BY PNSWEPROC                                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMSTATUS (SMPTR : B0BUFPTR);
  
CONST 
      LLLLN1 = P3;                          _INDEXES INTO LLS SM       ?
      LLLLN2 = P4;
      LLNPST = P3;
      LILIP  = P3;                          _INDEXES INTO LIS SM       ?
      LINPST = P3;
      TETEP  = P3;                          _INDEXES INTO TES SM       ?
      TETESP = P4;
      TETETN = P9;
      TELIP  = P3;
      TELIST = P5;
      TELLN1 = P3;
      TELLN2 = P4;
      TELLST = P5;
      TENPST = P3;
      TRTRP  = P3;                          _INDEXES INTO TRS SM       ?
      TRNPST = P3;
      CPCPN1 = P3;                          _INDEXES INTO CPS SM       ?
      CPNPST = P3;
      VCVCP  = P3;                          _INDEXES INTO VCS SM       ?
      VCVCAN = P9;
      VCLIP  = P3;
      VCLISP = P4;
      VCLIST = P5;
      VCSTIP = P16; 
  
VAR 
      SMSFC   : INTEGER;                    _SFC OF SERVICE MESSAGE    ?
      SMLI    : INTEGER;                    _LINE NUMBER (PORT)        ?
      NODE1   : INTEGER;                    _NODE ID 1 FROM SM         ?
      NODE2   : INTEGER;                    _NODE ID 2 FROM SM         ?
      I       : INTEGER;                    _GENERAL LOOP VARIABLE     ?
      REQSTS  : INTEGER;                    _STATUS REQUESTED IN SM    ?
      FNDSTS  : INTEGER;                    _STATUS FOUND IN CTRL BLOCK?
      SMPSP   : B0LINO;                     _LINE NO (PORT/SUBPORT)    ?
      WKPTR   : B0BUFPTR;                   _PTR TO CONTROL BLOCK      ?
                                            _    OR STATUS  BUFFER     ?
      SNDIR   : B0BUFPTR;                   _PTR TO SN DIRECTORY       ?
      DNENTRY : B0BUFPTR;                   _PTR TO DN DIRECTORY ENTRY ?
      CPCB    : B0BUFPTR;                   _PTR TO COUPLER CB         ?
                                            _    OR LINE CB            ?
  
_ 
** PROCEDURE NAME - P N 2 S W L E 
* 
** OVERVIEW       - THIS PROCEDURE BUILDS THE STATUS WORKLIST ENTRY 
*                   AND PUTS IT INTO THE STATUS PROCESSOR WORKLIST
*                   QUEUE 
* 
** INPUT          - WKCODE    WORK CODE FOR STATUS WORKLIST ENTRY 
? 
PROCEDURE PN2SWLE (WKCODE : INTEGER); 
  
BEGIN 
WITH DWWLENTRY.CMSMLEY DO                   _ACCESS TO STATUS WLE AREA ?
  BEGIN 
  CMWKCODE  := WKCODE;                      _STORE WORK CODE           ?
  CMCNFST   := FNDSTS;                      _STORE FOUND STATUS        ?
  CMCBP     := WKPTR;                       _STORE PTR TO CONTROL BLOCK?
                                            _          OR STATUS BUFFER?
  IF WKCODE = D9TE THEN                     _CHECK IF TERMINAL STATUS  ?
  IF FNDSTS " C7NOTCNF                      _FOR A CONFIGURED TERMINAL ?
  THEN
    CMDAT1 := WKPTR'.BSTCB.BSHN;            _STORE HOST NODE           ?
  
  IF WKCODE = D9LL                          _CHECK IF LL STATUS        ?
  THEN
    CMDAT1 := WKPTR'.BLLLCB.BLSPART.BLTREG; _STORE REGULATION LEVEL    ?
  
  PBLSPUT(DWWLENTRY,DYLISTCB[D6STAT]);      _PUT SWE IN QUEUE          ?
  END; _WITH DWWLENTRY.CMSMLEY DO?
END; _PROCEDURE PN2SWLE?
_ 
** PROCEDURE NAME - P N 2 C H E C K 
* 
** OVERVIEW       - THIS PROCEDURE CHECKS THE STATUS IN THE CONTROL 
*                   BLOCK STRUCTURE WITH THE REQUESTED STATUS.
*                   IF THERE IS A MATCH OR ALL STATUSES ARE REQUESTED 
*                   THEN PN2SWLE IS CALLED TO BUILD THE WORKLIST ENTRY
* 
** INPUT          - WKCODE    WORK CODE FOR STATUS WORKLIST ENTRY 
? 
PROCEDURE PN2CHECK (WKCODE : INTEGER);
  
CONST 
      C7ALLST = 0;                          _ALL STATUSES REQUESTED    ?
  
BEGIN 
IF (REQSTS = C7ALLST) !                     _ALL STATUSES REQUESTED OR ?
   (REQSTS = FNDSTS)                        _HAVE A STATUS MATCH       ?
THEN
  PN2SWLE (WKCODE);                         _YES BUILD APPROPRIATE SWE ?
END; _PROCEDURE PN2CHECK? 
_ 
** PROCEDURE NAME - P N 2 N P U S T A T U S 
* 
** OVERVIEW       - THIS PROCEDURE SETS UP THE PARAMETERS AND CALLS 
*                   PN2SWLE TO BUILD A SWE FOR NPU STATUS 
? 
PROCEDURE PN2NPUSTATUS; 
  
BEGIN 
FNDSTS := C7DUMMY;                          _FOUND STATUS N/A          ?
WKPTR  := NIL;                              _WORK PTR NOT APPLICABLE   ?
PN2SWLE(D9NP);                              _BUILD SWE FOR NPU STATUS  ?
END; _PROCEDURE PN2NPUSTATUS? 
_ 
** PROCEDURE NAME - P N 2 L L S T A T U S 
* 
** OVERVIEW       - THIS PROCEDURE SETS UP THE PARAMETERS AND CALLS 
*                   PN2SWLE TO BUILD A SWE FOR LL STATUS IF THE 
*                   LLCB EXISTS.
? 
PROCEDURE PN2LLSTATUS;
  
BEGIN 
IF WKPTR " NIL                              _CHECK IF LLCB EXISTS      ?
THEN
  BEGIN                                     _YES IT DOES               ?
  FNDSTS := WKPTR'.BLLLCB.BLSPART.BLCNFST;  _SAVE STATUS FROM LLCB     ?
  PN2SWLE (D9LL);                           _BUILD SWE FOR LL STATUS   ?
  END; _IF WKPTR " NIL? 
END; _PROCEDURE PN2LLSTATUS?
_ 
** PROCEDURE NAME - P N 2 L I N E S T A T U S 
* 
** OVERVIEW       - THIS PROCEDURE SETS UP THE PARAMETERS AND CALLS 
**                  PN2SWLE TO BUILD A SWE FOR LINE STATUS
? 
PROCEDURE PN2LINESTATUS;
  
BEGIN 
FNDSTS := WKPTR'.BZZLCB.BZCNFST;            _SAVE STATUS FROM LCB      ?
PN2SWLE (D9LI);                             _BUILD SWE FOR LINE STATUS ?
END; _PROCEDURE PN2LINESTATUS?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
_ 
** PROCEDURE NAME - P N 2 S V C S T A T U S 
* 
** OVERVIEW       - THIS PROCEDURE SETS UP THE PARAMETERS AND CALLS 
*                   PN2SWLE TO BUILD A SWE FOR SVC STATUS 
* 
? 
PROCEDURE PN2SVCSTATUS; 
  
BEGIN 
FNDSTS := WKPTR'.BSTCB.BSCNFST;             _SAVE STATUS FROM TCB      ?
PN2SWLE (D9VC);                             _BUILD SWE FOR SVC STATUS  ?
END; _PROCEDURE PN2SVCSTATUS? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
_ 
** FUNCTION NAME  - P N 2 V A L I D L I N E 
* 
** OVERVIEW       - THIS FUNCTION RETURNS A TRUE RESULT IF THE
*                   CURRENT LINE (SMLI) IS IN THE RANGE OF VALID LINES
*                   AND IS CONFIGURED 
? 
FUNCTION PN2VALIDLINE (DUMMY : INTEGER) : BOOLEAN;
  
BEGIN 
PN2VALIDLINE := FALSE;                      _SET FALSE RESULT          ?
IF SMLI > C0NPBL                            _CHECK IF LINE NOT A TRUNK ?
THEN
  IF SMLI @ C4LCBS                          _AND IN RANGE OF LINE NOS  ?
  THEN
    BEGIN 
    ADDR (CGLCBP'[SMLI],WKPTR);             _GET POINTER TO LCB        ?
    IF WKPTR'.BZZLCB.BZCNFST " C7DUMMY      _CHECK LINE IS CONFIGURED  ?
    THEN
      PN2VALIDLINE := TRUE;                 _YES SET TRUE RESULT       ?
    END;
END; _FUNCTION PN2VALIDLINE?
_ 
** PROCEDURE NAME - P N 2 A L L O N L I N E 
* 
** OVERVIEW       - THIS PROCEDURE PROCESSES THE STATUS OF ALL
*                   TERMINALS ON THE CURRENT LINE 
? 
PROCEDURE PN2ALLONLINE; 
  
BEGIN 
IF WKPTR'.BZZLCB.BZTCBCNT " 0               _IF TCB(S) ATTACHED        ?
THEN
  BEGIN 
  WKPTR  := WKPTR'.BZZLCB.BZTCBPTR;         _GET PTR TO FIRST TCB      ?
  WHILE WKPTR " NIL DO                      _WHILE MORE TCBS TO PROCESS?
    BEGIN 
    FNDSTS := WKPTR'.BSTCB.BSCNFST;         _SAVE STATUS FROM TCB      ?
    PN2CHECK (D9TE);                        _MAYBE BUILD SWE FOR TERM  ?
    WKPTR := WKPTR'.BSTCB.BSCHAIN;          _GET PTR TO NEXT TCB       ?
    END; _WHILE WKPTR " NIL DO? 
  END; _BZTCBCNT " 0 ?
END; _PROCEDURE PNALLONLINE?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
_ 
** PROCEDURE NAME - P N 2 A L S V C L I N E 
* 
** OVERVIEW       - THIS PROCEDURE PROCESSES THE STATUS OF ALL
*                   SVCS ON THE CURRENT LINE
? 
PROCEDURE PN2ALSVCLINE; 
  
VAR 
  I      : INTEGER;                         _LOOP VARIABLE             ?
  
BEGIN 
CPCB := WKPTR;                              _RETAIN THE LINE CB        ?
WITH CPCB'.BZZLCB.BZSLCBPTR'.BZXSLCB DO     _USING THE SUBLCB CB       ?
  BEGIN 
  IF BZLSVC " 0                             _IF SVCS DEFINED FOR THIS  ?
  THEN                                      _ LINE                     ?
    FOR I := N0XPAD TO N0X2USR DO           _FOR EACH SUBTIP TYPE      ?
      BEGIN 
      IF BZGRPTCB[I] " NIL                  _IF GROUP TCB EXISTS       ?
      THEN
        BEGIN 
        WKPTR := BZGRPTCB[I];               _TCB ADDRESS               ?
        PN2SVCSTATUS;                       _BUILD SWE FOR SVC STATUS  ?
        END; _BZGRPTCB[I] " NIL?
      END; _FOR I := N0XPAD TO N0X2USR DO?
  END; _WITH CPCB?
END; _PROCEDURE PN2ALSVCLINE? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
_$J+? 
_ 
**** S T A R T   P R O C E D U R E   P N S M S T A T U S
? 
BEGIN 
WITH SMPTR' DO                              _SET INDEX TO THE SM       ?
BEGIN 
_ 
****  IGNORE THE STATUS REQUEST IF CS HAS CHANGED 
? 
IF ORD(BFDATAC[SN]) " CS                    _CHECK IF CS " SN OF SM    ?
THEN
  PBREL1BF (SMPTR,BEDBSIZE)                 _YES RELEASE THE SM        ?
ELSE
_ 
****  SINCE PROCESSING A STATUS REQUEST IS CONSIDERED A LOW PRIORITY
****  TASK , NO PROCESSING IS INITIATED IF WE ARE IN ANY BUFFER 
****  REGULATION. 
? 
  BEGIN 
  IF PB1BFAVAIL (B0TH3LV) = FALSE           _CHECK IF LOW ON BUFFERS   ?
  THEN
    BEGIN 
    BWWLENTRY[OPS].CMSMLEY.CMTIMER := 1;    _TRY AGAIN IN 1-2 SECONDS  ?
    PBLSPUT (BWWLENTRY[OPS],                _TIMER ENTRY FOR D0SM      ?
             BYWLCB[B0SMTMR]);
    END 
  ELSE
_ 
****  PROCESS STATUS REQUEST
? 
    BEGIN 
                                            _SET STATIC SWE FIELD      ?
    DWWLENTRY.CMSMLEY.CMUNSOLIT := FALSE;   _NORMAL STATUS REPORT      ?
    SMSFC := ORD(BFDATAC[SFC]);             _EXTRACT THE SFC           ?
    CASE ORD(BFDATAC[PFC]) OF               _CASE OUT THE PFC          ?
_ 
****  1    NPU STATUS REQUEST 
? 
      D8NPS:  
  
      BEGIN 
      PN2NPUSTATUS; 
      END; _D8NPS CASE? 
_ 
****  2    LOGICAL LINK STATUS REQUEST
? 
      D8LLS:  
  
      BEGIN 
      IF SMSFC = D9NP                       _PROCESS LL STATUS TYPE    ?
      THEN
_ 
****  2.1  ALL LOGICAL LINKS ON NPU 
? 
  
        BEGIN 
        PN2NPUSTATUS;                       _BUILD SWE FOR NPU STATUS  ?
        REQSTS := ORD(BFDATAC[LLNPST]);     _SAVE REQUESTED STATUS     ?
_ 
****       FIRST FIND ALL LOGICAL LINKS TERMINATED BY A COUPLER 
? 
        FOR I := 3 TO (C0NCPLR + 2) DO      _FOR EACH COUPLER ON NPU   ?
          BEGIN 
          CPCB := CSUBLCBP'[I].BZTCBPTR;    _GET CPCB PTR FROM SUBLCB  ?
          IF CPCB " NIL                     _CHECK IF CPCB EXISTS      ?
          THEN
            BEGIN                           _YES IT DOES               ?
            WKPTR := CPCB'.BHCCB.BHLLCB;    _GET PTR TO FIRST LLCB     ?
            WHILE WKPTR " NIL DO            _STILL MORE LLCBS          ?
              BEGIN 
              FNDSTS := WKPTR'.BLLLCB.      _SAVE STATUS FROM LLCB     ?
                        BLSPART.BLCNFST;
              PN2CHECK (D9LL);              _MAYBE BUILD SWE FOR LL    ?
              WKPTR := WKPTR'.BLLLCB.       _GET PTR TO NEXT LLCB      ?
                       BLSPART.BLCHAIN; 
              END; _WHILE WKPTR " NIL DO? 
            END; _IF CPCB " NIL?
          END; _FOR I := 3 TO (C0NCPLR + 2) DO? 
_ 
****       NOW FIND ALL LOGICAL LINKS TERMINATED BY THIS NODE 
? 
        SNDIR := PN1SRCH (CKLOCNODE,        _GET PTR TO SN DIRECTORY   ?
                          DELOCDN); 
        FOR I := 1 TO C0NNODE DO            _FOR EACH POSSIBLE NODE NO ?
          BEGIN 
          WKPTR := PN2SRCH (I,SNDIR);       _GET PTR TO LLCB FOR THE SN?
          IF WKPTR " NIL                    _CHECK IF LLCB EXISTS      ?
          THEN
            BEGIN                           _YES IT DOES               ?
            FNDSTS := WKPTR'.BLLLCB.        _SAVE STATUS FROM LLCB     ?
                      BLSPART.BLCNFST;
            PN2CHECK (D9LL);                _MAYBE BUILD SWE FOR LL    ?
            END; _IF WKPTR " NIL? 
          END; _FOR I := 1 TO C0NNODE DO? 
        END _IF SMSFC = D9NP? 
      ELSE
_ 
****  2.2  SINGLE LOGICAL LINK
? 
  
        BEGIN 
        NODE1 := ORD(BFDATAC[LLLLN1]);      _GET NODE 1 FROM SM        ?
        NODE2 := ORD(BFDATAC[LLLLN2]);      _GET NODE 2 FROM SM        ?
        WKPTR := PNGTLLCB (NODE1,NODE2);    _GET PTR TO LLCB N1, N2    ?
        PN2LLSTATUS;                        _MAYBE BUILD SWE FOR LL    ?
        WKPTR := PNGTLLCB (NODE2,NODE1);    _GET PTR TO LLCB N2, N1    ?
        PN2LLSTATUS;                        _MAYBE BUILD SWE FOR LL    ?
        END; _IF SMSFC = D9NP ELSE? 
  
      END; _D8LLS CASE? 
_ 
****  3    LINE STATUS REQUEST
? 
      D8LIS:  
  
      BEGIN 
      IF SMSFC = D9NP                       _PROCESS LINE STATUS TYPE  ?
      THEN
_ 
****  3.1  ALL LINES ON NPU 
? 
  
        BEGIN 
        PN2NPUSTATUS;                       _BUILD SWE FOR NPU STATUS  ?
        REQSTS := ORD(BFDATAC[LINPST]);     _SAVE REQUESTED STATUS     ?
        FOR SMLI := (C0NPBL+1) TO C4LCBS DO _FOR EACH LINE ON NPU      ?
          BEGIN 
          IF PN2VALIDLINE(0)                _CHECK LINE CONFIGURED     ?
          THEN
            BEGIN                           _YES IT IS                 ?
            FNDSTS := WKPTR'.BZZLCB.BZCNFST; _SAVE STATUS FROM LCB     ?
            PN2CHECK (D9LI);                _MAYBE BUILD SWE FOR LINE  ?
            END;
          END; _FOR SMLI := (C0NPBL+1) TO C4LCBS DO?
        END _IF SMSFC = D9NP? 
      ELSE
_ 
****  3.2  SINGLE LINE
? 
  
        BEGIN 
        SMLI := ORD(BFDATAC[LILIP]);        _LINE (PORT) FROM SM       ?
        IF PN2VALIDLINE(0)                  _CHECK IF VALID LINE       ?
        THEN
          PN2LINESTATUS;                    _BUILD SWE FOR LINE STATUS ?
        END; _IF SMSFC = D9NP ELSE? 
  
      END; _D8LIS CASE? 
_ 
****  4    TERMINAL STATUS REQUEST
? 
      D8TES:  
  
      BEGIN 
      CASE SMSFC OF                         _CASE OUT THE SFC OF SM    ?
_ 
****  4.1  ALL TERMINALS ON NPU 
? 
        D9NP: 
  
        BEGIN 
        PN2NPUSTATUS;                       _BUILD SWE FOR NPU STATUS  ?
        REQSTS := ORD(BFDATAC[TENPST]);     _SAVE REQUESTED STATUS     ?
        FOR SMLI := (C0NPBL+1) TO C4LCBS DO _FOR EACH LINE ON NPU      ?
          BEGIN 
          IF PN2VALIDLINE(0)                _CHECK LINE CONFIGURED     ?
          THEN
            BEGIN 
            PN2LINESTATUS;                  _BUILD SWE FOR LINE STATUS ?
            PN2ALLONLINE;                   _PROCESS STATUS OF ALL TMLS?
            END;
          END; _FOR SMLI := (C0NPBL+1) TO C4LCBS DO?
        END; _D9NP CASE?
_ 
****  4.2  ALL TERMINALS ON A LOGICAL LINK
? 
        D9LL: 
  
        BEGIN 
        WKPTR:=PNGTLLCB(ORD(BFDATAC[TELLN2]), _GET LLCB BASED ON N2,N1 ?
                        ORD(BFDATAC[TELLN1]));
        IF WKPTR " NIL                      _CHECK IF LLCB EXISTS      ?
        THEN
          WITH WKPTR'.BLLLCB.BLSPART DO     _SET INDEX TO LLCB         ?
            BEGIN 
            PN2LLSTATUS;                    _BUILD SWE FOR LL STATUS   ?
            REQSTS := ORD(BFDATAC[TELLST]); _SAVE REQUESTED STATUS     ?
            IF BLCDS                        _CHECK IF LL HAS CN DIRCTRY?
            THEN
              IF BLCONDIR " NIL             _CHECK IF DIRECTORY EXISTS ?
              THEN
                FOR I := 1 TO 255 DO        _FOR EACH POSSIBLE CN NUMB ?
                  BEGIN 
                  WKPTR := PN2SRCH(I,       _GET PTR TO TCB            ?
                                   BLCONDIR); 
                  IF WKPTR " NIL            _CHECK IF TCB EXISTS       ?
                  THEN
                    BEGIN                   _YES IT DOES               ?
                    FNDSTS := WKPTR'.       _SAVE STATUS FROM TCB      ?
                              BSTCB.BSCNFST;
                    PN2CHECK (D9TE);        _MAYBE BUILD SWE FOR TERM  ?
                    END; _IF WKPTR " NIL? 
                  END; _FOR I := 1 TO 255 DO? 
            END; _WITH WKPTR'.BLLLCB.BLSPART DO?
        END; _D9LL CASE?
_ 
****  4.3  ALL TERMINALS ON A LINE
? 
        D9LI: 
  
        BEGIN 
        SMLI   := ORD(BFDATAC[TELIP]);      _LINE (PORT) FROM SM       ?
        IF PN2VALIDLINE (0)                 _CHECK IF VALID LINE       ?
        THEN
          BEGIN                             _YES IT IS                 ?
          PN2LINESTATUS;                    _BUILD SWE FOR LINE STATUS ?
          REQSTS := ORD(BFDATAC[TELIST]);   _SAVE REQUESTED STATUS     ?
          PN2ALLONLINE;                     _PROCESS STATUS OF ALL TMLS?
          END; _IF PN2VALIDLINE (0)?
        END; _D9LI CASE?
_ 
****  4.4  SINGLE TERMINAL
? 
        D9TE: 
  
        BEGIN 
        SMPSP.BDLINO :=                     _LINE (PORT/SUBPORT)       ?
            ORD(BFDATAC[TETEP]) * $100
          + ORD(BFDATAC[TETESP]); 
        WKPTR := PNFNDTCB(SMPSP,SMPTR,TETETN); _GET PTR TO MATCHING TCB?
        IF WKPTR " NIL                      _CHECK IF TCB EXISTS       ?
        THEN
          FNDSTS := WKPTR'.BSTCB.BSCNFST    _YES SAVE STATUS FROM TCB  ?
        ELSE
          BEGIN                             _NO IT DOES NOT            ?
          WKPTR := PBGET1BF(BEDBSIZE);      _GET BFR FOR TERMINAL STAT ?
          FOR I := (TETEP/2+1) TO           _COPY PARAMETERS FROM SM   ?
                  ((TETETN+6)/2+1) DO 
            WKPTR'.BIINT[I] := BIINT[I];
          FNDSTS := C7NOTCNF;               _STATUS IS NOT CONFIGURED  ?
          END; _IF WKPTR " NIL ELSE?
        PN2SWLE (D9TE);                     _BUILD SWE FOR TERM STATUS ?
        END; _D9TE CASE?
  
      END; _CASE SMSFC OF?
      END; _D8TES CASE? 
_ 
****  5    TRUNK STATUS REQUEST 
? 
      D8TRS:  
  
      BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,HLIP  ******  ? 
*IF DEF,HLIP
      IF SMSFC = D9NP                       _PROCESS TRUNK STATUS TYPE ?
      THEN
_ 
****  5.1  ALL TRUNKS ON NPU
? 
  
        BEGIN 
        PN2NPUSTATUS;                       _BUILD SWE FOR NPU STATUS  ?
        REQSTS := ORD(BFDATAC[TRNPST]);     _SAVE REQUESTED STATUS     ?
        FOR I := 1 TO C0NPBL DO             _FOR EACH TRUNK ON NPU     ?
          BEGIN 
          ADDR (CGLCBP'[I],WKPTR);          _GET PTR TO TRCB           ?
          WKPTR  := WKPTR'.BZZLCB.BZTCBPTR; 
          IF WKPTR " NIL                    _CHECK IF TRCB EXISTS      ?
          THEN
            BEGIN                           _YES IT DOES               ?
            FNDSTS := WKPTR'.TRKCB.TRCNFST; _SAVE STATUS FROM TRCB     ?
            PN2CHECK (D9TR);                _MAYBE BUILD SWE FOR TRUNK ?
            END; _IF WKPTR " NIL? 
          END; _FOR I := 1 TO C0NPBL DO?
        END _IF SMSFC = D9NP? 
      ELSE
_ 
****  5.2  SINGLE TRUNK 
? 
  
        BEGIN 
        SMLI := ORD(BFDATAC[TRTRP]);        _LINE (PORT) FROM SM       ?
        IF SMLI > 0 THEN                    _CHECK IF PORT IN RANGE    ?
        IF SMLI @ C0NPBL
        THEN
          BEGIN                             _YES IT IS                 ?
          ADDR (CGLCBP'[SMLI],WKPTR);       _GET PTR TO TRCB           ?
          WKPTR  := WKPTR'.BZZLCB.BZTCBPTR; 
          FNDSTS := WKPTR'.TRKCB.TRCNFST;   _SAVE STATUS FROM TRCB     ?
          PN2SWLE (D9TR);                   _BUILD SWE FOR TRUNK STATUS?
          END; _IF SMLI IN RANGE? 
        END; _IF SMSFC = D9NP ELSE? 
  
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR LIP CODE  ******  ?
      END; _D8TRS CASE? 
  
_ 
****  6    COUPLER STATUS REQUEST 
? 
      D8CPS:  
  
      BEGIN 
      IF SMSFC = D9NP                       _PROCESS CPLR STATUS TYPE  ?
      THEN
_ 
****  6.1  ALL COUPLERS ON NPU
? 
  
        BEGIN 
        PN2NPUSTATUS;                       _BUILD SWE FOR NPU STATUS  ?
        REQSTS := ORD(BFDATAC[CPNPST]);     _SAVE REQUESTED STATUS     ?
        FOR I := 3 TO (C0NCPLR + 2) DO      _FOR EACH COUPLER ON NPU   ?
          BEGIN 
          WKPTR := CSUBLCBP'[I].BZTCBPTR;   _GET PTR TO CPCB FROM SLCB ?
          IF WKPTR " NIL                    _CHECK IF CPCB EXISTS      ?
          THEN
            BEGIN                           _YES IT DOES               ?
            FNDSTS := WKPTR'.BHCCB.BHCNFST; _SAVE STATUS FROM CPCB     ?
            PN2CHECK (D9CP);                _MAYBE BUILD SWE FOR CPLR  ?
            END; _IF WKPTR " NIL? 
          END; _FOR I := 3 TO (C0NCPLR+2) DO? 
        END _IF SMSFC = D9NP? 
      ELSE
_ 
****  6.2  SINGLE COUPLER 
? 
  
        BEGIN 
        NODE1  := ORD(BFDATAC[CPCPN1]);     _GET NODE ID FROM SM       ?
        DNENTRY := PN1GTPTR(NODE1,DELOCDN); _GET PTR TO DN ENTRY FOR N1?
        IF DNENTRY " NIL                    _CHECK IF DN ENTRY EXISTS  ?
        THEN
          IF DNENTRY'.BRTYP1.BRLNKT         _CHECK IF DN IS FOR CPLR   ?
            = NLCOUPLER 
          THEN
            BEGIN                           _YES IT IS                 ?
            WKPTR := PN1SRCH(NODE1,DELOCDN);_GET PTR TO CPCB           ?
            FNDSTS := WKPTR'.BHCCB.BHCNFST; _SAVE STATUS FROM CPCB     ?
            PN2SWLE (D9CP);                 _BUILD SWE FOR CPLR STATUS ?
            END; _IF DNENTRY'.BRTYP1.BRLNKT = NLCOUPLER?
        END; _IF SMSFC = D9NP ELSE? 
  
      END; _D8CPS CASE? 
_ 
****  7    SVC STATUS REQUEST 
? 
      D8VCS:  
  
      BEGIN 
      CASE SMSFC OF                         _CASE OUT THE SFC OF SM    ?
_ 
****  7.1  ALL SVC ON NPU 
? 
        D9NP: 
  
        BEGIN 
        PN2NPUSTATUS;                       _BUILD SWE FOR NPU STATUS  ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
        FOR SMLI := (C0NPBL+1) TO C4LCBS DO _FOR EACH LINE ON THE NPU  ?
          BEGIN 
          IF PN2VALIDLINE(0)                _CHECK LINE CONFIGURED     ?
          THEN
            IF WKPTR'.BZZLCB.BZTIPTYPE =    _SVC DEFINED ON X.25 LINES ?
                                   N1X25    _ ONLY                     ?
            THEN
              BEGIN 
              PN2LINESTATUS;                _BUILD SWE FOR LINE STATUS ?
              PN2ALSVCLINE;                 _PROCESS STATUS OF ALL SVCS?
              END; _IF N1X25? 
          END; _FOR SMLI := (C0NPBL+1) TO C4LCBS DO?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
        END; _D9NP CASE?
_ 
****  7.2  ALL SVC ON A LINE
? 
        D9LI: 
  
        BEGIN 
        SMLI := ORD(BFDATAC[VCLIP]);        _LINE (PORT) FROM SM       ?
        IF PN2VALIDLINE (0)                 _CHECK IF VALID LINE       ?
        THEN
          BEGIN                             _YES IT IS                 ?
          PN2LINESTATUS;                    _BUILD SWE FOR LINE STATUS ?
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
          PN2ALSVCLINE;                     _PROCESS STATUS OF ALL SVCS?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
          END; _IF PN2VALIDLINE (0)?
        END; _D9LI CASE?
_ 
****  7.3  SINGLE SUB TIP SVC 
? 
        D9VC: 
  
        BEGIN 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
        SMPSP.BDLINO :=                     _LINE (PORT/SUBPORT)       ?
            ORD(BFDATAC[VCLIP]) * $100
          + ORD(BFDATAC[VCLISP]); 
        WKPTR := PNFNDSVC(SMPSP,SMPTR,VCVCAN);  _PTR TO MATCHING TCB   ?
        IF WKPTR " NIL                      _IF GROUP TCB EXISTS       ?
        THEN
          PN2SVCSTATUS                      _SVC STATUS                ?
        ELSE
          BEGIN                             _SVC NOT CONFIGURED        ?
          WKPTR := PBGET1BF(BEDBSIZE);      _GET BFR FOR SVC STATUS    ?
          FOR I := (VCVCP/2+1) TO           _COPY PARAMETERS FROM SM   ?
                  ((VCVCAN+6)/2+1) DO 
            WKPTR'.BIINT[I] := BIINT[I];
          FOR I := 0 TO 2 DO                _ENSURE STATUS FIELDS ZERO ?
            WKPTR'.BFDATAC[VCLIST + I] := CHR(0); 
          WKPTR'.BFDATAC[VCSTIP] := CHR(0); _ENSURE STIP IS NIL        ?
          FNDSTS := C7NOTCNF;               _STATUS IS NOT CONFIGURED  ?
          PN2SWLE (D9VC);                   _BUILD SWE FOR SVC STATUS  ?
          END; _WKPTR " NIL ELSE? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
        END; _D9VC CASE?
  
      END; _CASE SMSFC OF?
      END; _D8VCS CASE? 
  
    END; _CASE ORD(BFDATAC[PFC]) OF?
_ 
****  NOW FOR ALL CASES BUILD A RESPONSE SWE TO GENERATE A RESPONSE TO
****  THE ORIGINAL STATUS REQUEST AND SEND A D0SACTIVATE WORKLIST TO
****  THE SERVICE MODULE TO KICK OFF THE STATUS WORKLIST PROCESSOR
? 
    FNDSTS := C7DUMMY;                      _FOUND STATUS N/A          ?
    WKPTR  := SMPTR;                        _WORK PTR TO THE SM ITSELF ?
    PN2SWLE (D9RESPONSE);                   _BUILD SWE FOR RESPONSE SM ?
  
    WITH BWWLENTRY[OPS].CMSMLEY DO          _INTERMEDIATE ARRAY ACCESS ?
      BEGIN 
      CMWKCODE := D0SACTIVATE;              _WAKE UP WORK CODE         ?
      PBLSPUT (BWWLENTRY[OPS],              _QUEUE WORKLIST TO SVM     ?
               BYWLCB[B0SMWL]); 
      END; _WITH BWWLENTRY[OPS].CMSMLEY DO? 
  
    END; _IF PBBFAVAIL .... = FALSE ELSE? 
  END; _IF ORD(BFDATAC[SN]) " CS ELSE?
END; _WITH SMPTR' DO? 
END; _PROCEDURE PNSMSTATUS? 
_$J+? 
_ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                  PNSMTMR                                            * 
*                                                                     * 
*        SERVICE MODULE TIMING SERVICES PROCESSOR                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMTMR PROVIDES THE TIMING SERVICES REQUIRED BY       * 
*              SERVICE MODULE ROUTINES.                               * 
*              WHEN A ROUTINE NEEDS TO TIME OUT AN EVENT IT PUTS A    * 
*              WORKLIST INTO THE B0SMTMR WORKLIST QUEUE. THE WORKLIST * 
*              IS GENERALLY IDENTICAL TO THAT EXPECTED BY SVM (PNSMWL)* 
*              BUT INCLUDES A TIMER FIELD TO INDICATE HOW LONG THE    * 
*              EVENT IS TO TIMED OUT.                                 * 
*              PNSMTMR RECEIVES CONTROL FROM PBTIMAL EVERY SECOND AND * 
*              CHECKS EACH WORKLIST IN ITS QUEUE. IF THE TIMER HAS    * 
*              EXPIRED THEN THE WORKLIST IS QUEUED TO THE SVM WORKLIST* 
*              PROCESSOR, OTHERWISE THE TIMER IS DECREMENTED AND THE  * 
*              WORKLIST IS REQUEUED.                                  * 
*                                                                     * 
** INPUT -     DELAYED WORKLISTS FROM ALL OVER THE SERVICE MODULE     * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              1) PBTIMAL         CALL OPS LEVEL TIME DEPENDENT PGMS  * 
*                                                                     * 
** OUTPUT -    TIMED OUT WORKLISTS QUEUED TO SVM WORKLIST PROCESSOR   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*           DIRECT CALLS -                                            * 
*              1) PBLSGET          GET A WORK LIST ENTRY              * 
*              2) PBLSPUT          MAKE A WORK LIST ENTRY             * 
*           WORKLIST ENTRIES MADE TO -                                * 
*              1) PNSMWL           SVM WORKLIST PROCESSOR             * 
*              2) PNSMTMR          THATS ME                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMTMR;
  
VAR 
      I : INTEGER;                          _LOOP COUNTER              ?
      X : BOOLEAN;                          _PBLSGET RESULT            ?
  
BEGIN 
WITH DWWLENTRY.CMSMLEY DO                   _DELAYED WORKLIST AREA     ?
  FOR I := BYWLCB[B0SMTMR].BYCNT DOWNTO 1 DO   _FOR EACH ENTRY IN QUEUE?
    BEGIN 
    X := PBLSGET (DWWLENTRY,                _GET NEXT WORKLIST ENTRY   ?
                  BYWLCB[B0SMTMR]); 
    IF CMSMGEN = FALSE                      _IF NOT CALL TO *PNSMGEM*  ?
    THEN
      IF CMWKCODE = D0TCKCON                _CONNECTION TIMER          ?
      THEN
        IF CMPTR'.BZZLCB.BZTIPTYPE = N0LINIT
        THEN
          GOTO 999;                         _DISREGARD TIMER ENTRY     ?
    IF CMREALTIMER = 0                      _CHECK IF TIMER EXPIRED    ?
    THEN
_ 
****  WORKLIST TIMER HAS EXPIRED
? 
      BEGIN                                 _YES IT HAS EXPIRED        ?
      IF CMSMGEN                            _CHECK IF PNSMGEN ENTRY    ?
      THEN
        BEGIN                               _YES IT IS                 ?
        CMDATA   := CMPRM1;                 _SHIFT PARAMETER 1         ?
        CMWKCODE := D0TSMGEN;               _SET SVM WORKCODE          ?
        END; _IF CMSMGEN? 
  
      PBLSPUT (DWWLENTRY,                   _SEND WORKLIST TO SVM      ?
               BYWLCB[B0SMWL]); 
      END _IF CMREALTIMER = 0?
    ELSE
_ 
****  WORKLIST TIMER HAS NOT EXPIRED
? 
      BEGIN                                 _NO, TIMER HAS NOT EXPIRED ?
      CMREALTIMER := CMREALTIMER - 1;       _DECREMENT TIMER           ?
      PBLSPUT (DWWLENTRY,                   _REQUEUE WORKLIST ENTRY    ?
               BYWLCB[B0SMTMR]);
      END; _IF CMREALTIMER = 0 ELSE?
  
999:  
    END; _FOR I := .... DOWNTO 1 DO?
END; _PROCEDURE PNSMTMR?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                    PNSMWL                                           * 
*                                                                     * 
*        SERVICE MODULE WORKLIST PROCESSOR                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$R-,G-,I-? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW -  PNSMWL IS GIVEN CONTROL BY THE MONITOR TO PROCESS      * 
*              WORKLIST ENTRIES (WLE) MADE TO SVM.  PNSMWL ACTS AS A  * 
*              SWITCH, PASSING CONTROL TO THE APPROPRIATE PROCESS     * 
*              BASED ON THE WORKCODE (CMWKCODE) IN THE WLE.           * 
*                                                                     * 
** INPUT -     PNSMWL RECEIVES ALL WORKLIST ENTRIES FOR SVM.          * 
*                                                                     * 
** CALLING PROGRAMS -                                                 * 
*              DIRECT CALLS -                                         * 
*                PBMONITOR  - THE MONITOR                             * 
*              THE FOLLOWING PROGRAMS GENERATE WLE TO SVM             * 
*                                                                     * 
*                                                                     * 
** OUTPUT -    THE INPUT WLE IS PASSED IN THE INTERMEDIATE ARRAY.     * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              DIRECT CALLS BY NAME -                                 * 
*                PNLINK       - PROCESS LINK EVENTS                   * 
*                PNLINE       - PROCESS LINE EVENTS                   * 
*                PNTCB        - PROCESS TCB EVENTS                    * 
*                PNSMTO      - PROCESS TIMED EVENTS                   * 
*                PBCALL       - CALL PROGRAM BY ADDRESS               * 
*              THE FOLLOWING SVM SUBROUTINES ARE CALLED DIRECTLY VIA  * 
*              PBCALL USING THE ADDRESS IN CMPTR OF THE WLE.          * 
*                PNBWEPROC    - PROCESS BROADCAST MESSAGE             * 
*                PNSWEPROC    - PROCESS STATUS WORK ELEMENTS          * 
*                PNINITERR    - PROCESS INITIALIZATION ERRORS         * 
*                                                                     * 
** NOTES -                                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PNSMWL; 
  
VAR 
      SMDBGI : INTEGER;                     _INDEX TO NEXT WORKLIST    ?
      SMDBGA : ARRAY [0..24] OF CMSMWLE;    _SAVED WORKLIST ENTRY ARRAY?
      SMPFC : INTEGER;                      _PFC OF RECEIVED SM        ?
  
BEGIN 
SMDBGA [SMDBGI] := BWWLENTRY[OPS].CMSMLEY;  _SAVE WORKLIST ENTRY       ?
SMDBGI          := (SMDBGI + 1) MOD 25;     _UPDATE INDEX INTO ARRAY   ?
WITH BWWLENTRY[OPS].CMSMLEY DO              _ WITH WORKLIST ENTRY      ?
  CASE CMWKCODE OF                          _ CASE THE WORKCODE        ?
  
    D0SACTIVATE,                            _STATUS WORK EVENT PROC    ?
    D0NACTIVATE,                            _NOTIFY WORK EVENT PROC    ?
    D0BACTIVATE,                            _BROADCAST WORK EVENT PROC ?
    D0IACTIVATE :                           _INIT ERROR EVENT PROC     ?
      BEGIN 
      DWXACTIVATE.CMSMLEY.CMWKCODE          _PUT WKCODE IN LOCAL ARRAY ?
        := CMWKCODE;
  
      WITH DYLISTCB[CMWKCODE - D0BIAS] DO   _SET INDEX TO PROPER WLCB  ?
        PBXFER (BYPRADDR,BYPAGE);           _TRANSFER CONTOL TO PROGRM ?
      END;
  
    D0LINK :                                _  LINK EVENT              ?
      PNLINK;                               _   CALL LINK WL HANDLER   ?
  
    D0LINE :                                _  LINE EVENT              ?
      PNLINE;                               _   CALL LINE WL HANDLER   ?
  
    D0TCB :                                 _  TCB EVENT               ?
      PNTCB;                                _   CALL TCB WL HANDLER    ?
  
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******?
*IF DEF,X25 
    D0X25:                                  _ CONNECTION REQUEST - X25 ?
      PNX25CON;                             _ CALL X25 CONN WL HANDLER ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******?
  
    D0SM:                                   _  SM FOR DISPATCH         ?
      BEGIN 
      SMPFC := ORD(CMPOINT'.BFDATAC[PFC]);  _EXTRACT THE PFC OF SM     ?
      IF SMPFC \ D8FIRST                    _CHECK IF PFC IN RANGE     ?
      THEN
        IF SMPFC @ D8LAST 
        THEN                                _YES IT IS                 ?
          WITH DBPFCTBLE [SMPFC] DO         _SET INDEX TO PFC ENTRY    ?
            IF DBOUTRTE = J4DISPATCH        _CHECK IF TO BE DISPATCHED ?
            THEN
              BEGIN 
              PBCALL (DBHANDLER,CMPOINT);   _YES - CALL THE SM HANDLER ?
              GOTO 10;
              END;
      PBRELCHN (CMPOINT,BEDBSIZE);          _INVALID SM - RELEASE BFRS ?
10: 
      END;
  
    D0TSMGEN :                              _PNSMGEN TIMER RE-ENTRY    ?
      BEGIN 
      GENPFC       := CMDATA;               _RESTORE PFC               ?
      GENSFC.DHINT := CMPRM2;               _RESTORE SFC               ?
      GENSUP       := CMPRM3;               _RESTORE SUPERVISOR        ?
      GENPAR       := CMPRM4;               _RESTORE PARAMETER         ?
      WITH BRTNJUMP[C1PNSMGEN] DO           _CALL PNSMGEN              ?
        PBXFER (JENTADDR,JPAGEVAL); 
      END;
  
    D0TCONNECT :                            _CONNECTION RETRY ATTEMPT  ?
      BEGIN 
      CMPOINT'.BSTCB.BSCNTIMER := FALSE;    _TURN OFF TIMER FLAG       ?
      IF CMPOINT'.BSTCB.BSDELTCB            _IF TCB IS TO BE DELETED   ?
      THEN
        BEGIN 
        IF (CMPOINT'.BSTCB.BSSTATE " D4TPEND) 
        THEN                                _IF CONNECTION NOT BEING   ?
          IF (CMPOINT'.BSTCB.BSSTATE " D4IPREQ) 
          THEN                              _INITIATED THEN DELETE IT  ?
            IF PNTCBCHAIN(CMPOINT)          _IF TCB STILL CHAINED      ?
            THEN
              PNCNDLT (CMPOINT);            _ELSE IGNORE THE TIMEOUT   ?
        END 
      ELSE
        BEGIN 
        IF CMPOINT'.BSTCB.BSDEVTYP " N1CON
        THEN                                _PASSIVE DEVICE            ?
          PNCNINIT (CMPOINT)                _ATTEMPT CONNECTION        ?
        ELSE
          IF CMPOINT'.BSTCB.BSACON          _CONSOLE DEVICE            ?
          THEN                              _AND STILL AUTO-CONNECT    ?
            PNCNINIT (CMPOINT)              _ATTEMPT CONNECTION        ?
        END;
      END;
  
    D0TCKCON :                              _CHECK ANY CONNECTED TMLS  ?
      PNTCKCON (CMPTR); 
  
    D0TCKENB :                              _CHECK ANY ENABLED TMLS    ?
      PNTCKENB (CMPTR); 
_  ******  CAUTION - HIDDEN *IF DEF,X25  ******  ?
*IF DEF,X25 
  
    D0XCKCON :                              _ CHECK X25 TML CONNECTION ?
      IF PNTCBCHAIN(CMPTR)                  _IF TCB STILL CHAINED      ?
      THEN
        PNXCKCON (CMPTR);                   _THEN PROCESS THE TIMEOUT  ?
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25 CODE  ******  ?
  
    END; _ CASE ? 
END; _ PNSMWL ? 
