*COMDECK PBBPM
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        P B U B P M   -   UPLINE BLOCK PROTOCOL HANDLER              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$G-,R-,I-    NON RECURSIVE, INTERRUPTABLE ?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE HANDLES ALL THE UPLINE BLOCK PROTOCOL    * 
*             ELEMENTS GENERATED LOCALLY IN THIS NPU                  * 
*                                                                     * 
** INPUT    - B1TCB  POINTER TO THE TCB, K2BLKP AND K2BLKTP  THE      * 
*             BLOCK POINTER AND TYPE (PARAMETERS). THE BLOCK PTR      * 
*             CAN BE NIL TO ALLOW FOR AN UPLINE QUEUE CHECK (AFTER    * 
*             A DOWNLINE BACK HAS BEEN RECEIVED)                      * 
*                                                                     * 
** OUTPUT   - BLOCK PASSED TO BLOCK TRANSPORT VIA A WLE OR            * 
*             PASSED TO PBLOST FOR BAD BLOCKS.                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PTGETSET    - GET TRANSMITTER/RECEIVER STATES AS SET    * 
*             PGPURGEQUE  - PURGE UP AND/OR DOWNLINE QUEUE            * 
*             PBRELCHN    - RELEASE A CHAIN OF BUFFERS                * 
*             PBRELZRO    - RELEASE A POSSIBLE CHAIN OF BUFFERS       * 
*             PBSWLE      - SWITCH UPLINE BLOCK TO BLOCK TRANSPORT    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PBUBPM (K2BLKP : B0BUFPTR; K2BLKTP : INTEGER);
  
CONST 
  K2LIMIT = 63;                             _OUTSTANDING BLOCK LIMIT   ?
  
VAR 
  K2BT    : BLKTYPE;                        _ BLOCK TYPE OVERLAY       ?
  K2TSSET : B0OVERLAY;                      _TRANSMITTER STATE SET     ?
  K2RSSET : B0OVERLAY;                      _RECEIVER STATE SET        ?
  K2BUFP  : B0BUFPTR;                       _WORK BUFFER POINTER       ?
  K2QPTR  : 'B0BUFPTR;                      _WORK QUEUE POINTER        ?
  K2SEND  : BOOLEAN;                        _SEND U/L FLAG             ?
  K2OBCNT : INTEGER;                        _OUTSTANDING BLOCK COUNT   ?
  
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE NOTIFIES THE INTERACTIVE USER THAT INPUT * 
*             HAS BEEN DISCARDED, OR BREAKS THE CONNECTION IF IT IS   * 
*             BATCH OR APPLICATION TO APPLICATION.                    * 
*                                                                     * 
** INPUT    - B1TCB  POINTER TO THE TCB                               * 
*                                                                     * 
** OUTPUT   - MESSAGE TO USER, OR CONNECTION BROKEN                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PNNOTIFY    - SEND MESSAGE TO USER                      * 
*             PBLSPUT     - MAKE A WORKLIST ENTRY                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PBINPDISC;
  
BEGIN 
IF B1TCB'.BSTCB.BSDEVTYP = N1CON
THEN                                        _CONSOLE CONNECTION        ?
  PNNOTIFY (-H2INPDISC, B1TCB)              _TELL USER INPUT DISCARDED ?
ELSE
  WITH BWWLENTRY [OPS].CMSMLEY DO 
    BEGIN                                   _BATCH OR A-A BREAK CONNECT?
    CMWKCOD := D0TCB;                       _TCB EVENT                 ?
    CMDATA  := D5DISC;                      _EVENT IS DISCONNECT       ?
    CMPTR   := B1TCB;                       _INSERT TCB ADDRESS        ?
    CMRC    := DADISC;                      _INSERT REASON CODE        ?
    PBLSPUT (BWWLENTRY[OPS],
             BYWLCB [B0SMWL]);              _SEND WORKLIST TO SVM      ?
    END;
END; _PROCEDURE PBINPDISC?
_$J+? 
_ 
* * * *  S T A R T   P R O C E D U R E   P B U B P M
? 
BEGIN 
WITH B1TCB'.BSTCB DO
  BEGIN 
  PTGETSET (BSTRSTATE, K2TSSET);            _GET TRANSMITTER STATE SET ?
  PTGETSET (BSRSTATE, K2RSSET);             _GET RECEIVER STATE SET    ?
  K2SEND      := FALSE;                     _PRESET FOR NOT SEND       ?
  K2BT.BTCHR  := CHR (K2BLKTP);             _CLEAR BSN/PRI, SET BT     ?
  
  IF BSCN " 0 
  THEN                                      _NON-ZERO CONNECTION       ?
    CASE K2BLKTP OF 
  
_$J+? 
_***********************************************************************
*                                                                      *
*                    UPLINE BLOCKS FROM TRANSMITTER                    *
*                                                                      *
***********************************************************************?
  
