*COMDECK PBULTS 
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        P G U L T S   -   UPLINE TIP SERVICES                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$G-,R-,I-    NON RECURSIVE, INTERRUPTABLE ?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE DOES ALL THE NECESSARY PROCESSING TO     * 
*             TRANSFORM TIP SUPPLIED UPLINE BOUND DATA BLOCKS INTO    * 
*             FORMATS ACCEPTABLE BY THE VARIOUS HOST APPLICATIONS.    * 
*             FOR BATCH THIS MEANS CREATING MODULO PRU-SIZE BLOCKS    * 
*             AND FOR INTERACTIVE MODULO 100 CHARACTER BLOCKS.        * 
*             FOR APPLICATION TO APPLICATION THE DATA BLOCKS ARE      * 
*             EITHER MODULO PRU SIZE OR MODULO 100 CHARACTERS         * 
*             DEPENDING ON WHETHER THE CONNECTION IS IN PRU MODE      * 
*             OR NOT.                                                 * 
*             QUALIFIED APPLICATION TO APPLICATION DATA BLOCKS ARE    * 
*             ALWAYS MODULO 100 CHARACTER BLOCKS.                     * 
*             THIS PROCEDURE ALSO DOES ALL THE NECESSARY TESTS AND    * 
*             PROCESSING OF IVT COMMANDS AND FUNCTIONS. THE TIP       * 
*             PASSES A -FLAGWORD- SPECIFYING THE SERVICES IT WANTS    * 
*             FROM UPLINE TIP SERVICES. UPON COMPLETION A -FLAGWORD-  * 
*             IS RETURNED TO THE TIP, REPORTING TO THE TIP WHAT       * 
*             UPLINE TIP SERVICES HAS DONE                            * 
*                                                                     * 
** INPUT    - B1TCB TCB POINTER, B1FLGWD BIP FLAGWORD,                * 
*             UPLINE BLOCK POINTER (PARAMETER)                        * 
*                                                                     * 
** OUTPUT   - B1FLGWD, FOR INTERACTIVE CONNECTIONS, THE IVT           * 
*             COMMAND/FUNCTION IS PERFORMED AND POSSIBLE OUTPUT       * 
*             RESPONSE IS QUEUED IN THE DOWNLINE TCB QUEUE            * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             SEE INNER PROCEDURES                                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PGULTS (K5INBF : B0BUFPTR); 
  
CONST 
  K5BATCH  = 640;                           _BLOCK SIZE BACTH PRU      ?
  K5IVT    = 100;                           _BLOCK SIZE IVT BLOCK      ?
  
VAR 
  K5BKTYP  : INTEGER;                       _BLOCK TYPE                ?
  K5FLGWD  : KTULTSFLAG;                    _FLAG WORD VARIABLE        ?
  K5DBC    : DBDBC;                         _DBC CHARACTER             ?
  K5NEEDED : INTEGER;                       _CHARS NEEDED FOR UL BLOCK ?
  K5LAST   : INTEGER;                       _LAST CHARACTER (CANCEL)   ?
  K5ULBUF  : B0BUFPTR;                      _U/L DATA BUFFER POINTER   ?
  K5ULBT   : INTEGER;                       _U/L BLOCK TYPE            ?
  K5FCD    : INTEGER;                       _WORK FCD                  ?
  K5NODEL  : BOOLEAN;                       _NO *DEL* FLAG             ?
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P U L D A T A   -   PASS DATA FURTHER UPLINE               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE INSERTS THE DATA BLOCK CLARIFIER (DBC)   * 
*             GATHERS STATISTICS AND PASSES THE DATA BLOCK FURTHER    * 
*             UPLINE                                                  * 
*                                                                     * 
** INPUT    - K5ULBUF, POINTER TO UPLINE BLOCK                        * 
*             K5ULBT, UPLINE BLOCK TYPE (HTMSG, HTBLK)                * 
*                                                                     * 
** OUTPUT   - BLOCK SENT FURTHER UPLINE, UPLINE WORKQUEUE IN TCB      * 
*             CLEARED                                                 * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PBUBPM      - PASS BLK/MSG UPLINE                       * 
*             PNSGATH     - GATHER UPLINE STATISTICS                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPULDATA; 
  
BEGIN 
IF K5ULBUF = NIL
THEN
  BEGIN                                     _GET BUFFER FOR U/L DBC    ?
  K5ULBUF               := PBGET1BF 
                             (BEDBSIZE);    _GET A BUFFER              ?
  K5ULBUF'.BIINT [LFCD] := DBC * $100 + 
                             DBC + 1;       _SET LCD/FCD FOR DBC ONLY  ?
  END;
WITH K5ULBUF' DO                            _INDEX TO U/L BUFFER       ?
  BEGIN 
  K5FCD           := BFFCD - 1;             _GET FCD FOR THE DBC       ?
  BFFCD           := K5FCD; 
  BFDATAC [K5FCD] := K5DBC.DBCHAR;          _INSERT DBC CHARACTER      ?
  END;
PNSGATH (B1TCB'.BSTCB.BSLCBP,               _MAINTAIN STATISTICS       ?
                K5ULBUF, J0RCVE); 
PBUBPM  (K5ULBUF, K5ULBT);                  _PASS DATA FURTHER ALONG   ?
B1TCB'.BSTCB.BSWORKQUE := NIL;              _CLEAR WORKQ POINTER       ?
END; _PROCEDURE BPULDATA? 
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P C O U N T C H A R   -   CREATE UPLINE BLOCKS             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE TAGS THE NEWLY RECEIVED UPLINE DATA      * 
*             TO POSSIBLE LEFT OVER UPLINE DATA (IN WORKQUEUE)        * 
*             AND COUNTS THE CHARACTERS TO SEE IF A COMPLETE          * 
*             UPLINE BLOCK CAN BE CREATED. IF AN UPLINE BLOCK         * 
*             CAN BE CREATED, THIS ROUTINE MOVES THE POSSIBLE         * 
*             EXCESSIVE CHARACTERS INTO A NEW BUFFER, WHICH IS        * 
*             PLACED IN THE TCB WORKQUEUE.                            * 
*                                                                     * 
** INPUT    - B1TCB  POINTER TO THE TCB, BSWORKQUE,                   * 
*             K5INBF, POINTER TO NEW UPLINE DATA, K5NEEDED IS SET     * 
*             TO THE NR OF REQUIRED CHARACTERS IN EACH U/L BLOCK      * 
*                                                                     * 
** OUTPUT   - FULL BLOCK(S) SENT UPLINE, POSSIBLE LEFT OVER DATA      * 
*             IS PLACED IN THE TCB WORKQUEUE                          * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PTEBREL     - RELEASE POSSIBLE EMPTY FIRST BUFFER       * 
*             PTCHAIN     - CHAIN DATA BUFFERS TOGETHER               * 
*             PBGET1BF    - GET A NEW DATA BUFFER                     * 
*             PBFCOPY     - FIRMWARE COPY CHARACTERS ROUTINE          * 
*             BPULDATA    - PASS COMPLETED BLOCK(S) UPLINE            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPCOUNTCHAR;
  
VAR 
  K5OVFBUF : B0BUFPTR;                      _NEW UL DATA BUFFER (OVFL) ?
  K5WKB    : B0BUFPTR;                      _WORK BUFFER POINTER       ?
  K5COUNT  : INTEGER;                       _COUNT CHARS IN BSWORKQUE  ?
  K5LCD    : INTEGER;                       _WORK LCD                  ?
  K5NWLCD  : INTEGER;                       _WORK NEW LCD              ?
  
