*COMDECK 3270TIP
                                                                    _$J+
*********************************************************************** 
*                                                                     * 
*  COPYRIGHT CONTROL DATA CORPORATION 1982, 1983, 1984, 1985.         * 
*                                                                     * 
*                 3270 TIP VERSION 1.0                                * 
*                                                                     * 
*********************************************************************** 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
      3333333          2222222      77777777777777       00000
    33333333333      22222222222    7777777777777      000000000
   3333     3333    2222     2222            777      000     000 
             333              222           777      000       000
            333              222           777      000         000 
         33333              222           777       000         000 
      333333               222           777        000         000 
         33333           222            777         000         000 
            333        222             777          000         000 
             333      222             777            000       000
   3333     3333     222             777              000     000 
    33333333333     2222222222222    777               000000000
      3333333       2222222222222    777                 00000
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
          TTTTTTTTTTTTTTTTT    IIIIIIIIIII    PPPPPPPPPPP 
          TTTTTTTTTTTTTTTTT    IIIIIIIIIII    PPPPPPPPPPPPP 
                 TTT               III          PPP      PPP
                 TTT               III          PPP       PPP 
                 TTT               III          PPP       PPP 
                 TTT               III          PPP      PPP
                 TTT               III          PPPPPPPPPPP 
                 TTT               III          PPPPPPPPP 
                 TTT               III          PPP 
                 TTT               III          PPP 
                 TTT               III          PPP 
                 TTT           IIIIIIIIIII      PPP           HJB 
                 TTT           IIIIIIIIIII      PPP           ACS 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                        - 
                                                                  ?_$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 2 7 0 T I P                        * 
*                                                                     * 
** OVERVIEW -   THE OPS-MONITOR PASSES CONTROL TO THIS PROCEDURE      * 
*               WHENEVER IT FINDS A WORKLIST-ENTRY IN THE             * 
*               WORKLIST-CONTROL-BLOCK FOR THE 3270 TIP.              * 
*               WORKLISTS WILL BE PASSED FROM:                        * 
*                   - SERVICE MODULE (ENABLE/DISABLE LINE, ETC)       * 
*                   - INTERNAL PROCESSOR (OUTPUT QUEUED IN TCB)       * 
*                   - TIMER SERVICES (LINE TIMEOUTS)                  * 
*                   - MUX SUBSYSTEM (LINE ERRORS)                     * 
*                   - 3270 INPUT STATES (ACK,NAK,TEXT,ETC)            * 
*               THE OPS-MONITOR HAS PARSED THE WORKLIST-ENTRY AND     * 
*               MOVED IT INTO THE INTERMEDIATE-ARRAY PRIOR TO         * 
*               CALLING THE TIP.                                      * 
*                                                                     * 
** INPUTS -     WORKCODES FROM THE VARIOUS WORKLIST-SENDERS           * 
*                                                                     * 
** OUTPUTS -    3270 PROTOCOL ELEMENTS SENT TO THE TERMINAL           * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED (FOR MAIN PROGRAM ONLY) -                * 
*               PBCOIN           PBLSPUT                              * 
*               PBREL1BF         PBRELZRO                             * 
*                                                                     * 
** INTERNAL SUBROUTINES USED (IN ORDER OF THEIR DECLARATION) -        * 
*               PT3IO          - ISSUE INPUT/OUTPUT COMMANDS          * 
*               PT3TERMIO      - TERMINATE INPUT/OUTPUT               * 
*               PT3RETURN      - RETURN TO SAVED RETURN-ADDRESS       * 
*               PT3STATIMER    - SET STATE AND START TIMER IN CCB/TCB * 
*               PT3FINDTCB     - FIND TCB FOR CLUSTER/DEVICE ADDRESS  * 
*               PT3SENDSVM     - SEND WORKLIST TO SERVICE-MODULE      * 
*               PT3DELINK      - DELINK STRUCTURE FROM A GIVEN CHAIN  * 
*               PT3UPDEVICE    - DECLARE DEVICE (TCB) UP              * 
*               PT3RLBUFS      - RELEASE LOCAL TCB BUFFERS            * 
*               PT3DOWNDEVICE  - DECLARE DEVICE (TCB) DOWN            * 
*               PT3INOPCLUSTER - DECLARE CLUSTER INOPERATIVE          * 
*               PT3RESPOK      - VERIFY CORRECTNESS OF RESPONSE       * 
*               PT3DVCSTATUS   - PROCESS DEVICE-STATUS MESSAGE        * 
*               PT3QBLANKLINE  - QUEUE A BLANK LINE FOR INPUT         * 
*               PT3PINPUT      - POST-INPUT PROCESSING                * 
*               PT3PREOUTPUT   - PRE-OUTPUT PROCESSING                * 
*               PT3POUTPUT     - POST-OUTPUT PROCESSING               * 
*               PT3PSBUILD     - COMPLETE POLL/SELECT MESSAGE IN CCB  * 
*               PT3POLL        - POLL A 3270 DEVICE                   * 
*               PT3SELECT      - SELECT A 3270 DEVICE                 * 
*               PT3DRIVER      - DRIVE MULTIPLE 3270 CLUSTERS         * 
*                                                                     * 
** AUTHOR -     HENK J. BOTS,  ACS                                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                 ?_$J+? 
PROCEDURE PT3270TIP;
  
_************ 
**? LABEL _**     L A B E L   D E C L A R A T I O N 
************? 
  
  999;                                      _LABEL TO RETURN TO OPS-MON?
  
_************ 
**? CONST _**     C O N S T A N T   D E F I N I T I O N 
************? 
  
_ 
* * * *  TIMER VALUES FOR HALF-SECOND TIMER (PT3IO) 
? 
  ONESEC    = 3;                            _ONE SECOND TIMEOUT?
  TWOSECS   = 4;                            _TWO SECONDS               ?
  TMPOLL    = ONESEC;                       _RESPONSE TO POLL TIMOUT? 
  TMSELECT  = TMPOLL;                       _RESPONSE TO SELECT TIMOUT? 
  TMTEXT    = TWOSECS;                      _RESPONSE TO TEXT TIMOUT? 
  TMACK     = TMTEXT; 
  TMENQ     = TMTEXT; 
  TMNAK     = TMTEXT; 
  TMWACK    = TMTEXT; 
  TMEOT     = 2;                            _DELAY AFTER EOT XMITTED? 
  TMIDLE    = 1;                            _IDLE LINE DELAY (\ 1)? 
  TMWCKDLY  = ONESEC;                       _DELAY BEFORE WACKING      ?
  TMBUFT    = TWOSECS;                      _DELAY AFTER BUF-THRESHOLD? 
  TMOUTPUT  = 40;                           _TIMEOUT DURING OUTPUT? 
_ 
* * * *  TIMER VALUES FOR 100 MILLI-SECOND BASED COUNTER
? 
  TMGENP    = 5;                            _GENERAL-POLL DELAY?
  TMSPECP   = 750;                          _SPECIFIC POLL DELAY? 
  TMBUSYP   = 40;                           _BUSY - OUTPUT-QUEUED DELAY?
  TMIBUSYP  = TMSPECP;                      _BUSY - NO OUTPUT-QUEUED? 
  TMCERP    = 150;                          _CLUSTER ERROR POLL RATE? 
  TMTERP    = TMSPECP;                      _DEVICE ERROR POLL RATE?
_ 
* * * *  3270 TERMINAL/PROTOCOL CONTROL VALUES
? 
  NBPSELECT = 3;                            _NR BLOCK SENT PER SELECT?
  MAXSCREEN = 3840;                         _MAX POSSIBLE SCREENSIZE? 
_ 
* * * *  RETRY VALUES FOR 3270 CLUSTER/DEVICE ERRORS (MAX VALUE IS 31)
? 
  RTRNAK    = 15;                           _CONSEC NAKS ALLOWED? 
  RTRENQ    = 9;                            _CONSEQ ENQS ALLOWED? 
  RTRTENQ   = 5;                            _CONSEC TEXT TERM WITH ENQ? 
  RTRCRCE   = RTRNAK;                       _CONSEC CRC-ERRORS ALLOWED? 
  RTRTIMO   = RTRENQ;                       _CONSEC TIMEOUTS ALLOWED? 
  RTRBADR   = RTRENQ;                       _CONSEC BAD RESP ALLOWED? 
  RTRBACK   = RTRTENQ;                      _CONSEC WRONG ACK0/ACK1?
  
  RTRMAXE   = 31;                           _CONSEC TOTAL MIXED ERRORS? 
_ 
* * * *  WORKCODE RECEIVED FROM TIPS INPUT STATE PROGRAM
*        SEQUENCE OF A0WK11 THRU A0WK16 USED BY PT3RESPOK 
? 
  WKACK0    = A0WK1;    _ ACK0 = 0;  ?      _ACK0 RECEIVED? 
  WKACK1    = A0WK2;    _ ACK1 = 1;  ?      _ETC.?
  WKEOT     = A0WK3;    _ EOT  = 2;  ?
  WKWACK    = A0WK4;    _ WACK = 3;  ?
  WKRVI     = A0WK5;    _ RVI  = 4;  ?
  WKSTAT    = A0WK6;    _ STAT = 5;  ?      _STATUS RECEIVED? 
  WKTETB    = A0WK7;    _ TETB = 6;  ?      _TEXT TERM BY ETB?
  WKTETX    = A0WK8;    _ TETX = 7;  ?      _TEXT TERM BY ETX?
  WKTEST    = A0WK9;    _ TEST = 8;  ?      _TEST-REQUEST RECEIVED? 
  WKBUFT    = A0WK10;   _ BUFT = 9;  ?      _MUX-BUFFER-THRESHOLD?
  WKNAK     = A0WK11;   _ NAK  = 10; ?      _NAK RECEIVED?
  WKENQ     = A0WK12;   _ ENQ  = 11; ?      _ENQ WITHOUT TEXT?
  WKTENQ    = A0WK13;   _ TENQ = 12; ?      _TEXT TERM BY ENQ?
  WKCRCE    = A0WK14;   _ CRCE = 13; ?      _TEXT WITH CRC-ERROR? 
_ 
* * * *  WORKCODES CREATED INTERNALLY IN THE TIP
? 
  WKTIMO    = A0WK15;   _ TIMO = 14; ?      _TIMEOUT RECEIVED?
  WKBACK    = A0WK16;   _ BACK = 15; ?      _WRONG ACK0/ACK1 RECEIVED?
_ 
* * * *  WORKCODE RECEIVED FROM COMMAND-DRIVER AFTER INPUT TERMINATED 
? 
  WKINPT    = A0WK15;                       _INPUT TERMINATED?
_ 
* * * *  DATA-BLOCK-CLARIFIER (DBC) VALUES
? 
  DBCDNOFE  = $08;                          _NO FE-S IN DOWNLINE BLOCK? 
_ 
* * * *  BOOLEAN PASSED TO PT3RESPOK, PT3COUNTDOWN
? 
  TCB       = TRUE;                         _COUNT IN TCB?
  CCB       = FALSE;                        _COUNT IN CCB?
_ 
* * * *  PARAMETERS PASSED TO PT3POLL AND PT3PSBUILD
? 
  GENERAL   = 0;                            _GENERAL POLL REQUESTED?
  SPECIFIC  = 1;                            _SPECIFIC POLL REQUESTED? 
  SELECT    = 2;                            _SELECT REQUESTED?
_ 
* * * *  REASON FOR ERROR-COUNTING IN CCB OR TCB
? 
  ERNONE    = 0;                            _NO ERRORS BEING COUNTED? 
  ERNAK     = 1;                            _RECEIVING NAKS?
  ERENQ     = 2;                            _RECEIVING ENQS?
  ERTENQ    = 3;                            _TEXT TERM BY ENQ?
  ERCRCE    = 4;                            _CRC-ERRORS DETECTED? 
  ERTIMO    = 5;                            _TIMING OUT INPUT?
  ERBACK    = 6;                            _ACK0/ACK1 OUT OF ORDER?
  ERBADR    = 7;                            _BAD RESPONSE RECEIVED? 
_ 
* * * *  REASONS FOR DOWNING A CLUSTER OR A DEVICE
? 
  DWNNAK    = ERNAK;                        _RECEIVED NAKS? 
  DWNENQ    = ERENQ;                        _RECEIVED ENQS? 
  DWNTENQ   = ERTENQ;                       _TEXT TERM BY ENQ?
  DWNCRCE   = ERCRCE;                       _CRC-ERRORS RECEIVED? 
  DWNTIMO   = ERTIMO;                       _TIMEOUTS RECEIVED? 
  DWNBACK   = ERBACK;                       _BAD ACK0/ACK1 RECEIVED?
  DWNBADR   = ERBADR;                       _BAD RESPONSES RECEIVED?
  DWNINTR   = 8;                            _INTERVENTION-REQUIRED STAT?
  DWNCLST   = 9;                            _DEVC DOWN BECAUSE OF CLUST?
  DWNRCDL   = 10;                           _DOWN ON RECONF/DELETE TCB? 
_ 
* * * *  LINE STATES
? 
  LDISABLED    = 1;                         _LINE IS DISABLED?
  LINOPERATIVE = 2;                         _LINE INOPERATIVE?
  LWAITTCB     = 3;                         _LINE WAITING FOR TCBS? 
  LTERMIO      = 4;                         _LINE ACTIVE WAIT TERMIO? 
  LACTIVE      = 5;                         _LINE ACTIVE POLL-SELECT? 
  LDELAYED     = 6;                         _LINE ACTIVE BUT IDLE?
_ 
* * * *  CLUSTER STATES 
? 
  COPERATIVE   = 0;                         _CLUSTER OPERATIVE? 
  CINOPERATIVE = 1;                         _CLUSTER INOPERATIVE? 
_ 
* * * *  TERMINAL STATES (IN ASCENDING ORDER WITH CLUSTER STATES) 
? 
  TOPERATIVE   = 2;                         _TERMINAL OPERATIVE?
  TBUSY        = 3;                         _TERMINAL BUSY, OUTPUT-QUED?
  TIBUSY       = 4;                         _TERMINAL BUSY, NO OUTPUT?
  TINOPERATIVE = 5;                         _TERMINAL INOPERATIVE      ?
  
_************ 
**? TYPE  _**     T Y P E   D E F I N I T I O N 
************? 
  
  RSTPS     = (ACK0,ACK1,EOT,WACK,RVI,STAT,TETB,TETX, 
               TEST,BUFT,NAK,ENQ,TENQ,CRCE,TIMO,BACK);
  RSTYP     = SET OF RSTPS; 
  RSTPW     = RECORD
              CASE X : INTEGER OF 
                1: (ST  : RSTYP); 
                2: (STW : SETWORD); 
              END;
  SSTPS     = (OC,                          _OPERATION CHECK? 
               CC,                          _CONTROL CHECK? 
               DC,                          _DATA CHECK?
               EC,                          _EQUIPMENT CHECK? 
               IR,                          _INTERVENTION REQUIRED? 
               CR,                          _COMMAND REJECT?
               SS1B1,SS1B0, 
               TC,                          _TRANSMISSION CHECK?
               DE,                          _DEVICE END?
               US,                          _UNIT SPECIFY?
               DB,                          _DEVICE BUSY? 
               SS0B3,SS0B2,SS0B1,SS0B0);
  SSTYP     = PACKED RECORD 
              CASE X : INTEGER OF 
                1: (INT   : INTEGER); 
                2: (BYTE0,
                    BYTE1 : CHAR);
                3: (BITS  : SET OF SSTPS);
              END;
  
_************ 
**? VAR   _**     V A R I A B L E   D E C L A R A T I O N 
************? 
  
  TIPNAME   : ARRAY [1..4] OF INTEGER;      _TIP NAME?
  T3DBGI    : INTEGER;                      _INDEX TO NEXT WORKLIST    ?
  T3DBGA    : ARRAY [0..24] OF BWTIPWLE;    _SAVED WORKLIST ENTRY ARRAY?
  T3REPEAT  : ARRAY [0..10] OF INTEGER;     _REPEAT.. MESSAGE          ?
  T3WAIT    : ARRAY [0.. 9] OF INTEGER;     _WAIT.. MESSAGE            ?
  LINENO    : B0LINO;                       _PORT-SUBPORT?
  WORKCODE  : INTEGER;                      _LAST RECEIVED WORKCODE?
  RESP3270  : RSTPW;                        _SET OF RESPONSE RECEIVED?
  LCBPTR    : BZLCBP;                       _PTR TO LINE-CONTROL-BLOCK? 
  CCBPTR    : B0BUFPTR;                     _PTR TO CLUSTER-CNTRL-BLCK? 
  RETADDR   : INTEGER;
  WORKPTR   : B0BUFPTR;                     _WORKPTR FOR BUFFER/TCB/CCB?
  WORK      : B0OVERLAY;                    _WORK-WORD? 
  TERMIO    : BOOLEAN;                      _TERMINATE I/O FLAG?
  STATIMERS : ARRAY [COPERATIVE.. 
              TINOPERATIVE] OF INTEGER;     _TIMERS FOR CL/TERM STATES? 
  MAXERRORS : ARRAY [ERNAK..ERBADR] 
              OF INTEGER;                   _ERROR RETRY LIMITS?
 _PRWRTMSG  : ARRAY [1..8] OF INTEGER;?     _PRINTER WRITE MESSAGE? 
  