_******************** 
*                   * 
*  U/L BLK,MSG,CMD  * 
*      QBLK,QMSG    * 
*                   * 
********************? 
  
    HTBLK, HTMSG, HTCMD, HTQBLK, HTQMSG:  
      IF [BTDATAXFER, BTICRCPEND, BTITNCPEND] & _TS NOT DATA XFER OR   ?
         K2TSSET.BASETN = [ ]               _ICMDR FROM CONNECT PENDING?
      THEN                                  _OR INITN PENDING          ?
        BEGIN                               _TS NOT OK, DISCARD BLOCK  ?
        IF K2BLKP " NIL 
        THEN                                _NOT CALLED FROM D/L BACK  ?
          PBINPDISC;                        _DISCARD UPLINE BLOCK      ?
        END 
      ELSE                                  _TS OK, CHECK U/L BLOCK CNT?
        BEGIN 
  
            IF BSISYNC                      _IF INPUT SYNC IS ON       ?
            THEN
              IF K2BLKP " NIL               _MAKE SURE THIS IS NOT AN  ?
              THEN                          _U/L QUEUE CHECK           ?
                IF NOT BSISSENT             _IF UPLINE DATA IS ALLOWED ?
                THEN
                  BSISSENT :=               _CHANGE THE INPUT SEMAPHORE?
                    (K2BLKTYPE = HTMSG) 
                ELSE                        _ELSE                      ?
                  IF K2BLKTYPE " HTCMD      _UPLINE DATA IS NOT ALLOWED?
                  THEN                      _DISCARD BLKS AND MSGS     ?
                    BEGIN 
                    PBRELCHN (K2BLKP, BEDBSIZE0); 
                    IF BSXPT
                    THEN                    _NOTIFY THE TERMINAL       ?
                      PNNOTIFY (-H2BELL, B1TCB) 
                    ELSE                    _INPUT DISCARDED..         ?
                      PNNOTIFY (-H2INPDISC, B1TCB); 
                    END; _SYNCHRONIZE INPUT?
  
        IF K2BLKP " NIL                     _BLKP IS NIL IF REQUESTED  ?
        THEN                                _U/L QUEUE CHK (D/L BACK)  ?
          BEGIN 
          K2OBCNT := BSOBCNT + 1;           _BUMP UPLINE BLOCK COUNT   ?
          IF K2OBCNT @ K2LIMIT
          THEN
            BEGIN 
            K2BLKP'.BIINT [FLWD] := K2BLKTP;_PUT BLOCK TYPE IN BUFFER  ?
            K2BLKP'.
                 BCCHAINS [QCHN] := NIL;    _CLEAR QUEUE CHAIN         ?
            ADDR (BSFULLQ, K2QPTR); 
            WHILE K2QPTR' " NIL DO          _LOCATE END U/L QUEUE      ?
              ADDR (K2QPTR''.BCCHAINS 
                    [QCHN], K2QPTR);
            K2QPTR' := K2BLKP;              _INSERT AT END U/L QUEUE   ?
            BSOBCNT := K2OBCNT; 
            IF K2OBCNT @ BSUBL
            THEN                            _UBL NOT EXCEEDED          ?
              K2BLKP := NIL;                _ALLOW BLOCK TO GO UPLINE  ?
            IF K2BLKTP @ HTMSG
            THEN                            _BLK OR MSG BLOCK          ?
              BEGIN 
              IF BSQBLKUP                   _LAST U/L BLOCK = QBLK     ?
              THEN
                PBINPDISC                   _DISCARD, BREAK CONNECTION ?
              ELSE
                BSBLKUP := K2BLKTP = HTBLK; _REMEMBER LAST BLK/MSG U/L ?
              END _IF K2BLKTP @ HTMSG THEN? 
            ELSE
              BEGIN 
              IF K2BLKTP \ HTQBLK           _QBLK OR QMSG BLOCK        ?
              THEN
                BEGIN 
                IF BSBLKUP                  _LAST U/L BLOCK = BLK      ?
                THEN
                  PBINPDISC                 _DISCARD, BREAK CONNECTION ?
                ELSE
                  BSQBLKUP := K2BLKTP =     _REMEMBER LAST QBLK/QMSG UL?
                              HTQBLK; 
                END; _IF K2BLKTP \ HTQBLK THEN? 
              END; _IF K2BLKTP @ HTMSG ELSE?
            END 
          ELSE