BEGIN 
K5FCD         := K5INBF'.BFFCD; 
K5INBF'.BFFCD := K5FCD + 1;                 _REMOVE DBC                ?
K5COUNT       := 0;                         _CLEAR CHARACTER COUNTER   ?
_ 
* * * *  ADD NEW INPUT BUFFERS TO WORKQ, REMOVE EMPTY FIRST 
? 
K5ULBUF := B1TCB'.BSTCB.BSWORKQUE;          _GET NEXT UPLINE DATA BFR  ?
IF K5ULBUF " NIL
THEN                                        _WORK QUEUE NOT EMPTY,     ?
  PTEBREL (K5INBF);                         _DONT CHAIN EMPTY NEXT BFR ?
PTCHAIN (K5INBF, K5ULBUF);                  _CHAIN INPUT TO WORKQUE    ?
_ 
* * * *  GO THROUGH BUFFERS IN WORKQ TO SEE IF K5NEEDED REACHED 
? 
K5INBF := K5ULBUF;                          _GET FIRST UPLINE DATA BFR ?
REPEAT
  K5WKB := K5INBF;                          _GET NEXT UPLINE BUFFER    ?
  WITH K5WKB' DO
    BEGIN 
    K5INBF  := BCCHAINS [DBUFLEN];          _SET NEXT NEW INPUT BUFFER ?
    K5FCD   := BFFCD;                       _GET FCD LOCAL             ?
    K5COUNT := BFLCD - K5FCD + K5COUNT + 1; _ADD CHARS IN BUFFER TO CNT?
    IF K5COUNT \ K5NEEDED 
    THEN                                    _NEEDED CHARACTERS REACHED ?
_ 
* * * *  K5NEEDED REACHED, MOVE OVERFLOW INTO A NEW BUFFER
? 
      BEGIN 
      K5LCD   := BFLCD;                     _GET LCD OF OVERFLOWING BFR?
      K5NWLCD := K5LCD - K5COUNT + K5NEEDED;_GET NEW LCD FOR THIS BFR  ?
      IF K5LCD > K5NWLCD
      THEN                                  _CHAR(S) TO BE MOVED       ?
        BEGIN 
        K5OVFBUF        := PBGET1BF 
                           (BEDBSIZE);      _GET BUFFER FOR OVERFLOW   ?
        K5OVFBUF'.BFFCD := DATA + 1;        _FCD FOR OVERFLOW          ?
        K5FCD           := BFFCD;           _SAVE FCD OF CURRENT BFR   ?
        BFFCD           := K5NWLCD + 1;     _SET TEMP FCD FOR PBFCOPY  ?
        PBFCOPY (K5WKB, K5OVFBUF);          _COPY OVERFLOW INTO NEW BFR?
        BIINT [LFCD]    := K5NWLCD * $100 + 
                           K5FCD;           _RESTORE FCD, SET NEW LCD  ?
        PTCHAIN (K5INBF, K5OVFBUF);         _TAG INPUT TO OVERFLOW     ?
        K5INBF          := K5OVFBUF;        _SET NEXT INPUT BUFFER     ?
        END; _IF CHARS TO BE MOVED? 
      BCCHAINS [DBUFLEN] := NIL;            _CLEAR CHAINWORD OF FULL BF?
      K5COUNT            := 0;              _RESET COUNT               ?
_ 
* * * *  PASS FULL WORKQ BLOCK FURTHER UPLINE 
? 
      BPULDATA;                             _PASS DATA FURTHER UPLINE  ?
      K5ULBUF := K5INBF;                    _GET NEXT UL BUFFER        ?
      END; _IF K5COUNT \ K5NEEDED?
    END; _WITH K5WKB' DO? 
UNTIL K5INBF = NIL; 
_ 
* * * *  GONE THROUGH PREVIOUS AND NEW INPUT, UPDATE TCB IF INPUT LEFT
? 
B1TCB'.BSTCB.BSWORKQUE := K5ULBUF;
END; _BPCOUNTCHAR?
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P B A T D A T A   -   PROCESS BATCH UPLINE DATA            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE GENERATES UPLINE BATCH PRU-BLOCKS.       * 
*             THE UPLINE PRU SIZE IS DETERMINED BY FIELD BSUBZ IN     * 
*             THE TCB. BLOCK ARE SENT UPLINE ONLY WHEN FULL           * 
*             PRUB-S ARE CREATED AND/OR WHEN EOR/EOI BLOCKS MUST      * 
*             BE SENT. UPLINE ACCOUNTING DATA IS MAINTAINED AND       * 
*             SENT WHENEVER AN EOI IS PROCESSED OR WHEN INPUT         * 
*             HAS BEEN TERMINATED.                                    * 
*                                                                     * 
** INPUT    - B1TCB  POINTER TO THE TCB, K5INBF  UPLINE DATA          * 
*                                                                     * 
** OUTPUT   - PRUB(S) SENT UPLINE, ACCOUNTING DATA MAINTAINED AND     * 
*             SENT AFTER EOI OR INPUT TERMINATION                     * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PBREL1BF    - RELEASE A GIVEN BUFFER                    * 
*             BPCOUNTCHAR - COUNT CHARACTERS                          * 
*             BPULDATA    - SENT DATA BLOCK UPLINE                    * 
*             PBACCOUNTNG - SENT ACCOUNTING DATA UPLINE               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPBATDATA;
  
VAR 
  K5BUFP  : B0BUFPTR;                       _ POINTER TO ACCT DATA CMD ?
  K5PTR   : B0BUFPTR;                       _ WORKING POINTER          ?
  K5EOIF  : BOOLEAN;                        _ EOI SEEN FLAG            ?
  K5EORF  : BOOLEAN;                        _ EOR SEEN FLAG            ?
  K5ACTL8 : INTEGER;                        _ ACCOUNTING WORK VARIABLE ?
  K5LEVNO : INTEGER;                        _ TEMPORARY LEVEL NO FIELD ?
  K5LN1   : CHAR;                           _ CHAR 1 OF LEVEL NUMBER   ?
  K5LN2   : CHAR;                           _ CHAR 2 OF LEVEL NUMBER   ?
  
_$J+? 
BEGIN 
K5EOIF  := FALSE;                           _CLEAR LOCAL FLAGS         ?
K5EORF  := FALSE; 
K5ULBT  := HTMSG;                           _ALL BATCH OF TYPE MSG     ?
IF K5INBF " NIL 
THEN
  BEGIN                                     _FOUND INPUT TO PROCESS    ?
  K5DBC.DBBXPT  := K5INBF'.BFXPT;           _SET XPT BATCH DATA DBC    ?
  K5EORF        := K5INBF'.BFEOR;           _SET EOR FLAG              ?
  K5EOIF        := K5INBF'.BFEOI;           _SET EOI FLAG              ?
  WITH B1TCB'.BSTCB DO
    BEGIN 
    K5NEEDED := BSUBZ * K5BATCH;            _GET NEEDED UL CHAR COUNT  ?
    IF K5DBC.DBBXPT 
    THEN
      K5NEEDED := K5NEEDED / 2;             _ADJUST FOR XPT BATCH      ?
    K5ACTL8  := BSACTL8 + 
                K5INBF'.BIINT [4];          _ADD ACCOUNTING DATA       ?
    BSACTL8  := K5ACTL8;                    _STORE LOWER 8 BITS        ?
    BSACTH16 := K5ACTL8 / 256 + BSACTH16;   _AND UPPER 16 BITS         ?
    END;
  IF K5EORF 
  THEN                                      _EOR BLOCK                 ?
_ 
* * * *  PROCESS END OF RECORD LEVEL NUMBER 
? 
    BEGIN 
    K5PTR  := K5INBF;                       _SET POINTERS TO INPUT BFR ?
    K5BUFP := K5INBF; 
    WHILE K5BUFP'.BCCHAINS
          [DBUFLEN] " NIL DO                _LOCATE LAST BUFFER        ?
      BEGIN 
      K5PTR  := K5BUFP;                     _POINTER TO PREVIOUS LAST  ?
      K5BUFP := K5BUFP'.BCCHAINS [DBUFLEN]; 
      END;
    K5PTR'.BCCHAIN [DBUFLEN] := NIL;        _REMOVE LVLNO FROM DATA    ?
    IF K5PTR = K5BUFP 
    THEN                                    _OOPS THERE IS NO DATA     ?
      K5INBF := NIL;                        _ONLY LEVELNO PASSED       ?
    WITH K5BUFP' DO 
      BEGIN 
      K5LN1 := BFDATAC [DATA];              _GET CHAR 1 OF LEVELNO     ?
      K5LN2 := BFDATAC [DATA+1];            _GET CHAR 2 OF LEVELNO     ?
      END;
    PBREL1BF (K5BUFP, BEDBSIZE);            _RELEASE LEVELNO BUFFER    ?
