*COMDECK HASPTIP
_$J+? 
_ 
  
  
  
  
  
  
  HHHHHH       HHHH         AAA             SSSSSSSSS    PPPPPPPPP
  HHHHHH       HHHH        AAAAA         SSSSSSSSSSSSSS  PPPPPPPPPPP
   HHHH         HH        AAAA AA       SSSSS       SSS   PPPP     PP 
   HHHH         HH       AAAA   AA      SSSS        SS    PPPP      PP
   HHHH         HH      AAAA     AA     SSSS              PPPP      PP
   HHHH         HH     AAAA       AA    SSSSS             PPPP      PP
   HHHHHHHHHHHHHHH    AAAAAAAAAAAAAAA    SSSSSSSSSS       PPPPPPPPPPP 
   HHHHHHHHHHHHHHH    AAAAAAAAAAAAAAA       SSSSSSSSS     PPPPPPPPPP
   HHHHHHHHHHHHHHH    AAAAAAAAAAAAAAA              SSSS   PPPPPPP 
   HHHH         HH    AAAA         AA                SS   PPPP
   HHHH         HH    AAAA         AA    SSSS        SS   PPPP
   HHHH         HH   AAAAAA       AAAA  SSSSS      SSS   PPPPPP 
   HHHH         HH   AAAAAA       AAAA  SSSSSSSSSSSSS    PPPPPP 
   HHHH         HH   AAAAAA       AAAA    SSSSSSSS       PPPPPP 
  HHHHHH       HHHH 
  HHHHHH       HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH HJB
  HHHHHH       HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH ACS
  
  
  
  
  
         TTTTTTTTTTTTTTTTTTT   IIIIIIIIII     PPPPPPPPPPP 
         TTTTTTTTTTTTTTTTTTT   IIIIIIIIII     PPPPPPPPPPPPP 
         TTTTTT  TTTT   TTTT      IIII         PPPP       PP
                 TTTT             IIII         PPPP        PP 
                 TTTT             IIII         PPPP        PP 
                 TTTT             IIII         PPPP        PP 
                 TTTT             IIII         PPPPPPPPPPPPP
                 TTTT             IIII         PPPPPPPPPPPP 
                 TTTT             IIII         PPPPPPPPP
                 TTTT             IIII         PPPP 
                 TTTT             IIII         PPPP 
                TTTTTT         IIIIIIIIII     PPPPPP
                TTTTTT         IIIIIIIIII     PPPPPP
                TTTTTT         IIIIIIIIII     PPPPPP
  
  
  
? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T H S P T I P                                * 
*                                                                     * 
*        OPS-LEVEL HASPTIP                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$I-,R-,G-   INTERRUPTABLE, NON-RECURSIVE ? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - RECEIVES OPS-LEVEL WORKLIST ENTRIES                    * 
*                                                                     * 
** INPUT     - WORKLIST ENTRIES                                       * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PBMONITOR  - OPS-LEVEL MONITOR WITH WLES FROM:         * 
*                  1) SVM                                             * 
*                  2) BIP                                             * 
*                  3) HASPTIP INPUT STATES                            * 
*                  4) MUX-LEVEL HASPTIP                               * 
*                  5) TIMING SERVICES                                 * 
*              PTHTPOUT   - PRE-OUPUT TEXT PROCESSING (FOR CMD-S)     * 
*                                                                     * 
** OUTPUT    - WORKLIST ENTRIES TO SVM, COMM. OUTPUT TO WORKSTATION   * 
*                                                                     * 
** INTERNAL SUBROUTINES (IN ORDER OF DECLARATION) -                   * 
*              PTRET1ADR  - RETURN TO SAVED RETURN ADDRESS 1          * 
*              PTRET2ADR  - RETURN TO SAVED RETURN ADDRESS 2          * 
*              PTDRRET    - RETURN TO THE CALLER OF PTDRIVER          * 
*              PTDELINK   - DELINK ENTRY FROM DATA-LIST-QUEUE         * 
*              PTPUTDLQ   - PUT ENTRY IN DATA-LIST-QUEUE              * 
*              PTFNDTCB   - FIND TCB FOR STREAM ID                    * 
*              PTSETSST   - SET STREAM STATE FOR DEVICE               * 
*              PTGETSST   - RETURN CURRENT STREAM STATE               * 
*              PTABTSTRM  - ABORT STREAM                              * 
*              PTFCSOPN   - CHECK FCS FOR STREAM OPEN                 * 
*              PTSTROPN   - CHECK IF STREAM IS OPEN                   * 
*              PTGETFCS   - GET FCS TO SEND TO WS                     * 
*              PTGENDATA  - GENERATE DATA TO SEND TO WS               * 
*              PTGETDLQ   - GET ENTRY FROM DATA-LIST-QUEUE            * 
*              PTHSPIO    - ISSUE I/O COMMANDS TO MUX SUBSYSTEM       * 
*              PTHSPDOWN  - BRING HASP LINE/WS DOWN                   * 
*              PTERRTEST  - TEST FOR ERRORS                           * 
*              PTPREOUTP  - PRE-OUTPUT PROCESSING                     * 
*              PTPOSTOUTP - POST-OUTPUT PROCESSING                    * 
*              PTPINPTP   - POST-INPUT TEXT PROCESSING                * 
*              PTDRIVER   - HASP PROTOCOL DRIVER                      * 
*              PTTCBINIT  - INITIALIZE NEW TCB                        * 
*                                                                 ?_$J+ 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*              PBLCBP     - GET LCB ADDRESS                           * 
*              PBCLR      - CLEAR A MEMORY AREA (BUFFER)              * 
*              PBGET1BF   - GET A BUFFER                              * 
*              PBREL1BF   - RELEASE A BUFFER                          * 
*              PTCNFCARD  - PROCESS /*CONFIG CARD                     * 
*              PTPRUCMD   - PROCESS BATCH DEVICE/FILE COMMAND         * 
*              PTIVTCMD   - PROCESS DOWNLINE IVT COMMAND              * 
*              PBRELZRO   - RELEASE BUFFER CHAIN, IF ANY              * 
*              PBRELCHN   - RELEASE BUFFER CHAIN                      * 
*              PBLSPUT    - PASS WORKLIST ENTRY                       * 
*              PBQUEUMAIN - QUEUE MAINTENANCE                         * 
*              PBULTS     - UPLINE TIP SERVICES                       * 
*              PBPEOI     - SEND ACCOUNTING INFO                      * 
*              PBCOIN     - COMMAND DRIVER                            * 
*              PNCEFILE   - SEND CE-ERROR-FILE MESSAGE                * 
*              PTTPINF    - TEXT PROCESSING INTERFACE                 * 
*              PTHTPOUT   - HASP OUTPUT TEXT PROCESSING               * 
*              PTHTPREL   - RELEASE HASP TPCB BUFFERS                 * 
*              PTREGL     - TEST SYSTEM REGULATION                    * 
*                                                                     * 
** NAMING CONVENTIONS -                                               * 
*              PT....     - PREFIX FOR PROCEDURE/FUNCTION NAMES       * 
*              T4....     - PREFIX FOR LOCAL CONSTANTS                * 
*              T5....     - PREFIX FOR FIELDS IN LOCAL TYPES          * 
*              T6....     - PREFIX FOR LOCAL VARIABLES                * 
*              BSH...     - PREFIX FOR HASP FIELDS IN TCB             * 
*              BZH...     - PREFIX FOR HASP FIELDS IN LCB             * 
*              TZX...     - PREFIX FOR HASP LCB EXTENTION             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTHSPTIP; 
  
LABEL 
      999;                                  _RETURN TO OPS-MONITOR     ?
  
CONST 
_ 
* * * *  TIMER VALUES (HALF SECOND BASE)
? 
      T4T1P5SEC = 3;                        _ONE-AND-A-HALF SECONDS    ?
      T4T2SEC   = 4;                        _TWO SECONDS               ?
      T4T3SEC   = 6;                        _THREE SECONDS             ?
      T4T6SEC   = 12;                       _SIX SECONDS               ?
      T4TOUTP   = 20;                       _OUTPUT TIMEOUT TIME       ?
_ 
* * * *  INSTALLATION PERFORMANCE OPTIONS 
? 
      T4RETRY   = 63;                       _NR RETRIES ON CONSEC. ERRS?
      T4EBDELAY = 4;                        _4 CONSEC ERRS, THEN DELAY ?
      T4EDELAY  = T4T1P5SEC;                _DELAY AFTER N CONSEC ERRS ?
      T4BTDELAY = T4T2SEC;                  _DELAY AFTER BUFFER THRESH.?
      T4ENQTRY  = 41;                       _NBR OF 3 SEC INTERVALS    ?
                                            _WARNING - THIS VALUE      ?
                                            _SHOULD NOT EXCEED 63      ?
_ 
* * * *  HASP TIP CONSTANTS 
? 
      T4INPSTAT = 4;                        _FIRST STATE FOR INPUT     ?
      T4PITPST  = 4;                        _FIRST STATE POST INPUT TP ?
_ 
* * * *  HASP DRIVER STATES 
? 
      T4DSIGNON = 0;                        _DRIVER STATE READ SIGNON  ?
      T4DSWRQP  = 1;                        _DRIVER STATE AWAIT RQP    ?
      T4DSCONFG = 2;                        _DRIVER STATE READ CONFIG  ?
      T4DSRUN   = 3;                        _DRIVER STATE RUNNING      ?
_ 
* * * *  HASP PROTOCOL CONSTANTS
? 
      T4NORMAL  = 0;                        _NORMAL BCB                ?
      T4RESET   = 2;                        _RESET BCB                 ?
      T4CONTRCB = 0;                        _RCB CONTROL RECORD (TTTT) ?
      T4CARD    = 3;                        _RCB CARD INPUT RECORD     ?
      T4PRINT   = 4;                        _RCB PRINT OUTPUT RECORD   ?
      T4PUNCH   = 5;                        _RCB PUNCH/PLOT RECORD     ?
      T4RQP     = 1;                        _RCB REQ. PERMISSION (III) ?
      T4PG      = 2;                        _RCB PERMISSION GRANTED    ?
      T4BCBERR  = 6;                        _RCB BAD BCB RCVD BY WS    ?
      T4GCONT   = 7;                        _RCB GENERAL CONTROL RECORD?
_ 
* * * *  CANNED MESSAGE OUTPUT TYPES
? 
      T4EOFOT   = 0;                        _END-OF-FILE OUTPUT TYPE   ?
      T4RQPOT   = 1;                        _REQUEST PERMISSION OTYPE  ?
      T4PGOT    = 2;                        _PERMISSION GRANTED OTYPE  ?
      T4FCSOT   = 3;                        _FCS CHANGE OTYPE          ?
      T4LCLMOT  = 4;                        _PUNCH LACE/LIMIT OTYPE    ?
_ 
* * * *  ERROR TYPES
? 
      T4DISET   = 1;                        _DISABLE LINE ERROR TYPE   ?
      T4TMOTET  = 2;                        _TIMEOUTS ERROR TYPE       ?
      T4BTBCBET = 3;                        _BAD BCB RECEIVED BY TIP   ?
      T4BWBCBET = 4;                        _BAD BCB RECEIVED BY WS    ?
      T4ERRSET  = 5;                        _TOO MANY ERRORS ERROR TYPE?
      T4NAKSET  = 6;                        _TOO MANY NAKS ERROR TYPE  ?
      T4RSTRTET = 7;                        _WS RESTARTED (ENQ RECVD)  ?
      T4INFLOOD = 8;                        _INPUT AFTER WAIT-A-BIT SET?
      T4NOENQ   = 9;                        _NO ENQ RECEIVED IN 2 MINS ?
                                            _GIVE LINE BACK TO PTLINIT ?
_ 
* * * *  UPLINE TIP SERVICES FLAG WORD DEFINITIONS
? 
      T4ULTX    = $212;                     _UPLINE MSG (TEST IVT CMD) ?
      T4ABTINP  = $100;                     _TERMINATE BATCH INPUT     ?
  
TYPE
      T5CMD     = (T5CACK,T5CNAK,T5COUT,    _TYPE OF COMMANDS          ?
                   T5CINP,T5CNO); 
  
VAR 
      T6TIPNAME : PACKED ARRAY [0..6] 
                  OF CHAR;                  _NAME (HASPTIP) FOR DUMPS  ?
      T6DBGI    : INTEGER;                  _INDEX TO NEXT WORKLIST    ?
      T6DBGA    : ARRAY [0..24] OF BWTIPWLE;_SAVED WORKLIST ENTRY ARRAY?
      T6WRKCOD  : INTEGER;                  _CURRENT WORKCODE          ?
      T6LINO    : B0LINO;                   _CURRENT LINE-NUMBER (PORT)?
      T6BUFP    : B0BUFPTR;                 _CURRENT BUFFER POINTER    ?
      T6BCB     : T5TPBCB;                  _LOCAL BLOCK CHECK BYTE    ?
      T6FCS     : T5TPFCS;                  _LOCAL FUNCTION CONTROL SEQ?
      T6RCB     : T5TPRCB;                  _LOCAL RECORD CONTROL BYTE ?
      T6SRCB    : T5TPSRCB;                 _LOCAL SECONDARY RCB       ?
      T6PFC     : INTEGER;                  _PRIMARY FUNCTION CODE     ?
      T6SFC     : INTEGER;                  _SECUNDARY FUNCTION CODE   ?
      T6WP      : B0BUFPTR;                 _WORK BUFFER POINTER       ?
      T6WI      : INTEGER;                  _WORK INTEGER              ?
      T6DLQBUF  : B0BUFPTR;                 _DATA-LIST-QUEUE BUFFER PTR?
      T6CMDP    : NKINCOM;                  _IO COMMAND PACKET         ?
      T6EOF,                                _END-OF-FILE               ?
      T6RQP,                                _REQUEST PERMISSION        ?
      T6PG      : PACKED ARRAY [0..19]      _PERMISSION GRANTED        ?
                  OF CHAR;
      T6FCSC    : PACKED ARRAY [0..15]      _FUNCTION CONTROL SEQUENCE ?
                  OF CHAR;
      T6LACE    : PACKED ARRAY [0..25]      _LACE CARD FOR CARD PUNCH  ?
                  OF CHAR;
      T6LIMIT   : PACKED ARRAY [0..71]      _LIMIT CARD FOR CARD PUNCH ?
                  OF CHAR;
      T6ERRCDS  : ARRAY [T4DISET..T4NOENQ]  _CE-ERROR CODES FOR VARIOUS?
                  OF INTEGER;               _ LINE DOWN ERROR TYPES    ?
      T6PRPST   : ARRAY [BOOLEAN]           _PRE/POST SRCB FOR EOF     ?
                  OF INTEGER; 
      T6DWNRSN  : ARRAY [T4ERROR..T4TIMOUT] _HASP DOWN REASONS         ?
                  OF INTEGER; 
  
VALUE 
      T6TIPNAME = (#HASPTIP#);
      T6CMDP    = (8*0);
      T6EOF     = ($1204,$0500, 
                   $3232,$3232,$1002,$0000,$0000,$0000,$0010,$2600);
      T6RQP     = ($1204,$1500, 
                   $3232,$3232,$1002,$0000,$0090,$0000,$0010,$2600);
      T6PG      = ($1204,$2500, 
                   $3232,$3232,$1002,$0000,$00A0,$0000,$0010,$2600);
      T6FCSC    = ($0F04,$3500, 
                   $3232,$3232,$1002,$0000,$0000,$1026);
      T6LACE    = ($1804,$4500, 
                   $3232,$3232,$1002,$0000,$0000,$80BF,$58BF,$58B2, 
                   $5800,$0010,$2600);
      T6LIMIT   = ($4604,$4500, 
                   $3232,$3232,$1002,$0000,$0000,$80B0,$38EF,$3038, 
                   $3938,$3938,$3938,$3838,$0938,$3038,$0938,$3838, 
                   $3038,$1838,$2838,$1838,$3038,$3838,$0938,$3038, 
                   $0938,$3838,$0838,$0838,$3038,$0838,$08B1,$3800, 
                   $0010,$2600);
      T6ERRCDS  = (0,CEHSNORSP,CEHSTBCB,CEHSWBCB,CEHSBDRSP, 
                   CEHSNAK,CEHSWSRS,CEHSIGWAB,0); 
      T6PRPST   = ($31,$11);
      T6DWNRSN  = (T4ERRSET,0,T4NAKSET,0,0,T4TMOTET); 
  
_FORWARD? 
  PROCEDURE PTHSPDOWN (T6ETYP: INTEGER);                      FORWARD;
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T R E T 1 A D R                              * 
*                                                                     * 
*        RETURN TO SAVED RETURN-ADDRESS NUMBER 1                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - RETURN TO RETURN-ADDRESS-1 SAVED IN LCB                * 
*                                                                     * 
** INPUT     - BZRET1ADDR FROM LCB                                    * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - HASP WORKLIST PROCESSOR                   * 
*                                                                     * 
** OUTPUT    - BZRET1ADDR IN LCB SET TO ZERO                          * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
** NOTE      - THIS PROCEDURE ONLY RETURNS TO ITS CALLER IF THE       * 
*              SAVED RETURN ADDRESS IS NON-ZERO UPON ENTRY.           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTRET1ADR;
  
BEGIN 
IF T6LCBP'.BZRET1ADDR " 0                   _RETURN ADDRESS VALID      ?
THEN
  BEGIN 
  RETURN (T6LCBP'.BZRET1ADDR);              _ RETURN TO IT             ?
  T6LCBP'.BZRET1ADDR := 0;                  _ AND REMOVE RETURN ADDR   ?
  END;
END; _PROCEDURE PTRET1ADR?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T R E T 2 A D R                              * 
*                                                                     * 
*        RETURN TO SAVED RETURN-ADDRESS NUMBER 2                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - RETURN TO RETURN-ADDRESS-2 SAVED IN LCB                * 
*                                                                     * 
** INPUT     - BZRET2ADDR FROM LCB                                    * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTERRTEST  - TEST FOR ERRORS                           * 
*                                                                     * 
** OUTPUT    - NONE                                                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
** NOTE      - THIS PROCEDURE DOES NOT RETURN TO ITS CALLER           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTRET2ADR;
  
BEGIN 
RETURN (T6LCBP'.BZRET2ADDR);                _ALTER PROCEDURES RETURN   ?
END; _PROCEDURE PTRET2ADR?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T D R R E T                                  * 
*                                                                     * 
*        HASP PROTOCOL DRIVER RETURN                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - RETURN FROM HASP PROTOCOL DRIVER THROUGH RETURN        * 
*              ADDRESS SAVED IN LCBX.                                 * 
*                                                                     * 
** INPUT     - TZXDRRET, THE SAVED RETURN ADDRES                      * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - THE HASP WL PROCESSOR                     * 
*                                                                     * 
** OUTPUT    - NONE                                                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
** NOTE      - THIS PROCEDURE DOES NOT RETURN TO ITS CALLER           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTDRRET;
  
BEGIN 
RETURN (T6LCBXP'.TZXDRRET);                 _ALTER PROCEDURES RETURN   ?
END; _PROCEDURE PTDRRET?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T D E L I N K                                * 
*                                                                     * 
*        DELINK ENTRY FROM DATA-LIST-QUEUE                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - DELINK ENTRY FROM DLQ FOR A GIVEN TCB                  * 
*                                                                     * 
** INPUT     - T6TCB POINTS TO TCB TO BE DELINKED                     * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTGETDLQ   - REMOVE ENTRY FROM DLQ                     * 
*              PTHSPDOWN  - BRING LINE/WS DOWN                        * 
*              PTHSPTIP   - HASP WORKLIST PROCESSOR                   * 
*                                                                     * 
** OUTPUT    - T6DLQBUF POINTS TO BUFFER DELINKED FROM DLQ            * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTDELINK; 
  
BEGIN 
WITH T6TCB'.BSTCB DO                        _PTR TO TCB TO BE DELINKED ?
  BEGIN 
  IF BSHTAIL = NIL                          _FIRST ENTRY IN DLQ        ?
  THEN
    T6LCBXP'.TZXHEAD := BSHHEAD             _YES, SET HEAD IN LCBX     ?
  ELSE
    BSHTAIL'.BSTCB.BSHHEAD := BSHHEAD;      _NO, UPDATE PREV. HEAD PTR ?
  IF BSHHEAD = NIL                          _LAST ENTRY IN DLQ         ?
  THEN
    T6LCBXP'.TZXTAIL := BSHTAIL             _YES, UPDATE TAIL IN LCBX  ?
  ELSE
    BSHHEAD'.BSTCB.BSHTAIL := BSHTAIL;      _NO, UPDATE NEXT TAIL PTR  ?
  T6DLQBUF := BSHDLQB;                      _PASS DLQ BUFFER PTR       ?
  END; _WITH T6TCB'.BSTCB DO? 
END; _PROCEDURE PTDELINK? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T P U T D L Q                                * 
*                                                                     * 
*        PUT ENTRY IN DATA-LIST-QUEUE                                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - PUT ENTRY (TCB, BUF) AT END OF DATA-LIST-QUEUE         * 
*                                                                     * 
** INPUT     - T6TCB    POINTS TO TCB TO BE PUT IN DLQ                * 
*              T6DLQBUF POINTS TO DATA TO BE PUT IN DLQ               * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTPREOUTP  - PRE-OUTPUT PROCESSOR                      * 
*              PTPOSTOUTP - POST-OUTPUT PROCESSOR                     * 
*              PTHSPTIP   - HASP WORKLIST PROCESSOR                   * 
*                                                                     * 
** OUTPUT    - BSHOIP (OUTPUT IN PROGRESS) SET TO TRUE                * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTPUTDLQ; 
  
BEGIN 
WITH T6TCB'.BSTCB, T6LCBXP' DO              _INDEX TO TCB, LCBX        ?
  BEGIN 
  BSHHEAD := NIL;                           _NEW ENTRY LAST IN DLQ     ?
  BSHTAIL := TZXTAIL;                       _SET TAIL PTR IN NEW ENTRY ?
  IF TZXHEAD = NIL                          _WAS DLQ EMPTY             ?
  THEN
    TZXHEAD := T6TCB                        _YES, SET HEAD             ?
  ELSE
    TZXTAIL'.BSTCB.BSHHEAD := T6TCB;        _NO, INSERT AT TAIL OF DLQ ?
  TZXTAIL := T6TCB;                         _UPDATE TAIL IN LCBX       ?
  BSHDLQB := T6DLQBUF;                      _INSERT BUFFER ADDRESS     ?
  BSHOIP  := TRUE;                          _SET OUTPUT-IN-PROGRESS    ?
  END; _WITH T6TCB'.BSTCB,..? 
END; _PROCEDURE PTPUTDLQ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T F N D T C B                                * 
*                                                                     * 
*        FIND TCB FOR STEAM ID                                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - FIND TCB FOR A GIVEN STREAM ID AND DEVICE TYPE         * 
*                                                                     * 
** INPUT     - STREAM ID AND DEVICE TYPE FROM RCB (PARAMETER)         * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - HASP WORKLIST PROCESOR                    * 
*                                                                     * 
** OUTPUT    - T6TCB POINTS TO FOUND TCB IF RETURNED BOOLEAN IS TRUE  * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PTFNDTCB (T6XRCB : T5TPRCB) : BOOLEAN; 
  
BEGIN 
T6TCB := T6LCBP'.BZTCBPTR;                  _GET ADDRESS FIRST TCB     ?
WHILE (T6TCB " NIL) &                       _WHILE MORE TCBS IN CHAIN  ?
      (T6XRCB.T5RCBC " T6TCB'.BSTCB.BSHRCB) _ AND TCB NO FOR THIS RCB  ?
  DO T6TCB := T6TCB'.BSTCB.BSCHAIN;         _ GET NEXT TCB IN CHAIN    ?
PTFNDTCB := (T6TCB " NIL);                  _RETURN TRUE IF TCB FOUND  ?
END; _FUNCTION PTFNDTCB?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T G E T S S T                                * 
*                                                                     * 
*        RETURN CURRENT STREAM STATE                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - THIS FUNCTION RETURNS THE CURRENT STREAM STATE         * 
*                                                                     * 
** INPUT     - T6LCBXP, RECORD CONTROL BYTE (PARAMETER)               * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTSTROPN   - CHECK IF STREAM IS OPEN                   * 
*              PTPREOUTP  - PRE-OUTPUT PROCESSING                     * 
*                                                                     * 
** OUTPUT    - FUNCTON RETURNS CURRENT STREAM STATE                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PTGETSST (T6XRCB : CHAR) : INTEGER;
  
VAR 
      T6RCB : T5TPRCB;
  
BEGIN 
T6RCB.T5RCBC := T6XRCB; 
IF T6RCB.T5TTTT < T4CARD                    _STREAM STATE REQ FOR CONS.?
THEN
  PTGETSST := T4SPG                         _YES, JUST RETURN PG       ?
ELSE
  PTGETSST := (T6LCBXP'.TZXSTRST            _NO GET THE STREAM STATE   ?
              [T6RCB.T5TTTT].BAINT /        _ FROM THE LCBX            ?
              T6STMARR [T6RCB.T5III]) MOD 4;
END; _FUNCTION PTGETSST?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T A B T S T R M                              * 
*                                                                     * 
*        ABORT A STREAM                                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - ABORT A STREAM BY REMOVING DATA FROM THE DLQ OR        * 
*              KILL THE OUTPUT IF CURRENTLY ACTIVE FOR THIS STREAM    * 
*                                                                     * 
** INPUT     - T6LCBXP, T6TCB                                         * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - THE HASP WL PROCESSOR                     * 
*                                                                     * 
** OUTPUT    - TZXOTCB WILL BE ZERO IF OUTPUT CURRENTLY BEING XMIT    * 
*              FOR THIS STREAM, DATA IN DLQ FOR THIS STREAM REMOVED   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTHTPREL   - RELEASE HASP TPCB BUFFERS                 * 
*              PTDELINK   - DELINK ENTRY FROM DATA LIST QUEUE         * 
*              PBRELCHN   - RELEASE BUFFERS                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTABTSTRM;
  
BEGIN 
PTHTPREL;                                   _RELEASE POSSIBLE TP BUFRS ?
IF T6TCB'.BSTCB.BSHOIP                      _OUTPUT IN PROGRESS        ?
THEN
  BEGIN                                     _YES                       ?
  T6TCB'.BSTCB.BSHOIP := FALSE; 
  IF T6TCB = T6LCBXP'.TZXOTCB 
  THEN                                      _CURRENTLY TRANSMITTING:   ?
    T6LCBXP'.TZXOTCB := NIL                 _DETACH OUTPUT FROM TCB    ?
  ELSE
    BEGIN                                   _NO XMITTING: IN DLQ       ?
    PTDELINK;                               _DELINK FROM DLQ           ?
    IF T6DLQBUF'.BFPERM = FALSE 
    THEN
      PBRELCHN (T6DLQBUF, BEDBSIZE);        _RELEASE IF NON-PERMANENT  ?
    END; _IF T6TCB = T6LCBXP'.TZXOTCB ELSE? 
  END; _IF T6TCB'.BSTCB.BSHOIP? 
END; _PROCEDURE PTABTSTRM?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T F C S O P N                                * 
*                                                                     * 
*        CHECK FCS FOR STREAM OPEN                                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - CHECK IF THE FCS FOR A GIVEN OUTPUT STREAM IS OPEN     * 
*                                                                     * 
** INPUT     - T6LCBXP, T6TCB                                         * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTSTROPN   - CHECK IF STREAM IS OPEN                   * 
*              PTDRIVER   - THE HASP PROTOCOL DRIVER                  * 
*                                                                     * 
** OUTPUT    - FUNCTION RETURNS TRUE IF FCS FOR STREAM IS OPEN        * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PTFCSOPN (T6REDUNDANT : INTEGER) : BOOLEAN;
  
BEGIN 
PTFCSOPN := NOT T6LCBXP'.TZXWFCS.T5WAIT &   _FCS FOR STREAM IS OPEN    ?
            (T6LCBXP'.TZXWFCS.T5FCSO &      _IF WAIT-A-BIT NOT SET     ?
             T6TCB'.BSTCB.BSHFCSM " [ ]);   _AND FCS-BIT FOR STREAM SET?
END; _FUNCTION PTFCSOPN?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T S T R O P N                                * 
*                                                                     * 
*        CHECK IF STREAM IS OPEN                                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - CHECK IF THE OUTPUT-STREAM FOR A GIVEN TCB IS OPEN     * 
*                                                                     * 
** INPUT     - T6LCBXP, T6TCB, RECORD CONTROL BYTE (PARAMETER)        * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTGENDATA  - HASP DATA GENERATOR                       * 
*                                                                     * 
** OUTPUT    - FUNCTION RETURNS TRUE IF STREAM OPEN                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTGETSST   - GET STREAM STATE FOR DEVICE               * 
*              PTFCSOPN   - CHECK FCS FOR STREAM OPEN                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PTSTROPN (T6XRCB : CHAR) : BOOLEAN;
  
BEGIN 
PTSTROPN := PTFCSOPN (0) &                  _STREAM OPEN IF FCS OPEN   ?
            (PTGETSST (T6XRCB) = T4SPG);    _AND PERMISSION GRANTED    ?
END; _FUNCTION PTSTROPN?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T G E T F C S                                * 
*                                                                     * 
*        GET FUNCTION CONTROL SEQUENCE TO SEND TO WORK STATION        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - UPDATE WAIT-A-BIT IN FCS, RETURN TRUE IF FCS MUST BE   * 
*              SENT BECAUSE IT HAS CHANGED SINCE PREVIOUS XMISSION    * 
*              OR IF ANY OF THE INPUT STREAMS ARE CURRENTLY IN        * 
*              REGULATION. IF THE WORKSTATION IS IGNORING THE FCS     * 
*              WAIT-A-BIT THIS IS DETECTED, RESULTING IN THE LINE     * 
*              BEING TAKEN DOWN AND A CE ERROR MESSAGE ISSUED.        * 
*              DURING SIGNON, THIS FUNCTION WILL RETURN A FALSE.      * 
*                                                                     * 
** INPUT     - T6LCBXP, T6TCB (CAN BE NIL)                            * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPIO    - HASP I/O DRIVER                           * 
*              PTGENDATA  - HASP DATA GENERATOR                       * 
*                                                                     * 
** OUTPUT    - FCS IN LCBX IS UPDATED                                 * 
*              A TRUE IS RETURNED IF THE FCS MUST BE SENT             * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PB1BFAVAIL - TEST FOR BUFFER AVAILABILITY              * 
*              PTHSPDOWN  - BRING THE HASP LINE/WS DOWN               * 
*                                                                     * 
** NOTE      - THIS PROCEDURE WILL NOT RETURN TO ITS CALLER IF THE    * 
*              LINE IS BROUGHT DOWN BECAUSE THE WORKSTATION IS        * 
*              IGNORING THE WAIT-A-BIT FROM THE TIP.                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
FUNCTION PTGETFCS (T6REDUNDANT : INTEGER) : BOOLEAN;
  
CONST 
      T4WAITABIT = 14;                      _WAIT-A-BIT IN THE FCS     ?
  
VAR 
      T6CCBREG : BOOLEAN;                   _REGULATE FOR QUEUED INPUT ?
      T6CCBCNT : INTEGER;                   _QUEUED INPUT BUFFER COUNT ?
      T6IBUFP  : B0BUFPTR;                  _POINTER TO INPUT BUFFER(S)?
      T6XBZ    : INTEGER;                   _TRANSMISSION BLOCK SIZE   ?
  
BEGIN 
WITH T6LCBXP' DO                            _INDEX TO LCBX             ?
  BEGIN 
  PTGETFCS := FALSE;                        _PRESET RETURN TO FALSE    ?
  IF TZXDRSTAT " T4DSIGNON                  _DONT SEND FCS DURING      ?
  THEN                                      _ SIGNON                   ?
    BEGIN 
    T6IBUFP    := TZXCCB;                   _POINTER TO FIRST BUFFER   ?
    IF T6IBUFP " NIL                        _IF THE QUEUE IS NOT EMPTY ?
    THEN
      BEGIN 
      T6CCBCNT := 0;                        _CLEAR BUFFER COUNT        ?
      REPEAT
      T6CCBCNT := T6CCBCNT + 1;             _COUNT NUMBER OF BUF QUEUED?
      T6IBUFP  := T6IBUFP'. 
                  BCCHAINS [DBUFLENGTH];    _CHAIN TO NEXT BUFFER      ?
      UNTIL T6IBUFP = NIL;                  _UNTIL END OF BUFFER CHAIN ?
      T6XBZ    := TZXCTCB'.BSTCB.BSXBZ;     _GET XMISSION BLOCK SIZE   ?
      T6CCBREG := T6CCBCNT > (T6XBZ / 32);  _REG FOR > 3.6 XMIT BLOCKS ?
      IF T6CCBREG                           _IF REGULATING QUEUE SIZE  ?
      THEN
        IF T6CCBCNT > (T6XBZ / 16)          _IF MORE THAN 7.2 XMIT BLK ?
        THEN                                _W/S IGNORING WAIT-A-BIT   ?
          PTHSPDOWN (T4INFLOOD);            _BRING THE LINE DOWN       ?
      END _IF T6IBUFP " NIL THEN? 
    ELSE
      T6CCBREG := FALSE;                    _NOT REGULATING QUEUE SIZE ?
    TZXTFCS.T5WAIT := (NOT PB1BFAVAIL       _NOT ENOUGH BUFFERS        ?
                      (B0TH3LV)) !
                       T6CCBREG  !          _OR REGULATE QUEUED INPUT  ?
                      (NOT TZXTFCS.T5CONS); _OR CONSOLE IS OFF         ?
    PTGETFCS       := (TZXPFCS.T5INT  " 
                       TZXTFCS.T5INT) ! 
                       TZXIREGL;            _TRUE IF FCS MUST BE SENT  ?
    TZXPFCS.T5FCSO := TZXTFCS.T5FCSO -      _UPDATE PREVIOUS FCS       ?
                      [T4WAITABIT];         _ WITHOUT THE WAIT-A-BIT   ?
    END; _IF TZXDRSTAT " T4DSIGNON? 
  T6FCS.T5INT := TZXTFCS.T5INT;             _GET FCS LOCALLY           ?
  END; _WITH T6LCBXP' DO? 
END; _PROCEDURE PTGETFCS? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T G E N D A T A                              * 
*                                                                     * 
*        GENERATE DATA TO BE SEND TO HASP WORKSTATION                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - GENERATE DATA AND TEXTPROCESS PRIOR TO TRANSMISSION    * 
*              TO THE HASP WORKSTATION.                               * 
*                                                                     * 
** INPUT     - T6TCB, T6DLQBUF THE TCB AND BUFFER ADDRESS OF DATA     * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPIO    - HASP I/O DRIVER                           * 
*              PTGETDLQ   - GET TOP OF DLQ                            * 
*                                                                     * 
** OUTPUT    - T6BUFP POINTS TO DATA READY TO BE TRANSMIT TO WS       * 
*              T6BUFP WILL BE NIL IF DATA CANNOT (CURR.) BE XMITTED   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBGET1BF   - GET A DATA BUFFER                         * 
*              PTTPINF    - TEXT PROCESSING ROUTINE                   * 
*              PTSTROPN   - TEST FOR STREAM OPEN                      * 
*              PTFCSOPN   - CHECK FCS FOR STREAM OPEN                 * 
*              PBFCOPY    - COPY CANNED MSG TO DATA BUFFER            * 
*              PTSETSST   - SET STREAM STATE FOR DEVICE               * 
*              PTGETFCS   - GET FCS FOR CURRENT REGULATION            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTGENDATA;
  
CONST 
      T4RCBD    = 13;                       _RCB CHARACTER DISPLACEMENT?
      T4PUNSRCB = 0;                        _PUNCH SRCB                ?
      T4SOHDLE  = 12;                       _DISPLACEMENT FOR SOH/DLE  ?
      T4BFCD    = 4;                        _FCD FOR CRC BUFFER        ?
  
VAR 
      T6TPCBP  : B0BUFPTR;                  _POINTER TO TPCB           ?
      T6OUTOK  : BOOLEAN;                   _OK TO OUTPUT FLAG         ?
      T6WI     : INTEGER;                   _WORK INTEGER              ?
      T6FFCD   : INTEGER;                   _FCD OF FIRST BUFFER       ?
  
BEGIN 
T6BUFP  := NIL;                             _PRESET T6BUFP TO NIL      ?
T6OUTOK := FALSE;                           _PRESET OK TO OUTPUT FALSE ?
T6RCB.T5RCBC := T6TCB'.BSTCB.BSHRCB;        _SET LOCAL RCB CHARACTER   ?
IF T6DLQBUF'.BFPERM                         _TEST FOR CANNED MESSAGE   ?
THEN
_ 
* * * *  PROCESSED HASP INTERNAL CANNED MESSAGES (RQP, PG, ETC.)
? 
  BEGIN                                     _HAVE A CANNED MESSAGE     ?
  T6SRCB.T5SRCBC := T6RCB.T5RCBC;           _PRESET FOR RQP/PG         ?
  
  CASE T6DLQBUF'.BFHSTYP OF                 _CASE OUTPUT MESSAGE TYPE  ?
_ 
* * * *  SET UP TO SEND   R E Q U E S T   P E R M I S S I O N 
? 
    T4RQPOT:                                _REQUEST PERMISSION        ?
      BEGIN 
      T6RQP [T4RCBD+1] := T6SRCB.T5SRCBC;   _PUT SRCB IN RQP CANNED MSG?
      PTSETSST (T6RCB.T5RCBC,T4SRQP);       _SET PERMISSION REQUESTED  ?
      T6OUTOK := TRUE;
      END; _T4RQPOT:? 
_ 
* * * *  SET UP TO SEND   P E R M I S S I O N   G R A N T E D 
? 
    T4PGOT:                                 _PERMISSION GRANTED        ?
      BEGIN 
      IF T6LCBXP'.TZXWFCS.T5WAIT = FALSE
      THEN                                  _WS WAIT-A-BIT OFF         ?
        BEGIN                               _OK TO SEND PG NOW         ?
        T6PG [T4RCBD+1] := T6SRCB.T5SRCBC;  _PUT SRCB IN PG CANNED MSG ?
        PTSETSST (T6RCB.T5RCBC,T4SPG);      _SET PERMISSION GRANTED    ?
        T6OUTOK := TRUE;
        END;
      END; _T6PGOT:?
_ 
* * * *  SET UP TO SEND   E N D - O F - F I L E 
? 
    T4EOFOT:                                _END-OF-FILE               ?
      BEGIN 
      IF PTSTROPN (T6RCB.T5RCBC)            _TEST FOR STREAM OPEN      ?
      THEN
        BEGIN                               _OK TO SEND EOF NOW        ?
        IF T6RCB.T5TTTT = T4PRINT 
        THEN
          T6SRCB.T5SS := T6PRPST [T6TCB'.   _GET PROPER RECORD INFO    ?
            BSTCB.BSTCLASS = T4TCPOST]      _ FOR PRE/POST-CC PRINTER  ?
        ELSE
          T6SRCB.T5SS := T4PUNSRCB;         _PUNCH/PLOT SRCB           ?
        T6EOF [T4RCBD]   := T6RCB.T5RCBC;   _INSERT RCB AND            ?
        T6EOF [T4RCBD+1] := T6SRCB.T5SRCBC; _ SRCB IN CANNED EOF MSG   ?
        PTSETSST (T6RCB.T5RCBC,T4SPNED);    _PERMISSION NEEDED AGAIN   ?
        T6OUTOK := TRUE;
        END; _IF PTSTROPN?
      END; _T4EOFOT:? 
_ 
* * * *  SET UP TO SEND   F U N C T I O N   C O N T R O L   S E Q . 
? 
    T4FCSOT:                                _FUNCTION CONTROL SEQUENCE ?
      T6OUTOK := TRUE;
_ 
* * * *  SET UP TO SEND   L A C E / L I M I T   P U N C H   C A R D 
? 
    T4LCLMOT: 
      BEGIN 
      IF PTSTROPN (T6RCB.T5RCBC)            _TEST FOR STREAM OPEN      ?
      THEN
        BEGIN                               _OK TO SEND LACE/LIMIT NOW ?
        T6LACE [T4RCBD]  := T6RCB.T5RCBC;   _INSERT RCB IN LACE MSG    ?
        T6LIMIT [T4RCBD] := T6RCB.T5RCBC;   _AND IN LIMIT MSG          ?
        T6OUTOK := TRUE;
        END;
      END; _T4LCLMOT:?
  
    END; _CASE BFHSTYP OF?
_ 
* * * *  CONTINUE COMMON PROCESS FOR ALL INTERNAL CANNED MESSAGES 
? 
  IF T6OUTOK                                _SPECIAL OUTPUT OK TO GO   ?
  THEN                                      _ YES                      ?
    BEGIN 
    PBFCOPY (T6DLQBUF, T6BUFP);             _COPY CANNED MSG TO BUFFER ?
    IF T6LCBX'.TZXXPT = FALSE 
    THEN                                    _NON XPT WORK STATION      ?
      WITH T6BUFP' DO 
        BEGIN 
        BFDATAC [T4SOHDLE] := CHR ($01);    _SOH BEFORE STX FOR NON-XPT?
        BFDATAC [BFLCD-1]  := CHR ($32);    _SYN BEFORE ETX FOR NON-XPT?
        END;
    END; _IF T6OUTOK? 
  END _IF T6DLQBUF'.BFPERM THEN?
ELSE
_ 
* * * *  START PROCESSING NON-CANNED MESSAGES HERE
? 
  BEGIN 
  IF PTSTROPN (T6RCB.T5RCBC)                _TEST FOR STREAM OPEN      ?
  THEN
    T6BUFP := T6DLQBUF;                     _GET ADDRESS OF TEXT       ?
  END; _IF T6DLQBUF'.BFPERM ELSE? 
_ 
* * * *  CONTINUE FOR ALL OUTPUT (IF ANY GENERATED) 
? 
IF T6BUFP " NIL 
THEN                                        _HAVE DATA TO TRANSMIT     ?
_ 
* * * *  GET THE BCB AND THE FCS FROM THE LCB-EXTENTION 
? 
  BEGIN 
  WITH T6LCBXP' DO                          _INDEX TO LCBX             ?
    BEGIN 
    IF PTGETFCS (0) THEN;                   _GET FCS                   ?
    T6BCB.T5BCBC := CHR ($80 + TZXOBCB);    _AND BCB LOCALLY           ?
    IF TZXNBCB
    THEN
      TZXOBCB := TZXOBCB + 1                _NORMAL BCB, SET NEXT ONE  ?
    ELSE
      BEGIN                                 _RESET BCB                 ?
      T6BCB.T5XXX := T4RESET; 
      TZXNBCB     := TRUE;                  _SEND NORMAL BCB NEXT TIME ?
      END;
    END; _WITH T6LCBXP' DO? 
_ 
* * * *  INSERT BCB AND FCS IN THE OUTPUT BUFFER
? 
  WITH T6BUFP' DO                           _INDEX TO DATA BUFFER      ?
    BEGIN 
    T6FFCD               := BFFCD;          _PICK UP FCD OF FIRST BFR  ?
    BFDATAC [T6FFCD + 6] := T6BCB.T5BCBC;   _INSERT BCB                ?
    BFDATAC [T6FFCD + 7] := T6FCS.T5LFCS;   _INSERT LEFT FCS           ?
    BFDATAC [T6FFCD + 8] := T6FCS.T5RFCS;   _INSERT RIGHT FCS          ?
    END; _WITH T6BUFP' DO?
  END; _IF T6BUFP " NIL?
END; _PROCEDURE PTGENDATA?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T G E T D L Q                                * 
*                                                                     * 
*        GET ENTRY FROM DATA LIST QUEUE                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - REMOVE OLDEST ENTRY FROM DATA LIST QUEUE FOR STREAM    * 
*              THAT IS OPEN.                                          * 
*                                                                     * 
** INPUT     - T6LCBXP, T6BUFP = NIL                                  * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTDRIVER   - HASP PROTOCOL DRIVER                      * 
*                                                                     * 
** OUTPUT    - T6TCB, T6BUFP SET TO TCB, BUFFER READY TO TRANSMIT     * 
*              T6BUFP WILL BE ZERO IF NOTHING FOUND TO TRANSMIT       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTGENDATA  - GENERATE AND TEXTPROCESS DATA TO XMIT     * 
*              PTDELINK   - DELINK ENTRY FROM THE DATA LIST QUEUE     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTGETDLQ; 
  
VAR 
      T6DLQTCB : B0BUFPTR;
  
BEGIN 
T6DLQTCB := T6LCBXP'.TZXHEAD;               _GET TOP ENTRY FROM DLQ    ?
_ 
* * * *  GO THROUGH TCBS IN DLQ UNTIL WE FIND ONE READY TO OUTPUT 
? 
WHILE T6DLQTCB " NIL DO 
  BEGIN                                     _ENTRY FOUND IN DLQ        ?
  T6TCB    := T6DLQTCB; 
  T6DLQBUF := T6DLQTCB'.BSTCB.BSHDLQB;      _GET BUFFER FROM DLQ       ?
  PTGENDATA;                                _PREPARE FOR TRANSMISSION  ?
  IF T6BUFP = NIL 
  THEN                                      _CANT XMIT FOR THIS STREAM ?
    T6DLQTCB := T6DLQTCB'.BSTCB.BSHHEAD     _GET NEXT ENTRY FROM DLQ   ?
  ELSE
_ 
* * * *  FOUND A TCB WITH OUTPUT TO BE SENT, REMOVE TCB FROM DLQ
? 
    BEGIN 
    PTDELINK;                               _REMOVE ENTRY FROM DLQ     ?
    T6DLQTCB := NIL;                        _AND GET OUT OF -WHILE-    ?
    END;
  END; _WHILE T6DLQTCB " NIL DO?
END; _PROCEDURE PTGETDLQ? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T H S P I O                                  * 
*                                                                     * 
*        ISSUE COMMANDS TO MUX SUBSYSTEM                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - ISSUE VARIOUS COMMANDS TO MUX SUBSYSTEM, SET UP LINE   * 
*              TO RETURN CONTROL AFTER COMMAND IS COMPLETED.          * 
*                                                                     * 
** INPUT     - T6LCBP, T6LCBXP, COMMAND-TYPE, TIMEOUT                 * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTERRTEST  - TEST FOR ERRORS                           * 
*              PTDRIVER   - HASP PROTOCOL DRIVER                      * 
*              PTHSPTIP   - HASP WORKLIST PROCESSOR                   * 
*                                                                     * 
** OUTPUT    - COMMAND(S) SEND TO MUX SUBSYSTEM                       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBCOIN     - COMMAND DRIVER                            * 
*              PTGENDATA  - GENERATE HASP DATA FORMAT                 * 
*              PTGETFCS   - GET THE FUNCTION CONTROL SEQUENCE         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTHSPIO (T6CMD : T5CMD; T6TIMO : INTEGER);
  
BEGIN 
WITH T6LCBP' DO                             _INDEX TO LCB              ?
  BEGIN 
  RETADR (BZRET1ADDR);                      _SAVE RETURN ADDRESS IN LCB?
  BZWTCOUNT := BZWTCOUNT + 1;               _BUMP TIMER CONTENTION CNTR?
END;
WITH BLTIMTBL'[T6LINO.BDPORT] DO            _INDEX TO TIMER TABLE      ?
  BEGIN 
  BLTIME       := T4TOUTP;                  _TIMER DURING OUTPUT       ?
  BLTRESET     := T6TIMO;                   _TIMER DURING INPUT        ?
  T6CMDP.NKCMD := NKINOUT;                  _ASSUME INPUT-AFTER-OUTPUT ?
  CASE T6CMD OF                             _CASE COMMAND TYPE OF      ?
_ 
* * * *  SEND ACK OR AN FCS-CHANGE, RECEIVE INPUT AFTER ACK SENT
? 
    T5CACK:                                 _COMMAND TYPE: SEND ACK    ?
      BEGIN 
      ADDR (HSPACK,T6BUFP);                 _GET ADDRESS OF CANNED ACK ?
      IF PTGETFCS (0) 
      THEN                                  _INPUT REGULATION ACTIVE   ?
        BEGIN 
        ADDR (T6FCSC,T6DLQBUF);             _GET CANNED FCS CHANGE MSG ?
        PTGENDATA;                          _GENERATE FCS CHANGE MSG   ?
        T6LCBXP'.TZXOBUF := T6BUFP;         _SET OUTPUT TCB/BUF IN LCBX?
        END; _IF PTGETFCS (0)?
      END; _T5CACK:?
_ 
* * * *  SEND A NAK TO THE HASP/WS, RECEIVE INPUT AFTER NAK SENT
? 
    T5CNAK:                                 _COMMAND TYPE: SEND NAK    ?
      ADDR (HSPNAK,T6BUFP);                 _GET ADDRESS OF CANNED NAK ?
_ 
* * * *  SEND MESSAGE TO THE HASP/WS, RECEIVE INPUT AFTER MSG SENT
? 
    T5COUT:                                 _COMMAND TYPE: OUTPUT MSG  ?
      BEGIN 
      T6LCBXP'.TZXOTCB := T6TCB;
      T6LCBXP'.TZXOBUF := T6BUFP;           _ADDRESS OF OUTPUT         ?
      END; _T5COUT:?
_ 
* * * *  RECEIVE INPUT FROM HASP/WS 
? 
    T5CINP:                                 _COMMAND TYPE: INPUT       ?
      BEGIN 
      BLTIME       := T6TIMO;               _INPUT TIMOUT              ?
      T6CMDP.NKCMD := NKINPT;               _INPUT COMMAND             ?
      T6BUFP       := NIL;                  _NO OUTPUT                 ?
      END; _T5CINP:?
_ 
* * * *  DELAY COMMUNICATION WITH HASP/WS FOR SPECIFIED TIME
? 
    T5CNO:                                  _COMMAND TYPE: NO COMMAND  ?
      BEGIN 
      BLTIME := T6TIMO;                     _START TIMER               ?
      GOTO EXIT 999;                        _HAVE SET UP TIMER, EXIT   ?
      END; _T5CNO:? 
  
  END; _CASE T6CMD OF?
  T6CMDP.NKOBP   := T6BUFP;                 _INSERT BUFFER ADDRESS     ?
  T6CMDP.NKISTAI := T4INPSTAT;              _SET INITIAL INPUT STATE   ?
  PBCOIN (T6CMDP);                          _ISSUE THE COMMAND         ?
  END; _WITH BLTIMTBL'[T6LINO.BDPORT] DO? 
GOTO EXIT 999;                              _RETURN TO MONITOR         ?
END; _PROCEDURE PTHSPIO?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T T E R M I O                                * 
*                                                                     * 
*        TERMINATE INPUT AND OUTPUT                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - ISSUE TERMINATE OUTPUT/INPUT COMMANDS, SET UP LINE     * 
*              TO RETURN CONTROL AFTER TERMINATE INPUT COMPLETED      * 
*                                                                     * 
** INPUT     - T6LCBP                                                 * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - HASP WORKLIST PROCESSOR                   * 
*              PTHSPDOWN  - BRING LINE/WS DOWN                        * 
*                                                                     * 
** OUTPUT    - COMMANDS SEND TO MUX SUBSYSTEM                         * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBCOIN     - COMMAND DRIVER                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTTERMIO; 
  
BEGIN 
RETADR (T6LCBP'.BZRET2ADDR);                _SAVE RETURN ADDRESS IN LCB?
T6LCBP'.BZRET1ADDR := 0;                    _REMOVE PTHSPIO RETURN ADDR?
T6CMDP.NKWKFLG     := FALSE;                _NO WL ON TERM OUTPUT      ?
T6CMDP.NKCMD       := NKENDOT;
PBCOIN (T6CMDP);                            _ISSUE TERMINATE OUTPUT CMD?
T6CMDP.NKWKFLG     := TRUE;                 _WL ON TERM INPUT          ?
T6CMDP.NKWKCOD     := T4TERMIO;             _WORKCODE OF REQUESTED WL  ?
T6CMDP.NKWLINDX    := B0HASP;               _SEND WL TO THIS TIP       ?
T6CMDP.NKCMD       := NKENDIN;
PBCOIN (T6CMDP);                            _ISSUE TERMINATE INPUT CMD ?
GOTO EXIT 999;                              _EXIT FROM HASPTIP         ?
END; _PROCEDURE PTTERMIO? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T H S P D O W N                              * 
*                                                                     * 
*        BRING HASP LINE DOWN                                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - BRING HASP LINE DOWN BECAUSE OF ERRORS OR HOST REQUEST * 
*                                                                     * 
** INPUT     - T6LCBP                                                 * 
*              ERROR TYPE (PARAMETER)                                 * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTDRIVER   - THE HASP PROTOCOL DRIVER                  * 
*              PTERRTEST  - TEST FOR ERRORS                           * 
*              PTHSPTIP   - THE HASP WORKLIST PROCESSOR               * 
*              PTGETFCS   - GENERATES RESPONSE FCS FOR WORKSTATION    * 
*                                                                     * 
** OUTPUT    - WLE TO SVM TO INFORM HOST OF FAILURE                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBCOIN     - COMMAND DRIVER                            * 
*              PBLSPUT    - SEND WLE                                  * 
*              PNCEFILE   - SEND CE-ERROR-FILE MESSAGE                * 
*              PBRELZRO   - RELEASE BUFFERS                           * 
*              PBREL1BF   - RELEASE A SINGLE BUFFER                   * 
*              PTTERMIO   - TERMINATE IO                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTHSPDOWN (T6ETYP : INTEGER); 
  
BEGIN 
IF T6BUFP'.BFPERM = FALSE                   _IF NOT A CANNED MESSAGE   ?
THEN
  PBRELZRO (T6BUFP,BEDBSIZE);               _RELEASE BUFFER            ?
WITH T6LCBXP', BWWLENTRY [OPS].CMSMLEY DO   _INDEX TO LCBX, SVM-WLE    ?
  BEGIN 
  TZXETYP := T6ETYP;                        _SAVE ERROR-TYPE IN LCBX   ?
  PTTERMIO;                                 _ISSUE TERMINATE I/O       ?
_ 
* * * *  RELEASE ALL POSSIBLE PENDING BUFFERS FOR THIS LINE 
? 
  PBRELZRO (TZXCCB,BEDBSIZE);               _REL POSSIBLE CONTINUE BUFS?
  PBRELZRO (TZXOBUF, BEDBSIZE);             _RELEASE OUTPUT BUFFER(S)  ?
  IF TZXDRSTAT < T4DSRUN
  THEN                                      _DURING SIGNON, RELEASE    ?
    IF TZXCTCB " NIL                        _TEMPORARY TCB(S)          ?
    THEN                                    _ (IF THERE)               ?
      BEGIN 
      PBRELZRO (TZXCTCB'.BSTCB.BSCHAIN, 
                BEDBSIZE);                  _RELEASE POSSIBLE CR TCB   ?
      PBREL1BF (TZXCTCB, BEDBSIZE);         _AND CONSOLE TCB (TEMPS)   ?
      T6LCBP'.BZTCBPTR := NIL;
      END;
_ 
* * * *  ISSUE A CE-ERROR FILE MESSAGE IF ONE IS DEFINED FOR ERROR TYPE 
? 
  WITH CNCEOVL [OPS] DO                     _INDEX CE-ERROR FILE RECORD?
    BEGIN 
    CNCECODE := T6ERRCDS [TZXETYP];         _GET CE-ERROR CODE         ?
    IF CNCECODE " 0 
    THEN                                    _CE-ERROR CODE DEFINED     ?
      BEGIN 
      HSLINO := T6LINO.BDLINO;              _INSERT LINE NUMBER        ?
      PNCEFILE (3);                         _SEND CE-ERROR FILE MSG    ?
      END;
    END;
  CMWKCODE := D0LINE;                       _LINE EVENT WORKCODE TO SVM?
  IF TZXETYP = T4DISET
_ 
* * * *  ERROR TYPE IS DISABLE LINE, DO JUST THAT AND RELEASE LCBX
? 
  THEN
    BEGIN                                   _DISABLE LINE RCVD FM HOST ?
    T6WP := T6LCBXP;                        _DEFEAT SILLY TYPE-CHECKING?
    PBREL1BF (T6WP,B0S16);                  _RELEASE LCBX BUFFER       ?
    T6LCBP'.BZHXPTR := NIL;                 _CLEAR LCBX PTR IN LCB     ?
    T6CMDP.NKCMD    := NKDISL;              _INITIALIZE COMMAND PACKET ?
    PBCOIN (T6CMDP);                        _ISSUE DISABLE LINE COMMAND?
    CMDATA := D5DISA;                       _LINE DISABLED             ?
    END  _IF TZXETYP = T4DISET THEN?
_ 
* * * *  ERROR TYPE IS OTHER THEN DISABLE LINE
? 
  ELSE
    BEGIN 
    CMDATA := D5INOP;                       _LINE INOPERATIVE          ?
    END; _IF TZXETYP = T4DISET ELSE?
  
  PBLSPUT (BWWLENTRY [OPS],BYWLCB [B0SMWL]);
  END; _WITH T6LCBXP',BWWLENTRY...? 
GOTO EXIT 999;                              _RETURN TO OPS MONITOR     ?
END; _PROCEDURE PTHSPDOWN?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T E R R T E S T                              * 
*                                                                     * 
*        TEST FOR ERRORS                                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - TEST FOR ERRORS (NAK, TIMEOUT, BUF-THRESH, LINE ERROR) * 
*                                                                     * 
** INPUT     - T6WRKCOD, T6LCBP, T6LCBXP                              * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              HASPDRIVER - THE HASP PROTOCOL DRIVER                  * 
*                                                                     * 
** OUTPUT    - ERROR COUNTER UPDATED ACCORDING TO TYPE OF ERROR       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTHSPIO    - HASP COMMAND DRIVER INTERFACE             * 
*              PTHSPDOWN  - BRING THE HASP LINE/WS DOWN               * 
*              PTRET2ADR  - RETURN TO SAVED RETURN-ADDRESS            * 
*                                                                     * 
** NOTE      - THIS PROCEDURE WILL NOT RETURN TO ITS CALLER IN CASE   * 
*              THE LINE IS BROUGHT DOWN BECAUSE OF AN ERROR OVERFLOW. * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTERRTEST;
  
BEGIN 
RETADR (T6LCBP'.BZRET2ADDR);                _SAVE CALLERS RETURN IN LCB?
WITH T6LCBXP' DO                            _INDEX TO LCBX             ?
  BEGIN 
  CASE T6WRKCOD OF                          _CASE RECEIVED WORKCODE    ?
_ 
* * * *  LINE-ERROR, NAK OR TIME-OUT RECOGNIZED 
? 
    T4ERROR,                                _LINE ERROR RECOGNIZED     ?
    T4NAK,                                  _NAK RECEIVED              ?
    T4TIMOUT:                               _TIMEOUT OCCURRED          ?
      BEGIN 
_ 
* * * *  BUMP ERROR COUNTER FOR CONSECUTIVE ERROR OF SAME TYPE
? 
      IF T6WRKCOD " TZXEFLD.TZXERSN         _COMPARE WITH PREV ERRTYPE ?
      THEN                                  _FIRST TIME WE SEE THIS ERR?
        BEGIN 
       _TZXEFLD.TZXECOUNT := 0;?
        TZXEFLD.TZXERRS   := T6WRKCOD;      _CLEAR CNTR AND SET ERRTYPE?
        END;
      TZXEFLD.TZXECOUNT :=
      TZXEFLD.TZXECOUNT + 1;                _BUMP ERROR COUNTER BY 1   ?
      IF TZXEFLD.TZXECOUNT > T4RETRY        _OVERFLOW OF ERRORCOUNTER  ?
      THEN
        PTHSPDOWN (T6DWNRSN [T6WRKCOD]);    _YES, BRING LINE DOWN      ?
      IF (TZXEFLD.TZXECOUNT MOD 
          T4EBDELAY) = 0                    _NO, DELAY AFTER PREDEFINED?
      THEN                                  _ NR OF CONSEC ERRORS, TO  ?
        PTHSPIO (T5CNO,T4EDELAY);           _PREVENT LINE DOWN TOO SOON?
      T6WRKCOD := TZXEFLD.TZXERSN;          _RESTORE ORIGINAL WORKCODE ?
      PTRET2ADR;                            _RETURN TO CALLER          ?
      END; _T4NAK,T4ERROR,T4TIMOUT:?
_ 
* * * *  MUX BUFFER THRESHOLD, DELAY LINE, TREAT AS ERROR TO RECOVER
? 
    T4BUFTHR: 
      BEGIN 
      PTHSPIO (T5CNO,T4BTDELAY);            _DELAY A LITTLE            ?
      T6WRKCOD := T4BUFTHR;                 _AND PASS EVENT            ?
      PTRET2ADR;                            _TO CALLER OF ERRORTEST    ?
      END; _T4BUFTHR:?
_ 
* * * *  NO ERROR DETECTED, RESET ERROR COUNTER 
? 
    END; _CASE T6WRKCOD OF? 
  TZXEFLD.TZXERRS := 0;                     _NO ERROR, CLEAR COUNTER   ?
  END; _WITH T6LCBXP'?
END; _PROCEDURE PTERRTEST?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T P R E O U T P                              * 
*                                                                     * 
*        PRE-OUTPUT PROCESSING                                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - GET THE NEXT AVAILABLE OUTPUT BLOCK FROM THE TCB       * 
*              AND PUT IT IN THE DLQ.                                 * 
*                                                                     * 
** INPUT     - T6TCB SET TO TCB ADDRESS                               * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTPOSTOUTP - POST OUTPUT PROCESSOR                     * 
*              PTHSPTIP   - THE HASP WORKLIST PROCESSOR               * 
*                                                                     * 
** OUTPUT    - IF ANY OUTPUT DEQUEUED, IT IS PLACED IN THE DLQ        * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTGETSST   - GET STREAM STATE FOR DEVICE               * 
*              PBQUEMAINT - GET BLOCK FROM TCB QUEUE                  * 
*              PTPUTDLQ   - PUT OUTPUT IN DLQ                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTPREOUTP;
  
BEGIN 
T6DLQBUF := NIL;                            _PRESET FOR NO OUTPUT      ?
WITH T6TCB'.BSTCB DO                        _INDEX TO TCB              ?
  IF PTGETSST (BSHRCB) = T4SPNED            _CHECK FOR PERM. NEEDED    ?
  THEN
    ADDR (T6RQP,T6DLQBUF)                   _ADDRESS OF CANNED RQP     ?
  ELSE
    IF BSLIMC                               _LIMIT CARD TO BE PUNCHED  ?
    THEN
      BEGIN 
      ADDR (T6LIMIT, T6DLQBUF);             _ADDRESS OF LIMIT CARD     ?
      BSLIMC := FALSE;
      END 
    ELSE
      IF BSLACEC                            _LACE CARD TO BE PUNCHED   ?
      THEN
        BEGIN 
        ADDR (T6LACE, T6DLQBUF);            _ADDRESS OF LACE CARD      ?
        BSLACE := FALSE;
        END 
      ELSE                                  _NO LIMIT/LACE,            ?
        PBQUEMAINT (T6TCB, T6DLQBUF, K4GET);_TRY TO GET MORE OUTPUT    ?
IF T6DLQBUF " NIL                           _ DID WE FIND ANY OUTPUT   ?
THEN                                        _YES                       ?
  PTPUTDLQ;                                 _PUT TCB AND BUFFER IN DLQ ?
END; _PROCEDURE PTPREOUTP?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T P O S T O U T P                            * 
*                                                                     * 
*        PERFORM POST OUTPUT CHORES                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - CALLED BY HASPTIP AFTER OUTPUT FOR A TCB HAS BEEN      * 
*              DELIVERED.                                             * 
*                                                                     * 
** INPUT     - T6TCB SET TO TCB ADDRESS                               * 
*              T6BUFP SET TO THE DATA JUST TRANSMITTED                * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTDRIVER   - THE HASP PROTOCOL DRIVER                  * 
*                                                                     * 
** OUTPUT    - NEXT BLOCK OF OUTPUT FOR TCB IS PLACED IN DLQ (IF ANY) * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBRELCHN   - RELEASE BUFFERS                           * 
*              PTPUTDLQ   - PUT BLOCK IN DATA LIST QUEUE              * 
*              PBPEOI     - SEND UPLINE ACCOUNTING INFO               * 
*              PTGETSST   - TEST STREAM STATE                         * 
*              PTPREOUTP  - THE PRE-OUTPUT PROCESSOR                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTPOSTOUTP; 
  
BEGIN 
WITH T6TCB'.BSTCB DO                        _INDEX TO TCB              ?
  BEGIN 
  BSHOIP := FALSE;                          _RESET OUTPUT IN PROGRESS  ?
  IF T6BUFP'.BFEOI                          _END-OF-INFORMATION        ?
  THEN                                      _ YES                      ?
_ 
* * * *  FOUND END-OF-INFORMATION, SEND ACCOUNTING MESSAGE UPLINE 
? 
    BEGIN 
    PBPEOI (T6TCB, D9EOI);                  _SEND ACCOUNTING FOR EOI   ?
    IF T6BUFP'.BFEOR                        _EOI AND EOR = END-OF-JOB  ?
    THEN
_ 
* * * *  FOUND END-OF-JOB, SEND EOF TO PRINTER
? 
      BEGIN 
      ADDR (T6EOF,T6DLQBUF);                _GO SEND EOF               ?
      PTPUTDLQ;                             _PUT EOF IN DLQ            ?
      END;
    END; _IF T6BUFP'.BFEOI? 
_ 
* * * *  LOCATE NEXT BLOCK OF OUTPUT IF DLQ STILL EMPTY 
? 
  IF BSHOIP = FALSE 
  THEN
    BEGIN 
    IF BSQPTR.BABUFPTR " NIL
    THEN                                    _MORE OUTPUT AVAILABLE,    ?
      PTPREOUTP;                            _GO SET UP FOR TRANSMISSION?
    END; _IF BSHOIP = FALSE?
  END; _WITH T6TCB'.BSTCB DO? 
PBRELCHN (T6BUFP, BEDBSIZE);                _RELEASE XMITTED DATA      ?
END; _PROCEDURE PTPOSTOUTP? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T P I N P T P                                * 
*                                                                     * 
*        POST INPUT TEXT PROCESSING                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - PROCESS BLOCK OF INPUT FOR VARIOUS STREAMS RECEIVED    * 
*              BY THE INPUT STATE PROGRAM FROM THE HASP WORKSTATION.  * 
*                                                                     * 
** INPUT     - T6BUFP SET TO CURRENT RECORD IN BLOCK                  * 
*              T6TCB  SET TO TCB FOR THAT RECORD, OR NIL IF RECORD    * 
*                     MUST BE DISCARDED (E.G. STREAM CLOSED)          * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - THE HASP WL PROCESSOR                     * 
*                                                                     * 
** OUTPUT    - T6BUFP POINTS TO NEXT RECORD IN BLOCK (NIL IF DONE)    * 
*              THE TEXT PROCESSED PREVIOUS RECORDS IN THE BLOCK ARE   * 
*              PASSED TO BIP FOR TRANSMISSION TO THE HOST             * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBGET1BF   - GET A BUFFER                              * 
*              PBCLR      - CLEAR A BUFFER                            * 
*              PTTPINF    - TEXT PROCESSING FIRMWARE INTERFACE        * 
*              PBRELZRO   - RELEASE A CHAIN OF BUFFERS                * 
*              PBREL1BF   - RELEASE A SINGLE BUFFER                   * 
*              PTCOMMAND  - SEND COMMAND ON STREAM UPLINE             * 
*              PBULTS     - PASS UPLINE DATA TO BIP                   * 
*              PTREGL     - TEST FOR INPUT REGULATION                 * 
*              PTHTPOUT   - TEXT PROCESS IVT RESPONSE                 * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTPINPTP; 
  
CONST 
      T4ACCS  = 7;                          _TPF1 REGISTER ACC. SOURCE ?
      T4ACCD  = 4;                          _BUFFER WD ACC. DESTINATION?
      T4TPTEN = 10;                         _TPF1 REG WITH CONSTANT 10 ?
  
VAR 
      T6TPCBP : B0BUFPTR;                   _LOCAL TPCB POINTER        ?
      T6WV1,
      T6WV2   : B0OVERLAY;                  _WORK VARIABLES            ?
      T6EOF   : BOOLEAN;                    _END-OF-FILE ON INPUT      ?
  
BEGIN 
WITH T6TCB'.BSTCB DO                        _INDEX TO TCB              ?
  BEGIN 
  T6TPCBP := BSHTPCB;                       _GET T6TPCBP FROM TCB      ?
  IF (T6TCB = NIL) ! (T6TPCBP = NIL)        _DISCARD INPUT RECORD OR   ?
  THEN                                      _NO TPCB ASSIGNED          ?
_ 
* * * *  NO TPCB ASSIGNED GET A BUFFER AND INITIALIZE THE TPCB
? 
    BEGIN                                   _YES,                      ?
    T6TPCBP := PBGET1BF (BETPSIZE);         _GET TPCB BUFFER           ?
    PBCLR (T6TPCBP, TPBUFLEN);              _CLEAR TPCB (ALL ZEROES)   ?
    WITH T6TPCBP'.BGMLCB DO                 _INDEX TO TPCB             ?
      BEGIN 
      IF T6TCB " NIL                        _DO WE HAVE A TCB          ?
      THEN
        BEGIN                               _YES, FURTHER INIT TPCB    ?
        IF BSBATCH
        THEN                                _DEVICE TYPE IS BATCH      ?
          BEGIN 
          NCUOP1 := (BSSUBDT = B9DT26);     _SET 26 FLAG IF 26 IS DFLT ?
          NCUOP2 := TRUE;                   _SET JOB CARD EXPECTED     ?
          NCUOP3 := CSET63;                 _SET IF 63 CHARACTER SET   ?
          NCUOP7 := BSHXPT;                 _SET FOR TRANSPARENT INPUT ?
          NCUOP8 := TRUE;                   _BATCH AND TCB FOUND       ?
          NCTPF1 [T4TPTEN] := 10; 
          END; _IF BSBATCH? 
        END; _IF T6TCB " NIL? 
      END; _WITH T6TPCBP'.BGMLCB DO?
    END; _IF (T6TCB = NIL) ! (T6TPCBP = NIL)? 
  END; _WITH T6TCB'.BSTCB DO? 
WITH T6TPCBP'.BGMLCB DO                     _INDEX TO TPCB             ?
_ 
* * * *  SETUP TPCB FOR THE FIRMWARE CALL TO DO TEXT PROCESSING 
? 
  BEGIN 
  ADDR (ECASK, NCCXLTA);                    _EBCDIC TO ASCII DEFAULT   ?
  IF NCUOP8 & NOT NCUOP7                    _BATCH AND NOT XPARENT     ?
  THEN
    BEGIN 
    ADDR (H2BTCH, NCSPTA);                  _SET BATCH STATE-TABLE     ?
    IF T6LCBXP'.TZXDRSTAT \ T4DSRUN         _KEEP EBCDIC TO ASCII XLAT ?
    THEN                                    _ DURING SIGNON PROCEDURE  ?
      IF NCUOP1                             _TEST FOR 26/29            ?
      THEN
        ADDR (EB6DC, NCCXLTA)               _EBCDIC 26 - BCD           ?
      ELSE
        ADDR (EB9DC, NCCXLTA);              _EBCDIC 29 - BCD           ?
    END _IF NCUOP8 THEN?
  ELSE
    ADDR (H2INT, NCSPTA);                   _SET INTERACTIVE TABLE     ?
  NCFSBA  := T6BUFP;                        _SOURCE BUFFER IN TPCB     ?
  NCBFCD  := DATA;                          _FCD FIRST DESTINATION BUF ?
  NCISTAI := T4PITPST;                      _FIRST STATE PROGRAM INDEX ?
  
  PTTPINF (T6TPCBP');                       _ESCAPE TO FIRMWARE FOR TP ?
_ 
* * * *  GO SET T6BUFP TO THE REMAINDER OF UN-TEXTPROCESSED SOURCE
? 
  T6WV1.BABUFPTR := NCSBP;                  _GET RAW CURRENT SOURCE PTR?
  T6WV2.BASET    := T6WV1.BASET - 
                    BEDBSIZE'.BEMSK.BASET;  _GET BASE ADDRESS OF       ?
  T6BUFP         := T6WV2.BABUFPTR;         _ REST OF SOURCE TO TEXTPR.?
  IF NCEOSR 
  THEN                                      _ADJUST RAW SOURCE PTR     ?
    T6WV1.BAINT := T6WV1.BAINT + 1;         _BY ONE IF END-OF-SOURCE   ?
  T6WV1.BAINT := (T6WV1.BAINT - 
                  T6WV2.BAINT) * 2;         _CALCULATE THE NEW FCD     ?
  IF NCRIGHTC 
  THEN                                      _ADJUST FCD FOR RIGHT CHAR ?
    T6WV1.BAINT := T6WV1.BAINT + 1; 
  T6BUFP'.BFFCD := T6WV1.BAINT;             _INSERT NEW FCD            ?
  IF T6WV1.BAINT > T6BUFP'.BFLCD            _NEW FCD GREATER THAN LCD  ?
  THEN                                      _YES,                      ?
    T6BUFP := T6BUFP'.BCCHAINS [DBUFLEN];   _ADVANCE TO NEXT BUFFER    ?
  
  WHILE NCFSBA " T6BUFP DO                  _RELEASE TEXT-PROCESSED    ?
    PBREL1BF (NCFSBA,BEDBSIZE);             _ SOURCE BUFFERS           ?
_ 
* * * *  IN CASE TCB AVAIL, PROCESS SPECIAL CONDITIONS SUCH AS EOI, EOF 
? 
  IF T6TCB " NIL                            _DISCARDING INPUT (IF NIL) ?
  THEN                                      _NO                        ?
    BEGIN 
    WITH T6TCB'.BSTCB DO                    _INDEX TO TCB              ?
      BEGIN 
      T6WP := NCFDBA;                       _GET DESTINATION BUFFER(S) ?
      T6WI := NCTPF1 [T4ACCS];              _GET ACCOUNTING DATA       ?
      IF NCUOP6                             _EOI OR EOF OR INTERACTIVE ?
      THEN
        BEGIN                               _ YES                      ?
        PBREL1BF (T6TPCBP, BETPSIZE);       _RELEASE TPCB              ?
        T6EOF := NCUOP4;                    _GET EOF CONDITION         ?
        END _IF NCUOP6 THEN?
      ELSE
        BEGIN 
        NCFSBA  := NIL;                     _CLEAR FSBA PTR IN TPCB    ?
        NCFDBA  := NIL;                     _CLEAR FDBA PTR IN TPCB    ?
        NCSBP   := NIL;                     _CLEAR CURRENT SOURCE      ?
        NCBLCNT := 0;                       _RESET DESTIN. BUFFER CNTR ?
        END; _IF NCUOP6 ELSE? 
      BSHTPCB := T6TPCBP;                   _INSERT OR CLEAR PTR IN TCB?
_ 
* * * *  PASS DESTINATION TO BIP, OR COMPLETE SIGNON/CONFIG 
? 
      IF T6LCBXP'.TZXDRSTAT < T4DSRUN 
      THEN                                  _DURING SIGNON PROCESS     ?
        BEGIN 
        PTHTPREL;                           _RELEASE TPCB              ?
        PBRELZRO (T6BUFP, BEDBSIZE);        _RELASE REST OF SOURCE     ?
        T6BUFP := T6WP;                     _BUFFER WITH SIGNON        ?
        T6WP   := NIL;                      _DONT CALL BIP             ?
        T6EOF  := FALSE;                    _DONT PROCESS EOF          ?
        END;
      IF T6WP " NIL                         _IS UPLINE DATA AVAILABLE  ?
      THEN
        BEGIN                               _HAVE DATA TO PASS UPLINE  ?
_ 
* * * *  PASS TEXT-PROCESSED INPUT TO BIP, FOR UPLINE QUEUEING, ETC.
? 
        T6WP'.BIINT [T4ACCD] := T6WI;       _INSERT ACCOUNTING DATA    ?
        B1FLGWD.KTWORD       := T4ULTX;     _SET BIPS FLAG WORD        ?
        PBULTS (T6TCB, T6WP, B1FLGWD);      _CALL U/L TIP SERVICES     ?
        END; _IF T6WP " NIL?
      IF T6EOF                              _DO WE HAVE AN EOF         ?
      THEN
        BEGIN                               _ YES                      ?
        PTSETSST (BSHRCB, T4SPNED);         _PERMISSION NEEDED FOR STRM?
        PTCOMMAND (T6TCB, D8IS, D9ES);      _EOS INPUT STOPPED U/L     ?
        BSHIOK := FALSE;                    _INPUT NOT ALLOWED         ?
        T6EOF  := FALSE;
        END;
      END; _WITH T6TCB'.BSTCB DO? 
    END _IF T6TCB " NIL THEN? 
  ELSE
_ 
* * * *  TP CALLED TO DISCARD AN INPUT RECORD FROM BLOCK, CLEAN UP
? 
    BEGIN                                   _DISCARD INPUT RECORD      ?
    IF T6LCBXP'.TZXDRSTAT < T4DSRUN         _IF PROTOCOL NOT RUNNING   ?
    THEN
      PBRELZRO (T6BUFP, BEDBSIZE);          _DISCARD INPUT XMIT BLOCK  ?
    PBRELZRO (NCFDBA,BEDBSIZE);             _RELEASE DESTINATION BUFS  ?
    PBREL1BF (T6TPCBP,BETPSIZE);            _RELEASE TP CONTROL BLOCK  ?
    END; _IF T6TCB " NIL ELSE?
  END; _WITH T6TPCBP'.BGMLCB DO?
END; _PROCEDURE PTPINPTP? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T D R I V E R                                * 
*                                                                     * 
*        HASP PROTOCOL DRIVER                                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - HASP PROTOCOL DRIVER, SEND ACKS, NAKS, MSGS TO THE     * 
*              HASP-WORKSTATION, AND PROCESSES THE RECEIVED RESPONSES * 
*                                                                     * 
** INPUT     - DRIVER STATE (PARAMETER)                               * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - THE HASP WL PROCESSOR                     * 
*                                                                     * 
** OUTPUT    - VARIOUS HASP PROTOCOL ELEMENTS SENT TO THE WORKSTATION * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTGETDLQ   - GET NEXT MSG TO SEND TO WS                * 
*              PTTERMIO   - TERMINATE INPUT/OUTPUT                    * 
*              PTREGL     - TEST FOR INPUT REGULATION                 * 
*              PTHSPIO    - PERFORM OUTPUT/INPUT                      * 
*              PTERRCOUNT - MAINTAIN ERROR COUNTERS                   * 
*              PTPOSTOUTP - POST-OUTPUT PROCESSING                    * 
*              PBRELZRO   - RELEASE BUFFER(S)                         * 
*              PTHSPDOWN  - BRING LINE/WORKSTATION DOWN               * 
*              PTFCSOPN   - CHECK FCS FOR STREAM OPEN                 * 
*              PTCHAIN    - ADD BUFFER TO CHAIN                       * 
*              PBLSPUT    - SEND WORKLIST ENTRY                       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTDRIVER (T6DRSTAT : INTEGER);
  
VAR 
      T6SNDNAK : BOOLEAN;                   _SEND NAK CONTROL          ?
VALUE 
      T6SNDNAK = (FALSE); 
  
BEGIN 
WITH T6LCBXP' DO                            _INDEX TO LCBX             ?
  BEGIN 
  TZXDRSTAT := T6DRSTAT;                    _SET DRIVER STATE IN LCBX  ?
  RETADR (TZXDRRET);                        _PUT RETURN ADDRESS IN LCBX?
  PTTERMIO;                                 _START UP CLEAN            ?
  REPEAT
_ 
* * * *  SEE IF INPUT DEVICE(S) CAN BE TAKEN OUT OF REGULATION
? 
    IF TZXIREGL 
    THEN                                    _INPUT REGULATION ACTIVE   ?
      BEGIN 
      TZXIREGL := FALSE;
      T6TCB    := T6LCBP'.BZTCBPTR;         _GET FIRST TCB             ?
      WHILE T6TCB " NIL DO
        BEGIN 
        IF T6TCB'.BSTCB.BSHIOK              _(IMPLIES INPUT DEVICE)    ?
        THEN
          IF TZXTFCS.T5FCSO & T6TCB'.BSTCB. 
             BSHFCSM = [ ]                  _FCS BIT FOR THIS TCB OFF  ?
          THEN
            IF PTREGL (T6TCB) = RGNONE      _CURRENTLY IN REGULATION   ?
            THEN
              TZXTFCS.T5FCSO := TZXTFCS.    _NO, TURN FCS BIT ON       ?
              T5FCSO ! T6TCB'.BSTCB.BSHFCSM 
            ELSE
              TZXIREGL := TRUE;             _YES, REMAIN IN INPUT REGL ?
        T6TCB := T6TCB'.BSTCB.BSCHAIN;
        END;
      END;
_ 
* * * *   S E N D   A C K ,  M S G   O R   N A K
? 
    IF T6SNDNAK                             _ERROR/TIMEOUT OCCURRED    ?
    THEN
      BEGIN 
      T6SNDNAK := FALSE;
      PTHSPIO (T5CNAK,T4T3SEC);             _YES, SEND A NAK TO HASP-WS?
      END 
    ELSE
      BEGIN                                 _NO, SEND ACK OR MSG       ?
      T6TCB  := TZXOTCB;
      T6BUFP := TZXOBUF;                    _ANYTHING TO RETRANSMIT    ?
      IF T6BUFP = NIL 
      THEN                                  _NOTHING TO RETRANSMIT     ?
        PTGETDLQ;                           _ GET TOP OF DATA-LIST-QUEU?
      IF T6BUFP " NIL 
      THEN                                  _FOUND DATA TO TRANSMIT:   ?
        PTHSPIO (T5COUT,T4T3SEC)            _ SEND MSG TO WS           ?
      ELSE                                  _NOTHING TO TRANSMIT:      ?
        BEGIN                               _ SEND AN ACK              ?
        TZXDELAY := TRUE;                   _SLOW ACK IF ACK RECEIVED  ?
        PTHSPIO (T5CACK,T4T3SEC); 
        END;
      END; _IF T6SNDNAK ELSE? 
_ 
* * * *   P R O C E S S   I N P U T   R E C E I V E D   F R O M   W S 
? 
    PTERRTEST;                              _MAINTAIN ERROR COUNTERS   ?
  
    CASE T6WRKCOD OF                        _CASE OF RESPONSE WORKCODE ?
_ 
* * * *   A C K   R E C E I V E D 
? 
    T4ACK:                                  _ACK RECEIVED              ?
      BEGIN 
      IF TZXWFCS.T5WAIT 
      THEN
        BEGIN 
        TZXWFCS.T5WAIT := FALSE;            _ACK IMPLIES NO WAIT-A-BIT ?
        TZXDELAY       := FALSE;            _SEND A FAST ACK           ?
        END;
10: 
      IF TZXREXMIT = FALSE                  _RETRANSMISSION REQUIRED   ?
      THEN
        BEGIN                               _NO, SEE IF POSTOUTPUT REQ ?
        T6BUFP  := TZXOBUF;                 _GET OUTPUT TCB AND BUF ADR?
        TZXOBUF := NIL;                     _CLEAR OUTPUT BUFP IN LCBX ?
        T6TCB   := TZXOTCB; 
        IF T6TCB " NIL                      _WERE WE OUTPUTTING FOR TCB?
        THEN
          BEGIN 
          TZXOTCB := NIL;                   _CLEAR OUTPUT TCBP IN LCBX ?
          PTPOSTOUTP;                       _YES, DO POSTOUTPUT WORK   ?
          END 
        ELSE
          BEGIN 
          PBRELZRO (T6BUFP,BEDBSIZE);       _NO, RELEASE BUFFERS AND   ?
          IF TZXDELAY                       _IF ACK RECEIVED THEN      ?
          THEN                              _ START SLOW ACK-ACK       ?
            BEGIN 
            TZXSLWACK := TRUE;              _SET SLOW-ACK FLAG         ?
            PTHSPIO (T5CNO,T4T1P5SEC);      _DELAY LINE FOR 1 - 1.5 SEC?
            TZXSLWACK := FALSE;             _RESET SLOW-ACK FLAG       ?
            TZXDELAY  := FALSE;             _ AND DELAY FLAG           ?
            END; _IF TZXDELAY?
          END; _IF T6TCB " NIL ELSE?
        END; _IF TZXREXMIT = FALSE? 
      TZXREXMIT := FALSE;                   _RESET RETRANSMIT FLAG     ?
      END; _T4ACK:? 
_ 
* * * *   M E S S A G E   R E C E I V E D 
? 
    T4MSG:                                  _MSG RECEIVED              ?
      BEGIN 
      IF T6FCS.T5INT " TZXWFCS.T5INT
      THEN                                  _W/S FCS HAS CHANGED       ?
        TZXDELAY := FALSE;                  _SEND A FAST ACK           ?
      IF T6BCB.T5XXX = T4NORMAL             _IS IT A NORMAL BCB        ?
      THEN
        BEGIN 
        IF T6BCB.T5CCCC = TZXIBCB           _COMPARE RECEIVED WITH     ?
        THEN                                _ EXPECTED BCB             ?
          BEGIN 
          TZXIBCB       := TZXIBCB + 1;     _BCB OK, BUMP FOR NEXT TIME?
          TZXWFCS.T5INT := T6FCS.T5INT;     _SAVE RECEIVED FCS IN LCBX ?
          END _IF T6BCB.T5CCCC = TZXIBCB THEN?
        ELSE                                _BAD BCB RECEIVED, GO SEE  ?
          BEGIN                             _ HOW BAD                  ?
          IF ((T6BCB.T5CCCC+1) MOD 16) " TZXIBCB
          THEN                              _EXP.BCB - RCVD.BCB \ 2    ?
            PTHSPDOWN (T4BWBCBET);          _ BRING THE LINE/WS DOWN   ?
          PBRELZRO (T6BUFP, BEDBSIZE);      _RELEASE POSSIBLE BUFFERS  ?
          END; _IF T6BCB.T5CCCC = TZXIBCB ELSE? 
        END _IF T6BCB.T5XXX = T4NORMAL THEN?
      ELSE
        BEGIN                               _HAVE RESET/IGNORE BCB     ?
        IF T6BCB.T5XXX = T4RESET
        THEN
          TZXIBCB := T6BCB.T5CCCC;          _RESET INPUT BCB           ?
        TZXWFCS.T5INT := T6FCS.T5INT;       _SAVE RECEIVED FCS IN LCBX ?
        END; _IF T6BCB.T5XXX = T4NORMAL ELSE? 
      IF T6BUFP " NIL 
      THEN                                  _RECORD(S) RECEIVED        ?
        BEGIN 
        TZXDELAY := FALSE;                  _FAST ACK ON MSG           ?
        PTCHAIN (T6BUFP, TZXCCB);           _ADD RECORD TO CONT. CHAIN ?
        IF TZXCCB = T6BUFP                  _WAS CHAIN EMPTY           ?
        THEN
          BEGIN                             _YES                       ?
          BWWLENTRY [OPS].B0EWLQ. 
            MMIBP := TZXCCB;
          BWWLENTRY [OPS].B0EWLQ. 
            MMWKCODE := T4MSGCONT;
          PBLSPUT (BWWLENTRY [OPS], 
                   BYWLCB [B0HASP]);        _SEND CONTINUE WL TO HASP  ?
          IF TZXDRSTAT < T4DSRUN
          THEN                              _PROTOCOL NOT RUNNING,     ?
            GOTO EXIT 999;                  _ EXIT AFTER INPUT RCVD    ?
          END; _IF TZXCCB = T6BUFP? 
        END; _IF T6BUFP " NIL?
      GOTO 10;                              _MSG IS AN IMPLIED ACK     ?
      END; _T4MSG:? 
_ 
* * * *   N A K   R E C E I V E D 
? 
_   T4NAK:        ?                         _NAK RECEIVED              ?
_     BEGIN       ?                         _REXMIT IF TZXOBUF " NIL   ?
_     END;  T4NAK:? 
_ 
* * * *   E R R O R , T I M O U T   O R   B U F F E R T H R E S H O L D 
? 
    T4ERROR,                                _LINE/PROTOCOL ERROR,      ?
    T4TIMOUT,                               _TIMEOUT OR                ?
    T4BUFTHR:                               _BUFFER THRESHOLD DETECTED ?
      BEGIN 
      IF T6WRKCOD = T4TIMOUT
      THEN
        PTTERMIO;                           _TERMIO AFTER A TIMEOUT    ?
      TZXREXMIT := (TZXOBUF " NIL);         _RETRANSMIT OUTPUT         ?
      T6SNDNAK  := TRUE;                    _FORCE XMISSION OF NAK     ?
      END; _T4ERROR,T4TIMOUT,T4BUFTHR:? 
_ 
* * * *   E N Q   R E C E I V E D 
? 
    T4ENQ:                                  _ENQ RECEIVED              ?
      BEGIN 
      IF TZXDRSTAT " T4DSIGNON              _SIGNON COMPLETED          ?
      THEN
        BEGIN                               _YES,                      ?
        PTHSPIO (T5CINP,T4T6SEC);           _ TREAT AS RESTART OF WS   ?
        IF (T6WRKCOD = T4ENQ) !             _ IF WE RECEIVE ANOTHER ENQ?
           (T6WRKCOD = T4TIMOUT)            _ OR NO INPUT FOR 6 SECONDS?
        THEN
          PTHSPDOWN (T4RSTRTET);
       _ELSE?                               _NO RESTART DETECTED       ?
          T6SNDNAK := TRUE;                 _ SEND NAK TO CONTINUE     ?
        END; _IF TZXSGNON?
      END; _T4ENQ:? 
  
    END; _CASE T6WRKCOD OF? 
  
  UNTIL FALSE;
  
  END; _WITH T6LCBXP' DO? 
END; _PROCEDURE PTDRIVER? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                 S T A R T   O F   P T H S P T I P                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
BEGIN 
T6DBGA [T6DBGI] := BWWLENTRY[OPS].B0TIPWLE; _SAVE WORKLIST ENTRY       ?
T6DBGI          := (T6DBGI + 1) MOD 25;     _UPDATE INDEX INTO ARRAY   ?
WITH BWWLENTRY [OPS].B0EWLQ DO              _INDEX EVENT-WL-ENTRY      ?
  BEGIN 
  T6WRKCOD      := MMWKCODE;                _GET WORKCODE OF WLE,      ?
  T6BUFP        := MMIBP;                   _ THE BUFFER ADDRESS,      ?
  T6LINO.BDLINO := MMLINO;                  _ THE LINE NR,             ?
  T6CMDP.NKLINO := T6LINO.BDLINO; 
  PBLCBP (MMLINO, T6LCBP);                  _ AND THE LCB-ADDRESS      ?
  END;
T6LCBXP := T6LCBP'.BZHXPTR;                 _GET ADDRESS OF LCBX       ?
IF T6LCBXP = NIL
THEN
  IF T6WRKCOD " A0SMEN                      _NO LCBX, ONLY ALLOWED     ?
  THEN                                      _WORKCODE IS ENABLE LINE   ?
    GOTO 999; 
  
WITH T6LCBXP' DO                            _INDEX TO LCBX             ?
  
  CASE T6WRKCOD OF                          _CASE THE RECEIVED WORKCODE?
  
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*          P R O C E S S   W O R K L I S T   F R O M   S V M          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * *   E N A B L E   L I N E 
? 
  A0SMEN:                                   _ENABLE LINE               ?
    BEGIN 
    T6LCBXP         := PBGET1BF (B0S16);    _GET A BUFFER FOR LCBX     ?
    T6LCBP'.BZHXPTR := T6LCBXP;             _STICK LCBX PTR IN LCB     ?
    PBCLR (T6LCBXP, 16);                    _CLEAR THE NEW LCBX        ?
                                            _NOTE: LCBX-INDEX NIL      ?
                                            _UNTIL PTHSPIO EXECUTED    ?
_ 
* * * *  WAIT UNTIL THE HASP WORKSTATION SENDS AN ENQ 
? 
    REPEAT
      PTHSPIO (T5CINP, T4T3SEC);            _WAIT FOR INPUT FROM W/S   ?
      TZXENQCNT := TZXENQCNT + 1;           _INCREMENT ENQ TIMEOUT CTR ?
                                            _THIS FIELD IS USED ONLY   ?
                                            _WHILE THE TIP IS WAITING  ?
                                            _FOR THE ENQ FROM THE W/S  ?
                                            _IT IS UNUSED AFTER THE ENQ?
                                            _IS RECEIVED               ?
      IF TZXENQCNT > T4ENQTRY               _CHECK FOR ENQ TIME OUT    ?
      THEN
        PTHSPDOWN (T4NOENQ);                _DISCONECT THE LINE        ?
      PBRELZRO (T6BUFP, BEDBSIZE);          _RELEASE POSSIBLE BUFFERS  ?
    UNTIL T6WRKCOD = T4ENQ;                 _UNTIL ENQ RECEIVED        ?
_ 
* * * *  GET A TEMPORARY TCB BUFFER TO READ THE /*SIGNON OR /*CONFIG
? 
    T6TCB := PBGET1BF (BEDBSIZE);           _GET TEMPORARY TCB BUFFER  ?
    PBCLR (T6TCB, DBUFLEN);                 _CLEAR THE TCB BUFFER      ?
    T6TCB'.BSTCB.BSTA     := 1; 
    T6TCB'.BSTCB.BSDEVTYP := N1CON;         _INSERT TA AND DEVICE TYPE ?
    T6TCB'.BSTCB.BSXBZ    := 127;           _INSERT XMIT BLOCK SIZE    ?
    T6LCBP'.BZTCBPTR      := T6TCB;         _SET LCB POINTER TO TCB    ?
    PTTCBINIT;                              _INITIALIZE THE TEMP. TCB  ?
    PTDRIVER (T4DSIGNON);                   _READ SIGNON CARD          ?
    IF T6LCBP'.BZAUTO 
    THEN
      BEGIN 
      TZXTFCS.T5INT := $8FCE;               _SET CONSOLE/CR FCS BITS   ?
_ 
* * * *  AUTO RECOGNITION REQUESTED, PROCESS /*CONFIG CARD
? 
      REPEAT
        PTCNFCARD (T6LCBP, T6BUFP);         _PARSE CONFIGURE CARD      ?
        IF T6BUFP " NIL                     _/*CONFIG CARD BAD         ?
        THEN
_ 
* * * *  BAD /*CONFIG CARD RECEIVED, GO THROUGH TROUBLE TO READ IT AGAIN
? 
          BEGIN                             _YES, SEND MSG TO CONSOLE  ?
          PTHTPOUT (TZXCTCB, T6BUFP);       _TP AND QUEUE RESPONSE     ?
          PTDRIVER (T4DSWRQP);              _SEND IT AND WAIT FOR A RQP?
_ 
* * * *  HAVE RECEIVED RQP FORM CR OR /*CONFIG FROM CONSOLE 
? 
          IF TZXDRSTAT " T4DSCONFG          _WE DIDNT GET /*CONFIG     ?
          THEN                              _FROM THE CONSOLE          ?
            BEGIN 
            T6TCB := PBGET1BF (BEDBSIZE);   _GET A TEMP CARD TCB       ?
            PBCLR (T6TCB, DBUFLEN);         _CLEAR THE THING           ?
            T6TCB'.BSTCB.BSTA      := 
              T6SRCB.T5RCB.T5III;           _GET TA FROM RQP STREAM-ID ?
            T6TCB'.BSTCB.BSDEVTYP  := N1CR; _INSERT TA AND DEVICE TYPE ?
            T6TCB'.BSTCB.BSHIOK    := TRUE; _ALLOW CARD INPUT          ?
            PTTCBINIT;                      _FURTHER INITIALIZE TCB    ?
            TZXCTCB'.BSTCB.BSCHAIN := T6TCB;_ADD TCB TO LCB/TCB CHAIN  ?
            ADDR (T6PG, T6DLQBUF);          _QUEUE A PG FOR THE CR     ?
            PTPUTDLQ; 
            PTDRIVER (T4DSCONFG);           _SEND PG, AWAIT /*CONFIG   ?
_ 
* * * *  HAVE RECEIVED DATA (HOPEFULLY A GOOD /*CONFIG) FROM OUR CR 
? 
            PBREL1BF (TZXCTCB'.BSTCB. 
                      BSCHAIN, BEDBSIZE);   _RELEASE TEMP CARD TCB     ?
            END; _IF TZXDRSTAT " T4DSCONFG? 
          END; _IF T6BUFP " NIL?
      UNTIL T6BUFP = NIL;                   _UNTIL GOOD /*CONFIG SEEN  ?
      END _IF T6LCBP'.BZAUTO THEN?
    ELSE
_ 
* * * *  NO AUTO RECOGNITION REQUESTED, SEND LINE OPERATIONAL TO SVM
? 
      BEGIN 
      PBRELCHN (T6BUFP,BEDBSIZE);           _RELEASE SIGNON BUFFER     ?
      WITH BWWLENTRY [OPS].CMSMLEY DO       _INDEX TO SVM WLE          ?
        BEGIN 
        CMWKCODE := D0LINE;                 _LINE EVENT WORKCODE       ?
        CMDATA   := D5OPER;                 _LINE OPERATIONAL          ?
        CMLINO   := T6LINO;                 _INSERT LINE NUMBER        ?
        END;
      PBLSPUT (BWWLENTRY [OPS], 
               BYWLCB [B0SMWL]);            _SEND LINE OPERAT. TO SVM  ?
      END; _IF T6LCBP'.BZAUTO ELSE? 
    PBREL1BF (TZXCTCB,BEDBSIZE);            _RELEASE TEMP. CONSOLE-TCB ?
    T6LCBP'.BZTCBPTR := NIL;
    TZXTFCS.T5INT    := $C080;              _WAIT-A-BIT ON, FCS-BTS OFF?
    PTDRIVER (T4DSRUN);                     _START THE HASP PROTOCOL   ?
    END; _A0SMEN:?
_ 
* * * *   D I S A B L E   L I N E 
? 
  A0SMDA:                                   _DISABLE LINE              ?
    BEGIN 
    T6BUFP := NIL;                          _AVOID HALT A              ?
    PTHSPDOWN (T4DISET);                    _LINE DOWN, REASON DISABLE ?
    END; _A0SMDA:?
_ 
* * * *   D E L E T E   T C B 
? 
  A0SMDLTCB:                                _DELETE TCB                ?
    BEGIN 
    T6TCB := T6BUFP;                        _GET ADDRESS OF TCB        ?
    PTABTSTRM;                              _ABORT THE STREAM          ?
    WITH T6TCB'.BSTCB,
      BWWLENTRY [OPS].CMSMLEY DO            _INDEX TCB, SVM WLE        ?
      BEGIN 
      IF T6TCB = TZXCTCB
      THEN                                  _DELETING THE CONSOLE TCB  ?
        TZXCTCB := NIL; 
      T6WP := T6LCBP'.BZTCBPTR;             _GET ADDRESS FIRST TCB     ?
      IF T6TCB = T6WP 
      THEN
        T6LCBP'.BZTCBPTR := BSCHAIN         _TCB IS FIRST IN CHAIN     ?
      ELSE
        BEGIN                               _TCB NOT FIRST IN CHAIN    ?
        WHILE T6WP'.BSTCB.BSCHAIN " T6TCB   _DELETE TCB FROM MIDDLE    ?
          DO T6WP := T6WP'.BSTCB.BSCHAIN; 
        T6WP'.BSTCB.BSCHAIN := BSCHAIN;     _TCB NOW DELETED           ?
        END; _IF T6TCB = T6WP ELSE? 
  
      CMWKCODE := D0TCB;                    _TCB EVENT WORKCODE        ?
      CMDATA   := D5DELE;                   _DELETE TCB                ?
     _CMPTR    := T6TCB;?                   _INSERT TCB POINTER        ?
      PBLSPUT (BWWLENTRY [OPS], 
               BYWLCB [B0SMWL]);            _SEND WORKLIST TO SVM      ?
      END; _WITH T6TCB'.BSTCB,..? 
    END; _A0SMDLTCB:? 
_ 
* * * *  T I P   E V E N T S   ( C O N N E C T I O N   B R O K E N )
? 
  A0TIP:  
    BEGIN 
    T6TCB := T6BUFP;                        _GET TCB ADDRESS           ?
    WITH T6TCB'.BSTCB DO
      BEGIN 
      IF BSBATCH
      THEN                                  _BATCH CONNECTION          ?
        BEGIN 
        PTABTSTRM;                          _ABORT THE BATCH STREAM    ?
        IF BSDEVTYP = N1CR
        THEN
          BEGIN 
          BSHIOK         := FALSE;          _STOP ACCEPTING INPUT      ?
          TZXTFCS.T5FCSO := TZXTFCS.T5FCSO -
                            BSHFCSM;        _RESET CARD READER FCS BIT ?
          END 
        ELSE
          IF PTGETSST (BSHRCB) " T4SPNED
          THEN                              _STREAM CURRENTLY ACTIVE   ?
            BEGIN 
            ADDR (T6EOF, T6DLQBUF);         _SEND END-OF-FILE TO       ?
            PTPUTDLQ;                       _BATCH OUTPUT DEVICE       ?
            END;
        END;
      END;
    END; _A0TIP:? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*          P R O C E S S   D O W N L I N E   C O M M A N D S          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
  T4DLCMD:  
    BEGIN 
    WITH T6BUFP' DO                         _INDEX TO D/L BLOCK        ?
      BEGIN 
      T6PFC := ORD (BFDATAC [PFC]);         _GET PRIMARY AND           ?
      T6SFC := ORD (BFDATAC [SFC]);         _ SECUNDARY FUNCTION CODES ?
      END;
    WITH T6TCB'.BSTCB DO                    _INDEX TO TCB              ?
      BEGIN 
      IF T6BLKIND = HTICMD                  _SEE IF ICMD               ?
      THEN
        BEGIN 
        IF T6PFC = D7TERMINATE
        THEN
_ 
* * * *   T E R M I N A T E   B A T C H   O U T P U T   C O M M A N D 
? 
          PTABTSTRM;                        _ABORT THE STREAM          ?
        END _IF HTICMD = ...THEN? 
      ELSE
        BEGIN 
        CASE T6PFC OF                       _CASE COMMAND TYPE OF      ?
_ 
* * * *   T E R M I N A T E   B A T C H   O U T P U T   M A R K E R 
? 
          D8TO: 
            BEGIN 
            PBPEOI (T6TCB, D9IOT);          _SEND ACCOUNTING DATA      ?
            END; _D8TERMOUT:? 
_ 
* * * *   I V T   O R   B A T C H   D E V I C E / F I L E   C M D 
? 
          D8CTRL, 
          D8BD, 
          D8BF: 
            PTDLCMD (T6TCB, T6BUFP);        _PROCESS D/L IVT/PRU CMD   ?
_ 
* * * *   S T A R T   B A T C H   I N P U T   C O M M A N D 
? 
          D8SI: 
            BEGIN 
            BSHIOK := TRUE;                 _INPUT ALLOWED             ?
            IF T6SFC " D9RSM
            THEN                            _NOT A RESUME INPUT,       ?
              BSHXPT := T6SFC = D9TRAN;     _GET TRANSPARENT FLAG      ?
            TZXIREGL := TRUE;               _ FORCE TCB REGULATION     ?
            IF PTGETSST (BSHRCB) = T4SRQP 
            THEN                            _WE RECEIVED RQP FOR STREAM?
              IF BSHOIP = FALSE 
              THEN                          _ AND CURR. NO PG SENDING  ?
                BEGIN 
                ADDR (T6PG,T6DLQBUF);       _PERMISSION GRANTED MSG    ?
                PTPUTDLQ;                   _TO THE DATA-LIST-QUEUE    ?
                END; _IF BSHOIP = FALSE?
            END; _D8START:? 
_ 
* * * *   A B O R T   B A T C H   I N P U T   C O M M A N D 
? 
          D8AI: 
            BEGIN 
            BSHIOK := FALSE;                _INPUT NOT ALLOWED         ?
            PTHTPREL;                       _RELEASE TPCB              ?
            PTSETSST (BSHRCB,T4SPNED);      _REQUIRE RQP/PG SEQUENCE   ?
            B1FLGWD.KTWORD := T4ABTINP;     _SET FLAGS TO ABORT INPUT  ?
            PBULTS (T6TCB, NIL, B1FLGWD);   _HAVE BIP TERMINATE INPUT  ?
            END; _D8ABORTINP? 
  
          END; _CASE T6PFC OF?
        END; _IF HTICMD = ...ELSE?
      END; _WITH T6TCB'.BSTCB DO? 
    PBRELZRO (T6BUFP, BEDBSIZE);            _RELEASE POSSIBLE CMD BUF  ?
    END; _T4DLCMD:? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*           P R O C E S S   C O N T I N U E   W O R K L I S T         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
  T4MSGCONT:                                _MESSAGE CONTINUE (INPUT)  ?
    BEGIN 
    T6BUFP := TZXCCB;                       _GET POINTER TO INPUT-CONT ?
    IF T6BUFP " NIL 
    THEN                                    _MORE INPUT TO PROCESS     ?
_ 
* * * *  HAVE (MORE) RECORD(S) TO PROCESS 
? 
      BEGIN 
      TZXCCB := NIL;
      T6TCB  := NIL;                        _PRESET TCB POINTER TO NIL ?
_ 
* * * *  GET RCB ADN SRCB FROM BUFFER, SRCB CAN BE IN SECOND BUFFER 
? 
      T6WP := T6BUFP;                       _PRESET TO 1ST BF NXT RECRD?
      WITH T6BUFP' DO                       _INDEX TO NEXT INPUT RECORD?
        BEGIN 
        T6WI         := BFFCD;              _GET FCD OF FIRST BUFFER   ?
        T6RCB.T5RCBC := BFDATAC [T6WI];     _GET RCB                   ?
        T6WI         := T6WI + 1;           _PRESET TO SRCB IN FIRST BF?
        IF T6WI > BFLCD 
        THEN                                _SRCB IS IN NEXT BUFFER    ?
          BEGIN 
          T6WP := BCCHAINS [DBUFLEN];       _GET POINTER TO SECOND BUF ?
          T6WI := T6WP'.BFFCD;              _ADJUST INDEX TO SRCB      ?
          END;
        END;
      WITH T6WP' DO 
        T6SRCB.T5SRCBC := BFDATAC [T6WI];   _GET SRCB FM 1ST OR 2ND BFR?
_ 
* * * *  PROCESS VARIOUS TYPES OF RCB/SRCB RECORDS PRIOR TO TP-CALL 
? 
      IF T6RCB.T5TTTT " T4CONTRCB 
      THEN                                  _WE HAVE A DATA RECORD     ?
_ 
* * * *  PROCESS DATA INPUT RECORD
? 
        BEGIN 
        IF PTFNDTCB (T6RCB) 
        THEN                                _LOCATED THE TCB FOR DATA  ?
          BEGIN 
          IF T6TCB'.BSTCB.BSHIOK = FALSE
          THEN                              _INPUT NOT ALLOWED         ?
            T6TCB := NIL;                   _DISCARD INPUT             ?
          IF PTGETSST (T6RCB.T5RCBC) " T4SPG
          THEN                              _PERMISSION NOT GRANTED    ?
            T6TCB := NIL;                   _DISCARD INPUT             ?
          END; _IF PTFNDTCB?
        END _IF T6RCB.T5TTTT " T4CONTRCB THEN?
      ELSE
_ 
* * * *  PROCESS CONTROL INPUT RECORD 
? 
        CASE T6RCB.T5III OF                 _CASE CONTROL RECORD TYPE  ?
_ 
* * * *   R E Q U E S T   P E R M I S S I O N   R E C E I V E D 
? 
        T4RQP:                              _REQUEST PERMISSION        ?
          BEGIN 
          PTSETSST (T6SRCB.T5RCB.T5RCBC,
                    T4SRQP);                _SET RQP RECEIVED IN LCBX  ?
          IF PTFNDTCB (T6SRCB.T5RCB)
          THEN                              _LOCATED THE TCB           ?
            BEGIN 
            IF T6TCB'.BSTCB.BSHOIP = FALSE
            THEN                            _NOT CURRENTLY SENDING PG  ?
              IF T6TCB'.BSTCB.BSHIOK        _AND INPUT ALLOWED         ?
              THEN
                BEGIN 
                ADDR (T6PG, T6DLQBUF);      _YES, GO QUEUE PG          ?
                PTPUTDLQ; 
                END;
            T6TCB := NIL;                   _HAVE POSTINP REMOVE RECORD?
            END 
          ELSE
            IF TZXDRSTAT = T4DSWRQP         _ARE WE EXPECTING A RQP    ?
            THEN
              BEGIN 
              PBRELCHN (T6BUFP, BEDBSIZE);  _YES, RELEASE INPUT        ?
              PTDRRET;                      _RETURN TO PTDRIVER CALLER ?
              END;
          END; _T4RQP:? 
_ 
* * * *   P E R M I S S I O N   G R A N T E D   R E C E I V E D 
? 
        T4PG:                               _PERMISSION GRANTED        ?
          BEGIN 
          PTSETSST (T6SRCB.T5RCB.T5RCBC,
                    T4SPG);                 _SET PG RECEIVED IN LCBX   ?
          END; _T4PG:?
_ 
* * * *   B A D   B C B   R E C E I V E D   B Y   H A S P / W S 
? 
        T4BCBERR:                           _WS RCVD BAD BCB FROM TIP  ?
          PTHSPDOWN (T4BTBCBET);            _BRING LINE/WS DOWN        ?
_ 
* * * *   H A S P   C O N T R O L   R E C O R D   R E C E I V E D 
? 
        T4GCONT:                            _GENERAL CONTROL RECORD    ?
          T6TCB := TZXCTCB;                 _SEND OVER CONSOLE CONNECT.?
  
        END; _CASE T6RCB.T5III OF?
_ 
* * * *  CALL INPUT TEXT PROCESSING IF TERMINAL NOT IN REGULATION 
? 
      IF TZXDRSTAT \ T4DSRUN                _IF THE DRIVER IS RUNNING  ?
      THEN
        BEGIN 
        IF (PTREGL (T6TCB) " RGNONE) & (T6TCB " NIL)
        THEN                                _INPUT CONNECTION IN REGL  ?
          BEGIN 
          TZXIREGL       := TRUE;           _INPUT REGULATION ACTIVE   ?
          TZXTFCS.T5FCSO := TZXTFCS.T5FCSO  _RESET FCS BIT (CR/CON)    ?
                - T6TCB'.BSTCB.BSHFCSM; 
          END 
        ELSE
          PTPINPTP;                         _TEXT PROCESS INPUT RECORD ?
        END _IF PTREGL (T6TCB)...?
      ELSE
        BEGIN                               _DURING SIGNON PROCESS     ?
        PTPINPTP;                           _ TEXT PROCESS SIGNON CARD ?
        IF T6BUFP = NIL                     _EMPTY SIGNON RECORD       ?
        THEN
          BEGIN 
          T6BUFP := PBGET1BF (BEDBSIZE);    _GET A BUFFER              ?
          T6BUFP'.BIINT [LFCD] := 
            DATA * $101;                    _DECLARE IT EMPTY          ?
          END;
        TZXDRSTAT := T4DSCONFG;             _DECLARE SIGNON RECEIVED   ?
        PTDRRET;                            _RETURN TO A0SMEN PROCESS  ?
        END;  _IF TZXDRSTAT \ T4DSRUN ... ELSE? 
      IF T6BUFP " NIL                       _MORE RECORDS TO PROCESS   ?
      THEN
        BEGIN 
        TZXCCB := T6BUFP;                   _SET CONTINUE BUFFER PTR   ?
        WITH BWWLENTRY [OPS].B0EWLQ DO
          BEGIN 
          MMWKCODE := T4MSGCONT;            _MESSAGE CONTINUE WORKCODE ?
          MMLINO   := T6LINO.BDLINO;        _INSERT LINE NUMBER        ?
          MMIBP    := TZXCCB; 
          END;
        PBLSPUT (BWWLENTRY [OPS], 
                 BYWLCB [B0HASP]);          _YES, SEND CONT-WL TO TIP  ?
        END; _IF T6BUFP " NIL?
      END; _IF T6BUFP " NIL?
    END; _T4MSGCONT:? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*       P T H S P I O   C O M P L E T I O N   W O R K C O D E S       * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * *   T I M E - O U T   O C C U R R E D 
? 
  A0TIMEOUT:                                _LINE TIMEOUT              ?
    BEGIN 
    IF T6LCBP'.BZWTCOUNT =                  _TIMER EXPECTED IF COUNTS  ?
       BWWLENTRY [OPS].B0EWLQ.MMWTCOUNT     _ ARE MATCHING             ?
    THEN
      BEGIN 
      T6WRKCOD := T4TIMOUT;                 _SET HASP INTERNAL TIMOUT  ?
      T6BUFP   := NIL;                      _CLEAR BUFFER POINTER      ?
      PTRET1ADR;                            _RETURN TO HASPIO CALLER   ?
      END; _IF T6LCBP'.BZWTCOUNT = ?
    END; _A0TIMEOUT:? 
_ 
* * * *   D O W N L I N E   D A T A   Q U E U E D 
? 
  A0QUEOUT:                                 _OUTPUT QUEUED             ?
    BEGIN 
    T6TCB := T6BUFP;                        _GET THE TCB ADDRESS       ?
    IF T6TCB'.BSTCB.BSHOIP = FALSE
    THEN                                    _NO OUTPUT IN PROGRESS     ?
      BEGIN 
      PTPREOUTP;
      IF TZXSLWACK                          _ARE WE SLOW ACKING        ?
      THEN                                  _ YES,                     ?
        PTRET1ADR;                          _ RETURN TO HASPIO CALLER  ?
      END; _IF T6TCB'.BSTCB.BSHIOP = FALSE? 
    TZXDELAY := FALSE;                      _DONT SLOW ACK             ?
    END; _A0QUEOUT:?
_ 
* * * *   M E S S A G E   R E C E I V E D 
? 
  T4MSG:                                    _MSG RECEIVED              ?
    BEGIN 
    WITH T6BUFP' DO                         _INDEX TO BUFFER WITH MSG  ?
      BEGIN 
      T6BCB.T5BCBC := CHR(BIINT[DATA/2-1]); _GET BCB LOCAL             ?
      T6FCS.T5INT  := BIINT [DATA/2];       _GET FCS LOCAL             ?
      TZXXPT       := BFXPT;                _UPDATE TRANSPARENT FLAG   ?
      BFFCD        := DATA;                 _SET FCD TO FIRST RECORD   ?
      IF BFLCD @ DATA 
      THEN
        PBRELZRO (T6BUFP, BEDBSIZE);        _RELEASE FCS ONLY MSG      ?
      PTRET1ADR;                            _RETURN TO HASPIO CALLER   ?
      END; _WITH T6BUFP' DO?
    PBRELZRO (T6BUFP, BEDBSIZE);            _RELEASE IF RETURN FAILS   ?
    END; _T4MSG:? 
_ 
* * * *   E N Q  /  A C K  /  N A K   R E C E I V E D 
? 
  T4ENQ,                                    _ENQ, ACK, NAK RECEIVED OR ?
  T4ACK,                                    _ BUFFER-THRESHOLD         ?
  T4NAK,                                    _RECOGNIZED BY INPUT STATES?
  T4BUFTHR: 
    BEGIN 
    PTRET1ADR;                              _RETURN TO HASPIO CALLER   ?
    END; _T4ENQ,T4ACK,T4NAK,T4BUFTHR:?
_ 
* * * *   S O F T - E R R O R   R E C O G N I Z E D 
? 
  T4ERROR:                                  _SOFT-ERROR RECOGNIZED     ?
    BEGIN 
    PBRELZRO (T6BUFP, BEDBSIZE);            _RELEASE POSSIBLE BUFFERS  ?
    PTRET1ADR;                              _RETURN TO HASPIO CALLER   ?
    END; _T4ERROR:? 
_ 
* * * *   I N P U T   T E R M I N A T I O N   C O M P L E T E D 
? 
  T4TERMIO:                                 _INPUT TERMINATED          ?
    BEGIN 
    PBRELZRO (T6BUFP, BEDBSIZE);            _RELEASE POSSIBLE BUFFERS  ?
    PTRET2ADR;                              _RETURN TO PTTERMIO CALLER ?
  END; _T4TERMIO? 
_ 
* * * *   H A R D - E R R O R   R E C O G N I Z E D 
? 
  A0HARDERR:  
    IF TZXETYP " T4DISET                    _ CURRENTLY NOT DISABLING  ?
    THEN
      BEGIN 
      TZXINOP := BWWLENTRY [OPS]. 
                 B0EWLQ.MMINOP;             _SAVE REASON INOP. IN LCBX ?
      T6BUFP  := NIL;                       _AVOID HALT A              ?
      PTHSPDOWN (T4ERRSET);                 _BRING LINE/WS DOWN        ?
      END; _MMHARDER:?
  
  END; _WITH T6LCBXP'/CASE T6WRKCOD OF? 
_ 
* * * *  RETURN TO OPS-MONITOR (BY EXECUTING A -GOTO EXIT 999-) 
? 
999:                                        _EXIT TO OPS-MONITOR       ?
END; _PROCEDURE PTHSPTIP? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T H M U X T I P                              * 
*                                                                     * 
*        MUX-LEVEL HASPTIP                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$I-,R-,G-   INTERRUPTABLE, NON-RECURSIVE ? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - RECEIVES MUX-LEVEL WORKLIST ENTRIES                    * 
*                                                                     * 
** INPUT     - MUX LEVEL WORKLIST ENTRIES (NONE DEFINED)              * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PMWOLP     - MUX-LEVEL WORKLIST PROCESSOR              * 
*                                                                     * 
** OUTPUT    - WORKLIST ENTRIES PASSED TO THE OPS-LEVEL HASPTIP       * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PBLSPUT    - PASS WLE TO OPS-LEVEL HASPTIP             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTHMUXTIP;
  
BEGIN 
PBLSPUT (BWWLENTRY [MUX2],
         BYWLCB [B0HASP]);                  _PASS WLE TO OPS-LEVEL HASP?
END; _PROCEDURE PTHMUXTIP?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T S E T S S T                                * 
*                                                                     * 
*        SET NEW STREAM STATE FOR HASP DEVICE                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - UPDATE STREAM STATE FOR A HASP DEVICE                  * 
*                                                                     * 
** INPUT     - T6LCBXP, RCB FOR STREAM (PARAMETER)                    * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTGENDATA  - GENERATE DATA FOR HASP WS                 * 
*              PTHSPTIP   - HASP WORKLIST PROCESSOR                   * 
*              PTTCBUILD  - TCB BUILD                                 * 
*                                                                     * 
** OUTPUT    - STREAM STATE IN LCBX UPDATED                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              NONE                                                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTSETSST _(T6XRCB : CHAR; T6STATE : INTEGER)? ; 
  
CONST 
      T4CARD    = 3;                        _RCB CARD INPUT RECORD     ?
      T4PUNCH   = 5;                        _RCB PUNCH/PLOT RECORD     ?
  
VAR 
      T6RCB : T5TPRCB;                      _LOCAL WORKING RCB         ?
      T6I   : INTEGER;                      _LOCAL STREAM ID           ?
      T6T   : INTEGER;                      _LOCAL DEVICE TYPE FROM RCB?
      T6WK  : B0OVERLAY;                    _WORK VARIABLE             ?
  
BEGIN 
T6RCB.T5RCBC := T6XRCB; 
T6T          := T6RCB.T5TTTT;               _GET DEVICETYPE FROM RCB   ?
IF T6T \ T4CARD                             _PERFORM RANGE CHECK       ?
THEN                                        _ T4CARD,T4PRINT,T4PUNCH OK?
  IF T6T @ T4PUNCH
  THEN
    BEGIN 
    T6I := T6RCB.T5III;                     _GET STREAMID FROM RCB     ?
    T6WK.BAINT := T6STATE * T6STMARR [T6I]; _SHIFT STATE TO PROPER POSN?
    T6LCBXP'.TZXSTRST [T6T].BASET :=
      (T6LCBXP'.TZXSTRST [T6T].BASET -      _WIPE OUT OLD STREAM STATE ?
       T6STBARR [T6I]) ! T6WK.BASET;        _AND INSERT NEW ONE        ?
    END; _IF T6T \ T4CARD?
END; _PTSETSST? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T T C B I N I T                              * 
*                                                                     * 
*        INITIALIZE NEW TCB                                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - INITIALIZE A JUST CONFIGUERED TCB.                     * 
*                                                                     * 
** INPUT     - T6TCB, ADDRESS OF NEW TCB                              * 
*            - T6LCBXP, ADDRESS OF THE HASP LCB EXTENSION             * 
*            - TCLCBP, ADDRESS OF THE HASP LCB                        * 
*            - OR B1TCB IF CALLED BY PN2TELLTIP                       * 
*                  WE CAN TELL WHO CALLED BY THE CURRENT WORKCODE     * 
*                  BECAUSE THERE IS NO $20 WOKRLIST USED BY THE TIP   * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - THE HASP WL PROCESSOR                     * 
*              PN2TELLTIP - SUBROUTINE OF PNSMCNF IN SVM              * 
*                                                                     * 
** OUTPUT    - TCB INITIALIZED                                        * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTSETSST   - SET STREAM STATE                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTTCBINIT;
  
VAR 
      T6RCB     : T5TPRCB;                  _LOCAL WORKING RCB         ?
      T6XFCSARR : INTEGER;
      T6RCBARR  : ARRAY [N1CON..N1PLOT]     _RCBS FOR VARIOUS DEV.TYPES?
                  OF T5TPRCB; 
      T6FCSARR  : ARRAY [0..8]              _FCS BITS FOR VARIOUS STRMS?
                  OF SET OF 0..15;
  
VALUE 
      T6RCBARR  = (T4RCCON,T4RCCR,T4RCLP,T4RCCP,T4RCPL);
      T6FCSARR  = ($40,$800,$400,$200,$100,8,4,2,1);
  
BEGIN 
IF (BWWLENTRY[OPS].B0EWLQ.MMWKCOD = D0SM)   _IF CALLED BY SVM          ?
 ! (BWWLENTRY[OPS].B0EWLQ.MMWKCOD = D0TCB)
THEN
  BEGIN                                     _SET                       ?
  T6TCB   := B1TCB;                         _    T6TCB                 ?
  T6LCBP  := T6TCB'.BSTCB.BSLCBP;           _    T6LCBP                ?
  T6LCBXP := T6LCBP'.BZHXPTR;               _    AND T6LCBXP           ?
  END;
WITH T6TCB'.BSTCB DO                        _INDEX TO TCB              ?
  BEGIN 
  T6RCB.T5RCBC := T6RCBARR                  _CREATE RCB FOR THIS DEVICE?
                  [BSDEVTYP].T5RCBC;
  T6RCB.T5III  := BSTA;                     _INSERT STREAM-ID IN RCB   ?
  T6XFCSARR    := BSTA;                     _PRESET INDEX FOR CR/LP    ?
  BSHRCB       := T6RCB.T5RCBC;             _PUT RCB IN TCB            ?
  BSLCBP       := T6LCBP;                   _FOR AR: INSERT LCB ADDR   ?
  
  CASE BSDEVTYP OF                          _CASE THE DEVICE TYPE      ?
  
    N1CON:                                  _CONSOLE DEVICE            ?
      BEGIN 
      T6LCBXP'.TZXCTCB        := T6TCB;     _INSERT CONSOLE TCB IN LCBX?
      T6LCBXP'.TZXTFCS.T5CONS := TRUE;      _SET CONSOLE FCS BIT       ?
      BSHIOK                  := TRUE;      _ALLOW FOR CONSOLE INPUT   ?
      T6XFCSARR               := 0;         _INDEX FCS MASK FOR CONSOLE?
      END;
  
    N1CR:                                   _CARD READER DEVICE        ?
      BEGIN 
      PTSETSST (T6RCB.T5RCBC,T4SPNED);      _FORCE RQP/PG SEQUENCE     ?
      END;
  
    N1CP,                                   _PUNCH DEVICE              ?
    N1PLOT:                                 _PLOT DEVICE               ?
      BEGIN 
      T6XFCSARR := 9 - T6XFCSARR;           _INDEX TO MASK FOR CP/PLOT ?
      END;
  
    END; _CASE BSDEVTYP OF? 
  BSHFCSM := T6FCSARR [T6XFCSARR];          _INSERT FCS MASK IN TCB    ?
  END; _WITH T6TCBT'.BSTCB DO?
END; _PROCEDURE PTTCBINIT?
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T H T P R E L                                * 
*                                                                     * 
*        HASP RELEASE TPCB AND RELATED BUFFERS                        * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - CALLED BY THE HASPTIP TO RELEASE THE TPCB AND ALL      * 
*              REMAINING SOURCE AND DESTINATION BUFFERS.              * 
*                                                                     * 
** INPUT     - T6TCB, ADDRESS OF TCB                                  * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              PTHSPTIP   - HASP WORKLIST PROCESSOR                   * 
*              PTHTPOUT   - HASP PRE-OUTPUT TEXT PROCESSOR            * 
*                                                                     * 
** OUTPUT    - SRC/DEST TPCB BUFFERS RELEASED, TP PTRS IN TCB ZEROED  * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTTPRSMRK  - RELEASE BUFFER WITH TPMARKS               * 
*              PBRELZRO   - RELEASE A CHAIN OF BUFFERS                * 
*              PBREL1BF   - RELEASE A SINGLE BUFFER                   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTHTPREL; 
  
VAR 
      T6TPCBP : B0BUFPTR; 
  
BEGIN 
T6TPCBP := T6TCB'.BSTCB.BSHTPCB;            _GET TPCB ADDRESS FROM TCB ?
IF T6TPCBP " NIL                            _TPCB ASSIGNED             ?
THEN
  BEGIN                                     _YES, RELEASE BUFFERS      ?
  PBRELZRO (T6TPCBP'.BGMLCB.NCFSBA, 
            BEDBSIZE);                      _RELEASE POSSIBLE SOURCE   ?
  PBRELZRO (T6TPCBP'.BGMLCB.NCFDBA, 
            BEDBSIZE);                      _RELEASE POSSIBLE DESTINATN?
  IF T6TCB'.BSTCB.BSHMRKP " NIL             _SOURCE MARKS SAVED        ?
  THEN                                      _ YES                      ?
    PTTPRSMRK (T6TCB'.BSTCB.BSHMRKP, TRUE); _RELEASE BUFFER WITH MARKS ?
  T6TCB'.BSTCB.BSHTPCB := NIL;              _REMOVE TPCB PTR FROM TCB  ?
  PBREL1BF (T6TPCBP, BETPSIZE);             _RELEASE TPCB BUFFER       ?
  END; _IF T6TPCBP " NIL? 
END; _PROCEDURE PTHTPREL? 
_$J+? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                      P T H T P O U T                                * 
*                                                                     * 
*        HASP OUTPUT TEXT PROCESSING                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
_$I-,R-,G-   INTERRUPTABLE, NON-RECURSIVE ? 
_ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** OVERVIEW  - CALLED BY BIP TO TEXT PROCESS THE OUTPUT PRIOR TO      * 
*              THE QUEUING IN THE TCB.                                * 
*                                                                     * 
** INPUT     - T6TCBB, T6BUFB  ADDRESS OF TCB, BUF (PARAMETERS)       * 
*                                                                     * 
** CALLING PROGRAM -                                                  * 
*              BIP        - BLOCK INTERFACE PROGRAM                   * 
*                                                                     * 
** OUTPUT    - T6BUFP, NRBLKS  ADDRESS OF TEXT-PROCESSED DATA AND     * 
*              THE NUMBER OF BLOCKS TO BE QUEUED IN THE TCB           * 
*                                                                     * 
** EXTERNAL SUBROUTINES -                                             * 
*              PTHSPTIP   - HASP WORKLIST PROCESSOR                   * 
*              PBGET1BF   - GET A BUFFER                              * 
*              PBCLR      - CLEAR A BUFFER                            * 
*              PBRELZRO   - RELEASE A CHAIN OF BUFFERS (IF ANY)       * 
*              PBRELCHN   - RELEASE A CHAIN OF BUFFERS                * 
*              PBQUEMAINT - QUEUE MAINTENANCE ROUTINE                 * 
*              PTTPINF    - TEXT PROCESSOR FIRMWARE INTERFACE         * 
*              PTTPSVMRK  - SAVE LAST LEVELS 1/2 MARKS FROM TP        * 
*              PTTPRSMRK  - RESTORE LAST SAVED LEVELS 1/2 MARKS       * 
*              PTTPUSREL  - RELEASE UNMARKED TP SOURCE BUFFERS        * 
*              PTHTPREL   - RELEASE HASP TP BUFFER(S)                 * 
*              PTCHAIN    - ADD BUFFER TO CHAIN                       * 
*              PBREL1BF   - RELEASE A BUFFER                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
? 
PROCEDURE PTHTPOUT (T6TCBB : B0BUFPTR; VAR T6BUFB : B0BUFPTR);
  
CONST 
*CALL HASPCONST 
_ 
* * * *  LOCAL PRE-OUTPUT TEXTPROCESSING CONSTANTS
? 
      T4ACCS    = 5;                        _OUTPUT ACC. WORD SOURCE   ?
      T4ACCD    = 4;                        _OUTPUT ACC. WORD DESTINATN?
      T4FOTST   = 4;                        _FIRST OUTPUT TP STATE     ?
      T4XMSLK   = 13;                       _XMBF-SLACK FOR HDR/TRL (4)?
                                            _ AND FOR /*EOR CARD (9)   ?
      T4BFCD    = 8;                        _FCD FIRST DESTINATION BUF ?
_ 
* * * *  TPCB FILE REGISTER EQUATIONS 
? 
      T4MAXBL   = $04;                      _MAXIMUM COMPRESSED BLANKS ?
      T4PGLEN   = $09;                      _PAGE LENGTH               ?
      T4DEFLH   = $08;                      _DEFINITE PAGE POSITION    ?
      T4RCB     = $0C;                      _RCB FOR DEVICE            ?
      T4USCB    = $0E;                      _INITIAL UNCOMPRESSED SCB  ?
      T4BLNK    = $0F;                      _COMPRESSED/BLANK SCBS     ?
  
TYPE
*CALL HASPTYPE
  
VAR 
      T6TPCBP  : B0BUFPTR;                  _LOCAL POINTER TO TPCB     ?
      T6LCBXP  : 'TZLCBX;                   _POINTER TO LCB-EXTENSION  ?
      T6BUFP   : B0BUFPTR;                  _CURRENT BUFFER POINTER    ?
      T6DBC    : DBDBC;                     _DATA BLOCK CLARIFIER      ?
      T6PC, 
      T6PL, 
      T6PN, 
      T6PX     : B0BUFPTR;                  _WORK BUFFER POINTERS      ?
      T6LVLNO  : PACKED RECORD
                 CASE T5X : INTEGER OF
                   1: (T5INT   : INTEGER);
                   2: (T5SP1   : B05BITS; 
                       T5UPPER : B03BITS;   _UPPER DIGIT LEVELNO       ?
                       T5SP2   : B05BITS; 
                       T5LOWER : B03BITS);  _LOWER DIGIT LEVELNO       ?
                 END; 
  
VALUE 
      T6LVLNO  = (0); 
  
BEGIN 
T6BUFP := T6BUFB;                           _GET DL BLOCK FROM BIP PTR ?
WITH T6BUFP' DO                             _INDEX TO D/L BLOCK        ?
  BEGIN 
  T6DBC.DBCHAR := BFDATAC [DBC];            _GET DBC AND               ?
  T6BLKIND     := BIINT [BTWD];             _AND BLOCK TYPE LOCAL      ?
  END;
T6TCB := T6TCBB;                            _SET GLOBAL TCB PTR        ?
WITH T6TCB'.BSTCB DO                        _INDEX TO TCB              ?
  BEGIN 
  IF T6BLKIND \ HTCMD 
  THEN                                      _DOWNLINE COMMAND RECEIVED ?
_ 
* * * *  DOWNLINE COMMAND RECEIVED, CALL THE MAIN HASPTIP DIRECTLY
? 
    BEGIN 
    WITH BWWLENTRY [OPS].B0EWLQ DO          _INDEX TO WORKLIST ENTRY   ?
      BEGIN 
      MMWKCODE := T4DLCMD;                  _WORKCODE FOR PTHSPTIP     ?
      MMLINO   := BSLCBP'.BZLINO.BDLINO;    _SET LINE NUMBER           ?
      MMIBP    := T6BUFP;                   _PASS COMMAND BUFFER ADDR  ?
      END; _WITH BWWLENTRY [OPS].B0EWLQ DO? 
    PTHSPTIP;                               _CALL MAIN TIP DIRECTLY    ?
    END _IF T6BLKIND.BTYPE \ HTCMD THEN?
  ELSE
_ 
* * * *  DOWNLINE DATA BLOCK RECEIVED, GO PRE-TEXTPROCESS IT
? 
    BEGIN 
      T6BUFP'.BFFCD := DATA + 1;            _SET FCD TO FIRST DATA CHAR?
      T6TPCBP := BSHTPCB;                   _GET TPCB POINTER FROM TCB ?
      IF T6TPCBP = NIL
      THEN
_ 
* * * *  NO TPCB ASSIGNED, GO GET A TPCB AND PRE-INITIALIZE IT
? 
        BEGIN 
        T6TPCBP := PBGET1BF (BETPSIZE);     _GET A TPCB BUFFER         ?
        BSHTPCB := T6TPCBP;                 _INSERT TPCB PTR IN TCB    ?
        PBCLR (T6TPCBP, TPBUFLEN);          _CLEAR THE THING           ?
        WITH T6TPCBP'.BGMLCB DO             _INDEX TO NEW TPCB         ?
_ 
* * * *  INITIALIZE THE NEW TPCB (ONLY THE FIRST TIME)
? 
          BEGIN 
          NCSTAI  := T4FOTST;               _FIRST OUTPUT TP STATE     ?
          T6LCBXP := BSLCBP'.BZHXPTR;       _GET LCBX PTR (AVOID TYPCK)?
          NCUOP1  := T6LCBXP'.TZXXPT;       _TRANSPARENT-WS BIT        ?
          IF BSBATCH
          THEN                              _BATCH DEVICE              ?
            BEGIN 
            NCUOP2 := (BSDEVTYP = N1CP);    _SET PUNCH-BIT FOR CP      ?
            NCUOP4 := (BSTCLASS = T4TCPOST);_POST/PRE PRINT CC         ?
            NCTPF1 [T4RCB] := ORD (BSHRCB); _INSERT PROPER RCB         ?
            NCTPF1 [T4DEFLH] := BSPGLENGTH -1; _POSITION END OF PAGE   ?
            END _IF BSBATCH THEN? 
          ELSE                              _INTERACTIVE DEVICE        ?
            BEGIN 
            ADDR (HSITPS, NCSPTA);          _IA STATE-PROGRAM-TABLE    ?
            ADDR (ASKEC, NCCXLTA);          _AND TRANSLATE TABLE       ?
            NCTPF1[T4RCB] := ORD(BSHRCB)-1; _INSERT RCB FOR CONSOLE-OUT?
            END; _IF BSBATCH ELSE?
          NCTPF1 [T4MAXBL] := $001F;        _INSERT VARIOUS            ?
          NCTPF1 [T4USCB]  := $00C0;        _ HASP-PROTOCOL CONSTANTS  ?
          NCTPF1 [T4BLNK]  := $A380;
          NCTPF1 [T4PGLEN] := BSPGLENGTH;   _SET PAGE LENGTH           ?
          NCCNTL := BSPGWIDTH;              _SET PAGE WIDTH            ?
          NCBFCD := T4BFCD;                 _SET FCD FOR FIRST DESTIN. ?
          NCBLKL := BSXBZ - T4XMSLK;        _SET XMISSION BLOCK SIZE   ?
          END; _WITH T6TPCBP'.BGMLCB DO?
        END _IF T6TPCBP = NIL THEN? 
      ELSE
_ 
* * * *  TPCB ALREADY ASSIGNED, RESTORE THE SAVED -TPMARK- POINTERS 
? 
        PTTPRSMRK (BSHMRKP, FALSE);         _RESTORE SAVED MARKS FOR TP?
      WITH T6TPCBP'.BGMLCB DO               _INDEX TO TPCB             ?
        BEGIN 
_ 
* * * *  INITIALIZE TPCB PRIOR TO EVERY CALL OF -PTTPINF- 
? 
        IF T6DBC.DBBDATA
        THEN                                _DBC INDICATES BATCH DATA  ?
          BEGIN 
          NCUOP3 := BSSUPCC;                _SUPPRESS CARRIAGE CONTROL ?
          NCUOP5 := T6DBC.DBBEOR;           _GET EOR FLAG FROM DBC     ?
          IF NCUOP5 
          THEN
            IF NCUOP2 &                     _PUNCH DEVICE AND          ?
               (T6DBC.DBBEOI = FALSE)       _A TRUE EOR RECEIVED       ?
            THEN
_ 
* * * *  EOR DETECTED FOR PUNCH, PUNCH EOR CARD WITH LEVEL NUMBER 
? 
              BEGIN 
              T6LVLNO.T5UPPER := T6DBC. 
                DBBLEVNO / 8;               _GET UPPER DIGIT OF LEVELNO?
              T6LVLNO.T5LOWER := T6DBC. 
                DBBLEVNO;                   _GET LOWER DIGIT OF LEVELNO?
              T6PX := PBGET1BF (BEDBSIZE);  _GET BUFFER FOR EOR-CARD   ?
              T6PX'.BIINT [1] := $100C;     _INSERT LCD/FCD            ?
              T6PX'.BIINT [7] := $FF40;     _INSERT EOL/789-PUNCH      ?
              T6PX'.BIINT [8] := T6LVLNO. 
                T5INT + $1B1B;              _INSERT LEVEL NUMBER       ?
              T6PX'.BIINT [9] := $FF00;     _INSERT CLOSING EOL        ?
              PTCHAIN (T6PX, T6BUFP);       _TAG EOR TO D/L PRU        ?
              END;
          NCUOP6  := T6DBC.DBBEOI;          _GET EOI FLAG FROM DBC     ?
          NCSPTA  := T6SPTA [BSFTYPE];      _GET STATE PROGRAM TABLE   ?
          NCCXLTA := T6XLTA [BSFTYPE];      _AND XLATE TABLE ADDRESSES ?
          END 
        ELSE                                _DBC INDICATES IA DATA     ?
          NCUOP3 := T6DBC.DBDLFE;           _COPY NO-FORMAT-EFFECTORS  ?
_ 
* * * *  REMOVE EMPTY BUFFER, CHAIN NEW SOURCE AT END OF OLD SOURCE 
? 
        IF T6BUFP'.BFLCD < DATA + 1         _EMPTY FIRST SOURCE BUFFER ?
        THEN
          IF NCFSBA " NIL                   _AND PREVIOUS SOURCE LEFT  ?
          THEN                              _YES,                      ?
            PBREL1BF (T6BUFP, BEDBSIZE);    _RELEASE EMPTY FIRST BUFFER?
        PTCHAIN (T6BUFP, NCFSBA);           _ADD TO END OF SOURCE      ?
        PTTPINF (T6TPCBP');                 _ESCAPE TO FIRMWARE FOR TP ?
_ 
* * * *  UNRAVEL THE SERIAL XMISSION BLOCKS AND THE ACCOUNTING BUFFERS
? 
        T6PL := NIL;                        _PL WILL BE LAST FULL XMTBF?
        T6PX := NCFDBA;                     _PX IS CURRENT XMIT-BLK PTR?
        T6PC := T6PX;                       _PC IS CURRENT BUF PTR     ?
        WHILE T6PC " NIL DO 
          BEGIN 
          T6PN := T6PC'.BCCHAINS [DBUFLEN]; _PN IS NEXT BUF PTR        ?
          IF T6PN " NIL                     _IS THIS ACCOUNTING INFO   ?
          THEN
            IF T6PN'.BFEOI                  _(PASSED THROUGH EOI-FLAG) ?
            THEN
_ 
* * * *  FOUND A COMPLETE XMISSION BLOCK, QUEUE IT IN THE TCB 
? 
              BEGIN                         _YES, BLOCK FOR BIP        ?
              T6PX'.BIINT [T4ACCD]     := 
                T6PN'.BIINT [T4ACCS];       _ACC. INFO TO FIRST BUFFER ?
              T6PC'.BCCHAINS [DBUFLEN] :=   _DELINK ACC. INFO BUFFER   ?
                NIL;
              T6PL     := T6PX;             _PL IS LAST CMPLT XMIT-BLCK?
              PBQUEMAINT (T6TCB, T6PX,
                          K4PUT);           _PUT XMIT BLK IN D/L QUEUE ?
              PBREL1BF (T6PN, BEDBSIZE);    _RELEASE ACC. INFO BUFFER  ?
              T6PX := T6PN;                 _NEXT MAY BE A NEW XMIT BLK?
              END; _IF T6PN " NIL THEN? 
          T6PC := T6PN;                     _GO TO NEXT BUFFER IN CHAIN?
          END; _WHILE T6PC " NIL DO?
        NCFDBA := T6PX;                     _POSS. INCMPLT XMIT IN TPCB?
_ 
* * * *  COPY EOR/EOI FLAGS FROM DL PRU INTO LAST COMPLETE XMIT BLOCK 
? 
        IF T6PL " NIL 
        THEN
          IF BSBATCH
          THEN
            BEGIN                           _COPY EOI/EOR FLAGS IN LAST?
            T6PL'.BFEOR := NCUOP5;          _FROM DOWNLINE PRU-BLOCK   ?
            T6PL'.BFEOI := NCUOP6;
            END;
_ 
* * * *  TEST FOR SUCCESSFULL COMPLETION OF TEXT-PROCESSING 
? 
        IF NCSVWL " 0                       _NON ZERO INDICATES ERROR  ?
        THEN
          BEGIN 
          NCUOP6     := TRUE;               _FORCE TERMINATION OF TP   ?
          BSHTPERROR := TRUE;               _MARK ERROR IN TCB         ?
          END; _IF NCSVWL " 0?
_ 
* * * *  RELEASE THE TPCB FOR EOJ ON BATCH OR FOR INTERACTIVE TP
*        IF NO EOJ, RELEASE ALL SOURCE BUFFERS UP TO LAST LEVEL2 MARK 
? 
        IF NCUOP6                           _END-OF-INFORMATION        ?
        THEN
          PTHTPREL                          _RELEASE ALL TP BUFFERS    ?
        ELSE
          BEGIN 
          PTTPSVMRK (BSHMRKP);              _SAVE TPMARK IN TCB        ?
          PTTPUSREL (T6TPCBP, BSHMRKP, 2);  _REL. LVL2 UNMARKED TP SRC.?
          NCBLCNT := 0;                     _RESET DESTIN. BUFFER CNT  ?
          END; _IF NCUOP6 ELSE? 
        END; _WITH T6TPCBP'.BGMLCB DO?
    END; _IF T6BLKIND.BTYPE @ HTCMD ELSE? 
  END; _WITH T6TCB'.BSTCB DO? 
T6BUFB := NIL;
END; _PROCEDURE PTHTPOUT? 