_ 
* * * *  TIP IS IGNORING INPUT REGULATION, PREVENT MORE SERIOUS NPU 
*        REGULATION PROBLEMS BY IGNORING THE INPUT
? 
            BEGIN 
            PBRELCHN (K2BLKP, BEDBSIZE);    _RELEASE INPUT OVER LIMIT  ?
            PBINPDISC;                      _INPUT HAS BENN DISCARDED  ?
            K2BLKP   := NIL + 1;            _DISALLOW BLOCK UPLINE     ?
            END;
          END; _IF K2BLKP " NIL?
        IF K2BLKP = NIL                     _D/L BACK OR UBL NOT EXCEED?
        THEN                                _THEN SEND A BLOCK UPLINE  ?
         BEGIN
         IF NOT (BTITNCPEND IN K2TSSET.BASETN) _IF NOT INIT PENDING    ?
         THEN 
          BEGIN 
          K2BLKP := BSFULLQ.BABUFPTR;       _GET FIRST BLK FM U/L QUEUE?
          IF K2BLKP " NIL 
          THEN                              _FOUND U/L DATA TO SEND    ?
            BEGIN 
            BSFULLQ.BABUFPTR := K2BLKP'.
              BCCHAINS [QCHN];              _DEQUEUE FM U/L QUEUE      ?
            K2SEND     := TRUE;             _TS OK, U/L DATA LOCATED   ?
            K2BT.BTCHR := CHR (K2BLKP'. 
                          BIINT [FLWD]);    _GET BLOCK TYPE FROM BUFFER?
            BSCUBSN    := K0BSNA
                          [BSCUBSN + 1];    _GET NEXT U/L BSN          ?
            K2BT.BTBSN := BSCUBSN;          _PUT BSN IN OVERLAY        ?
            END;
          END; _ END IF NOT INIT PENDING? 
         END _IF K2BLKP = NIL THEN? 
        ELSE
          K2BLKP := NIL;                    _MAKE PBLOST CALL VALID    ?
        END;
  
_******************** 
*                   * 
*  U/L    RESET     * 
*                   * 
********************? 
  
    HTRESET:  
      IF BTRSTPPEND IN K2TSSET.BASETN       _TS RESET FROM PROCESS PEND?
      THEN
        BEGIN 
        K2SEND    := TRUE;                  _TS OK, SHIP RESET         ?
        BSTRSTATE := BTDATAXFER;            _TS NOW DATA TRANSFER      ?
        IF BRRSTPPEND IN K2RSSET.BASETN 
        THEN                                _RS RESET FROM PROCESS PEND?
          BSRSTATE := BRDATAXFER;           _RS NOW DATA TRANSFER      ?
        END;
  
_******************** 
*                   * 
*  U/L    INITR     * 
*                   * 
********************? 
  
    HTRINIT:  
      IF [BTITNCPEND, BTTRMCPEND] &         _TS NOT INITN OR TERM      ?
         K2TSSET.BASETN = [ ]               _FROM CONNECTION PENDING   ?
      THEN
        BEGIN 
        PGPURGEQUE (K4UPLN);                _PURGE UPLINE QUEUE(S)     ?
        K2SEND    := TRUE;                  _TS OK, SHIP INITR         ?
        BSTRSTATE := BTITNCPEND;            _TS INITN FROM CONNECT PEND?
        BSLUBSN   := 0;                     _CLEAR LAST UL BSN         ?
        BSCUBSN   := 0;                     _CLEAR CURRENT UL BSN      ?
        BSBLKUP   := FALSE;                 _CLEAR BLK BLOCK U/L FLAG  ?
        BSQBLKUP  := FALSE;                 _CLEAR QBLK BLOCK U/L FLAG ?
        END;
  
_******************** 
*                   * 
*  U/L    ICMD      * 
*                   * 
********************? 
  
    HTICMD: 
      IF BTDATAXFER IN K2TSSET.BASETN       _TS DATA TRANSFER          ?
      THEN
        BEGIN 
        K2SEND    := TRUE;                  _TS OK, SHIP ICMD          ?
        BSTRSTATE := BTICRCPEND;            _TS ICMDR FROM CONNECT PEND?
        END 
      ELSE
        PBINPDISC;                          _INPUT HAS BEEN DISCARDED  ?
  
_******************** 
*                   * 
*  U/L    TERM      * 
*                   * 
********************? 
  
    HTTERM: 
      IF [BTINITIAL, BTTRMCPEND] &          _TS NOT INITIAL OR TERM    ?
         K2TSSET.BASETN = [ ]               _FROM CONNECTION PENDING   ?
      THEN
        BEGIN 
        K2SEND    := TRUE;                  _TS OK, SHIP TERM          ?
        PGPURGEQUE (K4UPLN);                _PURGE UPLINE QUEUE(S)     ?
        BSTRSTATE := BTTRMCPEND;            _TS TERM FROM CONNECT PEND ?
        BSRSTATE  := BRTERMPEND;            _RS TERM FROM CONNECT PEND ?
        END;
  
  
_***********************************************************************
*                                                                      *
*                    UPLINE BLOCKS FROM RECEIVER                       *
*                                                                      *
***********************************************************************?
  
_******************** 
*                   * 
*  U/L    INITN     * 
*                   * 
********************? 
  
    HTNINIT:  
      IF BRITNPPEND IN K2RSSET.BASETN       _RS INITN FROM PROCESS PEND?
      THEN
        BEGIN 
        K2SEND   := TRUE;                   _RS OK, SHIP INITN         ?
        BSRSTATE := BRDATAXFER;             _RS NOW DATA TRANSFER      ?
        END;
  