_ 
* * * *  CONVERT EOR LEVELNUMBER TO 4 BIT INTEGER 
? 
    K5LEVNO := 0; 
    IF K5LN1 > CHR ($1A)
    THEN                                    _FIRST CHAR BETWEEN 0 - 7  ?
      IF K5LN1 < CHR ($23)
      THEN
        BEGIN 
        K5LEVNO := ORD (K5LN1) - $1B;       _SET LEVELNO TO FIRST CHAR ?
        IF K5LN2 < CHR ($23)
        THEN                                _SECOND CHAR LESS THAN 8   ?
          IF K5LN2 > CHR ($1A)
          THEN                              _SECOND CHAR BETWEEN 0 - 7 ?
            K5LEVNO := K5LEVNO * 8 +
                       ORD (K5LN2) - $1B    _ADD SECOND CHAR TO LEVELNO?
          ELSE
            K5LEVNO := 0                    _BAD SECOND CHARACTER      ?
        ELSE
          IF K5LN2 " CHR ($2D)
          THEN                              _SECOND CHAR NOT 0 - 7,    ?
            K5LEVNO := 0;                   _BAD LEVELNO IF NOT BLANK  ?
        IF K5LEVNO \ 16 
        THEN                                _FINAL LEVELNUMBER MUST BE ?
          K5LEVNO := 0;                     _BETWEEN 0 - 15            ?
        END;
    K5DBC.DBBLEVNO := K5LEVNO;              _PUT LEVELNO IN DBC        ?
    END; _IF K5EORF?
  IF K5INBF " NIL 
  THEN                                      _INPUT LEFT TO PROCESS     ?
    BPCOUNTCHAR;                            _COUNT FOR NEEDED CHARS    ?
  END; _IF K5INBF " NIL?
_ 
* * * *  BUILD AND SEND EOR BLOCK UPLINE
? 
IF K5FLGWD.KTINTERM ! K5EORF                _TERMINATE INPUT OR EOR    ?
THEN
  BEGIN                                     _INPUT TERM OR EOR         ?
  K5DBC.DBBEOR := TRUE;                     _SET EOR IN DBC            ?
  K5ULBUF      := B1TCB'.BSTCB.BSWORKQUE;   _GET LEFT OVER U/L DATA    ?
  BPULDATA;                                 _SEND EOR UPLINE           ?
  IF K5FLGWD.KTINTERM 
  THEN                                      _INPUT TERMINATION         ?
    BEGIN 
    PBACCOUNTING (D9IOT);                   _SEND ACCOUNTING U/L       ?
    K5EOIF := FALSE;                        _DONT PROCESS EOI          ?
    END;
  END;
_ 
* * * *  BUILD AND SEND EOI BLOCK UPLINE
? 
IF K5EOIF                                   _EOI                       ?
THEN
  BEGIN 
  K5DBC.DBBEOI := TRUE;                     _SET EOI IN DBC            ?
  K5ULBUF      := B1TCB'.BSTCB.BSWORKQUE;   _GET LEFT OVER U/L DATA    ?
  BPULDATA;                                 _SEND EOI UPLINE           ?
  PBACCOUNTING (D9EOI);                     _SEND EOI ACCOUNTING       ?
  END;
END; _PROCEDURE BPBATDATA?
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P I V T D A T A   -   PROCESS INTERACTIVE UPLINE DATA      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE PROCESSES ALL INTERACTIVE UPLINE DATA.   * 
*             DRIVEN BY THE TIP SUPPLIED FLAGWORD, IT CHECKS FOR      * 
*             THE FOLLOWING IVT FUNCTIONS:                            * 
*               IVT COMMANDS (FIRST CHARACTER IS CONTROL-CHAR)        * 
*               USER INTERRUPTS                                       * 
*               CANCEL LINE                                           * 
*               USER BREAK 1                                          * 
*               USER BREAK 2                                          * 
*               PAGE TURN                                             * 
*             IT QUEUES RESPONDING OUTPUT IF ONE OF THE ABOVE         * 
*             COMMAND/FUNCTIONS IS RECOGNIZED.                        * 
*                                                                     * 
** INPUT    - B1TCB  POINTER TO THE TCB, K5INBF  THE INPUT PTR        * 
*             B1FLGWD  BIPS FLAGWORD                                  * 
*                                                                     * 
** OUTPUT   - DATA BLOCKS PASSED FURTHER UPLINE, BIP FLAGWORD         * 
*             RETURNED VIA B1FLGWD.                                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             BPSPECIAL   - LOOK FOR IVT COMMANDS/FUNCTIONS           * 
*             BPACTIONSP  - ACTION RECOGNIZED COMMANDS/FUNCTIONS      * 
*             BPAUTO      - PROCESS POSSIBLE AUTO INPUT               * 
*             BPCOUNTCHAR - CREATE UPLINE BLOCKS                      * 
*             BPULDATA    - PASS BLOCK UPLINE                         * 
*             PBLSPUT     - SEND CONNECTION TRIGGER WL TO SVM         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPIVTDATA;
VAR 
  K5TBUF   : B0BUFPTR;                      _TEMPORARY BUFFER POINTER  ?
  K5LCHR   : INTEGER;                       _LAST CHARACTER            ?
  
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P S P E C I A L   -   LOOK FOR IVT COMMAND/FUNCTIONS       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE LOOKS FOR IVT COMMANDS AND FUNCTIONS     * 
*             AND PREPARES THE RETURN FLAGWORD SETTING THE            * 
*             FLAG(S) FOR THE RECOGNIZED FUNCTION FOR LATER           * 
*             PROCESSING BY BPACTIONSPECIAL, AND TO BE RETURNED       * 
*             TO THE TIP.                                             * 
*                                                                     * 
** INPUT    - B1TCB  POINTER TO THE TCB, K5FLGWD  THE TIP SUPPLIED    * 
*             FLAGWORD                                                * 
*                                                                     * 
** OUTPUT   - B1FLGWD  THE FLAGWORD TO BE RETURNED TO THE TIP         * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             NONE                                                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPSPECIAL;
  
CONST 
  K5FNSE   = 48;                            _SPECIAL EDIT FIELD NUMBER ?
VAR 
  K5FIRST  : INTEGER;                       _SPECIAL CHARACTER         ?
  K5IVTP   : B0BUFPTR;                      _IVT COMMAND POINTER       ?
  K5IVTL   : INTEGER;                       _LENGTH POSSIBLE IVT CMD   ?
  K5FCD    : INTEGER; 
  
BEGIN 
_ 
* * * *  GET LENGTH AND FIRST/LAST CHARACTER OF POSSIBLE CMD/FUNCTION 
*        ASSUME THAT THE FIRST BUFFER CONTAINS AT LEAST THE FIRST 2 
*        CHARACTERS OF INPUT (PROVIDING THERE ARE 2 OR MORE)
? 
K5IVTL := -1;                               _REMOVE DBC FROM LENGTH    ?
K5IVTP := K5INBF;                           _GET POSSIBLE IVT CMD/FUNCT?
IF K5IVTP " NIL 
THEN
  BEGIN 
  WITH K5IVTP' DO                           _INDEX TO FIRST BUFFER     ?
    K5FIRST := ORD (BFDATAC [BFFCD + 1]);   _GET FIRST CHARACTER       ?
  REPEAT
    WITH K5IVTP' DO                         _INDEX TO CURRENT BUFFER   ?
      BEGIN 
      K5FCD  := BFFCD;                      _GET LCD OF BUFFER         ?
      K5IVTL := BFLCD - K5FCD + K5IVTL + 1; _GET LENGTH OF IVT CMD/FUNC?
      K5LAST := ORD (BFDATAC [BFLCD]);      _GET POSSIBLE CANCEL CHAR  ?
      K5IVTP := BCCHAINS [DBUFLEN]; 
      END;
  UNTIL K5IVTP = NIL; 
  END; _IF K5IVTP " NIL?
  