_************ 
**? VALUE _**     V A L U E   I N I T I A L I Z A T I O N 
************? 
  
  TIPNAME   = (#3270TIP#);
  STATIMERS = (TMGENP,TMCERP,TMSPECP,TMBUSYP,TMIBUSY,TMTERP); 
  MAXERRORS = (RTRNAK,RTRENQ,RTRTENQ,RTRCRCE,RTRTIMO,RTRBACK,RTRBADR);
  T3REPEAT  = ($1502,$0400,$0000,$0000,$0000, 
               $0002,$0020,$5245,$5045,$4154,$2E2E);
  T3WAIT    = ($1302,$0400,$0000,$0000,$0000, 
               $0002,$0020,$5741,$4954,$2E2E);
 T3DBGA    = (#3270TIP VERSION 1.0  #,
              #COPYRIGHT CONTROL DATA CORP. 1982,1985#);
  
 _PRWRTMSG  = ($1004,$0404,$5532,$3232,$0227,$F1C8,$034C,$86FF);? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 I O                                * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE ISSUES OUTPUT COMMANDS TO THE          * 
*               LINE, AND CONDITIONS THE LINE SUCH THAT INPUT         * 
*               CAN BE RECEIVED AFTER THE OUTPUT IS TRANSMITTED.      * 
*               A TIMER IS STARTED PARALLEL WITH THE OUTPUT-INPUT.    * 
*                                                                     * 
** INPUTS -     BUFPTR - OUTPUT-BUFFER-ADDRESS, THIS PTR CAN          * 
*                        BE NIL, MEANING DELAY PROCESSING ON LINE     * 
*               TIME   - NR OF HALFSECONDS FOR TIMEOUT                * 
*                                                                     * 
** OUTPUTS -    TIMER AND/OR LINE I/O STARTED                         * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBCOIN                                                * 
*                                                                     * 
** ENTRY/EXIT - THE CALLERS RETURN-ADDRESS IS SAVED IN LCB            * 
*               FIELD BZRET1ADDR. PT3IO EXITS TO OPS-MONITOR.         * 
*               THE CALLER WILL RECEIVE CONTROL BACK WHEN AN          * 
*               APPROPRIATE WORKCODE COMES IN (ACK,NAK,EOT, ETC.).    * 
*               CALLERS FIRST TWO WITH-STATEMENTS SET UP TO INDEX     * 
*               LCB AND CCB RESP, WILL BE RESTORED UPON RETURN,       * 
*               OTHER WITH-INDEXES WILL BE LOST.                      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3IO (BUFPTR : B0BUFPTR; TIME : INTEGER);
  
BEGIN 
WITH BLTIMTBL'[LINENO.BDPORT] DO            _INDEX TO TIMER-TABLE?
  IF BUFPTR " NIL 
  THEN                                      _IF BUFPTR SUPPLIED THEN? 
    BEGIN                                   _THERE IS OUTPUT TO XMIT? 
    BLTIME          := TMOUTPUT;            _SET OUTPUT TIMER?
    BLTRESET        := TIME;                _SET INPUT TIMER? 
    C3IOCMDP.NKLINO := LINENO.BDLINO;       _INSERT LINENR IN CMD?
    C3IOCMDP.NKOBP  := BUFPTR;              _INSERT BUFFER-ADDRESS? 
    PBCOIN (C3IOCMDP);                      _ISSUE INPUT-AFTER-OUTPUT?
    END _IF BUFPTR " NIL THEN?
  ELSE
    BLTIME := TIME;                         _NO I/O, JUST START TIMER?
WITH LCBPTR' DO                             _INDEX TO LCB?
  BEGIN 
  IF BUFPTR " P3ENQ                         _SAVE BUFPTR IN LCB?
  THEN
    BZLBTOMUX := BUFPTR;                    _EXCEPT FOR ENQ?
  BZWTCOUNT := BZWTCOUNT + 1;               _BUMP TMR-CONTENTION-CNTR?
  RETADR (BZRET1ADDR);                      _SAVE PT3IO-CALLER ADDR?
  END; _WITH LCBPTR' DO?
GOTO EXIT 999;                              _RETURN TO OPS-MONITOR? 
END; _PROCEDURE PT3IO?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 T E R M I O                        * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE TERMINATES OUTPUT AND INPUT.           * 
*               THE LINE IS CONDITIONED SUCH THAT WORKCODES           * 
*               COMING IN FROM THE INPUT-STATES ARE IGNORED           * 
*               UNTIL THE INPUT-TERMINATED WORKCODE COMES IN          * 
*                                                                     * 
** INPUTS -     NXTSTATE - LINE-STATE AFTER IO TERMINATED             * 
*               LCBPTR, LINENO                                        * 
*                                                                     * 
** OUTPUTS -    OUTPUT/INPUT TERMINATED                               * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBCOIN                                                * 
*                                                                     * 
** ENTRY/EXIT - THE CALLERS RETURN-ADDRESS IS SAVED IN LCB            * 
*               FIELD BZRET2SAVE. PT3IOTERM EXITS TO OPS-MONITOR.     * 
*               INPUT-TERM WORKCODE WILL RETURN CONTROL TO CALLER.    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3TERMIO (NXTSTATE : INTEGER); 
  
BEGIN 
WITH LCBPTR' DO                             _INDEX TO LCB?
  BEGIN 
  BZ3STATE         := NXTSTATE;             _SET NEW STATE FOR LINE?
  BZWTCOUNT        := BZWTCOUNT + 1;        _BUMP CONTENTION-COUNTER? 
  C3TICMDP.NKUSRBY := BZWTCOUNT;            _PASS TO INP-TERM WL-ENTRY? 
  C3TOCMDP.NKLINO  := LINENO.BDLINO;
  C3TICMDP.NKLINO  := LINENO.BDLINO;        _INSERT LINO IN CMD-PACKS?
  PBCOIN (C3TOCMDP);                        _ISSUE TERMINATE OUTPUT?
  PBCOIN (C3TICMDP);                        _ISSUE TERMINATE INPUT? 
  RETADR (BZRET2ADDR);                      _SAVE PT3TERMIO-CALLER ADDR?
  END; _WITH LCBPTR' DO?
GOTO EXIT 999;                              _RETURN TO OPS-MONITOR? 
END;  _PROCEDURE PT3TERMIO? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 R E T U R N                        * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE EXITS TO THE ADDRESS PASSED            * 
*               TO IT AS THE PARAMETER.                               * 
*               PROCEDURES THAT HAVE GIVEN UP CONTROL WILL RETURN TO  * 
*               THEIR CALLER THROUGH THIS PROCEDURE, SUCH THAT THE    * 
*               INDEX-REGISTERS (WITH-STATEMENTS) ARE PASSED BACK.    * 
*                                                                     * 
** INPUTS -     RETADDR - THE RETURN ADDRESS                          * 
*                                                                     * 
** OUTPUTS -    NONE                                                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               RETURN - AN INTRINSIC COMPILER FUNCTION               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3RETURN;
  
BEGIN 
RETURN (RETADDR);                           _MODIFY PROCEDURES RETURN?
END; _PROCEDURE PT3RETURN?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 S T A T I M E R                    * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE SETS THE STATE AND STARTS THE TIMER    * 
*               IN EITHER THE CCB OR THE TCB.                         * 
*                                                                     * 
** INPUTS -     STATE FOR EITHER CCB OR TCB (PARAMETER)               * 
*               CCBPTR AND T3TCB IN CASE OF TERMINAL-STATE            * 
*                                                                     * 
** OUTPUTS -    STATE SET IN CCB OR TCB AND TIMER STARTED             * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               NONE                                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3STATIMER (STATE : INTEGER);
  
VAR 
  TIMER : INTEGER;
  
BEGIN 
TIMER := CTIMER.CT100MS + STATIMERS[STATE]; _GET TIMER FOR THIS STATE?
IF STATE < TOPERATIVE 
THEN                                        _STATE FOR CLUSTER? 
  BEGIN 
  CCBPTR'.BXCCB.BXSTATE := STATE;           _SET STATE IN CCB?
  CCBPTR'.BXCCB.BXTIMER := TIMER;           _SET TIMER IN CCB?
  END 
ELSE                                        _STATE FOR TERMINAL?
  BEGIN 
  T3TCB'.BSTCB.BS3STATE := STATE;           _SET STATE IN TCB?
  T3TCB'.BSTCB.BS3TIMER := TIMER;           _SET TIMER IN TCB?
  END;
END; _PROCEDURE PT3STATIMER?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** FUNCTION NAME -           P T 3 F I N D T C B                      * 
*                                                                     * 
** OVERVIEW -   THIS FUNCTION SEARCHES THE CCB-TCB CHAIN TO           * 
*               FIND THE TERMINAL-CONTROL-BLOCK ADDRESS FOR A         * 
*               GIVEN MESSAGE OF TEXT. A TRUE IS RETURNED IF THE TCB  * 
*               IS LOCATED.                                           * 
*                                                                     * 
** INPUTS -     T3BUFF - PTR TO TEXT CONTAINING CU AND DA ADDRESS     * 
*               LCBPTR, CCBPTR AND T3TCB FOR SPECIFIC POLL            * 
*                                                                     * 
** OUTPUTS -    TRUE RETURNED IF TCB IS FOUND                         * 
*               T3TCB - PTR TO FOUND TERMINAL-CONTROL-BLOCK           * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               NONE                                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
FUNCTION PT3FINDTCB (DUMMY : INTEGER) : BOOLEAN;
  
VAR 
  CUDA : INTEGER; 
  
BEGIN 
CUDA       := T3BUFF'.BIINT [(DATA-4)/2+1]; _GET ASCII CU/DA RECEIVED?
PT3FINDTCB := FALSE;                        _PRESET TO NOT FOUND? 
IF CCBPTR'.BXCCB.BXPSTYPE = GENERAL 
THEN                                        _DOING A GENERAL-POLL?
_ 
* * * *  GO THROUGH TCBS FOR CURRENT CCB TO FIND THE TCB
? 
  BEGIN 
  T3TCB := CCBPTR'.BXCCB.BXTCBPTR;          _SET TO FIRST TCB FROM CCB? 
  REPEAT
    IF CUDA = T3TCB'.BSTCB.BS3CUDA
    THEN                                    _FOUND TCB? 
      GOTO 90;
   _ELSE? 
      T3TCB := T3TCB'.BSTCB.BS3TCBPTR;      _TRY NEXT TCB?
  UNTIL T3TCB = NIL;
  END 
ELSE
  IF CUDA = T3TCB'.BSTCB.BS3CUDA
  THEN                                      _FOUND TCB? 
90: 
    PT3FINDTCB := TRUE;                     _RETURN FUNCTION TRUE?
END; _FUNCTION PT3FINDTCB?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -           P T 3 S E N D S V M                     * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE BUILDS AND SENDS WORKLIST-ENTRIES      * 
*               TO THE SERVICE-MODULE                                 * 
*                                                                     * 
** INPUTS -     PARAMETERS FOR THE WORKLIST-ENTRY                     * 
*                                                                     * 
** OUTPUTS -    WORKLIST-ENTRY SEND TO THE SERVICE-MODULE             * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBLSPUT                                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3SENDSVM (WKCODE, DATA : INTEGER);
  
BEGIN 
WITH BWWLENTRY [OPS].CMSMLEY DO 
  BEGIN 
  CMWKCODE := WKCODE;                       _INSERT THE WORK-CODE?
  CMDATA   := DATA;                         _INSERT PARAMETER?
  CMLINO   := LINENO;                       _INSERT LINE NUMBER?
  CMPTR    := T3TCB;                        _INSERT POSSIBLE TCB PTR? 
  END; _WITH BWWLENTRY[OPS].CMSMLEY DO? 
PBLSPUT (BWWLENTRY [OPS], BYWLCB [B0SMWL]); _SEND WL TO SVM?
END; _PROCEDURE PT3SENDSVM? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -           P T 3 D E L I N K                       * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE DELINKS A STRUCTURE (CCB-TCB)          * 
*               FROM A GIVEN CHAIN (LCB-TCB / LCB-CCB / CCB-TCB)      * 
*                                                                     * 
** INPUTS -     DLNKP - POINTER STRUCTURE TO DELINK (PARAMETER 1)     * 
*               FRSTP - POINTER TO START OF CHAIN (PARAMETER 2)       * 
*               INDEX - RELATIVE INDEX OF CHAIN-POINTER (PARAMETER 3) * 
*                                                                     * 
** OUTPUTS -    STRUCTURE DELINKED FROM CHAIN                         * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               NONE                                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3DELINK (DLNKP : B0BUFPTR; VAR FRSTP : B0BUFPTR;
                     INDEX : INTEGER);
  
VAR 
  WORKP : B0BUFPTR; 
  
BEGIN 
IF FRSTP = DLNKP                            _FIRST ENTRY TO BE DELINKED?
THEN
  FRSTP := DLNKP'.BCCHAINS [INDEX]          _YES, MAKE SECOND FIRST?
ELSE                                        _NO, SEARCH THRU CHAIN? 
  BEGIN 
  WORKP := FRSTP;                           _SET WORKP TO BEGIN CHAIN?
  WHILE WORKP'.BCCHAINS [INDEX] " DLNKP DO  _SEARCH FOR ENTRY THAT? 
    WORKP := WORKP'.BCCHAINS [INDEX];       _POINTS TO DLNKP? 
  WORKP'.BCCHAINS [INDEX] :=
    DLNKP'.BCCHAINS [INDEX];                _DELINK THE ENTRY?
  END; _IF FRSTP = DLNKP ELSE?
END; _PROCEDURE PT3DELINK?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 U P D E V I C E                    * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE DECLARES A DEVICE (TCB) THAT WAS       * 
*               PREVIOUSLY DOWN UP AND INFORMS THE HOST OF THE        * 
*               STATUS-CHANGE.                                        * 
*                                                                     * 
** INPUTS -     LCBPTR, CCBPTR, T3TCB                                 * 
*                                                                     * 
** OUTPUTS -    TCB UPDATED AND HOST INFORMED OF STATUS-CHANGE        * 
*                                                                     * 
** EXTERNAL SUBROUTINE USED -                                         * 
*               PT3STATIMER                                           * 
*               PT3SENDSVM                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3UPDEVICE;
  
BEGIN 
PT3STATIMER (TOPERATIVE);                   _DECLARE TERMINAL OPERATIVE?
_ 
* * * *  INFORM HOST OF OPERATIVE STATUS OF THIS DEVICE (TCB) 
? 
PT3SENDSVM (D0TCB, D5UP);                   _TERMINAL UP TO SVM?
_ 
* * * *  DECLARE CLUSTER OPERATIVE WHEN IT IS CURRENTLY INOPERATIVE 
? 
IF CCBPTR'.BXCCB.BXSTATE = CINOPERATIVE     _CLUSTER CURR INOPERATIVE?
THEN
  BEGIN 
  PT3STATIMER (COPERATIVE);                 _DECLARE CLUSTER OPERATIVE? 
  CCBPTR'.BXCCB.BXCOUNT.T3ERCLR := 0;       _CLEAR ERROR-COUNTERS?
  END;
END; _PROCEDURE PT3UPDEVICE?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 R L B U F S                        * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE RELEASES LOCAL TCB BUFFERS             * 
*                                                                     * 
** INPUTS -     T3TCB, POINTER TO THE TCB                             * 
*                                                                     * 
** OUTPUTS -    LOCAL TCB BUFFERS RELEASED                            * 
*                                                                     * 
** EXTERNAL SUBROUTINE USED -                                         * 
*               PBRELZRO                                              * 
*               PT3RELTP                                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3RLBUFS;
  
BEGIN 
PBRELZRO (T3TCB'.BSTCB.BS3INBUFF,BEDBSIZE); _RELEASE POSSIBLE INPUT?
PBRELZRO (T3TCB'.BSTCB.BS3OUBUFF,BEDBSIZE); _RELEASE POSSIBLE OUTPUT? 
PBRELZRO (T3TCB'.BSTCB.BS3FRAGM, BEDBSIZE); _REL POSSIBLE IVT-FRAGMENT? 
PT3RELTP;                                   _RELEASE TPCB BUFFERS?
END; _PROCEDURE PT3RLBUFS?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 D O W N D E V I C E                * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE DECLARES A DEVICE THAT HAS JUST        * 
*               GONE DOWN DOWN, INFORMS THE HOST OF THE STATUS-CHANGE,* 
*               AND CHANGES THE CLUSTER-STATUS TO INOPERATIVE IF ALL  * 
*               DEVICES ON THAT CLUSTER ARE NOW INOPERATIVE (DOWN).   * 
*                                                                     * 
** INPUTS -     LCBPTR, CCBPTR, T3TCB                                 * 
*               REASON FOR BRINGING DOWN DEVICE (PARAMETER)           * 
*                                                                     * 
** OUTPUTS -    CCB/TCB UPDATED AND HOST INFORMED OF STATUS-CHANGE    * 
*                                                                     * 
** EXTERNAL SUBROUTINE USED -                                         * 
*               PT3STATIMER                                           * 
*               PT3SENDSVM                                            * 
*               PT3RLBUFS                                             * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3DOWNDEVICE (DWNREASON : INTEGER);
  
VAR 
  WORKPTR : B0BUFPTR; 
  
BEGIN 
WITH T3TCB'.BSTCB DO                        _INDEX TO TCB?
  BEGIN 
  PT3RLBUFS;                                _RELEASE LOCAL TCB BUFFERS? 
  BS3PINPBT := 0;                           _FORGET ABOUT POST-INPUT? 
  IF BS3STATE " TINOPERATIVE
  THEN
    BEGIN                                   _IF NOT ALREADY INOPERATIVE?
    BS3DWNLAST := DWNREASON;                _SAVE REASON DEVICE DOWN? 
    PT3STATIMER (TINOPERATIVE);             _DECLARE DEVICE INOPERATIVE?
_ 
* * * *  INFORM HOST OF INOPERATIVE STATUS OF THIS DEVICE (TCB) 
? 
    PT3SENDSVM (D0TCB, D5DOWN);             _TERMINAL DOWN TO SVM?
    END; _IF BS3STATE " TINOPERATIVE? 
  END; _WITH T3TCB'.BSTCB DO? 
_ 
* * * *  DECLARE CLUSTER INOPERATIVE IF ALL TERMINALS ARE INOPERATIVE 
? 
WORKPTR := CCBPTR'.BXCCB.BXTCBPTR;          _GET PTR FIRST TCB ON CCB?
WHILE (WORKPTR " NIL) &                     _LOOP THROUGH TCBS ON CCB?
  (WORKPTR'.BSTCB.BS3STATE = TINOPERATIVE)
  DO WORKPTR := WORKPTR'.BSTCB.BS3TCBPTR;   _UNTIL ONE FOUND OPERATIVE? 
IF WORKPTR = NIL                            _WHEN ALL TERMINALS INOP? 
THEN
  PT3STATIMER (CINOPERATIVE);               _THEN CLUSTER GOES INOP?
END; _PROCEDURE PT3DOWNDEVICE?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 I N O P C L U S T E R              * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE DECLARES A 3270 CLUSTER INOPERATIVE    * 
*               ALL DEVICES ON THAT CLUSTER THAT ARE CURRENTLY UP     * 
*               WILL BE DECLARED DOWN. THE TIP WILL GO IN ERROR-      * 
*               POLLING UNTIL THE INDIVIDUAL DEVICES COME UP AGAIN    * 
*                                                                     * 
** INPUTS -     LCBPTR, CCBPTR                                        * 
*               REASON FOR BRINGING DOWN CLUSTER (PARAMETER)          * 
*                                                                     * 
** OUTPUTS -    CLUSTER AND ALL DEVS ON CLUSTER DECLARED DOWN         * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PT3DOWNDEVICE                                         * 
*               PT3STATIMER                                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3INOPCLUSTER (DWNREASON : INTEGER); 
  
BEGIN 
WITH CCBPTR'.BXCCB DO                       _INDEX TO CCB?
  BEGIN 
  IF BXSTATE " CINOPERATIVE 
  THEN                                      _IF NOT ALREADY INOPERATIVE?
    BEGIN 
    T3TCB     := BXTCBPTR;                  _GET PTR TO 1ST TCB ON CCB? 
    BXDWNLAST := DWNREASON;                 _SAVE REASON CLUSTER DOWN?
_ 
* * * *  DECLARE ALL TERMINALS ON CLUSTER DOWN
? 
    WHILE T3TCB " NIL DO
      BEGIN 
      PT3DOWNDEVICE (DWNCLST);              _DECLARE DEVICE DOWN? 
      T3TCB := T3TCB'.BSTCB.BS3TCBPTR;      _NEXT TCB ON CCB/TCB-CHAIN? 
      END;
    PT3STATIMER (CINOPERATIVE);             _DECLARE CLUSTER INOP?
    END; _IF BXSTATE " CINOPERATIVE?
  END; _WITH CCBPTR'.BXCCB DO?
END; _PROCEDURE PT3INOPCLUSTER? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** FUNCTION NAME -           P T 3 R E S P O K                        * 
*                                                                     * 
** OVERVIEW -   THIS FUNCTION VERIFIES THE RESPONSE RECEIVED          * 
*               THE 3270 CLUSTER OR DEVICE, UPDATES THE APPROPRIATE   * 
*               ERROR COUNTER IN CASE OF IMPROPER RESPONSE AND        * 
*               RETURNS A BOOLEAN REFLECTING CORRECTNESS OF RESPONSE  * 
*                                                                     * 
** INPUTS -     SET OF ALLOWED (GOOD) RESPONSES                       * 
*               BOOLEAN INTCB TO BUMP COUNTER(S) IN TCB/CCB           * 
*               LCBPTR, CCBPTR AND T3TCB IF INTCB IS TRUE             * 
*               WORKCODE, RESP3270 SET UP                             * 
*                                                                     * 
** OUTPUTS -    TRUE RETURNED IF ALLOWED RESPONSE RECEIVED AND THE    * 
*               ERRORCOUNTER DID NOT OVERFLOW, IN CASE OF OVERFLOW,   * 
*               THE CLUSTER OR DEVICE IS DECLARED DOWN                * 
*               ERRORS RECEIVED WHILE DEVICE OR CLUSTER DOWN          * 
*               WILL ALWAYS RETURN A FALSE CONDITION                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBRELZRO        PT3INOPCLUSTER                        * 
*               PT3DOWNDEVICE   PT3UPDEVICE                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
FUNCTION PT3RESPOK (RESPALLOWED : RSTYP; INTCB : BOOLEAN) : BOOLEAN;
  
VAR 
  LOCCOUNT   : T3ERCTS; 
  ERTYPE     : INTEGER; 
  UNITINOP   : BOOLEAN; 
  
BEGIN 
PT3RESPOK := TRUE;                          _PRESET FUNCTION TO TRUE? 
ERTYPE    := ERNONE;                        _PRESET TO NO ERROR?
_ 
* * * *  FIND OUT IF ANY ERROR OCCURED
? 
IF RESP3270.ST & RESPALLOWED = [ ]          _IS RECEIVED RESP ALLOWED?
THEN
  BEGIN                                     _BAD RESPONSE RECEIVED? 
  ERTYPE    := ERBADR;
  PT3RESPOK := FALSE;                       _RETURN FALSE ON CALL?
  END 
ELSE                                        _RESP ALLOWED, MAY HAVE TO? 
  BEGIN                                     _UPDATE OTHER COUNTERS? 
  IF RESP3270.ST & [ACK0,ACK1] " [ ]
  THEN                                      _IF EXPECTING AN ACK? 
    IF (ACK1 IN RESP3270.ST) "              _SEE IF WE RECEIVED THE?
       CCBPTR'.BXCCB.BXRCVACK1              _EXPECTED ONE?
    THEN
      BEGIN                                 _RECEIVED BAD ACK?
      WORKCODE    := WKBACK;
      RESP3270.ST := [BACK];                _SET BAD ACK RECEIVED?
      END;
  IF [NAK,ENQ,TENQ,CRCE,TIMO,BACK] &        _CHECK FOR ERRORS?
     RESP3270.ST " [ ]
  THEN
    ERTYPE := WORKCODE - (WKNAK-ERNAK);     _GET TYPE OF ERROR? 
  END; _IF RESP3270.ST & .. ELSE? 
_ 
* * * *  WORK ON THE ERROR-COUNTER IN TCB OR CCB
? 
WITH LOCCOUNT DO                            _QUALIFY THE LOC-COUNTERS?
  BEGIN 
  IF INTCB
  THEN                                      _WORK WITH TCB? 
    BEGIN 
    T3INT    := T3TCB'.BSTCB.BS3COUNT.T3INT;
    UNITINOP := T3TCB'.BSTCB.BS3STATE = 
                TINOPERATIVE;               _GET STATE OF TERMINAL? 
    END 
  ELSE                                      _WORK WITH CCB? 
    BEGIN 
    T3INT    := CCBPTR'.BXCCB.BXCOUNT.T3INT;
    UNITINOP := CCBPTR'.BXCCB.BXSTATE = 
                CINOPERATIVE;               _GET STATE OF CLUSTER?
    END; _IF INTCB ELSE?
  IF ERTYPE = ERNONE
  THEN
    T3ERCLR := 0                            _CLEAR ERROR-COUNTER? 
  ELSE
    BEGIN                                   _HAVE ERRORS, BUMP COUNTER? 
    PBRELZRO (T3BUFF, BEDBSIZE);            _RELEASE POSSIBLE INPUT?
    IF UNITINOP                             _TERM/CLUSTER INOPERATIVE?
    THEN
_ 
* * * *  HAVE ERRORS, COUNT IF DEVICE OR CLUSTER UP 
? 
      PT3RESPOK := FALSE                    _YES, EXIT WITH FALSE?
    ELSE                                    _NO, GO COUNT ERRORS? 
      BEGIN 
      T3TERCNT := T3TERCNT + 1;             _INCR TOTAL ERROR-CNTR? 
      IF T3ERTYPE = ERTYPE                  _SAME ERROR AS BEFORE?
      THEN
        T3ERCNT := T3ERCNT + 1              _YES, BUMP ERROR-CNTR?
      ELSE                                  _NO, START COUNTING?
        BEGIN 
        T3ERTYPE := ERTYPE;                 _STORE ERROR-TYPE?
        T3ERCNT  := 1;                      _FIRST ERROR OF THIS TYPE?
        END;
      IF (T3ERCNT \ MAXERRORS [ERTYPE]) !   _SPECIFIC ERRORCNT OVERFLOW?
         (T3TERCNT \ RTRMAXE)               _OR TOTAL-ERROR OVERFLOW? 
      THEN
_ 
* * * *  TOO MANY CONSECUTIVE ERRORS, DECLARE DEVICE OR CLUSTER DOWN
? 
        BEGIN 
        IF INTCB
        THEN
          PT3DOWNDEVICE (ERTYPE)            _DECLARE DEVICE DOWN? 
        ELSE
          PT3INOPCLUSTER (ERTYPE);          _OR DECLARE CLUSTER DOWN? 
        PT3RESPOK := FALSE;                 _FUNCTION RETURNS FALSE?
        END;
      END; _IF UNITINOP ELSE? 
    END; _IF ERTYPE = ERNONE ELSE?
  IF INTCB
  THEN
    T3TCB'.BSTCB.BS3COUNT.T3INT := T3INT    _STORE COUNTER IN TCB?
  ELSE
    CCBPTR'.BXCCB.BXCOUNT.T3INT := T3INT;   _OR IN CCB? 
  END; _WITH LOCCOUNT DO? 
END; _PROCEDURE PT3RESPOK?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 D V C S T A T U S                  * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE PROCESSES THE STATUS MESSAGE           * 
*               RECEIVED FROM A DEVICE ON A 3270 CLUSTER-UNIT         * 
*                                                                     * 
** INPUTS -     T3BUFF - PTR TO BUFFER CONTAINING STATUS MESSAGE      * 
*               LCBPTR, CCBPTR, T3TCB                                 * 
*                                                                     * 
** OUTPUTS -    DEVICE-STATE UPDATED IN TCB (BS3STATE)                * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PT3XLATE                                              * 
*               PT3DOWNDEVICE                                         * 
*               PT3UPDEVICE                                           * 
*               PT3STATIMER                                           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3DVCSTATUS; 
  
VAR 
  SS : SSTYP; 
  
BEGIN 
SS.INT := T3BUFF'.BIINT [(DATA-2)/2+1];     _GET STATUS/SENSE FROM BUF? 
PT3XLATE (P3ASCEBC, SS.INT);                _TRANSLATE TO EBCDIC? 
WITH T3TCB'.BSTCB DO                        _INDEX TO TCB?
  BEGIN 
  BS3SS := SS.INT;                          _STORE IN TCB FOR DEBUG?
  IF [OC,CC,DC,EC,IR,CR,TC] & SS.BITS " [ ] _TEST FOR DEVICE ERRORS    ?
  THEN
_ 
* * * *  INTERVENTION REQUIRED, DEVICE UNAVAILABLE
? 
    PT3DOWNDEVICE (DWNINTR)                 _DECLARE DEVICE DOWN? 
  ELSE
    BEGIN 
    IF BS3STATE = TINOPERATIVE
    THEN
      PT3UPDEVICE;                          _DECLARE DEVICE UP IF DOWN? 
    IF DB IN SS.BITS                        _TEST FOR BUSY DEVICE?
    THEN
_ 
* * * *  DEVICE IS AVAILABLE, BUT BUSY
? 
      IF (BS3OUBUFF = NIL)
      THEN
        PT3STATIMER (TIBUSY)                _DEVICE BUSY, NO OUTPUT?
      ELSE
        PT3STATIMER (TBUSY)                 _DEVICE BUSY, OUTPUT QUEUED?
    ELSE
      IF DE IN SS.BITS                      _TEST FOR DEVICE-END? 
      THEN
_ 
* * * *  DEVICE IS AVAILABLE, READY AND NOT BUSY
? 
        BEGIN 
        IF BSDEVTYPE = N1CON                _IF CONSOLE                ?
        THEN
          PT3DOWNDEVICE (DWNINTR)           _DECLARE DEVICE DOWN       ?
        ELSE
          PT3STATIMER (TOPERATIVE);         _REFLECT NOT BUSY STATUS   ?
        END;
      END;
  END; _WITH T3TCB'.BSTCB DO? 
END; _PROCEDURE PT3DVCSTATUS? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -           P T 3 Q B L A N K L I N E               * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE QUEUES A BLANK LINE TO ALLOW THE 3270  * 
*               DISPLAY-DEVICE USER TO ENTER NEW INPUT (TYPE AHEAD).  * 
*               BLANK LINE IS NOT GENERATED WHEN THERE IS OUTPUT      * 
*               IN THE QUEUE, BECAUSE A BLANK LINE WILL BE ATTACH     * 
*               AT THE END OF THAT OUTPUT.                            * 
*                                                                     * 
** INPUTS -     T3TCB - POINTER TO THE TERMINAL-CONTROL-BLOCK         * 
*                                                                     * 
** OUTPUTS -    BLANK LINE QUEUED AT THE TCB                          * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBGET1BF                                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3QBLANKLINE;
  
VAR 
  BUFPTR : B0BUFPTR;
  
BEGIN 
IF T3TCB'.BSTCB.BS3OUBUFF = NIL             _NO OUTPUT QUEUED?
THEN
  IF T3TCB'.BSTCB.BSXPT = FALSE 
  THEN                                      _AND NON TRANSPARENT MODE?
    BEGIN 
    BUFPTR := PBGET1BF (BEDBSIZE);          _GET A BUFFER?
    BUFPTR'.BIINT 
      [DBC/2+1]       := DBCDNOFE * $100;   _INSERT NO-FE DBC?
    BUFPTR'.BIINT [1] := DBC * $101;        _INSERT LCD/FCD?
    BUFPTR'.BFINTBLK  := TRUE;              _DECLARE INTERNAL-BLOCK?
    BUFPTR'.BFEOR     := TRUE;              _DECLARE BLANKFILL? 
    T3TCB'.BSTCB. 
      BS3OUBUFF       := BUFPTR;            _QUEUE IN TCB?
    END;
END; _PROCEDURE PT3QBLANKLINE?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 P I N P U T                        * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE PERFORMS THE POST-INPUT PROCESSING     * 
*                                                                     * 
** INPUTS -     BS3INBUFF - PTR TO INPUT DATA BUFFER(S)               * 
*               T3TCB  - PTR TO TERMINAL-CONTROL-BLOCK                * 
*                                                                     * 
** OUTPUTS -    BLOCK SEND TO THE HOST COMPUTER                       * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBULTS          PBGET1BF                              * 
*               PT3QBLANKLINE                                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3PINPUT;
  
VAR 
  FLGWD : KTULTSFLAG; 
  
BEGIN 
WITH T3TCB'.BSTCB DO                        _INDEX TO TCB?
  BEGIN 
  T3BUFF := BS3INBUF; 
  IF (T3BUFF = NIL) !                       _NO INPUT OR? 
     (T3BUFF'.BFFCD " (DATA+1)) 
  THEN                                      _NOT ALLIGNED FOR BIP?
    BEGIN 
    T3BUFF := PBGET1BF (BEDBSIZE);
    T3BUFF'.BCCHAINS [DBUFLEN] := BS3INBUF; _CHAIN INPUT AT END?
    T3BUFF'.BFLCD              := DATA;     _INSERT LCD?
    END;
  T3BUFF'.BFFCD   := DATA;                  _SET FCD TO DBC POSITION? 
  T3BUFF'.BFXPT   := BSXPT;                 _COPY TRANSPARENT FLAG? 
  FLGWD.KTWORD    := BS3PINPBT;             _BLOCK TYPE FOR BIP?
  FLGWD.KTCKPGTRN := BS3PGTURN;             _LOOK FOR PAGE TURN?
  FLGWD.KTCKSPEC  := NOT BSXPT;             _CHECK IVT-CMDS FOR NONXPT? 
  FLGWD.KTSEND    := TRUE;                  _SEND UPLINE PLS? 
  PBULTS    (T3TCB, T3BUFF, FLGWD); 
  BS3INBUF  := NIL;                         _CLEAR LOCAL INPUT PTR? 
  BS3PGTURN := FALSE;                       _END PAGE TURN REQUEST? 
  IF BS3PINPBT = HTMSG
  THEN                                      _MSG BLOCK-TYPE TO HOST?
    PT3QBLANKLINE;                          _YES, SEND BLANK LINE?
  END; _WITH T3TCB'.BSTCB DO? 
END; _PROCEDURE PT3PINPUT?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 P R E O U T P U T                  * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE PERFORMS THE PRE-OUTPUT PROCESSING     * 
*                                                                     * 
** INPUTS -     T3TCB  - PTR TO TERMINAL-CONTROL-BLOCK                * 
*                                                                     * 
** OUTPUTS -    HOST COMMANDS PROCESSED AND/OR BLOCK OF OUTPUT        * 
*               MADE AVAILABLE AND PLACED IN T3BUFF                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBQUEMAINT                                            * 
*               PTDLCMD                                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3PREOUTPUT; 
  
VAR 
  BLOCK : BLKTYPE;
  
BEGIN 
10:                                         _ENTERED FOR MORE OUTPUT? 
PBQUEMAINT (T3TCB, T3BUFF, K4GET);
IF T3BUFF " NIL                             _OUTPUT FOUND?
THEN
  WITH T3BUFF' DO 
  IF BF3TEXTPR = FALSE                      _THAT IS NOT TEXT PROCESSED?
  THEN
    BEGIN 
    BLOCK.BTYPE :=
      ORD (BFDATAC [BTPT]);                 _GET BLOCK-TYPE?
_ 
* * * *  CHECK IF COMMAND RECEIVED FROM HOST
? 
    IF BLOCK.BTYPE = HTCMD
    THEN
      BEGIN 
      PTDLCMD (T3TCB, T3BUFF);              _PROCESS DL IVT CMD?
      GOTO 10;                              _LOOK FOR MORE INPUT? 
      END; _IF BLOCK.BTYPE = HTCMD? 
   _ELSE? 
_ 
* * * *  RECEIVED A BLK OR MSG FROM HOST
? 
      BEGIN 
      T3TCB'.BSTCB.BS3LBMSG :=              _LAST BLOCKTYP SEEN IN TCB? 
        BLOCK.BTYPE = HTMSG;
          IF BFLCD = DBC
          THEN
            BEGIN 
            PBRELCHN (T3BUFF, BEDBSIZE);
            GOTO 10;
            END;
      IF BFLCD = DBC + 2
      THEN
        IF BIINT [DBC/2+1] = ORD (#,#)      _EMPTY NO-ACTION FE BLOCK?
        THEN                                _COMING FROM IAF, LETS HOPE?
          BEGIN                             _THE FORMAT HASNT CHANGED?
          PBRELCHN (T3BUFF, BEDBSIZE);      _GET RID OF THIS JUNK?
          GOTO 10;
          END;
      END;
    END; _IF BF3TEXTPR = FALSE? 
END; _PROCEDURE PT3PREOUTPUT? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 P O U T P U T                      * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE PERFORMS THE POST-OUTPUT PROCESSING    * 
*                                                                     * 
** INPUTS -     BS3OUBUFF - PTR TO OUTPUT BUFFER(S)                   * 
*               T3TCB - PTR TO TERMINAL-CONTROL-BLOCK                 * 
*                                                                     * 
** OUTPUTS -    BS3OUBUFF POINTS TO NEXT AVAILABLE OUTPUT             * 
*               T3BUFF = BS3OUBUFF IF OUTPUT READY TO GO, ELSE NIL    * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PT3PREOUTPUT     PBRELCHN                             * 
*               PT3STATIMER      PBPEOI                               * 
*               PT3RELTP                                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3POUTPUT; 
  
BEGIN 
WITH T3TCB'.BSTCB DO                        _INDEX TO TCB?
  BEGIN 
  T3BUFF := BS3OUBUFF;                      _GET OUTPUTTED BUFFERS? 
  IF BSBATCH
  THEN                                      _PRINTER DEVICE?
    IF T3BUFF'.BFEOI
    THEN                                    _SEND EOI ACCOUNTING DATA?
      BEGIN 
      PBPEOI (T3TCB, D9EOI);
      PT3RELTP; 
      END;
  PBRELCHN (T3BUFF, BEDBSIZE);              _RELEASE XMITTED BUFFERS? 
  IF BS3FRAGM = NIL 
  THEN                                      _NO IVT FRAGMENT LEFT?
    PT3PREOUTPUT                            _PRE-OUTPUT FOR MORE? 
  ELSE                                      _IVT-FRAGMENT LEFT? 
    BEGIN 
    T3BUFF   := BS3FRAGM;                   _GET THE FRAGMENT?
    BS3FRAGM := NIL;
    END; _IF BS3FRAGM = NIL ELSE? 
  BS3OUBUFF := T3BUFF;
  IF BS3STATE = TIBUSY
  THEN                                      _IF DEVICE BUSY AND?
    IF T3BUFF " NIL                         _THERE IS OUTPUT TO SEND? 
    THEN
      BEGIN 
      PT3STATIMER (TBUSY);                  _DEVICE-BUSY WITH OUTPUT? 
      T3BUFF := NIL;
      END;
  IF BS3INPREQ
  THEN                                      _PAGEWAIT/AUTOINP REQUIRED? 
    BEGIN 
    BS3OUTPOK := FALSE;                     _YES, SUSPEND OUTPUT? 
    BS3INPREQ := FALSE; 
    T3BUFF    := NIL;                       _OUTPUT NOT READY TO GO?
    END;
  END; _WITH T3TCB'.BSTCB DO? 
END; _PROCEDURE PT3POUTPUT? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 R E G U L A T E                    * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE QUEUES A WAIT.. OR A REPEAT.. MESSAGE  * 
*               TO THE FRONT OF THE DOWNLINE QUEUE                    * 
*                                                                     * 
** INPUT -      WAITMSG = TRUE, IF A WAIT.. SHOULD BE QUEUED          * 
*                         FALSE, IF A REPEAT.. SHOULD BE QUEUED       * 
*                                                                     * 
** OUTPUTS -    THE APPROPRIATE MESSAGE HAS BEEN QUEUED IN FRONT OF   * 
*               THE DOWNLINE QUEUE.                                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               ADDR        - SET ADDRESS OF GIVEN PARAMETER          * 
*               PBFCOPY     - COPY A BUFFER                           * 
*               PBQUEMAINT  - ADD BUFFER TO FRONT OF DOWNLINE QUEUE   * 
*                                                                     * 
** ENTRY/EXIT - THIS PROCEDURE IS CALLED FROM PT3POLL AND FROM        * 
*               PT3DRIVER.                                            * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                       ?
PROCEDURE PT3REGULATE (WAITMSG : BOOLEAN);
  
VAR 
  T3TTBUF : B0BUFPTR; 
  
BEGIN 
  T3BUFF        := PBGET1BF (BEDBSIZE);     _ALLOCATE A BUFFER         ?
  T3BUFF'.BFFCD := $02;                     _SET DEFAULT FCD           ?
  T3TCB'.BSTCB.BS3WTSENT := WAITMSG;
  IF WAITMSG                                _IF WAIT.. TO BE SENT      ?
  THEN
    ADDR (T3WAIT, T3TTBUF)
  ELSE
    ADDR (T3REPEAT,T3TTBUF);
  PBFCOPY   (T3TTBUF, T3BUFF);              _COPY MESSAGE              ?
  PBQUEMAIN (T3TCB, T3BUFF, K4PUTFR);       _QUEUE IN FRONT OF D/L QUE ?
END; _PROCEDURE PT3REGULATE?
                                                                    _$J+
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 P S B U I L D                      * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE COMPLETES THE TEXT OF THE              * 
*               POLL OR SELECT MESSAGE IN THE CLUSTER-CONTROL-BLOCK.  * 
*               CLUSTER-UNIT AND DEVICE ADDRESSES ARE INSERTED.       * 
*                                                                     * 
** INPUTS -     PSTYPE - TYPE OF POLL-SELECT TO BE BUILD (PARAMETER)  * 
*               LCBPTR, CCBPTR AND T3TCB IF SELECT/SPEC-POLL          * 
*                                                                     * 
** OUTPUTS -    POLL OR SELECT MESSAGE BUILD IN CCB                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               NONE                                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3PSBUILD (PSTYPE : INTEGER);
  
CONST 
  CUTAG = 7;                                _TAG TO CU IN POLSEL IN CCB?
  DATAG = 8;                                _TAG TO DA IN POLSEL IN CCB?
  
VAR 
  CU : INTEGER; 
  DA : INTEGER; 
  
BEGIN 
WITH CCBPTR'.BXCCB DO                       _SET INDEX TO CCB?
  BEGIN 
  BXPSTYPE := PSTYPE;                       _SAVE TYPE OF POLL/SELECT?
_ 
* * * *  GET THE CLUSTER-UNIT AND DEVICE-ADDRESS FROM PROPER TCBS 
? 
  IF PSTYPE = SELECT
  THEN
    CU := T3TCB'.BSTCB.BS3CUSEL             _GET CU FOR SELECT? 
  ELSE
    CU := BXTCBPTR'.BSTCB.BS3CUPOL;         _GET CU FOR POLL? 
  
  IF PSTYPE = GENERAL 
  THEN
    DA := BXTCBPTR'.BSTCB.BS3DAGPL          _GET DA FOR GENERAL-POLL? 
  ELSE
    DA := T3TCB'.BSTCB.BS3DAPSL;            _GET DA FOR SPEC-POLL/SEL?
  
  BXPOLSEL [CUTAG] := $100 * CU + CU;       _STORE CU IN POLL/SELECT? 
  BXPOLSEL [DATAG] := $100 * DA + DA;       _STORE DA IN POLL/SELECT? 
  END; _WITH CCBPTR'.BXCCB DO?
END; _PROCEDURE PT3PSBUILD? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 P O L L                            * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE SENDS A POLL TO A 3270 DEVICE,         * 
*               AND PROCESSES ALL THE RESPONSES FROM THE POLLED       * 
*               TERMINAL.                                             * 
*                                                                     * 
** INPUTS -     PARAMETER FOR SPECIFIC OR GENERAL POLL                * 
*               LCBPTR, CCBPTR AND T3TCB IF SPECIFIC POLL             * 
*                                                                     * 
** OUTPUTS -    POLL SEND TO 3270 CLUSTER OR TERMINAL                 * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PT3PSBUILD       PT3IO                                * 
*               PT3FINDTCB       PT3PINPUT                            * 
*               PT3DVCSTATUS     PT3RETURN                            * 
*               PBREL1BF         PBRELZRO                             * 
*               PT3RESPOK        PTREGL                               * 
*               PT3QBLANKLINE    PTBREAK                              * 
*               PTIVTCMD         PT3RLBUFS                            * 
*               PT3INPTP         PT3XLATE                             * 
*                                                                     * 
** ENTRY/EXIT - WHILE PT3IO-CALLS ARE OUTSTANDING, THE CALLERS        * 
*               RETURN-ADDRESS IS SAVED IN CCB-FIELD BXRET1ADDR.      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3POLL (POLLTYPE : INTEGER); 
  
CONST 
  PA1 = $25;                                _PR-ATTN-KEY-1 (USER-BRK-1)?
  ENT = $27;                                _ENTER KEY                 ?
  PA2 = $3E;                                _PR-ATTN-KEY-2 (USER-BRK-2)?
  CLR = $5F;                                _CLEAR-KEY? 
  
VAR 
  EXPCUDA : BOOLEAN;                        _LOCAL COPY OF BXEXPCUDA? 
  AID     : INTEGER;                        _ATTENTION-IDENTIFIER?
  PINPBT  : ARRAY [BOOLEAN] OF INTEGER;     _BLOCKTYPE HTBLK OR HTMSG?
  
VALUE 
  PINPBT  = (HTBLK,HTMSG);
  
BEGIN 
WITH CCBPTR'.BXCCB DO                       _INDEX TO CCB?
  BEGIN 
  RETADR (BXRET1ADDR);                      _SAVE CALLERS RETURN IN CCB?
  LCBPTR'.BZ3DELAY := FALSE;                _DOING I/O, NO DELAY REQ? 
  BXFOUNDTCB       := POLLTYPE = SPECIFIC;
  BXEXPCUDA        := TRUE;                 _LOOK FOR CU/DA FIRST?
  BXSNDACK1        := TRUE;                 _SEND ACK1 FIRST? 
_ 
* * * *  BUILD AND SEND SPECIFIC OR GENERAL POLL TO TERMINAL
? 
  PT3PSBUILD (POLLTYPE);                    _BUILD SPECIFIC OR GENERAL? 
  PT3IO      (CCBPTR, TMPOLL);              _ISSUE THE POLL?
  
  REPEAT
_ 
* * * *  RESPONSE RECEIVED FROM TERMINAL, IF DATA LOCATE THE TCB
? 
    IF (RESP3270.ST &                       _IF RECEIVED DATA FROM TERM?
       [TETB,TETX,CRCE,TENQ] " [ ]) 
    THEN                                    _AND? 
      IF BXEXPCUDA
      THEN                                  _CU/DA IN THIS BLOCK? 
        BEGIN 
        BXFOUNDTCB := PT3FINDTCB (0);       _LOCATE THE TCB?
        IF BXFOUNDTCB                       _FOUND THE TCB? 
        THEN
          BXCURTCB := T3TCB;                _SET CURRENT TCB IN CCB?
        END;
_ 
* * * *  VERIFY CORRECTNESS OF RESPONSE AND MAINTAIN ERROR-COUNTERS 
? 
    IF PT3RESPOK ([EOT,ENQ,STAT,TETB,       _IF NOT ALLOWED RESPONSE? 
       TETX,TENQ,CRCE,TEST,TIMO,BUFT],      _RECEIVED, OR ERROR-OVF?
       BXFOUNDTCB) = FALSE                  _IN TCB OR CCB? 
    THEN                                    _THEN EXIT POLLING? 
      GOTO 90;
  
    CASE WORKCODE OF                        _CASE OUT THE WORKCODE? 
  
      WKEOT:  
        GOTO 90;                            _DONE WITH THE POLL?
  
      WKTIMO: 
        BEGIN 
        IF LCBPTR'.BZLBTOMUX = CCBPTR 
        THEN                                _JUST SENT A POLL,? 
          GOTO 90;                          _POLL AGAIN LATER?
          PT3IO (P3ENQ, TMENQ);             _REQUEST FOR RETRANSMISSION?
        END;
  
      WKENQ:  
        PT3IO (LCBPTR'.BZLBTOMUX, TMTEXT);  _RETRANSMIT LAST OUTPUT?
  
      WKSTAT: 
        BEGIN 
        IF PT3FINDTCB (0)                   _CALL STATUS-HANDLER IF?
        THEN                                _TCB FOUND? 
          PT3DVCSTATUS; 
10:                                         _RELEASE BUFS, SEND ACK?
        PBRELZRO (T3BUFF, BEDBSIZE);
20:                                         _SEND ACK0 OR ACK1? 
        PT3IO (P3ACK [BXSNDACK1], TMACK); 
        BXSNDACK1 := NOT BXSNDACK1;         _REVERSE FOR NEXT TIME? 
        END;
  
      WKTEST: 
        GOTO 10;                            _IGNORE TEST-REQ, BUT ACK?
  
      WKTETB, 
      WKTETX: 
        WITH T3TCB'.BSTCB DO                _INDEX TO TCB (IF FOUND)? 
          BEGIN 
          EXPCUDA   := BXEXPCUDA;           _GET THIS BOOLEAN LOCAL?
          BXEXPCUDA := TETX IN RESP3270.ST; _SET CUDA-EXP FOR NEXT BLCK?
          IF BXFOUNDTCB = FALSE 
          THEN
            GOTO 10;                        _NO TCB FOUND, IGNORE INPUT?
  
          IF BS3STATE = TINOPERATIVE
          THEN
            PT3UPDEVICE;                    _DECLARE DEVICE UP IF DOWN? 
  
          IF BSBATCH
          THEN
            GOTO 10;                        _IGNORE PRINTER INPUT?
  
          BS3PINPBT := PINPBT               _SET BLOCK-TYPE TO BLK/MSG? 
            [TETX IN RESP3270.ST];          _DEPENDING ON ETB/ETX?
  
          IF EXPCUDA
          THEN
_ 
* * * *  FIRST BLOCK, GET ATTENTION-ID AND CURRENT CURSOR-ADDRESS 
? 
            BEGIN 
            AID := ORD (T3BUFF'.            _GET AID FROM FIRST INPUT?
                        BFDATAC [DATA-2]);
            T3BUFF'.BFFCD := DATA - 2;      _REMOVE CU/DA?
            IF T3BUFF'.BFLCD \ DATA 
            THEN                            _CURSOR-ADDR IN THIS BLOCK? 
              BEGIN 
              WORK.BALCHAR := 
                T3BUFF'.BFDATAC [DATA-1];   _GET LEFT CURSOR-ADDR?
              WORK.BARCHAR := 
                T3BUFF'.BFDATAC [DATA];     _GET RIGHT CURSOR-ADDR? 
              PT3XLATE (P3ASCEBC, WORK);    _CONVERT TO EBCDIC? 
              BS3LCURSADR := WORK.BALBYT; 
              BS3RCURSADR := WORK.BARBYT;   _STORE BINARY CURSOR-ADDR?
  
              IF BSXPT = FALSE
              THEN                          _NON-TRANSPARENT DATA?
                BEGIN 
                T3BUFF'.BFFCD := DATA + 1;  _REMOVE CU/DA/AID/CA1/CA2?
                PT3INPTP;                   _REMOVE SBA SEQUENCES?
                END;
              END _IF T3BUFF'.BFFCD \ DATA THEN?
            ELSE
              BEGIN                         _PROGR-ATTN- OR CLEAR-KEY?
              IF BSXPT = FALSE
              THEN
                BEGIN                       _IF NON-TRANSPARENT-MODE? 
                BS3PINPBT := 0;             _DONT SEND DATA TO HOST?
_ 
* * * *  LOOK FOR USER-BREAK-1 OR USER-BREAK-2 (NON XPT ONLY) 
? 
                IF AID = PA1                _PROGRAM-ATTENTION-KEY-1? 
                THEN
                  BEGIN 
                  T3BUFF'.BIINT [DATA/2+1] := 
                  ORD (BSUSR1); 
                  GOTO 30;
                  END;
  
                IF AID = PA2                _PROGRAM-ATTENTION-KEY-2? 
                THEN
                  BEGIN 
                  T3BUFF'.BIINT [DATA/2+1] := 
                  ORD (BSUSR2); 
30: 
                  T3BUFF'.BIINT [1] :=      _INSERT LCD?
                  (DATA+1) * $101;
                  BS3PINPBT := HTMSG;       _FORCE BIP CALL WITH BREAK? 
                  PT3RLBUFS;                _RELEASE LOCAL TCB BUFS?
                  PBRELZRO (T3BUFF'.
                    BCCHAINS [DBUFLEN],     _RELEASE ALL BUT FIRST? 
                    BEDBSIZE);
                  BS3TXTRCVD := TRUE;       _INPUT RECEIVED            ?
                  BS3OUTPOK  := TRUE;       _ALLOW OUTPUT              ?
                  BS3INBUF   := T3BUFF;     _RESTORE INPUT BUFFER PTR  ?
                  GOTO 50;                  _GO PROCESS AS NORMAL INPUT?
                  END;
                END; _IF BSXPT = FALSE? 
_ 
* * * *  LOOK FOR CLEAR-KEY ENTERED (BOTH XPT AND NON XPT)
? 
              IF AID = CLR                  _CLEAR-KEY ENTERED? 
              THEN
                BEGIN 
                BS3CLRSCR  := TRUE;         _MUST CHECK FOR PA1 NEXT   ?
                BS3PA1RCVD := FALSE;        _RESET JUST IN CASE        ?
                BS3CURSADR := MAXSCREEN;    _RESET CURSOR-ADDRESS?
                BS3PGTURN  := FALSE;
                END;
_ 
 * * * *  CHECK FOR POSSIBLE SECURE LOGIN SEQUENCE
? 
              IF AID = PA1                  _AND CURRENT KEY IS PA1    ?
              THEN
                BEGIN 
                BS3PA1RCVD := FALSE;        _INITIALIZE FLAG           ?
                IF BS3CLRSCR                _IF CLEAR SCREEN SEEN      ?
                THEN
                  BEGIN 
                  BS3PA1RCVD := TRUE;       _SET PA1 RECEIVED FLAG     ?
                  BS3CLRSCR  := FALSE;      _SECURE LOGIN SEQUENCE     ?
                  END;                      _MUST BE RESTARTED         ?
                END; _ IF AID = PA1?
              END; _IF T3BUFF'.BFLCD \ DATA ELSE? 
  
            BS3TXTRCVD := TRUE;             _INPUT RECEIVED?
            BS3OUTPOK  := TRUE;             _ALLOW OUTPUT?
            END _IF EXPCUDA THEN? 
          ELSE
            IF BSXPT = FALSE
            THEN
              PT3INPTP;                     _REMOVE SBA SEQUENCES?
_ 
* * * *  BLOCK FOR HOST READY, IF NO REGULATION SEND UPLINE, ELSE WACK
? 
          IF BS3PINPBT " 0                  _POST-INPUT TO BE CALLED? 
          THEN                              _YES? 
            BEGIN 
            BS3INBUF := T3BUFF;             _SAVE INPUT IN TCB? 
  
40: 
            IF PTREGL (T3TCB) > RGUBL2
            THEN                            _IN REGULATION? 
              IF BSQPTR.BABUFPTR = NIL      _AND EMPTY OUTPUT QUEUE?
              THEN                          _AND? 
                IF BSCN " 0                 _NON-ZERO CONNECTION? 
                THEN
                  BEGIN 
                  PT3IO    (NIL, TMWCKDLY); _DELAY A LITTLE?
                  PT3IO    (P3WACK, TMWACK);_SEND WACK TO TERMINAL? 
                  PBRELZRO (T3BUFF, 
                            BEDBSIZE);      _RELEASE POSSIBLE INPUT?
                  GOTO 40;
                  END;
            IF PTREGL (T3TCB) " RGNONE
            THEN
              BEGIN 
              IF T3BUFF'.BFLCD \ (DATA+1)   _IF AT LEAST ONE CHAR RECVD?
              THEN
                IF T3BUFF'.BFDATAC[DATA+1]  _AND FIRST CHARACTER IS THE?
                     = CHR(BSCNTRLCHAR)     _CONTROL CHARACTER         ?
                THEN
                  GOTO 50;                  _PASS IT UPLINE            ?
              PBRELZRO    (BS3INBUF,        _RELEASE POSSIBLE INPUT    ?
                           BEDBSIZE); 
              PT3REGULATE (TRUE);           _SEND OUT WAIT.. MESSAGE   ?
              GOTO 90;                      _RETURN TO CALLER          ?
              END; _IF PTREGL(T3TCB) " RGNONE?
            IF BS3PA1RCVD                   _IF SECURE LOGIN SEQUENCE  ?
            THEN
              BEGIN 
              IF AID = ENT                  _IF ENTER KEY              ?
              THEN
                BEGIN 
                T3BUFF :=                   _PICK UP SECOND BUFFER     ?
                    T3BUFF'.BCCHAINS[DBUFLEN];
                IF T3BUFF'.BFLCD = (DATA+1) _IF ONLY 1 CHAR RECEIVED   ?
                THEN
                  IF T3BUFF'.BFDATAC[DATA+1]
                     = CHR(BSSECHAR)        _AND IT IS THE SECURITY CHR?
                  THEN
                    BEGIN 
                    PBREL1BF (BS3INBUF,        _RELEASE SBA BUFFER     ?
                              BEDBSIZE);
                    T3BUFF'.BFFCD := DATA + 1; _ALIGN FOR BIP          ?
                    BSXPT         := FALSE;    _FORCE BIP TO LOOK AT IT?
                    END;
                BS3PA1RCVD := FALSE;        _MUST RESTART FROM THE TOP ?
                END;
              END;
50: 
            PT3PINPUT;                      _CALL POST-INPUT NOW? 
            GOTO 20;                        _GO SEND AN ACK?
            END; _IF BS3PINPBT " 0 THEN?
          PT3QBLANKLINE;                    _QUEUE BLANK LINE?
          GOTO 10;                          _REL BUFS, SEND ACK?
          END;
  
      WKCRCE: 
        PT3IO (P3NAK,TMNAK);                _SEND OUT A NAK?
  
      WKTENQ: 
        BEGIN 
        IF BXFOUNDTCB 
        THEN                                _THE TCB IS LOCATED THEN? 
          T3TCB'.BSTCB.BS3SPECPOLL := TRUE; _ISSUE SPEC-POLL FOR STATUS?
        PT3IO (P3NAK, TMNAK);               _SEND OUT A NAK?
        END;
  
      WKBUFT: 
        BEGIN 
        PT3IO (NIL, TMBUFT);                _DELAY LINE A BIT?
        PT3IO (P3ENQ, TMENQ);               _REQUEST FOR RETRANSMISSION?
        END;
  
      END; _CASE WORKCODE OF? 
  
  UNTIL FALSE;
90: 
  RETADDR := BXRET1ADDR;
  WITH T3TCB'.BSTCB DO
    PT3RETURN;                              _RETURN TO CALLER WITH? 
                                            _CCB/TCB INDEXES? 
  END; _WITH CCBPTR'.BXCCB DO?
END; _PROCEDURE PT3POLL?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 S E L E C T                        * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE SENDS A SELECT TO A 3270 DEVICE,       * 
*               AND PROCESSES ALL THE RESPONSES FROM THE SELECTED     * 
*               TERMINAL.                                             * 
*                                                                     * 
** INPUTS -     LCBPTR, CCBPTR, T3TCB                                 * 
*               BS3OUBUFF IS POINTER TO OUTPUT TO BE SENT TO TERM.    * 
*                                                                     * 
** OUTPUTS -    SELECT SEND TO 3270 TERMINAL                          * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PT3PSBUILD       PT3IO                                * 
*               PT3POUTPUT       PT3POLL                              * 
*               PT3RETURN        PT3TEXTPROCESS                       * 
*               PT3RESPOK                                             * 
*                                                                     * 
** ENTRY/EXIT - THIS PROCEDURE CAN ONLY BE CALLED FROM ONE LOCATION   * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3SELECT;
  
BEGIN 
WITH CCBPTR'.BXCCB, T3TCB'.BSTCB DO         _INDEX TO CCB AND TCB?
  BEGIN 
  LCBPTR'.BZ3DELAY := FALSE;                _DOING I/O, NO DELAY REQ? 
  BXRCVACK1        := FALSE;                _EXPECT ACK0 ON SELECT? 
  BS3BCOUNT        := 0;                    _RESET BLOCKS/SELECT CNTR?
_ 
* * * *  BUILD AND SEND THE SELECT-MESSAGE TO THE TERMINAL
? 
  PT3PSBUILD (SELECT);                      _BUILD THE SELECT IN CCB? 
  PT3IO      (CCBPTR, TMSELECT);            _ISSUE THE SELECT?
_ 
* * * *  VERIFY CORRECTNESS OF RESPONSE RECEIVED ON SELECT
? 
  IF PT3RESPOK ([ACK0,WACK,RVI,TIMO], TCB)  _ALLOWED RESPONSE?
  THEN
  
    CASE WORKCODE OF                        _CASE OUT RESP TO SELECT? 
  
    WKRVI:  
      PT3POLL (SPECIFIC);                   _SPECIFIC-POLL FOR STATUS?
  
    WKACK0: 
      BEGIN 
110:  
      BXRCVACK1 := NOT BXRCVACK1;           _EXPECT OPPOSITE ACK? 
_ 
* * * *  TERMINAL RESPONDED WITH ACK0 TO SELECT, SEND BLOCK OF TEXT 
? 
120:  
      T3BUFF := BS3OUBUFF;                  _GET OUTPUT LOCAL?
      IF T3BUFF'.BF3TEXTPR = FALSE
      THEN                                  _NOT TEXT-PROCESSED,? 
        PT3TEXTPROCESS;                     _PERFORM I/A TEXT-PROCESS?
      PT3IO (T3BUFF, TMTEXT);               _SEND TEXT TO TERMINAL? 
130:  
      IF PT3RESPOK ([ACK0,ACK1,EOT,BACK,    _WHILE ALLOWED RESPONSE?
         NAK,ENQ,WACK,TIMO],TCB)            _RECEIVED AND NO OVF? 
      THEN
  
        CASE WORKCODE OF
  
        WKEOT:  
          PT3POLL (SPECIFIC);               _SPEC-POLL FOR STATUS?
  
        WKTIMO: 
          BEGIN 
          PT3IO (P3ENQ, TMENQ);             _REQUEST FOR RETRANSMISSION?
          GOTO 130;                         _GO VERIFY RESPONSE?
          END;
  
        WKBACK, 
        WKNAK,
        WKENQ:  
          GOTO 120;                         _RETRANSMIT TEXT? 
  
        WKWACK: 
          PT3POUTPUT;                       _WACK IS IMPLIED ACK? 
                                            _BUT NOT READY FOR MORE?
        WKACK0, 
        WKACK1: 
          BEGIN 
          PT3POUTPUT;                       _CORRECT ACK, POSTOUTPUT? 
          IF T3BUFF " NIL                   _MORE OUTPUT QUEUED?
          THEN
            BEGIN 
            BS3BCOUNT := BS3BCOUNT + 1;     _MAINTAIN BLOCK-COUNT?
            IF BS3BCOUNT < NBPSELECT
            THEN                            _MORE BLOCKS ON THIS SEL? 
              GOTO 110; 
            END;
          BXTIMER := CTIMER.CT100MS;        _POLL FASTER TO UNLOCK TERM?
          LCBPTR'.BZ3DELAY := FALSE;        _DONT DO IDLE DELAY?
          END;
  
        END; _IF PT3RESPOK/CASE WORKCODE OF?
  
      END; _WKACK0 RECEIVED ON SELECT?
  
    END; _IF PT3RESPOK/CASE WORKCODE OF?
  
  IF WORKCODE = WKWACK
  THEN                                      _WACK RECEIVED? 
    IF BS3OUBUFF = NIL                      _DEVICE IS BUSY?
    THEN
      PT3STATIMER (TIBUSY)                  _DEVICE BUSY, NO OUTPUT?
    ELSE
      PT3STATIMER (TBUSY);                  _DEVICE BUSY, OUTPUT QUEUED?
  
  RETADR (RETADDR);                         _RETURN TO CALLER WITHOUT?
  PT3RETURN;                                _CHANGING CCB/TCB INDEXES?
  END; _WITH CCBPTR'.BXCCB, T3TCB'.BSTCB DO?
END; _PROCEDURE PT3SELECT?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 D R I V E R                        * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE DRIVES THE 3270 PROTOCOL AT THE        * 
*               LEVEL OF DECIDING WHICH CLUSTER TO POLL OR WHICH      * 
*               TERMINAL TO SELECT.                                   * 
*                                                                     * 
** INPUTS -     LCBPTR                                                * 
*                                                                     * 
** OUTPUTS -    POLLS AND SELECTS SEND TO VARIOUS                     * 
*               3270 CLUSTERS AND TERMINALS                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PT3POLL          PT3SELECT                            * 
*               PBBFAVAIL        PBRELZRO                             * 
*               PT3IO            PT3STATIMER                          * 
*               PT3TERMIO                                             * 
*                                                                     * 
** ENTRY/EXIT - THIS PROCEDURE WILL NEVER RETURN TO ITS CALLER        * 
*               CONTROL WILL BE TAKEN AWAY THROUGH PT3IOTERM          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3DRIVER;
  
BEGIN 
PT3TERMIO (LTERMIO);                        _CLEAN UP ON LINE?
PT3IO     (P3EOT, TMEOT);                   _CLUSTERS IN CONTROL-MODE?
PBRELZRO  (T3BUFF, BEDBSIZE);               _RELEASE POSSIBLE INPUT?
PT3TERMIO (LTERMIO);                        _FORCE EOT XMIT COMPLETION? 
CCBPTR    := NIL;                           _START WITH FIRST CCB?
  
REPEAT
  
  IF CCBPTR = NIL                           _AT END LCB-CCB CHAIN?
  THEN
    BEGIN 
_ 
* * * *  ALL CCBS SERVICED, PERFORM IDLE LINE DELAY IF NECESSARY
? 
    IF LCBPTR'.BZ3DELAY                     _NEED IDLE LINE DELAY?
    THEN
      BEGIN 
      LCBPTR'.BZ3STATE := LDELAYED;         _LINE IN DELAY STATE? 
      PT3IO            (NIL, TMIDLE);       _PERFORM THE IDLE-DELAY?
      LCBPTR'.BZ3STATE := LACTIVE;          _DECLARE ACIVE AGAIN? 
      END; _IF LCBPTR'.BZ3DELAY THEN? 
    CCBPTR           := LCBPTR'.BZ3CCBPTR;  _GET POINTER FIRST CCB? 
    LCBPTR'.BZ3DELAY := TRUE;               _PRESET FOR NEXT CYCLE? 
    END; _IF CCBPTR = NIL THEN? 
_ 
* * * *  GO PERFORM A WORKCYCLE FOR THE CURRENT CCB 
? 
  LCBPTR'.BZ3CURCCBP := CCBPTR;             _SET PTR CURRENT CCB IN LCB?
  WITH CCBPTR'.BXCCB DO                     _INDEX TO CURRENT CCB?
    BEGIN 
_ 
* * * *  SEE IF IT IS TIME TO ISSUE A GENERAL POLL TO 3270 CLUSTER
? 
    IF (BXTIMER - CTIMER.CT100MS < 1)       _CCB-TIMER EXPIRED? 
    THEN
      IF PB1BFAVAIL (BFTHRESH [B0TH3LV])    _NOT LOW ON BUFFERS?
      THEN
        BEGIN 
        BXGENPTIME  := TRUE;                _TIME FOR GENERAL POLL? 
        PT3STATIMER (BXSTATE);              _RESTART TIMER IN CCB?
        PT3POLL     (GENERAL);              _ISSUE GENERAL POLL?
        END;
_ 
* * * *  PERFORM A WORKCYCLE FOR ALL TCBS ON CURRENT CCB
? 
    BXCURTCBP := BXTCBPTR;                  _GET FIRST TCB ON CCB?
    WHILE BXCURTCBP " NIL DO
      BEGIN 
      T3TCB := BXCURTCBP;                   _SET THE TCB-POINTER? 
      WITH T3TCB'.BSTCB DO                  _INDEX TO TCB?
        BEGIN 
        IF BS3WTSENT                        _IF IN WAIT.. REGULATION   ?
        THEN
          IF PTREGL (T3TCB) = RGNONE        _IF TCB NOT IN REGULATION  ?
          THEN
            PT3REGULATE (FALSE);            _SEND OUT REPEAT.. MESSAGE ?
_ 
* * * *  SEE IF IT IS TIME FOR A SPECIFIC POLL (TERMINAL TIME OUT)
? 
        IF (BS3TIMER - CTIMER.CT100MS < 1)
        THEN
          BEGIN 
          IF BS3STATE = TBUSY 
          THEN                              _OUTPUT BUSY TERMINAL TO? 
            BS3STATE := TOPERATIVE          _ALLOW ANOTHER SELECT?
          ELSE
            BS3SPECPOLL := TRUE;            _ITS TIME FOR SPECIFIC POLL?
          PT3STATIMER (BS3STATE);           _RESTART THE TIMER? 
          END;
_ 
* * * *  SEE IF SPECIFIC POLL IS NEEDED TO RETAIN DEVICE STATUS 
? 
        IF BS3SPECPOLL
        THEN
          BEGIN 
          BS3SPECPOLL := FALSE;             _DECLARE SPECPOLL DONE? 
          PT3POLL     (SPECIFIC);           _ISSUE SPECIFIC POLL? 
          END; _IF BS3SPECPOLL? 
_ 
* * * *  SEE IF WE CAN AND NEED TO SELECT A 3270 DEVICE 
? 
        IF BS3OUBUFF " NIL                  _IF OUTPUT QUEUED?
        THEN
          IF BS3OUTPOK                      _AND ALLOWED TO SEND OUTPUT?
          THEN
            IF BS3STATE = TOPERATIVE        _AND DEVICE NOT BUSY? 
            THEN
              PT3SELECT;                    _SELECT THE 3270 DEVICE?
_ 
* * * *  WORKCYCLE FOR THIS TCB DONE, GET NEXT TCB IN CCB/LCB CHAIN 
? 
        BXCURTCBP := BS3TCBPTR;             _GET POINTER TO NEXT TCB? 
        END; _WITH T3TCB'.BSTCB DO? 
      END; _WHILE BXCURTCBP " NIL DO? 
_ 
* * * *  WORKCYCLE FOR CURRENT CCB DONE, GET NEXT CCB IN LCB/CCB CHAIN
? 
    BXGENPTIME := FALSE;                    _RESET GENPOLL-FLAG?
    CCBPTR     := BXCCBPTR;                 _GET POINTER NEXT CCB?
    END; _WITH CCBPTR'.BXCCB DO?
  
UNTIL FALSE;
  
END; _PROCEDURE PT3DRIVER?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
*                                                                     * 
*                      P T 3 2 7 0 T I P                              * 
*                                                                     * 
*             S T A R T  O F  M A I N  P R O G R A M                  * 
*                                                                     * 
*                 W O R K L I S T  H A N D L E R                      * 
*                                                                     * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
  
BEGIN 
T3DBGA[T3DBGI] := BWWLENTRY[OPS].B0TIPWLE;  _SAVE WORKLIST ENTRY       ?
T3DBGI         := (T3DBGI + 1) MOD 25;      _UPDATE INDEX INTO ARRAY   ?
WITH BWWLENTRY [OPS].B0EWLQ DO              _INDEX OPS-INTERM-ARRAY?
  BEGIN 
  WORKCODE      := MMWKCODE;                _PICK UP THE WORK-CODE? 
  LINENO.BDLINO := MMLINO;                  _PORT-SUBPORT NUMBER? 
  T3BUFF        := MMIBP;                   _BUFFER-ADDRESS?
  PBLCBP (MMLINO, LCBPTR);                  _GET ADDRESS OF LCB?
  END;
WITH LCBPTR' DO                             _INDEX TO LINE-CONTR-BLOCK? 
BEGIN 
  CCBPTR   := BZ3CURCCBP;                   _GET PTR CURRENT CCB? 
 _BZWKCODE := WORKCODE;?                    _SAVE IN LCB FOR DEBUG? 
  
  CASE WORKCODE OF                          _GO PROCESS THE WORK-CODE?
  
                                                                   _$J+ 
          * * * * * * * * * * * * * * * * * * * * * * * * * * 
          *                                                 * 
          *           W O R K L I S T  H A N D L E R        * 
          *                                                 * 
          *       F O R  S E R V I C E - M E S S A G E S    * 
          *                                                 * 
          * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
  
                _*****************
                **?  A0SMEN:   _**
                *****************?
  
  BEGIN                                     _LINE ENABLED FROM SVM? 
 _IF BZ3STATE @ LDISABLED?                  _IF CURRENTLY DISABLED THEN?
 _THEN? 
    BZ3STATE := LWAITTCB;                   _ENABLE LINE, WAIT FOR TCB? 
  PT3SENDSVM (D0LINE, D5OPER);              _LINE OPERATIONAL TO SVM? 
  END; _A0SMEN? 
  
                _*****************
                **?  A0SMTCB:  _**
                *****************?
  
  BEGIN                                     _TCB CONFIGURED FROM SVM? 
  T3TCB := T3BUFF;                          _GET THE TCB POINTER? 
  IF BZ3STATE = LWAITTCB                    _IF THIS IS FIRST TCB?
  THEN
    PT3DRIVER;                              _THEN START ON THIS LINE? 
  END; _A0SMTCB?
  
                _*****************
                **? A0SMDLTCB: _**
                *****************?
  
  BEGIN                                     _TCB TO BE DELETED FROM SVM?
  T3TCB  := T3BUFF;                         _GET THE TCB POINTER? 
  CCBPTR := T3TCB'.BSTCB.BS3CCBPTR;         _GET PTR TO CCB?
  WITH CCBPTR'.BXCCB DO                     _INDEX TO CCB?
    BEGIN 
    T3TCB'.BSTCB.BS3STATE := TINOPERATIVE;  _MAKE CLUSTER INOPERATIVE?
    PT3DOWNDEVICE (DWNRCDL);                _IF OTHER TCBS ARE DOWN?
_ 
* * * *  DELINK TCB FROM LCB-TCB AND CCB-TCB CHAINS 
? 
    PT3DELINK (T3TCB, BZTCBPTR, XBSCHAIN);
    PT3DELINK (T3TCB, BXTCBPTR, XBS3TCBPTR);_DELINK TCB FROM CCB/TCB? 
_ 
* * * *  TERMIO IF CURRENTLY ACTIVE TCB IS BEING DELETED
? 
    TERMIO := FALSE;
    IF CCBPTR = BZ3CURCCBP
    THEN                                    _TCB FOR CURRENT ACTIVE CCB?
      BEGIN 
      IF T3TCB = BXCURTCBP
      THEN                                  _TCB CURRENTLY ACTIVE?
        TERMIO := TRUE; 
      IF BXTCBPTR = NIL 
      THEN                                  _ACTIVE TCB REMOVED FM CCB? 
        TERMIO := TRUE; 
      END;
_ 
* * * *  DELINK CCB FROM LCB-CCB CHAIN IF NO MORE TCBS LEFT 
? 
    IF BXTCBPTR = NIL                       _NO MORE TCBS FOR CCB?
    THEN
      BEGIN 
      PT3DELINK (CCBPTR, BZ3CCBPTR, 
                 XBXCCBPTR);
      PBREL1BF  (CCBPTR, B0S16);            _REL THE CCB-BUFFER?
      END;
    END; _WITH CCBPTR'.BXCCB DO?
_ 
* * * *  SEND WORKCODE TO SVM TO SIGNAL COMPLETION OF DELETE TCB
? 
  PT3SENDSVM (D0TCB, D5DELE); 
_ 
* * * *  TCB DELETED, CONTINUE PROPERLY FOR THIS LINE 
? 
  IF BZ3STATE \ LTERMIO                     _ONLY IF LINE ACTIVE AND? 
  THEN
    IF BZ3CCBPTR " NIL                      _HAVE NOT DELETED ALL TCBS? 
    THEN
      BEGIN 
      IF TERMIO                             _IF ACTIVE FOR THIS TCB?
      THEN
        PT3DRIVER;                          _THEN CLEANUP AND RESTART?
      END                                   _THE 3270 DRIVER? 
    ELSE
      PT3TERMIO (LWAITTCB);                 _STOP SERVICING THIS LINE?
  END; _A0SMDLTCB?
  
                _*****************
                **?  A0SMDA:   _**
                *****************?
  
  BEGIN                                     _DISABLE LINE FROM SVM? 
  PT3TERMIO (LDISABLED);                    _TERMIO AND LINE DISABLED?
  C3DLCMDP.NKLINO := LINENO.BDLINO;         _INSERT LINE NUMBER?
  PBCOIN (C3DLCMDP);                        _ISSUE DISABLE LINE CMD?
  PT3SENDSVM (D0LINE, D5DISA);              _SEND WORKLIST TO SVM?
  B1TCB := BZTCBPTR;
  WHILE B1TCB " NIL DO
    BEGIN                                   _RELEASE TCB BUFFERS       ?
    PBRELZRO(B1TCB'.BSTCB.BS3INBUFF,BEDBSIZE);   _RELATIVE TO INPUT    ?
    PBRELZRO(B1TCB'.BSTCB.BS3OUBUFF,BEDBSIZE);   _RELATIVE TO OUTPUT   ?
    PBRELZRO(B1TCB'.BSTCB.BS3FRAGM,BEDBSIZE);    _RELATIVE TO IVT FRAG ?
    B1TCB := B1TCB'.BSTCB.BSCHAIN;
    END;
  
  END; _A0SMDA? 
  
                _*****************
                **? A0HARDER:  _**
                *****************?
  
  BEGIN                                     _HARD-ERROR OCCURRED? 
  IF BZ3STATE \ LWAITTCB                    _ACCEPT FOR ENABLED LINE? 
  THEN
    WITH BWWLENTRY[OPS].B0EWLQ DO 
      BEGIN 
      BZ3INOPCODE := MMINOP;                _SAVE IN LCB FOR DEBUG? 
      PT3SENDSVM  (D0LINE, D5INOP);         _SEND WORKLIST TO SVM?
      PT3TERMIO   (LINOPERATIVE);           _TERMIO AND LINE INOPERATIV?
      END;
  END; _A0HARDER? 
  
                _*****************
                **?   A0TIP:   _**
                *****************?
  
  BEGIN                                     _CONNECTION BROKEN? 
  T3TCB := T3BUFF;
  PT3RELTP;                                 _RELEASE TP BUFFERS?
  END; _A0TIP?
  
                _*****************
                **?  A0WK17:   _**
                *****************?
  
  BEGIN                                     _D/L CMD/ICMD (BATCH)?
  IF BWWLENTRY [OPS].B0EWLQ.
     MMWTCOUNT = HTICMD 
  THEN                                      _TERMINATE OUTPUT ICMD? 
    PT3RELTP                                _RELEASE TPCB BUFFERS?
  ELSE
    IF T3BUFF'.BFDATAC [PFC] = CHR (D8TO) 
    THEN                                    _TERMINATE OUTPUT MARKER? 
      PBPEOI (T3TCB, D9IOT) 
    ELSE
      PTDLCMD (T3TCB, T3BUFF);              _PROCESS DEVICE/FILE CMD? 
  PBRELZRO (T3BUFF, BEDBSIZE);
  END; _A0WK17? 
                                                                   _$J+ 
          * * * * * * * * * * * * * * * * * * * * * * * * * * 
          *                                                 * 
          *           W O R K L I S T  H A N D L E R        * 
          *                                                 * 
          *             P T 3 I O  R E T U R N S            * 
          *                                                 * 
          * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
  
                _*****************
                **? A0TIMEOUT: _**
                *****************?
  
  BEGIN                                     _OPS TIMER TIMEOUT? 
  IF BWWLENTRY [OPS].B0EWLQ.                _CHECK FOR TIMEOUT PRECEDED?
     MMWTCOUNT = BZWTCOUNT                  _BY AWAITED EVENT?
  THEN
    BEGIN                                   _TIMEOUT IS LEGITIMATE? 
    IF BZ3STATE = LACTIVE                   _TERMINATE I/O ONLY?
    THEN                                    _FOR ACTIVE LINE? 
      PT3TERMIO (LTERMIO);
200:                                        _ENTERED BY A0QUEOUT? 
    WORKCODE := WKTIMO;                     _SET INTERNAL WK FOR TIMOUT?
210:                                        _ENTERED WITHOUT BUFS IN WL?
    T3BUFF   := NIL;                        _WE HAVE NO VALID BUFADDR?
220:                                        _ENTERED WITH VALID BUFFER? 
    IF BZ3STATE \ LACTIVE 
    THEN                                    _IS LINE ACTIVE?
      BEGIN 
      RESP3270.STW :=                       _SET RESP ACCORD. WORKCODE? 
        BITMASK [WORKCODE - A0WK1]; 
      RETADDR      := BZRET1ADDR;           _GET RETURN ADDRESS?
      GOTO 300;                             _RETURN TO PT3IO CALLER?
      END; _IF BZ3STATE \ LACTIVE THEN? 
   _ELSE?                                   _INACTIVE LINE OR TERMIO? 
      PBRELZRO (T3BUFF, BEDBSIZE);          _RELEASE POSSIBLE INPUT?
                                            _AND EXIT BACK TO MONITOR?
    END; _IF BWWLENTRY [OPS].B0EWLQ...? 
  END; _A0TIMEOUT?
  
                _*****************
                **? A0QUEOUT:  _**
                *****************?
  
  BEGIN                                     _OUTPUT QUEUED FOR TCB? 
  T3TCB := T3BUFF;                          _SET TCB-POINTER? 
  WITH T3TCB'.BSTCB DO                      _INDEX TO TCB?
    IF BS3OUBUFF = NIL
    THEN                                    _IF NOTHING QUEUED? 
      BEGIN 
      PT3PREOUTPUT;                         _PRE-OUTPUT PROCESSING? 
      IF T3BUFF " NIL 
      THEN                                  _FOUND OUTPUT TO XMIT?
        BEGIN 
        BS3OUBUFF := T3BUFF;                _SET PTR TO OUTPUT-BLOCK? 
        IF BS3STATE = TIBUSY                _DEVICE BUSY NO OUTPUT? 
        THEN
          PT3STATIMER (TBUSY)               _DECLARE BUSY WITH OUTPUT?
        ELSE
          IF BS3STATE " TINOPERATIVE
          THEN                              _TERMINAL OPERATIONAL?
            BEGIN 
            IF BZ3STATE = LDELAYED          _TREAT AS END OF TIMEOUT? 
            THEN
              GOTO 200;                     _IF IDLE-TIMER RUNNING? 
            END 
          ELSE                              _TERMINAL INOPERTIVE? 
            PT3RLBUFS;                      _RELEASE BUFFERS? 
        END; _IF T3BUFF " NIL?
      END; _IF BS3OUBUFF = NIL? 
  END; _A0QUEOUT? 
  
                _*****************
                *? WKACK0,WKEOT,_*
                *? WKACK1,WKNAK,_*
                *? WKBUFT,WKENQ,_*
                *? WKWACK,WKRVI:_*
                *****************?
  
  BEGIN 
  GOTO 210;                                 _RETURN TO PT3IO CALLER?
  END;                                      _WITHOUT VALID BUFFER-ADDR? 
  
                _*****************
                **?  WKTETB,   _**
                **?  WKTETX,   _**
                **?  WKTENQ,   _**
                **?  WKCRCE,   _**
                **?  WKTEST,   _**
                **?  WKSTAT:   _**
                *****************?
  
  BEGIN 
  GOTO 220;                                 _RETURN TO PT3IO CALLER?
  END;                                      _WITH VALID BUFFER-ADDR?
  
                _*****************
                **?  WKINPT:   _**
                *****************?
  
  BEGIN 
  IF BWWLENTRY[OPS].B0EWLQ. 
     MMWTCOUNT = BZWTCOUNT                  _WORKLIST-ENTRY VALID?
  THEN
    BEGIN                                   _YES? 
    IF BZ3STATE = LTERMIO                   _REACTIVATE LINE IF TERMIO? 
    THEN
      BZ3STATE := LACTIVE;                  _DONE ON ACTIVE LINE? 
    RETADDR := BZRET2ADDR;                  _GET RETURN ADDRESS?
    PT3RETURN;                              _RETURN TO PT3TERMIO-CALLER?
    END;
  END;
  
  END; _CASE WORKCODE OF? 
  
  END; _WITH LCBPTR' DO?
GOTO 999; 
  
_ 
* * * *  RETURN TO PT3IO CALLER WITH INDEX TO CCB AND TCB SET 
? 
300:                                        _RETURN TO PT3IO CALLER?
  
WITH CCBPTR'.BXCCB DO                       _SET SECOND WITH TO CCB?
  BEGIN 
  T3TCB := BXCURTCBP;                       _SET UP T3TCB?
  WITH T3TCB'.BSTCB DO
    PT3RETURN;                              _RETURN TO PT3IO-CALLER?
  END;
  
999:  
  
END; _PROCEDURE PT3270TIP?                  _RETURN TO OPS-MONITOR? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 T E X T P R O C E S S              * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE PERFORMS THE OUTPUT TEXT-PROCESSING    * 
*               FOR INTERACTIVE CONNECTIONS ONLY                      * 
*                                                                     * 
** INPUTS -     T3TCB     - PTR TO TERMINAL-CONTROL-BLOCK             * 
*               BS3OUBUFF                                             * 
*               T3BUFF    - PTRS TO DATA TO BE TEXTPROCESSED          * 
*                                                                     * 
** OUTPUTS -    T3BUFF    - PTR TO TEXTPROCESSED OUTPUT               * 
*               BS3FRAGM  - PTR TO SOURCE-FRAGMENT DURING PAGE-WAIT   * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PTTPINF          PT3XLATE                             * 
*               PBRELCHN         PBRELZRO                             * 
*               PBGET1BF         PBREL1BF                             * 
*               PTBREAK                                               * 
*                                                                     * 
** INTERNAL SUBROUTINES USED -                                        * 
*               STORECURSADR                                          * 
*               ADDLINETOCURS                                         * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3TEXTPROCESS; 
  
CONST 
  US       = 1;                             _TP-RESULT: US DETECTED?
  CRLF     = 2;                             _TP-RESULT: CR/LF DETECTED? 
  DONE     = 4;                             _TP-RESULT: TP COMPLETED? 
  FRRESULT = 5;                             _RESULT OF TP-STATES? 
  FRRA     = 6;                             _BUF-ADDR FOR RA-ORDER? 
  FRSBA    = 7;                             _BUF-ADDR FOR SBA-ORDER?
  FRIC     = 8;                             _BUF-ADDR FOR IC-ORDER? 
  FRFLCNTR = 9;                             _FOLDED-LINES COUNTER?
  FRLNCNTR = 10;                            _LINE COUNTER FOR PAGEWAIT? 
  MAXNSCREEN = 1920;                        _MAX SCREEN SIZE NRML WRITE?
  
TYPE
  CURADTP  = PACKED RECORD
             CASE CTINT : INTEGER OF
             1: (INT : INTEGER);
             2: (FILLER : B04BITS;
                 L6BITS : B06BITS;
                 R6BITS : B06BITS); 
             3: (LCHAR : CHAR;
                 RCHAR : CHAR); 
             END; 
  FEPARTP  = PACKED RECORD
             CASE FTINT : INTEGER OF
             1: (INT : INTEGER);
             2: (FECLRWRT : BOOLEAN;        _CLEAR-WRITE REQUIRED?
                 FERSTWRT : BOOLEAN;        _RESET CURSOR TO TOP SCREEN?
                 FEPREACT : BOOLEAN;        _PRE-PRINT ACTION REQUIRED? 
                 FEPSTACT : BOOLEAN;        _POST-PRINT ACTION (N/A)? 
                 FEADJINP : B04BITS;        _PRE-PRINT ADJUST AFTER INP?
                 FEPRELNS : B04BITS;        _PRE-PRINT LINES TO SKIP? 
                 FEPSTLNS : B04BITS);       _POST-PRINT LINES (N/A)?
             END; 
  FETABTP  = RECORD 
               FECHAR   : CHAR;             _FORMAT-EFFECTOR CHARACTER? 
               FEPARAMS : FEPARTP;          _PARAMETERS FOR THIS FE?
             END; 
  
VAR 
  PGWIDTH  : INTEGER;                       _PAGE-WIDTH OF SCREEN?
  PGLENGTH : INTEGER;                       _PAGE-LENGTH OF SCREEN? 
  SCREENSZ : INTEGER;                       _SCREEN-SIZE? 
  CURSADR  : CURADTP;                       _START-OF-LINE CURSOR-ADDR? 
  CURRCURS : CURADTP;                       _CURRENT CHAR CURSOR-ADDR?
  DBCV     : DBDBC;                         _DATA-BLOCK-CLARIFIER?
  BUFLAGS  : INTEGER;                       _SOURCE BUFFER-FLAGS? 
  FIRSTLN  : BOOLEAN;                       _FIRST LINE FLAG? 
  BLANKFL  : BOOLEAN;                       _DOING BLANKFILL AFTER INP? 
  ENDSRCE  : BOOLEAN;                       _END-OF-SOURCE FLAG?
  FE       : CHAR;                          _CURRENT FORMAT-EFFECTOR? 
  FEPARMS  : FEPARTP;                       _PARAMETERS FOR CURRENT FE? 
  FETABLE  : ARRAY [1..7] OF FETABTP;       _FE-S AND CORRESP PARAMS? 
  I        : INTEGER;                       _WORK-INTEGER?
  W1, 
  W2       : B0OVERLAY;                     _WORK-FIELDS? 
  
VALUE 
  FETABLE  = (I9FSS,$2010,                  _PRE-PRINT ONE LINE?
              I9FDS,$2020,                  _PRE-PRINT TWO LINES? 
              I9FTS,$2030,                  _PRE-PRINT THREE LINES? 
              I9FNS,$2100,                  _PRE-PRINT START CURR LINE? 
              I9FRS,$6000,                  _PRE-PRINT HOME CURSOR? 
              I9FPE,$E000,                  _PRE-PRINT CLEAR SCREEN?
                0  ,$2010);                 _OTHERS, AS PRE-PRINT ONE?
  
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          A D D L I N E T O C U R S                * 
*                                                                     * 
** OVERVIEW -   ADD A GIVEN NUMBER OF LINES TO THE CURSOR ADDRESS     * 
*               AND MAINTAIN THE PAGE-WAIT COUNTER                    * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE ADDLINETOCURS (NRLINES : INTEGER);
  
BEGIN 
CURSADR.INT := NRLINES * PGWIDTH +
               CURSADR.INT;                 _INCREASE CURSOR-ADDRESS? 
IF CURSADR.INT \ SCREENSZ                   _OUT-OF-SCREEN? 
THEN
  CURSADR.INT := 0;                         _YES, RESET TO TOP? 
WITH T3TPMLCB DO                            _INDEX TO TP-MLCB?
  NCTPF1 [FRLNCNTR] := NCTPF1 [FRLNCNTR] -
                       NRLINES;             _MAINTAIN PAGEWAIT COUNTER? 
END; _PROCEDURE ADDLINETOCURS?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          S T O R E C U R S A D R                  * 
*                                                                     * 
** OVERVIEW -   CALCULATE CURSOR-ADDRESS FOR NEXT LINE AND            * 
*               STORE ADDRESS FOR THE GIVEN ORDER-CODE                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE STORECURSADR (ORDC : INTEGER);
  
VAR 
  LCURSA : CURADTP;                         _LOCAL CURSOR-ADDRESS?
  UOPSET : ARRAY [FRRA..FRIC] OF SETWORD; 
  
VALUE 
  UOPSET = ($20,$10,$08); 
  
BEGIN 
LCURSA.LCHAR := CHR (CURSADR.L6BITS);       _MOVE 6-BITS INTO 8-BITS? 
LCURSA.RCHAR := CHR (CURSADR.R6BITS);       _FOR LEFT/RIGHT CHARS?
PT3XLATE (P3BINEBC,LCURSA.INT);             _GET EBCDIC BUFFER-ADDRESS? 
WITH T3TPMLCB DO                            _INDEX TO TP-MLCB?
  BEGIN 
  NCTPF1 [ORDC] := LCURSA.INT;              _PUT BUFFER-ADDR IN MLCB? 
  W1.BAINT      := NCUOPS;                  _GET MUX-FLAGS LOCAL? 
  W1.BASET      := W1.BASET ! UOPSET [ORDC];_SET PROPER NCUOP-BIT?
  NCUOPS        := W1.BAINT;                _RESTORE NCUOPS IN TP-MLCB? 
  END;
END; _PROCEDURE STORECURSADR? 
                                                                  _$J+? 
_ 
* * * *  START OF MAIN PROCEDURE PT3TEXTPROCESS 
? 
BEGIN 
WITH T3TPMLCB, T3TCB'.BSTCB DO              _INDEX TP-MLCB AND TCB? 
  BEGIN 
_ 
* * * *  GET DATA-BLOCK-CLARIFIER AND THE TCB-PARAMETERS
? 
  FIRSTLN  := TRUE;                         _SET FIRST-LINE FLAG? 
  PGWIDTH  := BSPGWIDTH;                    _GET PAGEWIDTH AND? 
  PGLENGTH := BSPGLENGTH;                   _PAGELENGTH AND?
  SCREENSZ := PGWIDTH * PGLENGTH;           _SCREENSIZE?
  NCFSBA   := T3BUFF;                       _GET SOURCE TO BE TP-ED?
  WITH NCFSBA' DO                           _INDEX TO SOURCE-BUFFER?
    BEGIN 
    BUFLAGS := BIINT [2];                   _GET BUFFER-FLAGS LOCAL?
    IF BF3FRAGM                             _PARTIAL IVT-BLOCK? 
    THEN                                    _YES, GET DBC FROM TCB? 
      BEGIN 
      DBCV.DBCHAR := BS3SVDBC;              _SAVED DBC FROM TCB?
      BLANKFL     := FALSE;                 _RESET BLANKFILL FLAG?
      ENDSRCE     := FALSE;                 _RESET END-OF-SOURCE FLAG?
      END 
    ELSE                                    _NEW IVT-BLOCK? 
      BEGIN 
      BLANKFL     := BFEOR;                 _GET BLANKFILL FLAG?
      ENDSRCE     := BLANKFL;               _SET EOS ON BLANKFILL?
      DBCV.DBCHAR := BFDATAC [DBC];         _GET DBC FROM BUFFER? 
      BFFCD       := DBC + 1;               _SET FCD PAST THE DBC?
      IF NOT (DBCV.DBDLXPT ! BLANKFL) 
      THEN
        PTADDCHR (CHR (I9US), NCFSBA);      _FORCE TERMINATING US?
      END; _IF BF3FRAGM ELSE? 
    END; _WITH NCFSBA' DO?
_ 
* * * *  PRE-INITIALIZE SOME FIELD IN THE TP-MUX-LCB
? 
  NCUOPS  := 0;                             _RESET MUX-FLAGS INITIALLY? 
  NCBLCNT := 0;                             _RESET BUFFERS-USED COUNTER?
  NCDBP   := NIL; 
  NCFDBA  := NIL;                           _CLEAR DESTINATION PTRS?
  NCCNTL  := PGWIDTH;                       _PAGEWIDTH FOR LINE-FOLDING?
  NCUOP1  := DBCV.DBDLXPT;                  _SET FOR TRANSPARENT TEXT?
  IF NCFSBA'.BFINTBLK = FALSE 
  THEN
    BSXPT := DBCV.DBDLXPT;                  _SET/RESET XPARENT INPUT? 
  
  IF DBCV.DBDLXPT = FALSE THEN              _NON-TRANSPARENT TEXT?
_ 
* * * *  GET CURRENT CURSOR-ADDRESS, ADJUST IT TO BEGIN OF LINE 
? 
    BEGIN 
    CURSADR.INT := (BS3CURSADR DIV          _TEXT RECEIVED, ADJ CURSOR? 
                    PGWIDTH) * PGWIDTH;     _TO BEGIN OF LAST LINE? 
    NCTPF1 [FRLNCNTR] := BS3LNCNTR;         _GET PAGEWAIT CNTR FROM TCB?
    IF BS3TXTRCVD 
    THEN                                    _JUST RECEIVED INPUT,?
      NCTPF1 [FRLNCNTR] := PGLENGTH;        _RESET PAGEWAIT LINE CNTR?
_ 
* * * *  SEE IF THERE IS MORE IVT-SOURCE TO TEXT-PROCESS
? 
310:  
    WITH NCFSBA' DO                         _INDEX (REMAINING) SOURCE?
      IF BFFCD > BFLCD                      _FIRST BUFFER EMPTY?
      THEN
        IF BCCHAINS [DBUFLENGTH] " NIL      _AND NO MORE BUFFERS? 
        THEN
          PBREL1BF (NCFSBA,BEDBSIZE)        _NO, RELEASE 1ST EMPTY? 
        ELSE                                _YES, HAVE END-OF-SOURCE? 
          ENDSRCE := TRUE;                  _SET END-OF-SOURCE FLAG?
_ 
* * * *  GET THE FORMAT-EFFECTOR FOR THE NEXT LINE OF OUTPUT (IF ANY) 
? 
    WITH NCFSBA' DO                         _INDEX (REMAINING) SOURCE?
      IF ENDSRCE
      THEN                                  _NO MORE SOURCE TO SEND?
        BEGIN 
        FEPARMS.INT := 0;                   _NIL FE?
        BFFCD       := BFFCD - 2;           _MAKE SURE NON-EMPTY SOURCE?
        END 
      ELSE                                  _MORE SOURCE TO SEND? 
        BEGIN 
        IF DBCV.DBDLFE                      _FORMAT-EFFECTORS PRESENT?
        THEN                                _NO FE-S? 
          BEGIN 
          FE    := CHR (I9FSS);             _DEFAULT FE IS BLANK? 
          BFFCD := BFFCD - 1;               _TP-STATES SKIP FIRST CHAR? 
          END _IF DBCV.DBDLFE THEN? 
        ELSE                                _FE-S SUPPLIED BY HOST-APPL?
          FE := BFDATAC [BFFCD];            _GET FE FROM BUFFER?
_ 
* * * *  FIND PARAMETERS FOR THE GIVEN FORMAT-EFFECTOR
? 
        I := 1;                             _FIRST ENTRY IN FE-TABLE? 
        WHILE (FETABLE [I].FECHAR " FE) &   _ENTRY NOT FOUND AND? 
          (FETABLE [I].FECHAR " CHR(0))     _NOT AT END-OF-TABLE? 
        DO
          I := I + 1;                       _LOOK AT NEXT ENTRY?
        FEPARMS := FETABLE [I].FEPARAMS;    _GET PARAMETERS FOR FE? 
_ 
* * * *  PERFORM PRE-PRINT PROCESSING AND CHECK FOR PAGE-WAIT 
? 
        WITH FEPARMS DO                     _FE-PARAMETERS? 
          BEGIN 
          I := FEPRELNS;                    _GET NR PRE-PRINT LINES?
          IF BS3TXTRCVD                     _IS THIS THE FIRST LINE OF? 
          THEN                              _OUTPUT AFTER INPUT?
            I := FEADJINP + I               _DONT OVERWRITE INPUT LINE? 
          ELSE                              _NOT OUTPUT AFTER INPUT?
            IF BSPGWAIT                     _PAGE-WAIT TURNED ON AND? 
            THEN
              IF FERSTWRT !                 _CLEAR/RESET-WRITE OR?
                 (NCTPF1 [FRLNCNTR] @ 2)    _PAGE GETTING FULL? 
              THEN
                BEGIN                       _NEED TO GO INTO PAGE-WAIT? 
                I         := 0;             _ONLY SKIP ONE LINE?
                NCUOP6    := TRUE;          _SEND OVER..? 
                BS3INPREQ := TRUE;          _MUST FIRST RECEIVE INPUT?
                BS3PGTURN := TRUE;          _LOOK FOR PAGE TURN?
                END;
          END; _WITH FEPARMS? 
        ADDLINETOCURS (I);                  _ADD PRE-PRINT LINES? 
        END; _IF ENDSRCE ELSE?
  
    IF NCUOP6 ! ENDSRCE                     _GOING INTO PAGE-WAIT OR? 
    THEN                                    _NO MORE OUTPUT?
_ 
* * * *  GENERATE (SCREEN) BUFFER-ADDRESS-SEQ FOR END OF XMISSION BLOCK 
? 
      BEGIN 
      BS3CURSADR := CURSADR.INT;            _SAVE CURR CURSOR-ADDR? 
  
      BS3LNCNTR  := NCTPF1 [FRLNCNTR];      _AND PAGEWAIT LINE COUNTER? 
      ADDLINETOCURS (1);                    _ADDRESS OF NEXT LINE?
      IF FIRSTLN                            _MAKE SURE WE START WITH? 
      THEN
        STORECURSADR (FRSBA);               _A SET-BUFFER-ADDRESS?
      STORECURSADR  (FRIC);                 _INSERT CURSOR AT NEXT LINE?
      ADDLINETOCURS (1);                    _ADDRESS OF NEXT LINE?
      IF ENDSRCE = FALSE
      THEN                                  _FRAGMENTED SOURCE LEFT?
        BEGIN 
        NCFSBA'.BIINT [2] := BUFLAGS;       _SET ORIGINAL FLAGS IN BUF? 
        NCFSBA'.BF3FRAGM  := TRUE;          _DECLARE IT A FRAGMENT? 
        BS3FRAGM    := NCFSBA;              _SAVE BUFFER IN TCB?
        BS3SVDBC    := DBCV.DBCHAR;         _SAVE DATA-BLOCK-CLARIFIER? 
        CURSADR.INT := CURSADR.INT - 1;     _ADJUST CURSOR FOR OVER..?
        IF CURSADR.INT < 0
        THEN                                _JUST WRAPPED AROUND,?
          CURSADR.INT := SCREENSZ - 1;      _SET BACK TO END OF SCREEN? 
        END; _IF ENDSRCE = FALSE THEN?
      STORECURSADR (FRRA);                  _CLEAR ONE LINE FOR INPUT?
      END _IF NCUOP6 ! ENDSRCE THEN?
    ELSE                                    _MORE OUTPUT TO SEND? 
_ 
* * * *  GENERATE (SCREEN) BUFFER-ADDRESS-SEQ FOR NEXT LINE OF OUTPUT 
? 
      IF FIRSTLN
      THEN                                  _FIRST LINE OF OUTPUT?
        BEGIN 
        IF FEPARMS.FERSTWRT                 _RESET/CLEAR WRITE REQUEST? 
         ! BS3CLRSCR
        THEN
          BEGIN 
          CURSADR.INT := 0;                 _HOME CURSOR ADDRESS? 
          NCUOP2    := FEPARMS.FECLRWRT ! 
                       BS3CLRSCR;           _SET CLEAR - IF REQUIRED   ?
          BS3CLRSCR := FALSE;               _RESET CLEAR RCVD FLAG     ?
          IF SCREENSZ > MAXNSCREEN
          THEN
            NCUOP7 := TRUE;                 _SET ALTERNATE WRITE REQ   ?
          END;
        STORECURSADR (FRSBA);               _SBA ON FIRST LINE? 
        END _IF FIRSTLN THEN? 
      ELSE                                  _NOT THE FIRST LINE?
        IF (CURSADR.INT > CURRCURS.INT)     _ANYTHING LEFT TO CLEAR    ?
           ! (CURSADR.INT = 0)              _OR GOING TO TOP OF SCREEN ?
        THEN
          STORECURSADR (FRRA)               _YES, ZERO-FILL AREA? 
        ELSE
          STORECURSADR (FRSBA);             _NO, JUST START AT CURSADR? 
    END; _IF DBCV.DBDLXPT = FALSE THEN? 
  
  IF BLANKFL = FALSE
  THEN
    BS3TXTRCVD := FALSE;                    _RESET IF NOT DOING BLANKFL?
_ 
* * * *  SET UP FOR CALL TO TEXT-PROCESSING IN FIRMWARE 
? 
  NCSBP             := NIL;                 _RESET CURRENT SOURCE PTR?
  NCTPF1 [FRRESULT] := 0;                   _RESET RESULT?
  NCTPF1 [FRFLCNTR] := 0;                   _RESET FOLDED-LINES COUNTER?
  
  PTTPINF (T3TPMLCB);                       _CALL TP-STATES?
  
  IF DBCV.DBDLXPT = FALSE                   _NON-TRANSPARENT TEXT?
  THEN
_ 
* * * *  TEXT-PROCESSED A LOGICAL-LINE, PERFORM POST-PRINT PROCESSING 
? 
    BEGIN 
    ADDLINETOCURS (NCTPF1 [FRFLCNTR]);      _ADJUST FOR FOLDED LINES? 
    CURRCURS.INT := CURSADR.INT + 
                    PGWIDTH - NCCNT1 + 1;   _GET CURRENT SCREEN-BUFADR? 
  
    IF NCTPF1 [FRRESULT] @ CRLF             _CRLF OR UNIT-SEPARATOR,? 
    THEN                                    _MORE SOURCE TO TP? 
_ 
* * * *  US OR CR/LF DETECTED BY TP, RELEASE TEXT-PROCESSED SOURCE
? 
      BEGIN 
      W1.BABUFPTR := NCSBP;                 _GET CURR SOURCE-BUFF-PTR?
      W2.BASET    := W1.BASET - BEDBSIZE'.  _ADJUST THAT PTR TO?
                     BEMSK.BASET;           _BASE BUFFER ADDRESS? 
      WHILE NCFSBA " W2.BABUFPTR            _RELEASE TP-ED SOURCE?
        DO PBREL1BF (NCFSBA, BEDBSIZE); 
      I := (W1.BAINT - W2.BAINT) * 2;       _FCD OF CURRENT SOURCE? 
      IF NCEOSR                             _END OF CURRENT SOURCE BUF? 
      THEN
        I := I + 2                          _MAKE SURE BUFFER IS EMPTY? 
      ELSE
        IF NCRIGHTC 
        THEN
          I := I + 1;                       _NOT EOSR, ADJ RIGHT CHAR?
  
      IF NCTPF1 [FRRESULT] = CRLF 
      THEN                                  _FOUND CR/LF IN TETX? 
        BEGIN 
        I := I - 1;                         _POINT BACK TO CR?
        NCFSBA'.BFDATAC [I] := CHR (I9FSS); _INSERT PRE-PRINT-ONE FE? 
        END;
  
      NCFSBA'.BFFCD := I;                   _SET FCD TO REST OF SOURCE? 
      FIRSTLN       := FALSE;               _FIRST LINE DONE? 
      GOTO 310;                             _CONTINUE TP MORE SOURCE? 
  
      END; _IF NCTPF1 [FRRESULT] @ CRLF THEN? 
    END; _IF DBCV.DBDLXPT = FALSE THEN? 
_ 
* * * *  DONE WITH TP (END OF SOURCE REACHED) 
? 
  NCFDBA'.BIINT [2] := BUFLAGS;             _PASS ORIGINAL SOURCE FLAGS?
  NCFDBA'.BF3TEXTPR := TRUE;                _SET TEXT PROCESSED FLAG   ?
  IF BS3FRAGM = NIL                         _IF NO PAGEWAIT-FRAGMENT? 
  THEN
    PBRELCHN (NCFSBA, BEDBSIZE);            _THEN RELEASE SOURCE BUFS?
  BS3OUBUFF := NCFDBA;                      _GET TEXTPR-ED DATA?
  T3BUFF    := NCFDBA;                      _RETURN PTR OF TP-ED TEXT?
  END; _WITH T3TPMLCB, T3TCB'.BSTCB DO? 
END; _PROCEDURE PT3TEXTPROCESS? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 I N I T C B                        * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE IS CALLED BY THE SERVICE-MODULE (SVM)  * 
*               DURING CONFIGURATION OF A TERMINAL-CONTROL-BLOCK      * 
*               (TCB) TO INITIALIZE TIP-DEPENDENT FIELDS.             * 
*               IF THIS IS THE FIRST TCB ON A CLUSTER, THE TIP        * 
*               WILL CREATE AND INITIALIZE A CLUSTER-CONTROL-BLOCK    * 
*               (CCB) AND THE CCB WILL BE LINKED INTO THE LCB-CCB     * 
*               CHAIN. THEN THE NEW TCB WILL BE LINKED INTO THE       * 
*               CCB-TCB CHAIN. THE SVM WILL ALREADY HAVE LINKED       * 
*               THIS NEW TCB AT THE END OF THE LCB-TCB CHAIN.         * 
*                                                                     * 
** INPUTS -     T3TCB - THE POINTER TO THE NEW TCB                    * 
*                                                                     * 
** OUTPUTS -    INITIALIZED TCB (LCB/CCB IF FIRST TCB)                * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PT3XLATE                                              * 
*               PBGET1BF                                              * 
*               PBCLR                                                 * 
*                                                                     * 
** SPECIAL PROGRAMMING NOTE -                                         * 
*               THE CANNED POLL/SELECT MESSAGE BUILD IN THE CCB HAS   * 
*               FOR SPACE-UTILIZATION REASONS CHARACTERS IN THE FLAG  * 
*               WORD OF THE BUFFER. THE CHARACTERS ARE ARRANGED SUCH  * 
*               THAT FLAGS BFSUPCHAIN AND BF3CANNED ARE SET.          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3INITCB;
  
CONST 
  LPOLSEL = 9;                              _LENGTH OF POLL/SELECT TEXT?
  TOPERATIVE = 2;                           _STATE FOR TERM OPERATIVE?
  
VAR 
  CBPTR,
  PRCBPTR  : B0BUFPTR;
  CA, I    : INTEGER; 
  POLSEL   : ARRAY [1..LPOLSEL] OF INTEGER; 
  
VALUE 
  POLSEL   = ($1202,$5532,$3232,$37FF,$5532,$3232,0,0,$2DFF); 
  
BEGIN 
WITH B1TCB'.BSTCB DO                        _SET INDEX TO TCB?
  BEGIN 
_ 
* * * *  GO FIND CCB FOR THE NEW TCB
? 
  CA      := BSCA;
  PRCBPTR := NIL;                           _PRESET PREV-PTR TO ZERO? 
  CBPTR   := BSLCBPTR'.BZ3CCBPTR;           _SET POINTER TO FIRST CCB?
  WHILE (CBPTR " NIL) & (CA " CBPTR'.       _GO LOCATE THE CCB FOR? 
         BXCCB.BXTCBPTR'.BSTCB.BSCA) DO     _ THIS TCB? 
    BEGIN 
    PRCBPTR := CBPTR;                       _SET PTR TO PREVIOUS CCB? 
    CBPTR   := CBPTR'.BXCCB.BXCCBPTR;       _AND PICK UP NEXT CCB?
    END;
  IF CBPTR = NIL
  THEN                                      _NO CCB, GO CREATE ONE? 
_ 
* * * *  HAVE NO CCB FOR NEW TCB, CREATE AND INITIALIZE ONE 
? 
    BEGIN 
    CBPTR := PBGET1BF (B0S16);              _GET A BUFFER FOR THE CCB?
    PBCLR (CBPTR,16);                       _AND CLEAR IT FIRST?
    WITH CBPTR'.BXCCB DO                    _SET INDEX TO CCB?
      BEGIN 
      BXTIMER  := CTIMER.CT100MS + 15;      _START GENERAL POLL TIMER?
      BXTCBPTR := B1TCB;                    _INSERT TCB POINTER?
      FOR I := 1 TO LPOLSEL DO
        BXPOLSEL [I] := POLSEL [I];         _INSERT POLL/SELECT TEXT? 
      END;
_ 
* * * *  INSERT NEW CCB IN LCB-CCB CHAIN OF LCB 
? 
    IF PRCBPTR = NIL                        _IS THIS THE FIRST CCB? 
    THEN
      BSLCBPTR'.BZ3CCBPTR := CBPTR          _YES INSERT CCB-PTR IN LCB? 
    ELSE
      PRCBPTR'.BXCCB.BXCCBPTR := CBPTR;     _NO INSERT IN LAST CCB? 
    END 
  ELSE                                      _CCB EXISTS ADD TCB TO LINK?
_ 
* * * *  INSERT TCB IN CCB-TCB CHAIN OF CCB 
? 
    BEGIN 
    PRCBPTR := CBPTR'.BXCCB.BXTCBPTR;       _GET POINTER TO FIRST TCB?
    WHILE PRCBPTR'.BSTCB.BS3TCBPTR"NIL DO   _GO LOCATE LAST TCB IN LINK?
      PRCBPTR := PRCBPTR'.BSTCB.BS3TCBPTR;  _SHIFT TO NEXT TCB IN LINK? 
    PRCBPTR'.BSTCB.BS3TCBPTR := B1TCB;      _LINK TCB AT END CCB-TCB? 
    END; _IF CBPTR = NIL? 
_ 
* * * *  COMPLETE INITIALIZATION OF TCB 
? 
  BS3CCBPTR := CBPTR;                       _INSERT BACKPTR TO CCB? 
  BS3CUPOL  := ORD (T3BINEBC.T3POL [CA]);   _GET EBCDIC CU FOR POLLS? 
  BS3CUSEL  := ORD (T3BINEBC.T3SEL [CA]);   _GET EBCDIC CU FOR SELECTS? 
  BS3DAPSL  := ORD (T3BINEBC.T3POL [BSTA]); _GET EBCDIC DA FOR POLL/SEL?
  BS3DAGPL  := $7F;                         _GET EBCDIC DA FOR GEN-POLL?
  BS3CUDA   := BS3CPDPS;                    _SET EBCDIC CU/DA?
  PT3XLATE  (P3EBCASC, BS3CUDA);            _GET ASCII CU/DA? 
  BS3OUTPOK := TRUE;                        _OUTPUT INITIALLY OK? 
  BS3STATE  := TOPERATIVE;                  _SET TERMINAL-STATE?
  BS3TIMER  := CTIMER.CT100MS;              _SPECIFIC POLL FIRST? 
  END; _WITH B1TCB'.BSTCB DO? 
END; _PROCEDURE PT3INITCB?
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 X L A T E                          * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE TRANSLATES TWO CHARACTERS              * 
*                                                                     * 
** INPUTS -     POINTER TO TRANSLATE-TABLE (PARAMETER 1)              * 
*               TWO CHARACTERS TO BE TRANSLATED (PARAMETER 2)         * 
*                                                                     * 
** OUTPUTS -    WORD WITH TWO TRANSLATED CHARACTERS                   * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               NONE                                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3XLATE (XLTPTR : T3XLTPTR; VAR CHARS : INTEGER);
  
VAR 
  LOCCHARS : B0OVERLAY; 
  
BEGIN 
WITH LOCCHARS DO
  BEGIN 
  BAINT   := CHARS;                         _GET CHARACTERS TO LOCAL? 
  BALCHAR := XLTPTR' [BALBYT];              _TRANSLATE LEFT BYTE? 
  BARCHAR := XLTPTR' [BARBYT];              _TRANSLATE RIGHT BYTE?
  CHARS   := BAINT;                         _RETURN CHARS TO CALLER?
  END;
END; _PROCEDURE PT3XLATE? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P M 3 2 7 0 T I P                        * 
*                                                                     * 
** OVERVIEW -   THIS IS THE MUX-LEVEL PROCEDURE FOR THE 3270 TIP      * 
*                                                                     * 
** INPUTS -     WORKCODES RECEIVED FROM MUX-SUBSYSTEM                 * 
*                                                                     * 
** OUTPUTS -    WORKCODES SEND TO OPS-LEVEL 3270 TIP                  * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBLSPUT                                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PM3270TIP;
  
BEGIN 
PBLSPUT (BWWLENTRY [MUX2],BYWLCB [B03270]); _PASS WORKCODE TO OPS-TIP?
END; _PROCEDURE PM3270TIP?                  _THATS ALL? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 R E L T P                          * 
*                                                                     * 
** OVERVIEW -   RELEASE PRINTER TEXT PROCESSING BUFFERS/STRUCTURES    * 
*                                                                     * 
** INPUTS   -   TCB POINTER                                           * 
*                                                                     * 
** OUTPUTS  -   TPCB AND TP BUFFERS RELEASE                           * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PBRELZRO                                              * 
*               PBREL1BF                                              * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3RELTP; 
  
BEGIN 
IF T3TCB'.BSTCB.BS3TPCBP " NIL
THEN                                        _TEST IF ONE ASIGNED? 
  BEGIN 
  PBRELZRO (T3TCB'.BSTCB.BS3TPCBP'.BGMLCB.
            NCFDBA, BEDBSIZE);              _RELEASE POSSIBLE DESTIN.?
  PBREL1BF (T3TCB'.BSTCB. 
            BS3TPCBP, BETPSIZE);            _RELEASE TPCB BUFFER? 
  END; _IF TPCBP " NIL? 
END; _PROCEDURE PT3RELTP? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 I N P T P                          * 
*                                                                     * 
** OVERVIEW -   PERFORM INPUT TEXT-PROCESSING TO REMOVE THE NON-      * 
*               TRANSPARENT MODE FIELD ADDRESSES.                     * 
*                                                                     * 
** INPUTS   -   T3BUFF: POINTER TO INPUT BUFFER                       * 
*                                                                     * 
** OUTPUTS  -   T3BUFF: POINTER TO INPUT WITHOUT FIELD ADDRESSES      * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PTTPINF         PBRELCHN                              * 
*                                                                     * 
** NOTE     -   TPCB MUST BE FIRST VARIABLE FOR MPEDIT INITIALIZATION * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3INPTP; 
  
VAR 
  TPCB  : NCLCB;                            _INITIALIZED BY MPEDIT? 
  
BEGIN 
WITH TPCB DO                                _INDEX TO TPCB? 
  BEGIN 
  NCFSBA  := T3BUFF;                        _INSERT SOURCE BPTR?
  NCFDBA  := NIL;                           _CLEAR (OLD) DESTINATION? 
  NCSBP   := NIL;                           _CLEAR (OLD) SOURCE?
  NCBLCNT := 0;                             _CLEAR BUFFER COUNTER?
  
  PTTPINF (TPCB);                           _PERFORM TEXT-PROCESSING? 
  
  T3BUFF        := NCFDBA;                  _GET TP-ED INPUT? 
  T3BUFF'.BFFCD := DATA + 1;                _SET FCD? 
  PBRELCHN (NCFSBA, BEDBSIZE);              _RELESASE SOURCE BUFFERS? 
  END;
END; _PROCEDURE PT3INPTP? 
                                                                   _$J+ 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** PROCEDURE NAME -          P T 3 O T P                              * 
*                                                                     * 
** OVERVIEW -   THIS PROCEDURE IS CALLED BY BIP PRIOR TO QUEUING      * 
*               OF OUTPUT IN THE TCB QUEUE, IT CREATES PRINTER        * 
*               TRANSMISSION BLOCKS.                                  * 
*                                                                     * 
** INPUTS -     TCB ADDRESS, BUFFER ADDRESS (PARAMETERS)              * 
*                                                                     * 
** OUTPUTS -    TRANSMISSION BLOCK, QUEUED IN TCB                     * 
*                                                                     * 
** EXTERNAL SUBROUTINES USED -                                        * 
*               PT3270TIP       PBGET1BF                              * 
*               PBCLR           PBRELZRO                              * 
*               PBRELCHN        PBQUEMAINT                            * 
*               PTTPINF         PBREL1BF                              * 
*               PT3RELTP        PTCHAIN                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
                                                                      ? 
PROCEDURE PT3OTP (VAR T3TCBP, T3BUFP : B0BUFPTR); 
  
CONST 
_ 
* * * *  LOCAL PRE-OUTPUT TEXTPROCESSING CONSTANTS
? 
  T1ACCS    = 5;                            _OUTPUT ACC. WORD SOURCE? 
  T1ACCD    = 4;                            _OUTPUT ACC. WORD DESTINATN?
  T1FOTST   = 1;                            _FIRST OUTPUT TP STATE? 
  T1BFCD    = 8;                            _FCD FIRST DESTINATION BUF? 
_ 
* * * *  TPCB FILE REGISTER EQUATIONS 
? 
  T1XMINIT  = $05;                          _TRANSMISSION BLOCK SIZE? 
  T1PGLEN   = $06;                          _PAGE LENGTH? 
  T1BLANK   = $07;                          _ASCII/DISPLAY BLANKS?
  
VAR 
  T3TPCBP  : B0BUFPTR;                      _LOCAL POINTER TO TPCB? 
  T3DBC    : DBDBC;                         _DATA BLOCK CLARIFIER?
  T3BLKIND : BLKTYPE;                       _BLOCK TYPE?
  T3PC, 
  T3PL, 
  T3PN, 
  T3PX     : B0BUFPTR;                      _WORK BUFFER POINTERS?
  
BEGIN 
T3TCB := T3TCBP;                            _SET GLOBAL TCB PTR?
IF T3TCB'.BSTCB.BSBATCH 
THEN                                        _BATCH (PRINTER) DEVICE?
  WITH T3TCB'.BSTCB DO
    BEGIN 
    T3BUFF := T3BUFP;                       _GET DL BLOCK FROM BIP PTR? 
    WITH T3BUFF' DO                         _INDEX TO D/L BLOCK?
      BEGIN 
      T3DBC.DBCHAR   := BFDATAC [DBC];      _GET DBC AND? 
      T3BLKIND.BTCHR := BFDATAC [BTPT];     _AND BLOCK TYPE LOCAL?
      END;
    IF T3BLKIND.BTYPE \ HTCMD 
    THEN                                    _DOWNLINE COMMAND RECEIVED? 
_ 
* * * *  DOWNLINE COMMAND RECEIVED, CALL THE MAIN 3270TIP DIRECTLY
? 
      BEGIN 
      WITH BWWLENTRY [OPS].B0EWLQ DO        _INDEX TO WORKLIST ENTRY? 
        BEGIN 
        MMWKCODE  := A0WK17;                _WORKCODE FOR PT3270TIP    ?
        MMLINO    := BSLCBP'.BZLINO.BDLINO; _SET LINE NUMBER? 
        MMIBP     := T3BUFF;                _PASS COMMAND BUFFER ADDR?
        MMWTCOUNT := T3BLKIND.BTYPE;        _PASS BLOCK TYPE? 
        END; _WITH BWWLENTRY [OPS].B0EWLQ DO? 
      PT3270TIP;                            _CALL MAIN TIP DIRECTLY?
      END _IF T3BLKIND.BTYPE \ HTCMD THEN?
    ELSE
_ 
* * * *  DOWNLINE DATA BLOCK RECEIVED, GO PRE-TEXTPROCESS IT
? 
      BEGIN 
      T3BUFF'.BFFCD := DATA + 1;            _SET FCD TO FIRST DATA CHAR?
      T3TPCBP := BS3TPCB;                   _GET TPCB POINTER FROM TCB? 
      IF T3TPCBP = NIL
      THEN
_ 
* * * *  NO TPCB ASSIGNED, GO GET A TPCB AND PRE-INITIALIZE IT
? 
        BEGIN 
        T3TPCBP := PBGET1BF (BETPSIZE);     _GET A TPCB BUFFER? 
        BS3TPCB := T3TPCBP;                 _INSERT TPCB PTR IN TCB?
        PBCLR   (T3TPCBP, TPBUFLEN);        _CLEAR THE THING? 
        WITH T3TPCBP'.BGMLCB DO             _INDEX TO NEW TPCB? 
_ 
* * * *  INITIALIZE THE NEW TPCB (ONLY THE FIRST TIME)
? 
          BEGIN 
          NCSTAI := T1FOTST;                _FIRST OUTPUT TP STATE? 
          NCBFCD := T1BFCD;                 _SET FCD FOR FIRST DESTIN.? 
          NCCNTL := BSPGWIDTH;              _SET PAGE WIDTH?
          NCTPF1 [T1XMINIT] := BSXBZ;       _SET XMIT BLOCK SIZE? 
          NCTPF1 [T1PGLEN]  := BSPGLENGTH;  _SET PAGE LENGTH? 
          NCTPF1 [T1BLANK]  := $202D;       _ASCII/DISPLAY BLANK? 
          END; _WITH T3TPCBP'.BGMLCB DO?
        END; _IF T3TPCBP = NIL? 
  
      WITH T3TPCBP'.BGMLCB DO               _INDEX TO TPCB? 
        BEGIN 
_ 
* * * *  INITIALIZE TPCB PRIOR TO EVERY CALL OF -PTTPINF- 
? 
        NCBLCNT := 0;                       _CLEAR BUFFER COUNTER?
        NCSBP   := NIL;                     _CLEAR WORK SOURCE PTR? 
        NCUOP4  := BSSUPCC;                 _SUPPRESS CARRIAGE CONTROL? 
        NCUOP6  := T3DBC.DBBEOI;            _GET EOI FLAG FROM DBC? 
        NCSPTA  := T3SPTA [BSFTYPE];        _GET STATE PROGRAM TABLE? 
        NCCXLTA := T3XLTA [BSFTYPE];        _AND XLATE TABLE ADDRESSES? 
        NCFSBA  := T3BUFF;                  _INSERT SOURCE BUFFERS? 
_ 
* * * *  PERFORM TEXT PROCESSING AND RELEASE SOURCE BUFFERS 
? 
        PTTPINF  (T3TPCBP');                _PERFORM TEXT PROCESSING? 
        PBRELCHN (T3BUFF, BEDBSIZE);        _RELEASE SOURCE BUFFERS?
_ 
* * * *  UNRAVEL THE SERIAL XMISSION BLOCKS AND THE ACCOUNTING BUFFERS
? 
        T3PL := NIL;                        _PL WILL BE LAST FULL XMTBF?
        T3PX := NCFDBA;                     _PX IS CURRENT XMIT-BLK PTR?
        T3PC := T3PX;                       _PC IS CURRENT BUF PTR? 
  
        WHILE T3PC " NIL DO 
          BEGIN 
          T3PN := T3PC'.BCCHAINS [DBUFLEN]; _PN IS NEXT BUF PTR?
          IF T3PN " NIL                     _IS THIS ACCOUNTING INFO? 
          THEN
            IF T3PN'.BFEOI                  _(PASSED THROUGH EOI-FLAG)? 
            THEN
_ 
* * * *  FOUND A COMPLETE XMISSION BLOCK, QUEUE IT IN THE TCB 
? 
              BEGIN                         _YES, BLOCK FOR BIP?
              T3PX'.BIINT [T1ACCD]     := 
                T3PN'.BIINT [T1ACCS];       _ACC. INFO TO FIRST BUFFER? 
              T3PC'.BCCHAINS [DBUFLEN] :=   _DELINK ACC. INFO BUFFER? 
                NIL;
              T3PL := T3PX;                 _PL IS LAST CMPLT XMIT-BLCK?
              PBQUEMAINT (T3TCB, T3PX,      _PUT XMIT BLK IN D/L QUEUE? 
                          K4PUT); 
              PBREL1BF   (T3PN, BEDBSIZE);  _RELEASE ACC. INFO BUFFER?
              T3PX := T3PN;                 _NEXT MAY BE A NEW XMIT BLK?
              END; _IF T3PN " NIL THEN? 
          T3PC := T3PN;                     _GO TO NEXT BUFFER IN CHAIN?
          END; _WHILE T3PC " NIL DO?
  
        NCFDBA := T3PX;                     _POSS. INCMPLT XMIT IN TPCB?
        IF T3PX = NIL 
        THEN                                _NO DESTINATION LEFT? 
          NCDBP := NIL;                     _CLEAR WORK POINTER?
        END; _WITH T3TPCBP'.BGMLCB DO?
_ 
* * * *  COPY EOR/EOI FLAGS FROM DL PRU INTO LAST COMPLETE XMIT BLOCK 
? 
      IF T3PL " NIL 
      THEN
        BEGIN 
       _T3PL'.BFEOR := T3DBC.DBBEOR;? 
        T3PL'.BFEOI := T3DBC.DBBEOI;
        END;
      END; _IF T3BLKIND.BTYPE @ HTCMD ELSE? 
  T3BUFP := NIL;                            _RETURN NIL PTR?
  END; _IF BSBATCH? 
END; _PROCEDURE PT3OTP? 