_******************** 
*                   * 
*  U/L    BACK      * 
*                   * 
********************? 
  
    HTBACK: 
      IF [BRDATAXFER, BRICRPPEND] &         _RS DATA TRANSFER OR ICMDR ?
         K2RSSET.BASETN " [ ]               _FROM PROCESS PENDING      ?
      THEN                                  _RS OK TO SEND BACK        ?
        IF BSBCKDUE " 0 
        THEN                                _U/L BACK(S) DUE           ?
          BEGIN 
          K2SEND     := TRUE; 
          BSBCKDUE   := BSBCKDUE - 1;       _DECREMENTS U/L BACKS DUE  ?
          BSLDBSN    := K0BSNA [BSLDBSN+1]; _GENERATE NEXT D/L BSN     ?
          K2BT.BTBSN := BSLDBSN;            _PUT BSN IN OVERLAY        ?
          END;
  
_******************** 
*                   * 
*  U/L    BREAK     * 
*                   * 
********************? 
  
    HTBREAK:  
      IF [BRDATAXFER, BRRSTPPEND, BRICRPPEND] & 
         K2RSSET.BASETN " [ ]               _RS DATA TRANSFER OR RESET ?
      THEN                                  _OR ICMDR FROM PROCESS PEND?
        BEGIN 
        BSLDBSN  := 0;                      _CLEAR LAST DL BSN         ?
        BSCDBSN  := 0;                      _CLEAR CURRENT DL BSN      ?
        BSBCKDUE := 0;                      _CLEAR BACKS DUE           ?
        PGPURGEQUE (K4DWNLN);               _PURGE DOWNLINE QUEUE      ?
        IF BRRSTPPEND IN K2RSSET.BASETN 
        THEN                                _RS RESET FROM PROCESS PEND?
          BSRSTATE := BRDATAXFER            _RS NOW DATA TRANSFER      ?
        ELSE
          BEGIN 
          K2SEND   := TRUE;                 _RS OK, SHIP BREAK         ?
          BSRSTATE := BRRSTCPEND;           _RS RESET FROM CONNECT PEND?
          END;
  
        IF [BTDATAXFER, BTRSTPPEND, BTICRCPEND] & 
           K2TSSET.BASETN " [ ]             _TS DATA TRANSFER OR RESET ?
        THEN                                _FROM PROCESS OR ICMDR FROM?
          BEGIN                             _CONNECTION PENDING        ?
          PGPURGEQUE (K4UPLN);              _PURGE UPLINE QUEUE        ?
          BSLUBSN := 0;                     _CLEAR LAST UL BSN         ?
          BSCUBSN := 0;                     _CLEAR CURRENT UL BSN      ?
          IF BTRSTPPEND IN K2TSSET.BASETN 
          THEN                              _TS RESET FROM PROCESS PEND?
            BEGIN 
            K2SEND        := TRUE;          _TS OK, SHIP RESET BLOCK   ?
            K2BT.BTYPE    := HTRESET;       _RATHER THAN BREAK BLOCK   ?
            K2BLKP'.BFLCD := BTPT;          _ADJUST LCD FOR RESET BLOCK?
            BSTRSTATE     := BTDATAXFER;    _TS NOW DATA TRANSFER      ?
            END 
          ELSE
            BSTRSTATE  := BTRSTCPEND;       _TS RESET FROM CONNECT PEND?
          END;
        END;
  
_******************** 
*                   * 
*  U/L    ICMDR     * 
*                   * 
********************? 
  
      HTICMR: 
      IF BRICRPPEND IN K2RSSET.BASETN       _RS ICMDR FROM PROCESS PEND?
      THEN
        BEGIN 
        K2SEND   := TRUE;                   _RS OK, SHIP ICMDR         ?
        BSRSTATE := BRDATAXFER              _RS NOW DATA TRANSFER      ?
        END;
  
    END; _CASE K2BLKTP OF?
  
  IF BSIPRI = 1 
  THEN
    K2BT.BTPRID := TRUE;                    _INSERT PRIORITY BIT       ?
  END; _WITH B1TCB'.BSTCB DO? 
_ 
* * * *  IF AN UPLINE BLOCK GENERATED, INSERT NETWORK HEADER, ROUTE 
? 
IF K2SEND 
THEN
  BEGIN 
  IF K2BLKP'.BFFCD " DATA                   _IF DATA NOT STORED IN     ?
  THEN                                      _FIRST POSITION            ?
    BEGIN 
    K2BUFP        := PBGET1BF (BEDBSIZE);   _GET A NEW BUFFER          ?
    K2BUFP'.BCCHAINS [DBUFLEN] := K2BLKP;   _AND CHAIN OLD TO NEW BFR  ?
    K2BUFP'.BFLCD := BTPT;                  _INSERT LCD                ?
    K2BLKP        := K2BUFP;                _UPDATE POINTER TO DATA    ?
    END;
  WITH K2BLKP', B1TCB'.BSTCB. 
       BSLLCB'.BLLLCB.BLSPART DO
    BEGIN 
    BFFCD          := DN;                   _SET FCD                   ?
    BFDATAC [DN]   := CHR (BLSN);           _INSERT DN                 ?
    BFDATAC [SN]   := CHR (BLDN);           _INSERT SN                 ?
    BFDATAC [CN]   := CHR (B1TCB'.BSTCB.
                           BSCN);           _INSERT CN                 ?
    BFDATAC [BTPT] := K2BT.BTCHR;           _INSERT BT/PRI/BSN         ?
    END;