WITH B1TCB'.BSTCB DO
  BEGIN 
_ 
* * * *  LOOK FOR BREAK THAT MUST BE TREATED AS USER BREAK 1 OR CANCEL
? 
  IF K5FLGWD.KTUBREAK                       _BREAK DETECTED            ?
  THEN
    BEGIN 
    B1FLGWD.KTBRKSEEN := TRUE;              _TELL TIP BREAK SEEN       ?
    IF BSBRUSR1                             _TO BE TREATED AS USER BR 1?
    THEN                                    _OR CANCEL INPUT LINE      ?
      IF (K5INBF " NIL) ! BSBLKUP           _OLD OR NEW INPUT AVAILABLE?
      THEN                                  _YES                       ?
        BEGIN 
        K5LAST := BSCANCHAR;                _FORCE CANCEL RECOGNITION  ?
        K5IVTL := 1;
        END 
      ELSE                                  _NO                        ?
        B1FLGWD.KTUB1 := TRUE;              _TREAT AS USER BREAK 1     ?
    END; _IF K5FLGWD.KTUBREAK?
_ 
* * * *  SET UP FOR POSSIBLE PAGE TURN THROUGH EMPTY LINE OF INPUT
? 
  IF K5IVTL = 0 
  THEN
    BEGIN                                   _ZERO LENGTH INPUT, FORCE  ?
    K5IVTL  := 1;                           _PAGE-TURN TEST            ?
    K5FIRST := BSCNTRLCHAR;                 _UNLESS                    ?
    IF BSCKCAN = TRUE                       _IT IS TIME TO             ?
    THEN                                    _CHECK FOR CANCEL INPUT    ?
      IF K5FLGWD.KTBLKT = HTMSG             _FROM PREVIOUS BLOCK       ?
      THEN                                  _FOLLOWED BY EMPTY MSG     ?
        BEGIN                               _SET UP TO FORCE CANCEL    ?
        K5FIRST := BSCANCHAR;               _RECOGNITION THIS TIME     ?
        BSCKCAN := FALSE;                   _BUT NEVERMORE             ?
        END;
    K5LAST := K5FIRST;
    END; _ K5IVTL = 0 ? 
  
  IF K5IVTL > 0                             _INPUT TEXT AVAILABLE      ?
  THEN
    BEGIN 
    IF K5LAST = BSCANCHAR                   _IF LAST CHAR IS CANCEL    ?
    THEN
      BEGIN 
      B1FLGWD.KTCAN  := TRUE;               _THEN SET CANCEL FLAG      ?
      IF BSSPEDIT                           _ONLY SPECIAL EDIT HAS A   ?
      THEN                                  _PROBLEM WITH CANCEL INPUT ?
        IF BSXPT = FALSE                    _NOT TRANSPARENT           ?
        THEN                                _AND                       ?
          IF BSFLASCII = FALSE              _NOT FULL ASCII            ?
          THEN
            IF DGTCBFDT[K5FNSE].DDFDISP @   _THIS ENSURES THE ABOVE    ?
               BJTIPTYP[BSLCBP'.BZTIPTYPE]  _TESTED REAL DATA NOT      ?
                 .BJLIVTBVT.BAINT           _RANDOM BITS ABOVE THE IVT ?
            THEN                            _AREA AND IF OKAY THEN     ?
              B1FLGWD.KTCAN := FALSE;       _IGNORE THIS CANCEL        ?
      END 
    ELSE
      IF BSBLKUP = FALSE                    _IF NO BLOCKS UPLINE       ?
      THEN
        IF BSWORKQUE = NIL
        THEN
          IF K5IVTL = 1                     _ONE CHARACTER RECEIVED    ?
          THEN
            BEGIN 
            IF K5FIRST = BSCNTRLCHAR        _CHARACTER = CONTROL CHAR  ?
            THEN
              B1FLGWD.KTPGTURN :=           _SET PAGE TURN FLAG        ?
                K5FLGWD.KTCKPGTURN          _ELSE                      ?
            ELSE
              IF K5FIRST = BSUSR1           _IF USER BREAK 1           ?
              THEN
                B1FLGWD.KTUB1  :=  TRUE     _THEN SET USER B1 FLAG ELSE?
              ELSE
                IF K5FIRST = BSUSR2         _IF USER BREAK 2           ?
                THEN
                  B1FLGWD.KTUB2  := TRUE    _THEN SET USER B2 FLAG ELSE?
                ELSE
                  IF K5FIRST = BSSECHAR     _IS IT THE SECURITY CHAR   ?
                  THEN
                    BEGIN 
                    IF BSSECHAR " 0         _IF SECURITY CHAR DEFINED  ?
                    THEN
                      B1FLGWD.KTSECHAR  :=  TRUE; 
                    END _ SECURITY CHARACTER ?
                  ELSE
                    IF K5FIRST = BSABTBLK   _IF ABORT OUTPUT           ?
                    THEN
                      BEGIN 
                      K5NODEL := TRUE;      _NO *DEL* MESSAGE          ?
                      B1FLGWRD.KTCAN := TRUE; _SET CANCEL FLAG         ?
                      END; _ END IF K5FIRST = CT ... AB ? 
            END  _ IF K5IVTL = 1 ?
          ELSE
            IF K5FIRST = BSCNTRLCHAR        _IF CONTROL CHARACTER      ?
            THEN
              IF K5IVTL = 2                 _IF 2 CHARACTERS           ?
              THEN
                BEGIN                       _VALIDATE USER INTERRUPT   ?
                IF K5LAST > $40             _DATA BETWEEN 41 AND 5A    ?
                THEN                        _OR BETWEEN 61 AND 7A      ?
                  IF K5LAST < $5B 
                  THEN
                    B1FLGWD.KTUI  := TRUE   _USER INTERRUPT            ?
                  ELSE
                    IF K5LAST > $60 
                    THEN
                      IF K5LAST < $7B 
                      THEN
                        B1FLGWD.KTUI  := TRUE; _USER INTERRUPT         ?
                END _ IF K5IVTL = 2 ? 
              ELSE
                B1FLGWD.KTGOODIVT := TRUE;  _IVT COMMAND               ?
    END; _IF K5IVTL > 0 ELSE? 
  END; _WITH B1TCB'.BSTCB DO? 
END; _PROCEDURE BPSPECIAL?
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P A C T I O N S P   -   ACTION IVT COMMANDS/FUNCTIONS      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE ACTIONS THE IVT COMMANDS/FUNCTIONS       * 
*             RECOGNIZED BY BPSPECIAL.                                * 
*                                                                     * 
** INPUT    - B1TCB  POINTER TO THE TCB, B1FLGWD  FLAGWORD WITH       * 
*             THE RECOGNIZED COMMAND/FUNCTION                         * 
*                                                                     * 
** OUTPUT   - B1TCB  POINTER TO THE TCB, ACTION RESPONSE QUEUED IN    * 
*             THE TCB,  B1FLGWD  FLAGWORD TO BE PASSED BACK TO TIP    * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PBGET1BF    - GET A BUFFER                              * 
*             PBUBPM      - PASS BREAK / USER INTERRUPT UPLINE        * 
*             PBRELZRO    - RELEASE POSSIBLE CHAIN OF BUFFERS         * 
*             PTIVTCMD    - PROCESS USER ENTERED IVT COMMAND          * 
*             PNCLOAD     - LOAD TEXT IN TERMINAL RESPONSE            * 
*             PBRELCHN    - RELEASE CHAIN OF BUFFERS                  * 
*             PBFCOPY     - FIRMWARE COPY RESPONSE TO DATA BUFFER     * 
*             PBDLTS      - QUEUE RESPONSE IN DOWNLINE TCB QUEUE      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPACTIONSPECIAL;
  
CONST 
  K5DBCNA   = $202C;                        _ DBC/FE FOR CANNED MSG    ?
  K5DBCFE   = $202E;                        _ DBC/FE FOR CANNED MSGS   ?
  K5IVTNM   = 5;                            _ IVT NAME POSITION IN CM  ?
  K5RCERR   = 19;                           _ IVT ERROR CODE           ?
  K5STMSG   = 7;                            _ OFFSET INTO K5SBAD ARRAY ?
  K5LENGTH  = 12;                           _ LENGTH OF MESSAGE - WORDS?
  
VAR 
  K5BLKP    : B0BUFPTR;                     _ WORKING VARIABLE         ?
  K5SPTR    : B0BUFPTR;                     _ PTR TO MESSAGE TO SEND   ?
  K5SGOOD   : PACKED ARRAY [0..21] OF CHAR; _ ACCEPTED.. MESSAGE       ?
  K5SDEL    : PACKED ARRAY [0..13] OF CHAR; _ *DEL*      MESSAGE       ?
  K5SBAD    : PACKED ARRAY [0..18] OF INTEGER;
  K5MSGS    : PACKED ARRAY [1..5, 0..11] OF INTEGER;
  
VALUE 
  K5SGOOD   = ($1502,0,HTMSG,K5DBCFE,#XX ACCEPTED.#,$2E1F); 
  K5SBAD    = ($2402,0,HTMSG,K5DBCFE,#XX  #,12*0,$1F00);
  K5MSGS    = (#INCORRECT VALUE         #,
               #DUPLICATE CHARACTER     #,
               #VALUE INAPPROPRIATE     #,
               #INCORRECT TERMINAL CLASS#,
               #INCORRECT COMMAND       #); 
  K5SDEL    = ($0D02,0,HTBLK,K5DBCFE,#*DEL#,$2A1F); 
_$J+? 
BEGIN 
K5SPTR := NIL;                              _CLEAR RESPONSE PTR        ?
  
_******************** 
*                   * 
*    USER BREAK 1   * 
*    USER BREAK 2   * 
*                   * 
********************? 
  
IF B1FLGWD.KTUBS " 0
THEN
  BEGIN 
  IF B1TCB'.BSTCB.BSTRSTATE " BTDATAXFER    _TS NOT DATA TRANSFER      ?
  THEN
    PNNOTIFY (-H2INPDISC, B1TCB)            _TELL USER INPUT DISCARDED ?
  ELSE
    BEGIN 
    K5BLKP := PBGET1BF (BEDBSIZE);          _GET BUFFER FOR ICMD BLOCK ?
    K5BLKP'.BFDATAC [DATA] :=               _STORE USER BREAK 1 OR 2   ?
      CHR (B1FLGWD.KTUBS + 2);
    K5BLKP'.BIINT [LFCD] := DATA * $101;    _INSERT LCD AND FCD        ?
    PBUBPM (K5BLKP, HTICMD);                _PASS ICMD FURTHER UPLINE  ?
  
    K5ULBUF := B1TCB'.BSTCB.BSWORKQUE;      _PICK UP ANY PARTIAL INPUT ?
    IF K5ULBUF " NIL                        _FOUND SOME                ?
    THEN
      BEGIN                                 _MUST SEND BEFORE MARKER   ?
      K5ULBT := HTBLK;                      _SET BLOCK TYPE TO BLK     ?
      BPULDATA;                             _PASS DATA FURTHER UPLINE  ?
      END;
  
    K5BLKP := PBGET1BF (BEDBSIZE);          _GET BUFFER FOR BI/MARK CMD?
    K5BLKP'.BIINT [PFC/2+1] :=              _STORE PFC = BI, SFC = MARK?
      D8BI * $100 + D9MARK; 
    K5BLKP'.BIINT [LFCD] :=                 _INSERT LCD AND FCD        ?
      SFC  * $100 + PFC;
    PBUBPM (K5BLKP, HTCMD);                 _PASS CMD FURTHER UPLINE   ?
  
    WHILE B1TCB'.BSTCB.BSBCKDUE " 0 DO      _SEND ALL OUTSTANDING BACKS?
      BEGIN 
      K5BLKP := PBGET1BF (BEDBSIZE);        _GET BUFFER FOR BACK BLOCK ?
      K5BLKP'.BIINT [LFCD] :=               _INSERT LCD AND FCD        ?
        (DATA - 1) * $100 + DATA; 
      PBUBPM (K5BLKP, HTBACK);              _PASS BACK FURTHER UPLINE  ?
      END;
  
    PGPURGEQUE (K4DWNLN);                   _PURGE DOWNLINE DATA       ?
    B1TCB'.BSTCB.BSWTOMRK := TRUE;          _SET WAITING FOR RESUME MRK?
    END;
  PBRELZRO (K5INBF, BEDBSIZE);              _RELEASE POSSIBLE INPUT    ?
  END;
  
_******************** 
*                   * 
*    IVT COMMAND    * 
*                   * 
********************? 
  
IF B1FLGWD.KTGOODIVT
THEN
  BEGIN 
  ADDR (K5SGOOD, K5SPTR);                   _PRESUME GOOD IVT COMMAND  ?
  IF PTIVTCMD (K5INBF, B1TCB, 
               C9TERM) = FALSE              _PROCESS IVT COMMAND       ?
  THEN
    BEGIN 
    ADDR (K5SBAD, K5SPTR);                  _BAD IVT COMMAND           ?
    B1IW := K5STMSG;                        _OFFSET TO STORE CANNED MSG?
    B1LBF := K5SPTR;                        _WHERE TO LOAD MESSAGE     ?
    PNCLOAD (K5MSGS[CONFIGOK,0], K5LENGTH); 
    END;
  K5SPTR'.BIINT [K5IVTNM] := IVTNM.BAINT;   _INSERT COMMAND MNEMONIC   ?
  IF IVTNM.BAINT = -1 
  THEN                                      _PTIVTCMD CALLED PNNOTIFY, ?
    K5SPTR := NIL;                          _DONT GENERATE ANOTHER RESP?
  K5INBF := NIL;                            _PTIVTCMD RELEASED BUFFER  ?
  END;
  
_******************** 
*                   * 
*        USER       * 
*     INTERRUPT     * 
*                   * 
********************? 
  
IF B1FLGWD.KTUI 
THEN
  BEGIN 
  K5BLKP := PBGET1BF (BEDBSIZE);
  K5BLKP'.BFDATAC[DATA] := CHR (K5LAST);    _INSERT USER INTERRUPT CHAR?
  K5BLKP'.BIINT [LFCD]  := DATA * $101;     _INSERT LCD/FCD            ?
  PBUBPM (K5BLKP, HTICMD);                  _PASS UPLINE AS ICMD       ?
  PBRELCHN (K5INBF, BEDBSIZE);              _RELEASE INPUT BUFFER      ?
  END;
  
_******************** 
*                   * 
*   CANCEL INPUT    * 
*                   * 
********************? 
  
IF B1FLGWD.KTCAN
THEN
  BEGIN 
  IF K5NODEL = FALSE                        _IF *DEL TO BE ISSUED      ?
  THEN
    ADDR(K5SDEL,K5SPTR);                    _GET ADDRESS OF *DEL*      ?
  K5BKTYP  :=  HTMSG;                       _FORCE MSG BLOCK TYPE      ?
  K5FLGWD.KTSEND := TRUE;                   _SEND CANCELED DATA UPLINE ?
  B1FLGWD.KTDATA := TRUE;                   _(BY PTIVTDATA ROUTINE)    ?
  END;
  
_******************** 
*                   * 
*     SECURITY      * 
*     CHARACTER     * 
*                   * 
********************? 
  
IF B1FLGWD.KTSECHAR 
THEN
  BEGIN                                     _TERMINATE ANY CONNECTION  ?
  IF B1TCB'.BSTCB.BSCN = 0                  _NO HOST CONNECTED         ?
  THEN
    PNNOTIFY (-H2NHNCONN, B1TCB);           _INFORM USER AS SUCH       ?
  WITH BWWLENTRY [OPS].CMSMLEY DO           _BREAK POSSIBLE CONNECTION ?
    BEGIN 
    CMWKCOD := D0TCB;                       _TCB EVENT FOR SVM         ?
    CMDATA  := D5DISC;                      _USER DISCONNECT           ?
    CMPTR   := B1TCB;                       _INSERT TCB ADDRESS        ?
    CMRC    := DAUSER;                      _INSERT REASON CODE        ?
    PBLSPUT (BWWLENTRY [OPS],               _SEND WLE TO SVM           ?
             BYWLCB [B0SMWL]);
    END;
  PBRELCHN (K5INBF, BEDBSIZE);              _RELEASE INPUT BUFFER      ?
  END;
_ 
* * * *  SEND IVT RESPONSE TO TERMINAL (IF ONE GENERATED) 
? 
IF K5SPTR " NIL                             _REPONSE GENERATED         ?
THEN
  BEGIN 
  K5BLKP := NIL;                            _CLEAR RESPONSE BUFFER     ?
  PBFCOPY (K5SPTR, K5BLKP);                 _COPY RESPONSE TO BUFFER   ?
  IF B1TCB'.BSTCB.BSNINCP 
  THEN
    K5BLKP'.BIINT[DBC/2+1] := K5DBCNA;      _ CHANGE FE TO NO ACTION   ?
  B1FLGWD.KTRESP   := TRUE;                 _TELL TIP RESPONSE AVAILABL?
  K5BLKP'.BFINTBLK := TRUE;                 _DECLARE INTERNAL BLOCK    ?
  PBDLTS (B1TCB, K5BLKP);                   _TP AND QUEUE RESPONSE     ?
  END; _IF K5SPTR " NIL?
END;  _PROCEDURE BPACTIONSPECIAL? 
_$J+? 
_*****************************
*                            *
*     START BPIVTDATA        *
*                            *
*****************************?
  
BEGIN 
WITH B1TCB'.BSTCB DO
  BEGIN 
  IF K5INBF " NIL 
  THEN
    BEGIN 
    K5DBC.DBULPERR  := K5INBF'.BFPARITY;    _GET PARITY IN DBC         ?
    K5DBC.DBULXPT   := K5INBF'.BFXPT;       _AND TRANSPARENT BIT       ?
    END; _IF K5INBF " NIL?
_ 
* * * *  LOOK FOR AND PROCESS IVT COMMAND AND IVT FUNCTION
? 
  IF K5DBC.DBULXPT = FALSE
  THEN
    BEGIN 
    IF K5FLGWD.KTCKSPEC 
    THEN
      BPSPECIAL                             _TEST FOR IVT CMD/FUNCTIONS?
    END 
  ELSE                                      _ELSE                      ?
    BEGIN 
    IF K5INBF'.BFLCD - K5INBF'.BFFCD = 1    _CHECK FOR PAGE TURN       ?
    THEN
      B1FLGWD.KTPGTURN := K5FLGWD.KTCKPGTURN; 
    IF BSXB12                               _IF WE SHOULD CHECK FOR XPT?
    THEN                                    _BREAKS THEN               ?
      IF BSBLKUP = FALSE                    _ONLY IF THE LAST BLOCK WAS?
      THEN                                  _AN MSG BLOCK AND NO UPLINE?
        IF BSWORKQUE = NIL                  _TRANSMISSION BLOCKS EXIST ?
        THEN                                _SHALL WE CHECK IF THE ONLY?
        WITH K5INBF' DO                     _CHARACTER IN THE MSG      ?
          IF BFLCD - BFFCD = 1
          THEN                              _IF IT IS A USER BREAK 1   ?
            IF ORD (BFDATAC [BFLCD])
                           = BSUSR1         _THEN SET THE FLAG WORD BIT?
            THEN
              B1FLGWD.KTUB1 := TRUE 
            ELSE                            _ELSE IF ITS A USER BREAK 2?
              IF ORD (BFDATAC [BFLCD])
                             = BSUSR2       _THEN SET THAT BIT         ?
              THEN
                B1FLGWD.KTUB2 := TRUE 
              ELSE                          _IF PARITY IS AN ISSUE     ?
                IF (BSPARITY = B7NPAR) !    _THEN CHECK FURTHER MATCHES?
                   (BSPARITY = B7IPAR)
                THEN                        _IF IT IS A USER BREAK 1   ?
                  IF ORD (BFDATAC [BFLCD]) - 128
                           = BSUSR1         _THEN SET THE FLAG WORD BIT?
                  THEN
                    B1FLGWD.KTUB1 := TRUE 
                  ELSE                      _ELSE IF ITS A USER BREAK 2?
                    IF ORD (BFDATAC [BFLCD]) - 128
                             = BSUSR2       _THEN SET THAT BIT         ?
                    THEN
                      B1FLGWD.KTUB2 := TRUE;
    END;
  IF B1FLGWD.KTWORD " 0 
  THEN
    BEGIN 
    K5FLGWD.KTSEND := FALSE;                _DONT SEND CMD UPLINE      ?
    BPACTIONSPECIAL;                        _PROCESS IVT CMD/FUNCTION  ?
    END 
  ELSE
    BEGIN 
    B1FLGWD.KTDATA := TRUE;                 _NO IVT CMD/FNCT, ITS DATA ?
    IF K5BKTYP = HTBLK                      _IF BLK BLOCK              ?
    THEN
      BEGIN 
      K5TBUF := K5INBF; 
      IF K5TBUF " NIL                       _IF THERE IS AN INPUT BUF  ?
      THEN
        BEGIN 
        BSCKCAN := FALSE;                   _INITIALIZE CHECK FLAG     ?
        REPEAT
          WITH K5TBUF' DO 
            BEGIN 
            K5LCHR := ORD(BFDATAC[BFLCD]);  _ GET LAST CHARACTER       ?
            K5TBUF := BCCHAINS[DBUFLEN];    _GET CHAIN                 ?
            END;
        UNTIL K5TBUF = NIL; 
        IF K5LCHR = BSCANCHAR               _IF LAST CHARACTER IS CN   ?
        THEN                                _SET FLAG.                 ?
          BSCKCAN := TRUE;
        END 
      END;  _ IF K5BKTYP = HTBLK ?
    END;
  
  IF B1FLGWD.KTDATA 
  THEN
_ 
* * * *  DATA FOUND, PASS UPLINE IF CONNECTION ESTABLISHED
? 
    IF BSCN " 0                             _CONNECTION ESTABLISHED    ?
    THEN
      BEGIN 
      K5NEEDED := BSUBZ * K5IVT;            _GET UPLINE BLOCKING SIZE  ?
      IF K5NEEDED = 0 
      THEN
        K5NEEDED := K5IVT;                  _BSUBZ IS ZERO, ASSUME ONE ?
      K5ULBT := HTBLK;
      BPCOUNTCHAR;                          _COUNT/BLOCK UPLINE DATA   ?
_ 
* * * *  SEND PARTIAL LEFT OVER BLOCK UPLINE IF SO REQUESTED BY THE TIP 
? 
      IF K5FLGWD.KTSEND 
      THEN
        BEGIN 
        K5ULBUF := BSWORKQUE;               _GET POSSIBLE PARTIAL BLOCK?
        K5ULBT  := K5BKTYP;                 _GET REQUESTED U/L BT      ?
        IF K5ULBT = HTMSG 
        THEN                                _REQUESTED TO SEND MSG U/L ?
          K5DBC.DBULCAN := B1FLGWD.KTCAN;   _GET DBC CANCEL BIT        ?
        BPULDATA;                           _PASS BLOCK FURTHER UPLINE ?
        END; _IF K5FLGWD.KTSEND?
      END _IF BSCN " 0 THEN?
    ELSE
_ 
* * * *  DATA ENTERED BY TERMINAL USER WHILE NO CONNECTION ESTABLIHED 
? 
      WITH BWWLENTRY [OPS].CMSMLEY DO       _SEND CONNECTION TRIGGER   ?
        BEGIN 
        CMWKCOD := D0TCB;                   _WORKCODE FOR SVM          ?
        CMDATA  := D5CONN;                  _CONNECTION TRIGGER        ?
        CMPTR   := B1TCB;                   _TCB ADDRESS               ?
        PBLSPUT (BWWLENTY [OPS],
                 BYWLCB [B0SMWL]);          _SEND WLE TO SVM           ?
        END;
  END; _WITH B1TCB'.BSTCB DO? 
END; _PROCEDURE BPIVTDATA?
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P A A P R U D A T A   -   PROCESS UPLINE A-A PRU DATA      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE PROCESSES ALL UPLINE A-A PRU TYPE DATA.  * 
*             IT ASSUMES THAT THE SENDING APPLICATION IS USING THE    * 
*             SAME PRU SIZE AS IS EXPECTED BY THE RECEIVING           * 
*             APPLICATION.                                            * 
*                                                                     * 
** INPUT    - B1TCB    POINTER TO THE TCB                             * 
*             K5INBF   POINTER TO THE UPLINE PRU DATA                 * 
*             K5FLGWD  BIP LOCAL FLAG WORD                            * 
*                                                                     * 
** OUTPUT   - PRU DATA BLOCKS (MSG ONLY) PASSED FURTHER UPLINE        * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PTCHAIN     - CHAIN DATA BUFFERS TOGETHER               * 
*             BPULDATA    - PASS BLOCK UPLINE                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPAAPRUDATA;
  
BEGIN 
K5NEEDED := 2043;                           _MAX NETWORK BLOCK SIZE    ?
K5ULBT   := HTMSG;                          _SET BLOCK TYPE MSG        ?
BPCOUNTCHAR;                                _SET FCD, SEND IF TOO LARGE?
IF K5FLGWD.KTSEND                           _X25 M-BIT NOT SET         ?
THEN                                        _PRU IS READY TO SHIP      ?
  BEGIN 
  K5ULBUF        := B1TCB'.BSTCB.BSWORKQUE; _GET POINTER UPLINE BLOCK  ?
  K5DBC.DBCHAR   := K5ULBUF'.BFDATAC        _COPY DBC FROM TBC         ?
                      [DATA + 1]; 
  K5DBC.DBBDATA  := TRUE;                   _ENSURE BATCH DATA FLAG SET?
  BPULDATA;                                 _PASS BLOCK FURTHER UPLINE ?
  END;
END; _PROCEDURE BPAAPRUDATA?
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P A A C H R D A T A   -   PROCESS UPLINE A-A NON-PRU       * 
*                                    (CHARACTER) DATA                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE PROCESSES ALL UPLINE A-A NON-PRU TYPE    * 
*             DATA. BLOCKS WILL BE GENERATED BASED ON THE UPLINE      * 
*             BLOCKING SIZE.                                          * 
*                                                                     * 
** INPUT    - B1TCB    POINTER TO THE TCB                             * 
*             K5INBF   POINTER TO THE UPLINE PRU DATA                 * 
*             K5FLGWD  BIP LOCAL FLAG WORD                            * 
*                                                                     * 
** OUTPUT   - NON-PRU (CHARACTER) DATA BLOCKS PASSED FURTHER UPLINE   * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             BPCOUNTCHAR - CHAIN DATA BUFFERS TOGETHER               * 
*             BPULDATA    - PASS BLOCK UPLINE                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPAACHRDATA;
  
BEGIN 
K5NEEDED := B1TCB'.BSTCB.BSUBZ * K5IVT;     _GET UPLINE BLOCKING SIZE  ?
IF K5NEEDED = 0 
THEN
  K5NEEDED := K5IVT;                        _BSUBZ IS ZERO, ASSUME ONE ?
K5ULBT := HTBLK;                            _ASSUME BLK BLOCK TYPE     ?
BPCOUNTCHAR;                                _COUNT / BLOCK UPLINE DATA ?
_ 
* * * *  SEND PARTIAL LEFT OVER BLOCK UPLINE IF SO REQUESTED BY THE TIP 
? 
IF K5FLGWD.KTSEND                           _X25 M-BIT NOT SET         ?
THEN                                        _MSG BLOCK READY TO SHIP   ?
  BEGIN 
  K5ULBUF := B1TCB'.BSTCB.BSWORKQUE;        _GET POSSIBLE PARTIAL BLOCK?
  K5ULBT  := HTMSG;                         _SET BLOCK TYPE MSG        ?
  BPULDATA;                                 _PASS BLOCK FURTHER UPLINE ?
  END;
END; _PROCEDURE BPAACHRDATA?
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P A A Q D A T A   -   PROCESS UPLINE A-A QUALIFIED DATA    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE PROCESSES ALL UPLINE A-A QUALIFIED DATA. * 
*             BLOCKS WILL BE GENERATED BASED ON THE UPLINE BLOCKING   * 
*             SIZE.                                                   * 
*                                                                     * 
** INPUT    - B1TCB    POINTER TO THE TCB                             * 
*             K5INBF   POINTER TO THE UPLINE PRU DATA                 * 
*             K5FLGWD  BIP LOCAL FLAG WORD                            * 
*                                                                     * 
** OUTPUT   - QUALIFIED DATA BLOCKS PASSED FURTHER UPLINE             * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             BPCOUNTCHAR - CHAIN DATA BUFFERS TOGETHER               * 
*             BPULDATA    - PASS BLOCK UPLINE                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPAAQDATA;
  
BEGIN 
K5NEEDED := B1TCB'.BSTCB.BSUBZ * K5IVT;     _GET UPLINE BLOCKING SIZE  ?
IF K5NEEDED = 0 
THEN
  K5NEEDED := K5IVT;                        _BSUBZ IS ZERO, ASSUME ONE ?
K5ULBT := HTQBLK;                           _ASSUME QBLK BLOCK TYPE    ?
BPCOUNTCHAR;                                _COUNT / BLOCK UPLINE DATA ?
_ 
* * * *  SEND PARTIAL LEFT OVER BLOCK UPLINE IF SO REQUESTED BY THE TIP 
? 
IF K5FLGWD.KTSEND                           _X25 M-BIT NOT SET         ?
THEN                                        _QMSG BLOCK READY TO SHIP  ?
  BEGIN 
  K5ULBUF := B1TCB'.BSTCB.BSWORKQUE;        _GET POSSIBLE PARTIAL BLOCK?
  K5ULBT  := HTQMSG;                        _SET BLOCK TYPE QMSG       ?
  BPULDATA;                                 _PASS BLOCK FURTHER UPLINE ?
  END;
END; _PROCEDURE BPAAQDATA?
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        B P P R O T O C O L   -   PROCESS UPLINE PROTOCOL BLOCKS     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE PROCESSES ALL UPLINE PROTOCOL BLOCKS     * 
*             THAT ARE NOT OF TYPE BLK AND MSG. THE TIP MUST          * 
*             PROVIDE THE BUFFER IF THE UPLINE BLOCK REQUIRES MORE    * 
*             THAN THE NETWORK BLOCK HEADER, IN WHICH CASE IT IS      * 
*             ASSUMED THAT THE DN/SN/CN/ETC. START AT DATA-4.         * 
*                                                                     * 
** INPUT    - B1TCB  POINTER TO THE TCB, K5INBF  OPTIONAL INPUT       * 
*             POINTER                                                 * 
*                                                                     * 
** OUTPUT   - BLOCK PROTOCOL ELEMENT PASSED FURTHER UPLINE            * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PBGET1BF    - GET A BUFFER                              * 
*             PBUBPM      - PASS BLOCK FURTHER UPLINE                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE BPPROTOCOL; 
  
  
BEGIN 
IF K5INBF = NIL 
THEN                                        _NO BUFFER PASSED          ?
  BEGIN                                     _GO GET ONE                ?
  K5INBF         := PBGET1BF (BEDBSIZE);
  K5INBF'.
    BIINT [LFCD] := (DATA-1) * $100 + DATA; _INSERT LCD/FCD (EMPTY)    ?
  END;
PBUBPM (K5INBF, K5BKTYP);                   _PASS BLOCK FURTHER UPLINE ?
END;  _PROCEDURE BPPROTOCOL?
_$J+? 
_*****************************
*                            *
*     START UPLINE TIP       *
*         SERVICES           *
*                            *
*****************************?
  
BEGIN 
K5NODEL  :=  FALSE;                         _ASSUME *DEL* ACTIVE       ?
K5FLGWD.KTWORD := B1FLGWD.KTWORD;           _GET FLAG WORD LOCAL       ?
B1FLGWD.KTWORD := 0;                        _CLEAR RETURN FLAG WORD    ?
K5BKTYP        := K5FLGWD.KTBLKT;           _GET BLOCKTYPE LOCAL       ?
CASE K5BKTYP OF 
  
  0:                                        _DEFAULT BLOCK TYPE        ?
    BEGIN 
    K5BKTYP := HTMSG;                       _SET BLOCK TYPE TO MSG     ?
    GOTO 10;                                _PROCESS MSG BLOCK         ?
    END; _0:? 
  
  HTBLK, HTMSG: 
    BEGIN 
10: 
    IF B1TCB'.BSTCB.BSBATCH                 _BATCH CONNECTION          ?
    THEN
      BEGIN 
      K5DBC.DBCHAR := CHR ($80);            _SET BATCH DBC             ?
      BPBATDATA;                            _PROCESS U/L BATCH DATA    ?
      END 
    ELSE
      BEGIN 
      K5DBC.DBCHAR := CHR ($00);            _SET NON BATCH DBC         ?
      IF B1TCB'.BSTCB.BSDEVTYP = N1AA       _A-A CONNECTION            ?
      THEN
        BEGIN 
        IF B1TCB'.BSTCB.BSPRUON 
        THEN
          BEGIN                             _PRU TYPE DATA             ?
          BPAAPRUDATA;                      _PROCESS U/L PRU DATA      ?
          END 
        ELSE
          BEGIN                             _CHARACTER TYPE DATA       ?
          BPAACHRDATA;                      _PROCESS U/L NON-PRU DATA  ?
          END;
        END 
      ELSE
        BEGIN                               _CONSOLE CONNECTION        ?
        IF K5BKTYP = HTBLK                  _IF BLK BYPE, CLEAR CN     ?
        THEN                                _FLAG                      ?
          B1TCB'.BSTCB.BSCKCAN  := FALSE; 
        BPIVTDATA;                          _PROCESS U/L I/A DATA      ?
        END;
      END;
    PBRELZRO (K5INBF, BEDBSIZE);            _RELEASE LEFT OVER INPUT   ?
    END; _HTBLK, HTMSG:?
  
  HTQBLK, HTQMSG: 
    BEGIN 
    K5DBC.DBCHAR := CHR ($00);              _SET NON BATCH DBC         ?
    BPAAQDATA;                              _PROCESS U/L QUALIFIED DATA?
    END; _HTQBLK, HTQMSG:?
  
  HTBACK, HTCMD, HTBREAK, HTRESET,
  HTRINIT, HTNINIT, HTTERM, HTICMD, HTICMR: 
    BEGIN 
    BPPROTOCOL;                             _PROCESS PROTOCOL BLOCK    ?
    END;
  
  END; _CASE K5BKTYP OF?
END; _PROCEDURE PGULTS? 
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        P B U L T S   -   PAGE SWITCHER FOR PGULTS                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$G-,R-,I-    NON RECURSIVE, INTERRUPTABLE ?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE SET UP THE GLOBAL TCB POINTER AND        * 
*             FLAGWORD AND TRANSFERS CONTROL TO THE PAGED ROUTINE     * 
*             PGULTS (SAVING THE CALLERS PAGE NUMBER)                 * 
*                                                                     * 
** INPUT    - K5TCBP  POINTER TO TCB, K5INBF  POINTER TO U/L BLOCK    * 
*             K5FLGWD  TIP/BIP FLAGWORD (ALL PARAMETERS)              * 
*                                                                     * 
** OUTPUT   - FLAGWORD RETURNED TO CALLER (VIA VAR PARAMETER)         * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PBRDPGE     - SAVE CALLERS PAGE NUMBER                  * 
*             PBPSWITCH   - SWITCH TO NEW (BIPS) PAGE NUMBER          * 
*             PGULTS      - PAGED UPLINE TIP SERVICES ROUTINE         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PBULTS (K5TCBP : B0BUFPTR; K5INBF : B0BUFPTR; 
                  VAR K5FLGWD : KTULTSFLAG);
  
VAR 
  K5PAGE : INTEGER;                         _PAGE NUMBER OF CALLER     ?
  
BEGIN 
B1TCB          := K5TCBP;                   _GET PARAMETERS TO GLOBALS ?
B1FLGWD.KTWORD := K5FLGWD.KTWORD; 
PBRDPGE   (K5PAGE);                         _SAVE CALLERS PAGE         ?
PBPSWITCH (K0PGBIP);                        _SWITCH TO BIPS PAGE       ?
PGULTS    (K5INBF);                         _CALL U/L TIPS SERVICES    ?
PBPSWITCH (K5PAGE);                         _RESTORE CALLERS PAGE      ?
K5FLGWD.KTWORD := B1FLGWD.KTWORD;           _RETURN FLAGWORD           ?
END; _PROCEDURE PBULTS? 
_$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*        P T C O M M A N D   -   GENERATE UPLINE COMMANDS             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$G-,R-,I-    NON RECURSIVE, INTERRUPTABLE ?
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW - THIS PROCEDURE BUILDS UPLINE COMMANDS THAT REQUIRE      * 
*             ONLY A PRIMARY AND SECONDARY FUNCTION CODE (PFC/SFC)    * 
*                                                                     * 
** INPUT    - K5TCBP  POINTER TO TCB, K5PFC/K5SFC  PRIMARY/SECONDARY  * 
*             FUNCTION CODES (PARAMETERS)                             * 
*                                                                     * 
** OUTPUT   - UPLINE COMMAND BUILT AND SENT                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*             PBGET1BF    - GET A BUFFER                              * 
*             PBULTS      - SENT COMMAND FURTHER UPLINE               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTCOMMAND (K5TCBP : B0BUFPTR; K5PFC, K5SFC : INTEGER);
  
BEGIN 
IF K5PFC = D8OS 
THEN                                        _OUTPUT STOPPED COMMAND    ?
  K5TCBP'.BSTCB.BSSTSTOP := TRUE;           _SET STREAM STOPPED        ?
B1FLGWD.KTWORD := HTCMD;                    _SET BLOCKTYPE OF CMD      ?
B1BUFF         := PBGET1BF (BEDBSIZE);      _GET BUFFER FOR U/L CMD    ?
B1BUFF'.BIINT 
  [PFC/2+1]    := K5PFC * $100 + K5SFC;     _INSERT PFC                ?
B1BUFF'.BIINT 
  [LFCD]       := SFC * $100 + PFC;         _INSERT LCD AND FCD        ?
PBULTS (K5TCBP, B1BUFF, B1FLGWD);           _SEND COMMAND U/L          ?
END; _PTCOMMAND?