_ 
* * * *  PASS U/L BLOCK TO PBBLOCKTRANSPORT THROUGH WORKLIST
? 
  PBSWLE (K2BLKP);                          _SEND WLE TO BLK TRANSPORT ?
  END  _IF K2SEND THEN? 
ELSE
  PBLOST (K2BLKP);                          _RELEASE IF NOT TO BE SENT ?
  
END; _PROCEDURE PBUBPM? 
  
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        P B T I P W L E   -   BUILD/SEND A0QUEOUT WLE TO THE TIP     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$G-,R-,I-    NON RECURSIVE, INTERRUPTABLE ?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE BUILDS AND SENDS AN A0QUEOUT WORKLIST    * 
*             TO THE TIP, TO NOTIFY THE TIP THAT THE DOWNLINE TCB     * 
*             QUEUE IS CURRENTLY NOT EMPTY                            * 
*                                                                     * 
** INPUT    - B1TCB, POINTER TO THE TCB                               * 
*                                                                     * 
** OUTPUT   - WORKLIST ENTRY BUILD AND SEND TO THE TIP                * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PBPUTYP     - SEND WORKLIST ENTRY TO THE TIP            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PBTIPWLE; 
  
BEGIN 
WITH BWWLENTRY [OPS].B0EWLQ DO
  BEGIN                                     _INDEX TO WLCB ENTRY       ?
  MMWD0.BAINT    := A0QUEOUT;               _INSERT WORK CODE          ?
  MMLINO         := B1TCB'.BSTCB.BSLCBP'. 
                    BZLINO.BDLINO;          _INSERT LINE NUMBER        ?
  MMWD2.BABUFPTR := B1TCB;                  _INSERT TCB ADDRESS        ?
  END;
PBPUTYP (BWWLENTRY [OPS]);                  _SEND WORKLIST TO THE TIP  ?
END; _PROCEDURE PBTIPWLE? 
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        P B D B P M   -   DOWNLINE BLOCK PROTOCOL HANDLER            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$G-,R-,I-    NON RECURSIVE, INTERRUPTABLE ?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE HANDLES ALL DOWNLINE BLOCK DESTINED      * 
*             FOR THIS NPU, TRAVELING OVER NON-ZERO CONNECTIONS.      * 
*                                                                     * 
** INPUT    - B1BUFF, B1TCB POINTERS TO NETWORK BLOCK AND TCB         * 
*                                                                     * 
** OUTPUT   - DOWNLINE BLOCK PROCESSED AND CERTAIN BLOCKTYPES         * 
*             PASSED TO THE TIP                                       * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PBDLTS      - PASS DOWNLINE BLOCK TO TIP                * 
*             PTGETSET    - GET TRANSMITTER/RECEIVER STATES AS SET    * 
*             PGULTS      - GENERATE/SEND UPLINE BLOCK                * 
*             PBUBPM      - FORCE UPLINE DATA QUEUE CHECK             * 
*             PNREVERSE   - REVERSE DN/SN                             * 
*             PBSWLE      - ROUTE BLOCK THROUGH NETWORK               * 
*             PBLOST      - DISCARD BAD NETWORK BLOCK                 * 
*             PBRELZRO    - RELEASE POSSIBLE CHAIN OF BUFFERS         * 
*             PBTIPWLE    - BUILD AND SEND WORKLIST TO TIP            * 
*             PGPURGEQUE  - PURGE UP AND/OR DOWNLINE QUEUE            * 
*             PBLSPUT     - SEND WORKLIST ENTRY TO SVM                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PBDBPM; 
  
VAR 
  K2BT    : BLKTYPE;                        _D/L BLOCK TYPE FIELD      ?
  K2DLBSN : INTEGER;                        _D/L BSN                   ?
  K2DLBT  : INTEGER;                        _D/L BLOCK TYPE            ?
  K2PFC   : INTEGER;                        _D/L PFC OF CMD/ICMD       ?
  K2WBSN  : INTEGER;                        _WORK BSN                  ?
  K2TSSET : B0OVERLAY;                      _TRANSMITTER STATE SET     ?
  K2RSSET : B0OVERLAY;                      _RECEIVER STATE SET        ?
  K2CALLT : BOOLEAN;                        _CALL DLTS FLAG            ?
  K2ATOA  : BOOLEAN;                        _A-TO-A DEVICE TYPE        ?
  
BEGIN 
WITH B1BUFF' DO 
  BEGIN 
  K2BT.BTCHR := BFDATAC [BTPT];             _GET BT/PR/BSN LOCAL       ?
  K2PFC      := ORD (BFDATAC [PFC]);        _GET POSSIBLE PFC LOCAL    ?
  END;
WITH B1TCB'.BSTCB DO                        _INDEX TO TCB              ?
  BEGIN 
  PTGETSET (BSTRSTATE, K2TSSET);            _GET TRANSMITTER STATE SET ?
  PTGETSET (BSRSTATE, K2RSSET);             _GET RECEIVER STATE SET    ?
  K2CALLT := FALSE;                         _PRESET TO DONT CALL TIP   ?
  K2ATOA  := BSDEVTYP = N1AA;               _SET A-TO-A DEVICE FLAG    ?
  K2DLBSN := K2BT.BTBSN;                    _GET D/L BSN LOCAL         ?
  K2DLBT  := K2BT.BTYPE;                    _GET D/L BLOCKTYPE LOCAL   ?
  
  CASE K2DLBT OF                            _CASE THE D/L BLOCK TYPE   ?
_$J+? 
_***********************************************************************
*                                                                      *
*                    DOWNLINE BLOCKS FOR TRANSMITTER                   *
*                                                                      *
***********************************************************************?
  
_******************** 
*                   * 
*  D/L    INITN     * 
*                   * 
********************? 
  
    HTNINIT:  
      IF BTITNCPEND IN K2TSSET.BASETN       _TS INITN FROM CONNECT PEND?
      THEN
        BEGIN 
        BSTRSTATE := BTDATAXFER;            _TS NOW DATA TRANSFER      ?
        IF BSFULLQ.BABUFPTR " NIL 
        THEN                                _BLOCK(S) IN U/L QUEUE     ?
          PBUBPM (NIL, HTBLK);              _SEND NEXT BLK FM U/L QUEUE?
        END;
  
_******************** 
*                   * 
*  D/L    BACK      * 
*                   * 
********************? 
  
    HTBACK: 
      IF [BTDATAXFER, BTICRCPEND] &         _TS DATA TRANSFER OR ICMDR ?
         K2TSSET.BASETN " [ ]               _FROM CONNECTION PENDING   ?
      THEN                                  _OK TO PROCESS             ?
        BEGIN 
        K2WBSN := K0BSNA [BSLUBSN + 1];     _GENERATE EXPECTED BSN     ?
        IF K2DLBSN = K2WBSN 
        THEN                                _EXPECTED BSN              ?
          BEGIN 
          BSOBCNT := BSOBCNT - 1;           _DECR OUTSTANDING BLOCKCNT ?
          BSLUBSN := K2WBSN;                _UPDATE LAST U/L BSN       ?
          IF BSFULLQ.BABUFPTR " NIL 
          THEN                              _BLOCK(S) IN U/L QUEUE     ?
            PBUBPM (NIL, HTBLK);            _SEND NEXT BLK FM U/L QUEUE?
          END 
        ELSE
          PBLOST (B1BUFF);                  _BACK WITH BAD BSN FOUND   ?
        END;
  
_******************** 
*                   * 
*  D/L    BREAK     * 
*                   * 
********************? 
  
    HTBREAK:  
      IF [BTDATAXFER, BTICRCPEND, BTRSTCPEND] & 
         K2TSSET.BASETN " [ ]               _TS DATA TRANSFER OR ICMDR ?
      THEN                                  _OR RESET FROM CONNECT PEND?
        BEGIN 
        PGPURGEQUE (K4UPLN);                _PURGE UPLINE QUEUE        ?
        BSLUBSN := 0;                       _CLEAR LAST UL BSN         ?
        BSCUBSN := 0;                       _CLEAR CURRENT UL BSN      ?
        BSBLKUP  := FALSE;                  _CLEAR BLK BLOCK U/L FLAG  ?
        BSQBLKUP := FALSE;                  _CLEAR QBLK BLOCK U/L FLAG ?
        IF BTRSTCPEND IN K2TSSET.BASETN 
        THEN                                _TS RESET FROM CONNECT PEND?
          BSTRSTATE := BTDATAXFER           _TS NOW DATA TRANSFER      ?
        ELSE
          BEGIN 
          K2CALLT   := K2ATOA;              _CALL TIP IF A TO A        ?
          BSTRSTATE := BTRSTPPEND;          _TS RESET FROM PROCESS PEND?
          END;
  
        IF [BRDATAXFER, BRRSTCPEND, BRICRPPEND] & 
           K2RSSET.BASETN " [ ]             _RS DATA TRANSFER OR RESET ?
        THEN                                _FROM CONNECTION OR ICMDR  ?
          BEGIN                             _FROM PROCESS PENDING      ?
          BSLDBSN  := 0;                    _CLEAR LAST DL BSN         ?
          BSCDBSN  := 0;                    _CLEAR CURRENT DL BSN      ?
          BSBCKDUE := 0;                    _CLEAR NUMBER OF BACKS DUE ?
          PGPURGEQUE (K4DWNLN);             _PURGE DOWNLINE QUEUE      ?
          IF BRRSTCPEND IN K2RSSET.BASETN 
          THEN                              _RS RESET FROM CONNECT PEND?
            BEGIN 
            K2CALLT    := K2ATOA;           _CALL TIP IF A TO A        ?
            K2BT.BTYPE := HTRESET;          _CHANGE BLOCK TYPE TO RESET?
            B1BUFF'.BFDATAC [BTPT] :=       _STORE BLOCK TYPE IN BUFFER?
              K2BT.BTCHR; 
            BSRSTATE := BRDATAXFER;         _RS NOW DATA TRANSFER      ?
            END 
          ELSE
            BSRSTATE := BRRSTPPEND;         _RS RESET FROM PROCESS PEND?
          IF NOT K2ATOA 
          THEN
_  ******  CAUTION - HIDDEN *IF DEF,ASYNC  ******?
*IF DEF,ASYNC 
            IF BSLCBP'.BZTIPTYPE = N1ASYNC  _SPECIAL CASE ASYNCTIP     ?
            THEN                            _SHIP THIS TIP A WORKLIST  ?
              WITH BWWLENTRY[OPS].B0EWLQ DO _STATING WHICH LINE        ?
              BEGIN                         _RECEIVED A DOWNLINE BRK   ?
              MMWKCODE := A0BREAK;
              MMLINO   := BSLCBP'.BZLINO.BDLINO;
              PBLSPUT (BWWLENTRY[OPS],
                       BYWLCB[B0ASYNC]);
              END _ N1ASYNC ? 
            ELSE
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR ASYNC CODE  ******?
              BEGIN                         _NON-ASYNC NON A TO A CONN ?
              B1FLGWD.KTWORD := HTRESET;
              PGULTS (NIL);                 _SEND RESET U/L            ?
_  ******  CAUTION - HIDDEN *IF DEF,X25PAD  ******? 
*IF DEF,X25PAD
              IF BSLCBP'.BZTIPTYPE = N1X25  _SPECIAL CASE X25PADTIP    ?
              THEN                          _SHIP THIS TIP A WORKLIST  ?
                WITH BWWLENTRY[OPS].B0EWLQ DO _STATING WHICH LINE      ?
                BEGIN                       _RECEIVED A DOWNLINE BRK   ?
                MMWKCODE := A0BREAK;
                MMLINO    := 0;             _ SEND TCB ADDRESS         ?
                MMIBP     := B1TCB; 
                PBLSPUT (BWWLENTRY[OPS],
                         BYWLCB[B0X25TIP]); 
                END _ N1X25 ? 
*ENDIF
_  ******  CAUTION - HIDDEN *ENDIF FOR X25PAD CODE  ******? 
              END;
          END;
        END;
  
_******************** 
*                   * 
*  D/L    ICMDR     * 
*                   * 
********************? 
  
    HTICMR: 
      IF BTICRCPEND IN K2TSSET.BASETN       _TS ICMDR FROM CONNECT PEND?
      THEN
        BEGIN 
        BSTRSTATE := BTDATAXFER;            _TS NOW DATA TRANSFER      ?
        K2CALLT   := BSLCBP'.BZTIPTYPE =    _CALL DLTS FOR X25         ?
                     N1X25; 
        END;
  
  
_***********************************************************************
*                                                                      *
*                    DOWNLINE BLOCKS FOR RECEIVER                      *
*                                                                      *
***********************************************************************?
  
  
_******************** 
*                   * 
*  D/L    RESET     * 
*                   * 
********************? 
  
    HTRESET:  
      IF BRRSTCPEND IN K2RSSET.BASETN       _RS RESET FROM CONNECT PEND?
      THEN
        BEGIN 
        BSRSTATE := BRDATAXFER;             _RS NOW DATA TRANSFER      ?
        K2CALLT  := K2ATOA;                 _CALL DLTS FOR A TO A      ?
        IF BTRSTCPEND IN K2TSSET.BASETN 
        THEN                                _TS RESET FROM CONNECT PEND?
          BSTRSTATE := BTDATAXFER;          _TS NOW DATA TRANSFER      ?
        END;
  
_******************** 
*                   * 
*  D/L    INITR     * 
*                   * 
********************? 
  
    HTRINIT:  
      BEGIN 
      BSLDBSN  := 0;                        _CLEAR LAST DL BSN         ?
      BSCDBSN  := 0;                        _CLEAR CURRENT DL BSN      ?
      BSBCKDUE := 0;                        _CLEAR (U/L) BACKS DUE     ?
      BSSTSTOP := FALSE;                    _RESET STREAM STOPPED      ?
      BSWTOMRK := FALSE;                    _RESET WAITING FOR MARKER  ?
      BSCKCAN := FALSE; 
      IF [BRITNPPEND, BRTERMPEND] &         _RS NOT INITN FROM PROCESS ?
         K2RSSET.BASETN = [ ]               _AND NOT TERM PENDING FROM ?
      THEN                                  _CONNECTION                ?
        BEGIN 
        BSRSTATE       := BRITNPPEND;       _RS RESET FROM PROCESS PEND?
        B1FLGWD.KTWORD := HTNINIT;          _SET BLOCK TYPE TO INITN   ?
        PGULTS (NIL);                       _SEND INITN IN RESPONSE    ?
        END;
      END;
  
_******************** 
*                   * 
*  D/L    TERM      * 
*                   * 
********************? 
  
    HTTERM: 
      BEGIN 
      IF [BRINITIAL] &                      _RS NOT INITIAL            ?
         K2RSSET.BASETN = [ ] 
      THEN                                  _THEN PROCESS TERM         ?
        WITH BWWLENTRY[OPS].CMSMLEY DO      _BUILD W/L TO SVM          ?
          BEGIN 
          CMWKCODE := D0TCB;                _TCB EVENT                 ?
          CMDATA   := D5TERM;               _TERM RECEIVED             ?
          CMPTR    := B1TCB;                _PASS TCB ADDRESS          ?
          PBLSPUT (BWWLENTRY [OPS],         _PASS W/L TO SVM           ?
                   BYWLCB [B0SMWL]);
          END;
      IF [BTTRMCPEND] &                     _TS NOT TERM FROM          ?
         K2TSSET.BASETN = [ ]               _CONNECTION PENDING        ?
      THEN
        BEGIN 
        PGPURGEQUE (K4UPLN);                _PURGE UPLINE QUEUE        ?
        PNREVERSE  (B1BUFF);                _REVERSE DN AND SN         ?
        PBSWLE     (B1BUFF);                _SEND TERM UPLINE          ?
        B1BUFF := NIL;                      _DONT RELEASE D/L TERM     ?
        END;
      BSRSTATE  := BRINITIAL;               _SET RS TO INITIAL STATE   ?
      BSTRSTATE := BTINITIAL;               _SET TS TO INITIAL STATE   ?
      BSISSENT  := FALSE;                   _CLEAR INPUT SYNC FLAGS    ?
      BSISYNC   := FALSE; 
      END;
  
_******************** 
*                   * 
*  D/L    ICMD      * 
*                   * 
********************? 
  
    HTICMD: 
      IF BRDATAXFER IN K2RSSET.BASETN       _RS DATA TRANSFER          ?
      THEN
        BEGIN                               _OK TO PROCESS ICMD        ?
        K2CALLT  := TRUE;                   _PASS ICMD TO DLTS         ?
        BSRSTATE := BRICRPPEND;             _RS ICMDR FROM PROCESS PEND?
        IF K2ATOA = FALSE 
        THEN                                _TRUE DVC TYPE (NON A-TO-A)?
          BEGIN 
          IF K2PFC = D7TERMINATE            _TERMINATE ICMD RECEIVED   ?
          THEN
            BEGIN 
            PGPURGEQUE (K4DWNLN);           _PURGE D/L QUEUE           ?
            BSWTOMRK := TRUE;               _WAITING FOR TERMOUT MARKER?
            END 
          ELSE
            BEGIN 
            BSSTSTOP := FALSE;              _CLEAR STREAM STOPPED      ?
            PBTIPWLE;                       _SEND A0QUEOUT WL TO TIP   ?
            END;
          B1FLGWD.KTWORD := HTICMR; 
          PGULTS (NIL);                     _SEND ICMR U/L             ?
          END;
        END;
  
_******************** 
*                   * 
*  D/L BLK,MSG,CMD  * 
*      QBLK,QMSG    * 
*                   * 
********************? 
  
    HTBLK, HTMSG, HTCMD, HTQBLK, HTQMSG:  
      IF [BRDATAXFER, BRICRPPEND] &         _RS DATA TRANSFER OR ICMDR ?
         K2RSSET.BASETN " [ ]               _FROM PROCESS PENDING      ?
      THEN
        BEGIN 
        BSCDBSN  := K2BT.BTBSN;             _SAVE CURRENT DL BSN       ?
        BSBCKDUE := BSBCKDUE + 1;           _INCREMENT U/L BACKS DUE   ?
        IF K2ATOA = FALSE 
        THEN                                _NOT AN A-TO-A DEVICE      ?
          IF BSWTOMRK 
          THEN                              _WAITING FOR TERMOUT MARKER?
            BEGIN 
            IF K2DLBT = HTCMD 
            THEN
              IF (K2PFC = D8TO) !           _TERMINATE OUTPUT MARKER OR?
                 (K2PFC = D8RO)             _RESUME OUTPUT MARKER      ?
              THEN
                BSWTOMRK := FALSE;          _END WAITING FOR MARKER    ?
            PBBACKCHECK;                    _SEND BACK(S) UPLINE       ?
            END;
        K2CALLT := NOT BSWTOMRK;            _PASS IF NOT TERMOUT ACTIVE?
        IF BSISYNC
        THEN
          IF K2DLBT = HTMSG 
          THEN
            BSISSENT := FALSE;
        END;
  
    END; _CASE K2DLBT OF? 
  
  END; _WITH B1TCB'.BSTCB DO? 
_ 
* * * *  CALL DOWNLINE TIP SERVICES OR RELEASE THE DOWNLINE BLOCK 
? 
IF K2CALLT
THEN
  PBDLTS (B1TCB, B1BUFF)                    _PASS DATA D/L TO THE TIP  ?
ELSE
  PBRELZRO (B1BUFF, BEDBSIZE);              _RELEASE DOWN LINE BLOCK   ?
END; _PROCEDURE PBDBPM? 
  
