*M*      TICLABOR LABORER SEGMENT OF TIC MODULE OF TP
*P*  NAME:        TICLABOR
*P*  PURPOSE:     TICLABOR PERFORMS THE LABORER FUNCTIONS OF THE TIC.
*P*  DESCRIPTION: EXECUTING ON BEHALF OF A TIC STATION, TICLABOR
*P*               PRODUCES THE INTERFACE WITH THE CLERK THAT IS
*P*               ATTRIBUTED TO THE TIC IN THE TP REFERENCE MANUAL. IT
*P*               PRODUCES THAT EXTERNAL INTERFACE FOR A SINGLE CLERK OR
*P*               STATION. IN ORDER TO SUPPORT MANY STATIONS, THE TIC
*P*               CREATES A TIC-TASK FOR EACH STATION, AND BEGINS
*P*               EXECUTION OF EACH OF THESE TASKS IN THE LABORER CODE.
*P*  REFERENCE:   CP-V TP REFERENCE MANUAL, 90 31 12
         PCC       0
*
*
*
         SYSTEM    SIG7                                                 TIC00010
         SYSTEM   TPPROCS
         M:PT     1
         SYSTEM   TICPROCS
*
DO#UTS   SET       0                   ON TO RUN ON UTS.  OFF FOR CP-V.
*
DO#CHECKOUT SET    0                   OFF FOR NO CHECKOUT, NO #SNAPS.
*
DO#OWNCODEHELP SET 0                   OFF FOR NO SPECIAL OWN CODE AIDS.
*
DO#3270  EQU       1                   ON TO HANDLE IBM3270 STATIONS.
*
*
*
DO#FIXEDMDLBUFFERS SET 1               ON FOR UN-DYNAMIC MDL BUFFERS.
*                                                                       TIC00060
DO#GATEOBTAININTERNAL SET 1            ON ALLOWS ONLY ONE TASK INTO THE
*                                      OBTAININTERNALFILERECORD ROUTINE
*                                      AT A TIME.
*
DO#STAIPROMPTS SET 1                   ON TO PROCESS PN'STRING'
*                                      LOGON PROMPTS SUPPLIED IN
*                                      STATION NAMES RECORD.
*
DO#ARESNAPS SET    DO#CHECKOUT         FOR SNAP-DEPENDENT CODE - DON'T
*                                       ASSEMBLE SET-UP CODE FOR #SNAP
*                                        IF #SNAP IS ITSELF NO-OPED.
*
DO#XMISSIONUPARROWS SET 1              ON IF UP-ARROW IS A MESSAGE ESC.
*
DO#HOLDSTAIDURINGLOGON SET 0           ON TO KEEP STATION'S STAI
*                                       RECORD IN CORE WHILE
*                                        CLERK ANSWERS PROMPT.
*
DO#CORETFDS SET    0                   ON TO KEEP CHAIN OF IN-CORE
*                                       TFDS SO THAT MORE THAN ONE
*                                        CLERK MAY BE USING THE SAME
*                                         CORE COPY OF A TFD.
*
*
*                                                                       TIC00080
TICABORTCOUNT      EQU 9999            NUMBER OF #ABORT'S TO ALLOW.     TIC00090
BYTESPERRANDOMBLOCK EQU 1000        MAX BYTES IN INTERNAL GRANULES
XACTIONTEXTINCREMENT EQU 76            NUMBER OF CHARS IN TSI FQM PIECESTIC00100
*
*
BYTESINSMALLBXR EQU 400                SMALL ENUF BXR TO REMOVE
*                                       IT FROM 2036 BYTE BUFFER
*                                        INTO ITS OWN FOR PROCESSING.
*
*
*
HOWMANYXMITSBREAK  EQU 1               ESTABLISHES HOW MANY TIMES
*                                       IN A ROW WE MUST GET AN
*                                        UNEXPECTED TRANSMISSION
*                                         FROM A MULTI-POINT STATION
*                                          IN ORDER TO CONSIDER IT
*                                           AS AN ATTENTION.
         PAGE
*
*
*
         REF      #DEV#RECORD#STATUS#IW  INPUT; USED TO TEST FOR
*,*  ERRORS IN A STATION'S DEVICE I/O; BYTE 2=ERROR CODE; BYTE 3=SUBCODE;
*,*  ZERO/NONZERO MEANS GOOD/BAD
         REF      #NET#ECB          INPUT, OUTPUT; WORD; USED IN
*,*  CONJUNCTION WITH #WAIT#ON PROC TO WAIT ON A NETWORK I/O EVENT
         REF      #MDL#WAKEUP#ECB#IW  INPUT; USED IN
*,*  CONJUNCTION WITH #GO#TO#ON PROC SO WAKE-UP WILL OCCUR WHEN TIC-TASK
*,*  REQUESTS AN I/O
         REF      #DEV#CURRENT#IO#IW  INPUT; USED TO
*,*  KEEP TRACK OF VARIOUS I/O CONDITIONS OF A STATION
         REF      #CIO#REQD         INPUT; EQU; BIT 27 OF #DEV#CURRENT-
*,*  #IO TABLE ENTRY USED TO TEST FOR OR SET TO INDICATE I/O
*,*  REQUESTED BUT NOT INITIATED
         REF      #CIO#READ         INPUT; EQU; BIT 30 OF #DEV#CURRENT-
*,*  #IO TABLE ENTRY USED TO DETERMINE IF OR SET TO INDICATE I/O IS
*,*  A READ
         DO       HOWMANYXMITSBREAK>1
         REF      #DEV#XMIT#COUNT#IW  INPUT; USED TO KEEP TRACK
*,*  OF NO. OF TIMES IN A ROW AN UNEXPECTED TRANSMISSION WAS
*,*  RECEIVED FROM A MULTIPOINT STATION
         FIN
         REF      #DEV#RECORD#LENGTH#IW  INPUT; USED
*,*  TO KEEP TRACK OF THE LENGTH OF A RECORD IN #DEV#RECORD#BA
         REF      #DEV#RECORD#BA#IW  INPUT; USED TO
*,*  KEEP TRACK OF THE LOCATION OF A BUFFER FOR DEVICE I/O
         REF      #CIO#COMP         INPUT; EQU; USED SET BIT 25, I/O
*,*  COMPLETED BIT, IN THE #DEV#CURRENT#IO TABLE ENTRY FOR A STATION
         REF      #BIGGEST#TIC#TASK INPUT; WORD; USED TO DELIMIT LOOPS
*,*  THROUGH VARIOUS DEV-TASK TABLES
         REF      #DEV#DCB#POINTER#IW  INPUT; USED TO IDENTIFY THE
*,*  DCB ADDRESS ASSOCIATED WITH A STATION OR LINE
         REF      #CIO#WRITE        INPUT; EQU; USED TO TEST OR SET
*,*  BIT 31, THE WRITE BIT, IN THE #DEV#CURRENT#IO TABLE FOR A STATION
         REF      #X#ED             INPUT; WORD; USED TO SEE IF TIC HAS
*,*  BEEN X'ED (I.E., SHUT DOWN) BY THE OPERATOR
         REF      #MDL#FIXED#BUFFERS#IW  INPUT; IF TIC
*,*  ASSEMBLED WITH UN-DYNAMIC MDL BUFFERS, USED TO ACCESS SUCH BUFFERS
         REF      #DCB#TABLE#IW     INPUT; USED TO GET A
*,*  STATION'S DCB ADDRESS (POINTED TO BY #DEV#DCB#POINTER)
         REF      #DEV#LINE#STATUS#BITS#IW  INPUT; USED
*,*  TO KEEP TRACK OF THE STATUS OF A LINE
         REF      #LINE#REESTABLISH INPUT; EQU; USED TO FLAG OR TEST
*,*  BIT 22 OF #DEV#LINE#STATUS#BITS FOR RE-SETUP OF MDL LINE
         REF      #LINE#UNACQUIRED  INPUT; EQU; USED TO FLAG OR TEST
*,*  BIT 31 OF #DEV#LINE#STATUS#BITS FOR LINE THAT IS TABLED ONLY
         REF      #DEV#MULTIPOINT#INDEX#IW  INPUT; USED BY THE
*,*  MULTIPOINT LINE HANDLER TO OBTAIN THE M:LIST INDEX OF A STATION
         REF      #DEV#LINE#IDENTIFIER#IW  INPUT; USED BY
*,*  MULTIPOINT LINE HANDLER AND LOGON AND ECHO PROCESSORS TO OBTAIN A
*,*  STATION'S LINE ID
         REF      #LINE#AWAITING#ACQUIRE  INPUT; EQU; USED TO FLAG OR
*,*  TEST BIT 25 OF #DEV#LINE#STATUS#BITS FOR I/O ERROR THAT TABLED THE LINE
         REF      #TIMESUP#ECB      INPUT, OUTPUT; WORD; USED IN
*,*  CONJUNCTION WITH THE #WAIT#ON PROC TO CLEAR THIS ECB THAT THE
*,*  DISPATCHER USES TO AWAKEN INDEFINITE WAITERS
         REF      #BIGGEST#MDL#TASK INPUT; WORD; USED TO DELIMIT LOOPS
*,*  THROUGH VARIOUS MDL-TASK TABLES
         REF      #DEV#OUTPUT#TRL#IW  INPUT; USED BY THE TFD
*,*  PROCESS ROUTINES TO CREATE OUTPUT BUFFERS OF THE PROPER LENGTH
         REF      #DEV#INPUT#TRL#IW  INPUT; USED IN SETTING
*,*  UP I/O BUFFERING FOR A MULTIPOINT LINE TASK
         DEF      #MDLADR           ENTRY POINT FROM TICROOT
         REF      #LINE#AWAITING#ATTENTION  INPUT; EQU; USED TO FLAG OR
*,*  TEST BIT 27 OF #DEV#LINE#STATUS#BITS FOR A DORMANT STATION
         REF      #LINE#ATTENTION   INPUT; EQU; USED TO FLAG OR TEST
*,*  BIT 28 OF #DEV#LINE#STATUS#BITS FOR ATTENTION RECEIVED
         REF      #DEV#REGULATION#IW  INPUT; USED TO DETER-
*,*  MINE WHAT FUNCTIONS OF THE STATION HAVE BEEN REGULATED OFF BY THE
*,*  OPERATOR
         REF      #REGULATE#AT      INPUT; EQU; USED TO TEST OR SET
*,*  BIT 30 OF #DEV#REGULATION TABLE FOR @-REGULATION
         REF      #REGULATE#CRUNCH  INPUT; EQU; USED TO TEST OR SET
*,*  BIT 29 OF #DEV#REGULATION TABLE FOR #-REGULATION
         REF      #REGULATE#QUESTION INPUT; EQU; USED TO TEST OR SET
*,*  BIT 31 OF #DEV#REGULATION TABLE FOR ?-REGULATION
         REF      #MESSAGE#CHAIN    INPUT, OUTPUT; WORD; USED AS
*,*  POINTER TO BLOCK OF PENDING MESSAGES
         REF      #DEV#LOGON#BLOCK#IW  INPUT; USED
*,*  IN OBTAINING/STORING INFORMATION WITHIN THE BLOCK FOR A
*,*  LOGGED-ON STATION
         REF      #LINE#REGULATED   INPUT; EQU; USED TO SET OR TEST
*,*  BIT 29 OF #DEV#LINE#STATUS#BITS FOR FOLLOWING:
*,*  LINE HAS JUST BEEN REGULATED
         REF      #DEV#STATION#TYPE#IW  INPUT; USED TO BUILD TFD KEYS
         REF      #LINE#AWAITING#REPORT INPUT; EQU; USED TO FLAG OR TEST
*,*  BIT 26 OF #DEV#LINE#STATUS#BITS FOR STATION'S WAITING ON REPORT DUE
*,*  TO DMODE OUT OR DMODE ONE
         REF      #DEV#COMMAND#LINE#RECORD#BA#IW  INPUT; POINTER TO
*,*  ARRAY TABLE USED IN THE FOLLOWING WAYS:
*,*   **WHEN LOGON FINDS A Y-TYPE NPS, IT ACQUIRES A BUFFER FROM
*,*     DYNAMIC STORAGE, COPIES THE INDICATED STRING TO IT, & STORES
*,*     A DYNAMIC STORAGE POINTER INTO THIS TABLE.
*,*   **WHEN THE Z PRIMITIVE PROCESSOR FINISHES WITH A TFD (Z0) IT
*,*     A) FREES THE 'CURRENT' COMMAND LINE BUFFER BY USING THE
*,*        POINTER IN THE TABLE, AND
*,*     B) COPIES THE DSP OF THE CURRENT Y-PRIMITIVE STRING OR A
*,*        ZERO (EXACTLY THE CONTENTS OF THE TFD PROCESS OWN-STORAGE
*,*        CELL TSIYSTRINGBA) TO THE TABLE.
*,*   **COMMAND LEVEL TESTS THE CONTENTS OF THE TABLE TO SEE IF A COMMAND
*,*     LINE IS PRESENT (NONZERO CONTENTS).  IF NO COMMAND LINE IS
*,*     PRESENT, THE STATION IS PROMPTED AND A READ PERFORMED.
*,*     THE DSP RETURNED BY THE READ IS THEN PLACED IN THE TABLE.
*,*   **COMMAND LEVEL USES THE TABLE TO FIND THE COMMAND LINE.
*,*   **VARIOUS PROCESSORS USE THE TABLE TO FIND THE COMMAND LINE.
*,*   **THE TRAN CODE PROCESSOR USES THE TABLE TO FIND THE TRANCODE.
*,*   **THE TFD PROCESSOR USES THE TABLE TO FIND THE TRANCODE LINE
*,*     FOR @0 USAGE.
         REF      #DEV#COMMAND#LINE#RECORD#LENGTH#IW  INPUT;
*,*  USED TO FIND LENGTH OF CURRENT COMMAND LINE
         REF      ZEROANDNINE       INPUT; CONSTANTS
         SREF     T:MYPRIM
         SREF     O:SETOUTPUTFIELD
         REF      F:JRNL            INPUT; JOURNAL FILE
         REF      #INFOBLOCK#TFDI   INPUT; WORD; USED AS A POINTER TO
*,*  THE CHAIN OF INTERNAL TFD RECORDS
         REF      GATEOBTAININTERNALCOUNT INPUT, OUTPUT; WORD; USED TO
*,*  DETERMINE WHETHER OBTAININTERNALFILERECORD ROUTINE IS IN USE OR NOT
         REF      GATEOBTAININTERNALECB  INPUT, OUTPUT; WORD; ECB USED
*,*  TO INDICATE THAT A RECORD HAS BEEN READ FROM AN INTERNAL FILE
         REF      F:TICI            INPUT; INTERNAL VERSION OF
*,*  TFD, STATION NAMES, & DELIVERIES FILES
         SREF     T:LOGON
         REF      #INFOBLOCK#DELI   INPUT; WORD; USED AS A POINTER TO
*,*  THE CHAIN OF INTERNAL DELIVERIES FILE RECORDS
         SREF     O:LOGONNAMEPROMPT
         SREF     O:LOGONPASSWORDPROMPT
         REF      #INFOBLOCK#STAI   INPUT; WORD; USED AS A POINTER TO
*,*  THE CHAIN OF INTERNAL STATION NAMES RECORDS
         DEF      #BEGIN            ENTRY POINT FOR START OF
*,*  PROCESSING AFTER INITIALIZATION IS COMPLETE
         REF      #WAIT#ON#CODE     ENTRY POINT USED BY #WAIT#ON PROC
         REF      #GO#TO#ON#CODE  ENTRY POINT USED BY #GO#TO#ON PROC
         REF      #INITIATE#WRITE#READ#CODE  ENTRY POINT USED BY
*,*                                 #INITIATE#WRITE#READ PROC
         REF      #CHECK#CODE  ENTRY POINT USED BY #CHECK PROC
         REF      #FREE#DEV#BUFFER#CODE  ENTRY POINT USED BY
*,*                                 #FREE#DEV#BUFFER PROC
         REF      SIGNALATTENTIONCODE  ENTRY POINT USED BY
*,*                                 SIGNALATTENTION PROC
         REF      #GET#MAIN#BYTES#CODE  ENTRY POINT USED BY
*,*                                 #GET#MAIN#BYTES PROC
         REF      MBS678CODE        ENTRY POINT USED BY MBS678 PROC
         REF      #WAIT#ON#DEVICE#CODE  ENTRY POINT USED BY
*,*                                 #WAIT#ON#DEVICE PROC
         REF      #FREE#MAIN#BYTES#CODE  ENTRY POINT USED BY
*,*                                 #FREE#MAIN#BYTES PROC
         REF      #EXIT#CODE        ENTRY POINT USED BY #EXIT PROC
         REF      #TYPE89#CODE      ENTRY POINT USED BY #TYPE89 PROC
         REF      #FREE#MAIN#BYTES#IF#CODE  ENTRY POINT USED BY
*,*                                 #FREE#MAIN#BYTES#IF PROC
         REF      FIELD6789POINTTOSTRINGCODE  ENTRY POINT USED BY
*,*                                 FIELD6789POINTTOSTRING PROC
         REF      FIELD6789LOADAAAAAAAACODE  ENTRY POINT USED BY
*,*                                 FIELD6789LOADAAAAAAAA PROC
         REF      #DEV#ECB#IW       INPUT; USED TO ACCESS ARRAY
*,*                                 TABLE OF ECBS
         REF      #INITIATE#READ#CODE  ENTRY POINT USED BY
*,*                                 #INITIATE#READ PROC
         REF      SIGNALATTENTIONCODECFTWO  ENTRY POINT USED
*,*                                 BY SIGNALATTENTION PROC
         REF      #INITIATE#WRITE#CODE  ENTRY POINT USED BY
*,*                                 #INITIATE#WRITE PROC
         REF      #DOING#REPORT  CONSTANT USED TO TEST #DEV#DOING ENTRY
         REF      ABORTCODE         ENTRY POINT USED BY #ABORT PROC
         REF      #DEV#TYPE#INDEX#IW  INPUT; USED TO ACCESS TABLE
*,*                                 OF TYPE NUMBERS FOR TERMINALS
         REF      #DEV#TYPE#INDEX#BIGGEST  CONSTANT; USED TO TEST
*,*  FOR LARGEST POSSIBLE TERMINAL TYPE NO.
*,*  #DEV#LINE#STATUS#BITS FOR ATTENTION RECEIVED
         REF      #DOING#ACCEPT  CONSTANT USED TO TEST #DEV#DOING ENTRY
         REF      #GET#MAIN#WORDS#SPECIAL#CODE#CLEAR  ENTRY POINT
*,*                                 USED BY #ENTRY#SPACE#CLEAR PROC
         REF      #FREE#MAIN#WORDS#SPECIAL#CODE  ENTRY POINT USED
*,*                                 BY #EXIT#SPACE PROC
         REF      #GET#MAIN#WORDS#SPECIAL#CODE  ENTRY POINT USED BY
*,*                                 #ENTRY#SPACE PROC
         REF      #TIC#STACK        INPUT; USED BY #PUSH & #PULL PROCS
         REF      FOURWORDSFORMTIME  OUTPUT; USED BY M:TIME TO
*,*                                 STORE TIME
         DEF      LABORDEF          USED FOR PATCHING TICLABOR
         DO       DO#3270
         REF      #DEV#PLATEN#R#IW  INPUT; USED TO ACCESS ARRAY TABLE OF
*,*                                 MAX ROWS.
         REF      #DEV#PLATEN#C#IW  INPUT; USED TO ACCESS ARRAY TABLE OF
*,*                                 MAX COLS.
         REF      #DEV#TC#RETRY#IW  INPUT; USED TO ACCESS ARRAY TABLE
*,*  OF RETRY COUNTS FOR TC/BCC ERRORS FOR 3275 STATIONS.
         FIN
         REF      #DEV#MDL#RETRY#IW  INPUT; USED TO ACCESS ARRAY TABLE
*,*  OF RETRY COUNTS FOR MDL STATIONS
         REF      COCLINEERR        ENTRY POINT IN TICROOT USED AS
*,*  ERROR RETURN ADDRESS AFTER ATTEMPTING TO M:OPEN THE DCB FOR A
*,*  WOULD-BE TP LINE BEING SWITCHED FROM TIME SHARE
         REF      COCLINEABN        ENTRY POINT IN TICROOT USED AS
*,*  ABNORMAL RETURN ADDRESS AFTER ATTEMPTING TO M:OPEN THE DCB FOR A
*,*  WOULD-BE TP LINE BEING SWITCHED FROM TIME SHARE
         REF      HEXTABLE          INPUT; CONSTANT
         PAGE
*
*
*
*        REGISTER UTILIZATION BY THE TIC                                TIC00540
*                                                                       TIC00550
*        THE TIC-EXECUTIVE 'OWNS' THREE REGISTERS, NAMELY               TIC00560
*        REGISTERS ONE, TWO, AND THREE.  THEY ARE EQU'ED BELOW.         TIC00570
*                                                                       TIC00580
*        TIC-TASKS SHOULD NOT USE THESE REGISTERS.                      TIC00590
*                                                                       TIC00600
*        REGISTER '#DEV' CONTAINS THE LOGICAL DEVICE NUMBER             TIC00610
*        THAT THE TIC-TASK IS WORKING ON.  SEVERAL PROCEDURES           TIC00620
*        (E.G. #T#GET) ASSUME THAT IT IS CORRECT!                       TIC00630
*                                                                       TIC00640
#DEV     EQU       1                                                    TIC00650
#ERR     EQU       2                   HOLDS STATUS ON #CHECK RETURN    TIC00660
#ARG     EQU       2                   ARGUMENT TO PROC REGISTER        TIC00670
#BAL     EQU       3                   REGISTER WE BAL ON INTO TIC EXEC TIC00680
#OWN     EQU       4                   REG THAT POINTS TO SUB LOCAL STORTIC00690
         PAGE
*
*
*
*        TIC TABLE NAMES ARE DEFINED WITH LISTS FOR                     TIC00710
*        FLEXIBLIITY.  FOR NOW, THE LIST CONSISTS OF THE                TIC00720
*        ADDRESS OF THE INDIRECT WORD THAT POINTS TO THE                TIC00730
*        TABLE AND THE LENGTH OF A TABLE ENTRY IN BYTES.                TIC00740
*                                                                       TIC00750
#DEV#RECORD#BA SET #DEV#RECORD#BA#IW,4                                  TIC00760
#DEV#RECORD#LENGTH SET #DEV#RECORD#LENGTH#IW,4                          TIC00780
#DEV#RECORD#STATUS SET #DEV#RECORD#STATUS#IW,4                          TIC00800
*                                                                       TIC00830
#DEV#DCB#POINTER SET #DEV#DCB#POINTER#IW,2                              TIC00840
#DEV#CURRENT#IO SET #DEV#CURRENT#IO#IW,1                                TIC00850
#DEV#INPUT#TRL SET #DEV#INPUT#TRL#IW,2                                  TIC00860
#DEV#OUTPUT#TRL SET #DEV#OUTPUT#TRL#IW,2                                TIC00870
#DEV#MDL#RETRY SET #DEV#MDL#RETRY#IW,1
*                                                                       TIC00880
#MDL#WAKEUP#ECB              SET       #MDL#WAKEUP#ECB#IW,8             TIC00890
         DO        DO#FIXEDMDLBUFFERS
#MDL#FIXED#BUFFERS SET #MDL#FIXED#BUFFERS#IW,4
         FIN
*                                                                       TIC00910
#DEV#COMMAND#LINE#RECORD#BA SET #DEV#COMMAND#LINE#RECORD#BA#IW,4        TIC00920
#DEV#COMMAND#LINE#RECORD#LENGTH SET #DEV#COMMAND#LINE#RECORD#LENGTH#IW,2TIC00930
*                                                                       TIC00940
#DEV#LINE#IDENTIFIER         SET       #DEV#LINE#IDENTIFIER#IW,4        TIC00950
#DEV#MULTIPOINT#INDEX        SET       #DEV#MULTIPOINT#INDEX#IW,1       TIC00960
*
#DEV#LINE#STATUS#BITS        SET       #DEV#LINE#STATUS#BITS#IW,2
#LINE#SWITCHABLE EQU 1024
#LINE#SWITCH#DONT EQU 2048
*
#DEV#REGULATION    SET #DEV#REGULATION#IW,1                             TIC00980
*
#DEV#TYPE#INDEX    SET       #DEV#TYPE#INDEX#IW,1
*                                                                       TIC00990
#DEV#STATION#TYPE SET #DEV#STATION#TYPE#IW,2                            TIC01000
*                                                                       TIC01010
         DO       DO#3270
#DEV#PLATEN#R  SET  #DEV#PLATEN#R#IW,1
#DEV#PLATEN#C  SET  #DEV#PLATEN#C#IW,1
#DEV#TC#RETRY  SET #DEV#TC#RETRY#IW,1
         FIN
         DO        HOWMANYXMITSBREAK>1
#DEV#XMIT#COUNT    SET       #DEV#XMIT#COUNT#IW,1
         FIN
*
#DEV#ECB SET        #DEV#ECB#IW,8                                       TIC01020
*                                                                       TIC01021
*                                                                       TIC01022
*                                                                       TIC01023
#DCB#TABLE                   SET       #DCB#TABLE#IW,4                  TIC01024
*                                                                       TIC01030
*                                                                       TIC01040
*                                                                       TIC01050
#DEV#LOGON#BLOCK SET #DEV#LOGON#BLOCK#IW,4,0                            TIC01060
*                                                                       TIC01070
*        THE FOLLOWING FIELDS ARE IN THE BLOCK                          TIC01080
*        POINTED TO BY THE ABOVE.                                       TIC01090
*                                                                       TIC01100
#DEV#GET#LIST#LENGTH SET #DEV#LOGON#BLOCK#IW,4,3,4                      TIC01110
#DEV#DMODE         SET #DEV#LOGON#BLOCK#IW,4,0,1                        TIC01120
#DEV#USING#TFD     SET #DEV#LOGON#BLOCK#IW,4,1,4                        TIC01130
#DEV#DOING         SET #DEV#LOGON#BLOCK#IW,4,1,1                        TIC01140
#DEV#GET#LIST#ID   SET #DEV#LOGON#BLOCK#IW,4,1,2                        TIC01150
#DEV#DOLLARS#LAL   SET #DEV#LOGON#BLOCK#IW,4,4,4                        TIC01160
#DEV#QUESTIONS#LAL SET #DEV#LOGON#BLOCK#IW,4,5,4                        TIC01170
#DEV#AT#NAME#LAL     SET #DEV#LOGON#BLOCK#IW,4,6,4                      TIC01180
#DEV#CRUNCH#NAME#LALS SET #DEV#LOGON#BLOCK#IW,4,7,4                     TIC01190
         PAGE                                                           TIC35520
*                                                                       TIC35530
*        DEFINE PRIM NUMBERS FOR THE VARIOUS PRIMITIVES.                TIC35540
*                                                                       TIC35550
UPJ      CNAME                                                          TIC35560
         PROC                                                           TIC35570
I        DO        NUM(AF)                                              TIC35580
AF(I)    SET       J                                                    TIC35590
J        SET       J+1                                                  TIC35600
         FIN                                                            TIC35610
         PEND                                                           TIC35620
*                                                                       TIC35630
J        SET       1                                                    TIC35640
*                                                                       TIC35650
         UPJ       TFDZ,TFDA,TFDB,TFDC,TFDD,TFDE                        TIC35660
         UPJ       TFDF,TFDG,TFDI,TFDJ,TFDK,TFDL                        TIC35670
         UPJ       TFDM,TFDP,TFD@,TFD#,TFDX,TFDY                        TIC35680
         TITLE    'TIC - TICLABOR'
*        IN CONNEXION WITH #ENTRY#SPACE AND #EXIT#SPACE, A ROUTINE
*        MAY WISH TO RETURN A RESULT IN A REGISTER.  TO DO SO IT
*        NEEDS TO KNOW WHERE THE REGISTERS HAVE BEEN STORED:
*
RETURNR5 SET      -16+5,#OWN
RETURNR6 SET      -16+6,#OWN
RETURNR7 SET      -16+7,#OWN
RETURNR8 SET      -16+8,#OWN
RETURNR9 SET      -16+9,#OWN
RETURNR10 SET     -16+10,#OWN
RETURNR11 SET     -16+11,#OWN
RETURNR12 SET     -16+12,#OWN
RETURNR13 SET     -16+13,#OWN
RETURNR14 SET     -16+14,#OWN
RETURNR15 SET     -16+15,#OWN
*                                                                       TIC20820
         PAGE
LABORDEF CSECT    1
*                                                                       TIC21050
#MDLADR    RES     0                                                    TIC21060
*
         LI,#ARG   #NET#ECB            AVOID POLL LOOP IF NET OFF
         #WAIT#ON                       BY WAITING RIGHT HERE.
*                                                                       TIC21070
         LI,4      MDLTASKWOKENUP      SET TO WAKE US UP                TIC21090
         #T#GWA,5  #MDL#WAKEUP#ECB      SO WE CAN EXIT THE              TIC21100
         #GO#TO#ON                       READ/POLL LOOP                 TIC21110
         #CLEAR#WORD 0,5                                                TIC21120
*                                                                       TIC21130
MDLTASKPOLLEDREAD RES 0
         #INITIATE#READ                DO THE POLLED READ               TIC21140
         #CHECK#READ  MDLTASKREADERROR
*                                                                       TIC21170
*        NOTE THAT THE READ ENDED EITHER BECAUSE IT                     TIC21180
*        WAS 'SATISFIED' BY A STATION OR BECAUSE WE STOPPED             TIC21190
*        THE READING POLL AT THE END OF THE LIST.  FI IT                TIC21200
*        WAS THE LATTER, WE TOOK THE ERROR EXIT FROM THE                TIC21210
*       #CHECK.                                                         TIC21220
*                                                                       TIC21230
         LB,10     #BAL                RECOVER THE 'IND' OF THE READ    TIC21240
*                                                                       TIC21250
         LW,5      #DEV                SAY US IS US TO SUBROUTINE.
         BAL,15    MDLFINDINDGUY       AND STATION'S #DEV TO R4.
         LI,11    0
         #T#PUT,11,4  #DEV#MDL#RETRY  RESET RETRY CNT AFTER GOOD I/O.
*                                                                       TIC21400
MDLTASKFOUNDREAD RES 0                                                  TIC21410
         #T#GET,11,4 #DEV#CURRENT#IO   SEE WHAT STATION'S TASK DOING    TIC21420
         CI,11     #CIO#REQD+#CIO#READ IS IT DOING A READ?              TIC21430
         BE        MDLTASKOKREAD       OVER IF SO.
*
*        FALL THROUGH ON AN UNEXPECTED TRANSMISSION.
*
         #FREE#DEV#BUFFER
*
         DO        HOWMANYXMITSBREAK>1 IF WE ARE COUNTING,
         #T#GET,8,4 #DEV#XMIT#COUNT     CURRENT COUNT
         AI,8      1                     PLUS ONE.
         CI,8      HOWMANYXMITSBREAK   ARE WE AT LIMIT.
         BGE       MDLTASKBREAK3410    GO BREAK IF SO.
         #T#PUT,8,4 #DEV#XMIT#COUNT    OR CONTINUE COUNTING.
         B         MDLTASKSEEIFWRITE
         FIN
*
MDLTASKBREAK3410 RES 0
         SIGNALATTENTION,4             INDICATE ATTN FROM STATION.
*
         DO        HOWMANYXMITSBREAK>1
         LI,8      0                   ON A BREAK,
         #T#PUT,8,4 #DEV#XMIT#COUNT     CLEAR COUNT.
         FIN
*
         B         MDLTASKSEEIFWRITE   AND WE'RE DONE WITH THIS READ.
*                                                                       TIC21450
*        HERE TO COPY OUR MDL READ INTO THE READ OF THE TIC-TASK        TIC21460
*                                                                       TIC21470
MDLTASKOKREAD RES  0
         DO        HOWMANYXMITSBREAK>1
         LI,8      0                   ON GOOD READ, CLEAR
         #T#PUT,8,4 #DEV#XMIT#COUNT     THE XMIT/BREAK COUNT.
         FIN
*
MDLTASKREADCOPY RES 0
         #T#GET,8  #DEV#RECORD#LENGTH  GET HOW MANY BYTES READ.
         DO        DO#FIXEDMDLBUFFERS
         ELSE
         CI,8      255                 SEE IF LOTS.
         BG        MDLTASKBUFFERSWAP   OVER IF LOTS AND IF NOT IN
*                                       A PERMANENT MDL BUFFER.
         FIN
*                                                                       TIC21510
*        HERE ON 'FIXEDMDLBUFFERS' OR ON A SMALL NUMBER OF
*        BYTES READ.  IN EITHER CASE, WE GET A NEW BUFFER,
*        MOVE THE BYTES, AND THEN (IF NOT PERMANENT) FREE
*        THE OLD BUFFER.
*                                                                       TIC21550
         LW,#ARG   8                   COPY BYTE COUNT
         #GET#MAIN#BYTES                   AND GET THAT MANY            TIC21570
        #T#PUT,#ARG,4 #DEV#RECORD#BA  STORE ADDRESS OF DEV-TASK'S BUFFE TIC21580
         #T#PUT,8,4 #DEV#RECORD#LENGTH STORE DEV-TASK LENGTH TOO.
         LW,7      #ARG                DESTINATION OF MBS.
         #T#GET,6  #DEV#RECORD#BA      SOURCE OF MBS.
*                                      (COUNT STILL IN R8)
         MBS678                        DO THE MOVE.
*                                                                       TIC21650
         #FREE#DEV#BUFFER              FREE OUR (BIG) BUFFER            TIC21660
         B         MDLTASKSETREADDONE                                   TIC21670
*                                                                       TIC21680
         DO        DO#FIXEDMDLBUFFERS  (NEVER SWAP A FIXED MDL BUFFER --
         ELSE                           SO BELOW CODE NOT NECESSARY)
MDLTASKBUFFERSWAP RES 0                                                 TIC21690
         LI,10     0                   ZERO AND                         TIC21700
         #T#XCA,10 #DEV#RECORD#BA      COPY BUFFER ADDRESS              TIC21710
         #T#PUT,10,4 #DEV#RECORD#BA    TO THE TEV-TASK                  TIC21720
*                                                                       TIC21730
         #T#GET,10 #DEV#RECORD#LENGTH  COPY RECORD LENGTH               TIC21740
         #T#PUT,10,4 #DEV#RECORD#LENGTH TO DEV-TASK                     TIC21750
         FIN
*                                                                       TIC21760
MDLTASKSETREADDONE RES 0                                                TIC21770
         LI,8      #CIO#COMP+#CIO#READ SET THE READ TO COMPLETE         TIC21780
         #T#PUT,8,4 #DEV#CURRENT#IO    IN THE DEV-TASK'S TABLE ENTRY    TIC21790
*                                                                       TIC21800
         #T#POST,8,4 #DEV#ECB          POST DEV-TASK'S EVENT.
*                                                                       TIC21830
*        AND FALL THROUGH TO DO ANY WRITES.
*                                                                       TIC21850
MDLTASKENDOFLIST RES 0                                                  TIC21860
MDLTASKSEEIFWRITE RES 0                                                 TIC21910
*                                                                       TIC21920
         LW,4      #BIGGEST#TIC#TASK                                    TIC21930
MDLTASKLOOKWRITE RES 0                                                  TIC21940
         #T#GET,8,4 #DEV#DCB#POINTER   GET TASK'S DCB POINTER-POINTER.
         CW,8      #DEV                IS IT THE SAME AS OURS.
         BNE       MDLTASKBDR3003      IF NOT, DON'T LOOK AT HIM.
*
         #T#GET,8,4 #DEV#CURRENT#IO    GET DEV-TASKS STATUS             TIC21950
         CI,8      #CIO#REQD           IS HE REQUESTING?                TIC21960
         BAZ       MDLTASKBDR3003       NO, TRY ANOTHER TIC-TASK        TIC21970
         CI,8      #CIO#WRITE          IS HE REQUESTING A WRITE?        TIC21980
         BANZ      MDLTASKDOAWRITE      YES, GO DO WRITE.
*
*        FALL THROUGH ON DEV-TASK REQUESTING, BUT
*        NOT REQUESTING A WRITE.
*        MUST BE REQUESTING A READ.
*
         MTW,0     #X#ED               SEE IF WE HAVE BEEN 'X NOW'ED.
         BGEZ      MDLTASKBDR3003      IF NOT, DO NUTTIN ON READS.
*
         LI,8      X'3FF'              WHEN 'X NOW'ED, ZAP ANY READ
         #T#PUT,8,4 #DEV#RECORD#STATUS  REQUESTS THAT WE HAPPEN UPON.
         B         MDLTASKSETREADDONE    (WE WILL ZAP 'EM ALL, THOUGH
*                                         INTERSPERSED WITH DOING WRITES
*                                                                       TIC22070
MDLTASKBDR3003 BDR,4 MDLTASKLOOKWRITE                                   TIC22080
*                                                                       TIC22090
         B         MDLTASKPOLLEDREAD   NO WRITING TO DO.
*                                                                       TIC22110
MDLTASKDOAWRITE RES 0                                                   TIC22120
*        SINCE MESSAGE NODE I/O DAMAGES THE MESSAGE,                    TIC22130
*        WE MUST COPY IF IF THE CALLER OF #INITIATE DIDN'T              TIC22140
*        ASK THAT IT BE FREED:                                          TIC22150
*                                                                       TIC22160
         #T#GET,8,4 #DEV#RECORD#BA     GET RECORD ADDRESS               TIC22170
*
*        ALSO, MESSAGE MODE I/O USES A BUFFER
*        LARGER THAN THE DATA.  SO WE MUST
*        COPY IN ANY CASE.
*                                                                       TIC22250
MDLTASKWRITECOPY RES 0                                                  TIC22260
         #T#GET,11,4 #DEV#RECORD#LENGTH                                 TIC22270
*                                                                       TIC22280
         DO        DO#FIXEDMDLBUFFERS
         #T#GET,9  #MDL#FIXED#BUFFERS  GET BA OF FIXED MDL BUFFER.
         ELSE
*        ALGORITHM HERE TO PUT INTO R12 THE EXTRA                       TIC22290
*        BUFFER LENGTH REQUIRED FOR THE                                 TIC22300
*        MESSAGE WHOSE LENGTH IS IN R11:                                TIC22310
*                                                                       TIC22320
         LI,12     8                                                    TIC22330
*                                                                       TIC22340
         LW,#ARG   11                  LENGTH OF MESSAGE                TIC22350
         AW,#ARG   12                   PLUS THE EXTRA                  TIC22360
         #GET#MAIN#BYTES                 GO GET IT                      TIC22370
*                                                                       TIC22380
         LW,9      #ARG                COPY MDL BUFFER ADDRESS          TIC22390
         FIN
*
         #T#PUT,9  #DEV#RECORD#BA       AND SAVE WHILE WE'RE AT IT      TIC22400
         #T#PUT,11 #DEV#RECORD#LENGTH    RECORD LENGTH TOO              TIC22410
*                                                                       TIC22440
*        HERE WE MUST MOVE C(R11) BYTES FROM THE                        TIC22450
*        DEV-TASK'S BUFFER (BA IN R8) TO OUR MDL-TASK'S                 TIC22460
*        BUFFER (BA IN R9):                                             TIC22470
*                                                                       TIC22480
         CI,11     255                 SEE IF SMALL NUMBER OF BYTES     TIC22490
         BLE       MDLTASKWRITECOPYLAST ALMOST DONE IF SO               TIC22500
*                                                                       TIC22510
         OR,9      =X'FF000000'        OR IN A 255 COUNT                TIC22520
         MBS,8     0                   MOVE THAT MANY                   TIC22530
        AI,11     -255                DECREMENT THE COUNT               TIC22540
        B         %-5                 AND BACK                          TIC22550
*                                                                       TIC22560
MDLTASKWRITECOPYLAST RES 0                                              TIC22570
         STB,11    9                   STORE LAST COUNT                 TIC22580
         MBS,8     0                   AND MOVE LAST BYTES              TIC22590
*                                                                       TIC22600
*        AT EXECUTION TIME, THE #DEV#LINE#IDENTIFIER                    TIC22610
*        FOR A STATION THAT IS ON A MULTI-POINT LINE                    TIC22620
*        CONTAINS THE STATION'S 'INDX' VALUE.                           TIC22630
*                                                                       TIC22640
*        SET UP FOR THE WRITE:                                          TIC22650
*                                                                       TIC22660
         #T#GET,8,4 #DEV#MULTIPOINT#INDEX GET STATION'S M:LIST INDEX    TIC22670
*                                                                       TIC22680
         #T#GET,5  #DEV#DCB#POINTER    GET POINTER TO MDL'S DCB ADDRESS.TIC22690
         LW,5      *#DCB#TABLE#IW,5    GET THE MDL'S DCB ADDRESS.       TIC22700
*                                                                       TIC22710
         M:MDFLST  *5,(INDX,8),(SEL)   POINT THE LIST TO THE STATION.
*                                                                       TIC22730
*                                                                       TIC22740
         #INITIATE#WRITE                                                TIC22750
         #WAIT#ON#DEVICE                                                TIC22760
        #CHECK#WRITE MDLTASKWRITEERROR                                  TIC22770
         LI,11    0                 R4 STILL CONTAINS #DEV OF THE STN.
         #T#PUT,11,4  #DEV#MDL#RETRY  RESET RETRY CNTRS FOR THIS STN.
         DO       DO#3270
         #T#PUT,11,4  #DEV#TC#RETRY   IN CASE STATION IS 3275.
         FIN
*                                                                       TIC22780
         LI,#ARG   0                                                    TIC22790
         #T#XCA,#ARG,4 #DEV#RECORD#BA  RECOVER TEV-TASK BA              TIC22800
         #FREE#MAIN#BYTES#IF           AND FREE IF DYNAMIC SPACE.
*                                                                       TIC22820
MDLTASK4704 RES    0
        #T#GET,8,4 #DEV#CURRENT#IO    RETRIEVE TYPE OF I/O              TIC22830
         CI,8      #CIO#READ           SEE IF IT WAS WRITE-THEN-READ    TIC22840
         BAZ       MDLTASKWRITEDONE      OVER IF NOT.
*                                                                       TIC22860
         LI,8      #CIO#REQD+#CIO#READ WAS WRITE-THEN-READ SO NOW HE    TIC22870
         #T#PUT,8,4 #DEV#CURRENT#IO    NEEDS A READ DONE FOR HIM        TIC22880
         B         MDLTASKSEEIFWRITE
*                                                                       TIC22900
MDLTASKWRITEDONE RES 0                                                  TIC22910
         LI,8      #CIO#COMP+#CIO#WRITE INDICATE THE WRITE              TIC22920
         #T#PUT,8,4 #DEV#CURRENT#IO     IS COMPLETED                    TIC22930
*                                                                       TIC22940
         #T#POST,8,4 #DEV#ECB            TO THE DEV-TASK.
         B         MDLTASKSEEIFWRITE
         PAGE
*
*
*                                                                       TIC22980
MDLTASKWOKENUP RES 0                                                    TIC23010
         #T#GET,4  #DEV#DCB#POINTER    GET POINTER TO POINTER           TIC23020
         LW,5      *#DCB#TABLE#IW,4    GET POINTER TO MY DCB            TIC23030
         M:MDFLST  *5,(HALT)           END ON-GOING POLLING.
*
         LI,4      MDLTASKWOKENUP      RE-ESTABLISH
         #T#GWA,5  #MDL#WAKEUP#ECB      THE WAKE-UP
         #CLEAR#WORD 0,5                 EVENT TO
         #GO#TO#ON                        COME HERE.
*
         #EXIT                         AND EXIT                         TIC23050
         PAGE
*
*
*                                                                       TIC23060
MDLTASKREADERROR RES 0                                                  TIC23070
         LB,10     #BAL                ON READ ERROR, ESTABLISH
         LW,5      #DEV                 IN R4 WHO THE BAD
         BAL,15    MDLFINDINDGUY         STATION IS.
*
         LI,11     0                   AND SET 'READ' FLAG.
MDLTASKWRITEERROR RES 0
         LI,11    1                 SET FLAG FOR WRITE ERROR.
MDLTASK9100  RES  0
         LW,9      #ARG                COPY ERR/ABN CODE/SUBCODE.
*
         DO        DO#3270
         #T#GET,#ARG #DEV#RECORD#BA    IF WE HAVE 3270'S,
         SLS,#ARG  -2                   OBTAIN POSSIBLE STATUS
         LW,12     1,#ARG                BYTES FROM BUFFER.
         FIN
*
         CI,11    0
         BNE      %+2               BRANCH IF WRITE, OTHERWISE
         #FREE#DEV#BUFFER              GIVE UP BUFFER SPACE.
*
         CI,9      X'5906'             IS IT HALTED POLLED READ.
         BNE       MDLTASK9121         OVER IF NOT.
*
         #T#GET,9  #DEV#LINE#STATUS#BITS GET LINE STATUS.
         CI,9      #LINE#REESTABLISH     SEE IF WE SHOULD RE-DEFINE IT.
         BAZ       MDLTASKENDOFLIST      NUTTIN TO DO HERE IF NOT.
         AND,9     =(-#LINE#REESTABLISH-1)
         #T#PUT,9  #DEV#LINE#STATUS#BITS
*
*
*
MDLREESTABLISH RES 0
         LI,10    0                 COUNT OF ACQUIRED STATIONS.
         LW,5      #BIGGEST#TIC#TASK   SCAN ALL TASKS,
MDLREEST2200 RES   0                    LOOKING FOR ONES ON THIS LINE.
         #T#GET,7,5 #DEV#DCB#POINTER
         CW,7      #DEV
         BNE       MDLREEST2900
*
*        FALL THROUGH ON FOUND STATION ON THIS LINE.
*
         #T#GET,9,5 #DEV#LINE#STATUS#BITS GET BITS TO SEE IF
         CI,9      #LINE#UNACQUIRED       UNACQUIRED OR ACQUIRED.
         BANZ      MDLREEST2500
*
MDLREEST2400 RES   0                   HERE ON IT IS ACQUIRED.
         AI,10    1
         LW,8      *#DCB#TABLE#IW,7
         #T#GET,9,5 #DEV#MULTIPOINT#INDEX
         M:MDFLST  *8,(INCL,9),(PSL)
         B         MDLREEST2900
*
MDLREEST2500 RES   0                   HERE ON IT IS UNACQUIRED.
         LW,8      *#DCB#TABLE#IW,7
         #T#GET,9,5 #DEV#MULTIPOINT#INDEX
         M:MDFLST  *8,(EXCL,9),(PSL)
*
MDLREEST2900 RES   0
         BDR,5     MDLREEST2200
*
         AI,10    0                 SEE IF ANY ACQUIRED STATIONS.
         BLEZ     MDLREEST3000
         B         MDLTASKENDOFLIST
*
MDLREEST3000  RES  0
         LW,8      *#DCB#TABLE#IW,#DEV NO ACQUIRED STATIONS NOW, SO
         M:SETDCB  *8,(ERR,MDLREEST6200),(ABN,MDLREEST6200) KILL LINE:
         M:CLOSE   *8
MDLREEST6200 #T#GWA,9 #DEV#LINE#IDENTIFIER
         M:RLSLINE *9
*
         #T#GET,9  #DEV#LINE#STATUS#BITS
         OR,9       =(#LINE#UNACQUIRED)
         #T#PUT,9  #DEV#LINE#STATUS#BITS
*
         B         MDLTASK9185         LINE DEAD.  SO GO WAIT.
         PAGE
*
*
*
MDLTASK9121 RES    0
         CI,9      X'590C'             IS IT CLERK HIT XMIT DURING WRITE
         BE        MDLTASKPOLLEDREAD   IF SO, TRY TO READ.
*
         DO        DO#3270
         CI,9      X'3270'             IF 'RETURNED STATUS'
         BNE       MDLTASK9138          BY 3270 AND IF
         CW,12     =X'000D3F00'          STATUS NOT REALLY BAD
         BAZ       MDLTASKENDOFLIST       THEN PROCEED NORMALLY.
         CI,12    X'10000'          TEST FOR TC/BCC FOR 3275'S
         BAZ      MDLTASK9130
*  WE HAVE A 3275 TRANSMISSION CHECK ERROR.  ALLOW 5 OCCURRENCES
*  BEFORE FREEING STATION.
         #T#GET,8,4 #DEV#MDL#RETRY
         CI,8     2                 HAVE WE RETRIED MAX. NO. ALLOWED?
         BGE      MDLTASK9146       YES. DROP STN FROM POL/SEL LIST.
         AI,8     1                 NO. INCREMENT COUNT OF RETRIES.
         #T#PUT,8,4 #DEV#MDL#RETRY
         B        MDLTASKENDOFLIST
MDLTASK9130 RES 0
         CI,12    X'3000' IF CMND REJECT OR INTERVENTION REQUIRED
         BANZ     MDLTASK9146       DROP THE STATION.
         CI,12    X'C0E00'  IF DEVICE BUSY, UNIT SPECIFY, EQUIP. CK,
         BANZ     MDLTASK9140       DATA CK, OR CONTROL CK, RETRY.
         LW,8     12
         AND,8    =X'C1700'
         CI,8     X'100'
         BE       MDLTASK9146       IF OPERATION CK IS SET ALONE,
         B        MDLTASKENDOFLIST    DROP THE STATION.
         FIN
*
MDLTASK9138 RES    0
         CI,9      X'01FF'             SEE IF FREED.
         BE        MDLTASK9185         NO MESSAGE IF SO.
*  CHECK FOR ERROR CODES X'5905' THRU X'5910'.  IF ONE OF THOSE, RETRY
*  UNTIL COUNT IS EXHAUSTED BEFORE FREEING STATION.  IF NOT X'5905' THRU
*  X'5910', DROP STATION.
         CI,9     X'5905'
         BL       MDLTASK9148       TIC ERROR.  DROP STN FROM
         CI,9     X'5910'             POLLING/SELECTION LIST.
         BG       MDLTASK9148       TIC ERROR.
*  ALLOW OUR OWN NUMBER OF RETRIES (3) BEFORE GIVING UP ON THIS STATION..
MDLTASK9140 RES 0
         #T#GET,8,4  #DEV#MDL#RETRY  R4 NOW HAS #DEV OF THE STATION.
         CI,8     2                 HAVE WE RETRIED MAX NO. ALLOWED?
         BGE      MDLTASK9148       YES, DROP STN FROM POL/SEL LIST.
         AI,8     1                 NO. INCREMENT RETRY COUNT.
         #T#PUT,8,4  #DEV#MDL#RETRY
         B        MDLTASKENDOFLIST
*  STATION REPORTING A X'3270' CODE IS ABOUT TO BE DROPPED.
MDLTASK9146  RES  0
         CI,11    1                 IF WRITE ERROR,
         BNE      %+2               GIVE UP BUFFER SPACE NOW.
         #FREE#DEV#BUFFER
         LW,8     12                FIRST, PRINT OC MESSAGE.
         AND,8    =X'FFFF00'        STATUS BYTES
*O*  MESSAGE:     'STATUS & CODE: 00XXXX00 YYYYYYYY'
*O*  ACTION:      CHECK STATUS OF SPECIFIED STATION.
*O*  MEANING:     I/O ERROR OCCURRED ON 3270 OR 3275 STATON ON MULTI-
*O*      DROP LINE.  XXXX=3270 STATUS BYTES;  YYYYYYYY=I/O ERROR CODE.
         #TYPE89  'STATUS & CODE: '
         B        MDLTASK9150
MDLTASK9148  RES  0
         CI,11    1                 IF WRITE ERROR,
         BNE      %+2               GIVE UP BUFFER SPACE NOW.
         #FREE#DEV#BUFFER
         LW,8     =X'40404040'      PRINT OC MSG FOR NON-'3270' CODE
         XW,8     9
*O*  MESSAGE:     'ERROR CODE: YYYYYYYY'
*O*  ACTION:      CHECK STATUS OF SPECIFIED STATION.
*O*  MEANING:     I/O ERROR CORRESPONDING TO CODE GIVEN OCCURRED
*O*               ON STATION ON MULTI-DROP LINE.
         #TYPE89  'ERROR CODE: '
*  EITHER  (1)ERROR IS OF NATURE THAT STATION SHOULD BE DROPPED
*  IMMEDIATELY, OR  (2)OUR RETRY COUNT FOR THIS STATION HAS BEEN
*  EXHAUSTED, SO THE STATION MUST BE DROPPED.  DETERMINE VIA
MDLTASK9150  RES  0
         #T#GET,8 #DEV#LINE#IDENTIFIER  GET LINE ID
         #T#GET,9,4 #DEV#LINE#IDENTIFIER  AND DEVICE ADDRESS.
*O*  MESSAGE:     'FREEING STATION:     XXXX YYYYYYYY'
*O*  ACTION:      ATTEMPT TO REACQUIRE STATION.
*O*  MEANING:     STATION ON MULTI-DROP LINE HAS REPORTED
*O*               I/O ERROR, SO STATION IS BEING FREED.
         #TYPE89  'FREEING STATION: '  PRINT OC MESSAGE.
MDLTASK9158  RES  0
         #T#GET,9,4  #DEV#LINE#STATUS#BITS
         OR,9     =(#LINE#UNACQUIRED)
         #T#PUT,9,4  #DEV#LINE#STATUS#BITS
         #T#GET,9,4  #DEV#CURRENT#IO
         CI,9     #CIO#REQD
         BAZ       MDLTASK9166
         EOR,9    =(#CIO#COMP+#CIO#REQD)
         #T#PUT,9,4  #DEV#CURRENT#IO
         #T#POST,8,4  #DEV#ECB
         LI,8     X'5FF'            LOAD AN ERR/ABN.
         #T#PUT,8,4  #DEV#RECORD#STATUS
MDLTASK9166 RES    0
         B         MDLREESTABLISH
MDLTASK9185 RES    0
         #T#GET,10 #DEV#LINE#STATUS#BITS         SET A
         OR,10     =#LINE#AWAITING#ACQUIRE        BIT TO
         #T#PUT,10 #DEV#LINE#STATUS#BITS           WAIT FOR.
*
MDLTASK9200 RES    0
         MTW,0     #X#ED               IF WE HAVE BEEN X'ED,
         BNEZ      MDLTASKSEEIFWRITE    GO CLEAN UP.
*
         #CLEAR#ECB #TIMESUP#ECB       OR WAIT
         #WAIT#ON  #TIMESUP#ECB         FOR AWHILE.
*
         #T#GET,10 #DEV#LINE#STATUS#BITS
         CI,10     #LINE#AWAITING#ACQUIRE
         BANZ      MDLTASK9200
*
         BAL,15   MDLREESTABLISH
         PAGE
*
*
*
MDLFINDINDGUY RES  0
*
*        BAL'ED TO ON R15.
*        'IND' OF STATION IN R10.
*        R5 IS THE #DEV OF THIS MDL TASK.
*        RETURNS R4 AS #DEV OF THE STATION.
*        USES R8 AND R9.
*
         LW,4      #BIGGEST#TIC#TASK
MDLFIND2600 RES    0
         #T#GET,8,4 #DEV#DCB#POINTER
         CW,8      5
         BNE       MDLFIND2700         OVER WHEN WRONG MDL TASK MATCH.
         #T#GET,9,4 #DEV#MULTIPOINT#INDEX
         CW,9      10
         BE        *15                 OUT WHEN MATCH ON MDL AND 'IND'.
MDLFIND2700 BDR,4  MDLFIND2600
         B         -1                  DISASTER IF NO MATCH.
         PAGE                                                           TIC23140
#BEGIN     RES     0                                                    TIC23150
*
*
*
*        HERE WHEN COMPLETELY DONE WITH THE
*        'INITIALIZATION' SECTION OF CODE.
         DO        DO#FIXEDMDLBUFFERS
         LW,#DEV   #BIGGEST#MDL#TASK   IF FIXED BUFFERS, THEN
         BEZ       BEGIN6270           (OVER IF NO MDL-TASKS)
BEGIN6230 #T#GET,8 #DEV#OUTPUT#TRL      FOR EACK MDL TASK,
         #T#GET,#ARG #DEV#INPUT#TRL      GET A BUFFER.
         CW,#ARG   8
         BGE       %+2                 (AS BIG AS INPUT BUFFER
         LW,#ARG   8                    OR OUTPUT BUFFER AS NECESSARY)
         #GET#MAIN#BYTES
         AND,#ARG  =X'7FFFF'
         #T#PUT,#ARG #MDL#FIXED#BUFFERS
         BIR,#DEV  BEGIN6230
BEGIN6270 RES      0
         FIN
*
*                                                                       TIC23160
         LW,#DEV   #BIGGEST#TIC#TASK   INITIALIZE DEV-TASKS FOR STATIONSTIC23320
         LI,4      COMMANDLEVEL                                         TIC23330
         LI,5      0                   ZERO IS EVENT THATS HAPPENED     TIC23340
STARTLUP #GO#TO#ON                                                      TIC23350
         BDR,#DEV  STARTLUP                                             TIC23360
*                                                                       TIC23370
         LW,#DEV   #BIGGEST#MDL#TASK   START UP THE MDL-TASKS           TIC23380
         BEZ       BEGIN9000           (IF THERE ARE ANY)               TIC23390
         LI,4      #MDLADR             WHERE TO START.                  TIC23400
         LI,5      0                   0 HAS HAPPENED - GO RIGHT AWAY.  TIC23410
BEGIN7020 RES      0                                                    TIC23420
         #GO#TO#ON                                                      TIC23430
         BIR,#DEV  BEGIN7020                                            TIC23440
*                                                                       TIC23450
BEGIN9000 RES      0                                                    TIC23460
         #EXIT                                                          TIC23470
         TITLE     'TIC - DEV-TASK - COMMAND LEVEL'
PROMPTTTY GEN,32   X'030D156F'         TTY'S PROMPT.
PROMPT3270 GEN,32  X'0DF1C311'
         GEN,32    X'40401DC1'
         GEN,32    X'136F3C40'
         GEN,32    X'E7400000'
*                                                                       TIC25010
COMMANDLEVELSURVEY RES 0                                                TIC25020
COMMANDLEVELWAITFORATTENTION RES 0                                      TIC25030
         MTW,0     #X#ED               SEE IF XED BY OPERATOR.
         BNEZ      COMMANDLEVEL        #EXIT IF SO.
*
         #T#CLEAR  #DEV#ECB                                             TIC25040
*                                                                       TIC25050
         #T#GET,8  #DEV#LINE#STATUS#BITS                                TIC25060
         OR,8      =#LINE#AWAITING#ATTENTION                            TIC25070
         #T#PUT,8  #DEV#LINE#STATUS#BITS                                TIC25080
*                                                                       TIC25090
         #T#GWA,#ARG #DEV#ECB                                           TIC25100
         #WAIT#ON                                                       TIC25110
*                                                                       TIC25120
COMMANDLEVEL RES   0                                                    TIC25130
*                                                                       TIC25140
*        AT COMMAND LEVEL -- SEE IF OPERATOR 'X'.                       TIC25150
*                                                                       TIC25160
         MTW,0     #X#ED               SEE IF OPERATIR HAS 'X'ED.       TIC25170
         BEZ       COMMANDLEVELNOTXED  OVER IF NTO.                     TIC25180
*                                                                       TIC25190
COMMANDLEVELXED RES 0
         #SNAP,1   'XED'                                                TIC25200
         #EXIT                                                          TIC25210
*                                                                       TIC25220
COMMANDLEVELNOTXED RES 0                                                TIC25230
*                                                                       TIC25240
*        AT COMMAND LEVEL - SO CAN RESET ATTENTION FLAG:                TIC25250
*                                                                       TIC25260
         #T#GET,#ARG #DEV#LINE#STATUS#BITS                              TIC25270
         AND,#ARG  =(-#LINE#ATTENTION-1)                                TIC25280
         #T#PUT,#ARG #DEV#LINE#STATUS#BITS                              TIC25290
*                                                                       TIC25300
*        AT COMMAND LEVEL:  SEE IF NET OFF:                             TIC25310
*                                                                       TIC25320
         LI,#ARG   #NET#ECB            POINT TO NET ECB.                TIC25370
         #WAIT#ON                       AND WAIT FOR IT.                TIC25380
*                                                                       TIC25390
COMMANDLEVELNETISON RES 0                                               TIC25400
*                                                                       TIC25410
*        AT COMMANDLEVEL:  SEE IF REGULATED COMPLETELY OFF:             TIC25420
*                                                                       TIC25430
         #T#GET,#ARG #DEV#REGULATION                                    TIC25440
         AND,#ARG   =(#REGULATE#AT+#REGULATE#CRUNCH+#REGULATE#QUESTION) TIC25450
         CI,#ARG     (#REGULATE#AT+#REGULATE#CRUNCH+#REGULATE#QUESTION) TIC25460
         BE         COMMANDLEVELWAITFORATTENTION IF REGULATED DOWN      TIC25470
*                                      TO NOTHING, WE CAN'T DO ANYTHING.TIC25480
*                                                                       TIC25490
*                                                                       TIC25500
*        AT COMMAND LEVEL:  SEND ANY MESSAGES.                          TIC25510
COMMANDLEVELMESS200 RES 0                                               TIC25520
         LI,4      #MESSAGE#CHAIN      HEAD THE CHAIN OF MESSAGES.
COMMANDLEVELMESS222 RES 0                                               TIC25540
         LW,10     4                   REMEMBER PREVIOUS CHAIN ENTRY.
         LW,4      *4                  DOWN THE CHAIN.
         BEZ       COMMANDLEVELMESS900                                  TIC25570
*                                                                       TIC25580
*        WHEN HERE, HAVE POINTER TO POINTERS TO OUTSTANDING MESSAGE.    TIC25590
*                                                                       TIC25600
         LW,6      1,4                 GET DSP OF LIST OF STATIONS.
         SLS,6     -1                  CONVERT IT TO A HA.              TIC25620
COMMANDLEVELMESS255 RES 0                                               TIC25630
         LH,8      0,6                 GET A STATION NUMBER.            TIC25640
         BLZ       COMMANDLEVELMESS222 CONTINUE SCAN IF HIT FENCE.      TIC25650
         CW,8      #DEV                SEE IF FOR THIS STATION.         TIC25660
         BE        COMMANDLEVELMESS444 GO PRINT IF SO.                  TIC25670
*                                                                       TIC25680
         AI,6      1                   FOR SOME OTHER STATION.          TIC25690
         B         COMMANDLEVELMESS255 CONTINUE TO SEE IF THIS ONE TOO. TIC25700
*                                                                       TIC25710
COMMANDLEVELMESS444 RES 0              HERE ON FOUND MESSAGE TO PRINT.  TIC25720
         LI,9      0                   CLEAR STATION NUMBER             TIC25730
         STH,9     0,6                  SO WE WON'T PRINT AGAIN.        TIC25740
*                                                                       TIC25750
         BAL,13    ERRORBUFFERCREATE   OUTPUT
         LW,12     2,4                  THE
         BAL,14    ERRORBUFFERTEXTC      INDICATED
         BAL,13    ERRORBUFFERFLUSH       STRING.
*                                                                       TIC25790
*                                                                       TIC25800
*        SEE IF WE CAN FREE-UP THE MESSAGE SPACE.                       TIC25810
*        WE CAN IF THE LIST OF STATIONS CONTAINS NO STATIONS.           TIC25820
*                                                                       TIC25830
         LW,6      1,4                 RE-LOAD DSP OF STATION LIST.
         SLS,6     -1                  TO AN (UN-NEAT) HA.              TIC25850
COMMANDLEVELMESS500 RES 0                                               TIC25860
         LH,8      0,6                 GET A STATION NUMBER.            TIC25870
         BGZ       COMMANDLEVELMESS550 CAN'T FREE-UP IF A STATION IN LISTIC25880
         BLZ       COMMANDLEVELMESS540 CAN FREE-UP IF AT FENCE.         TIC25890
         AI,6      1                   IF WAS ZERO,                     TIC25900
         B         COMMANDLEVELMESS500 CONTINUE LOOKING.                TIC25910
*                                                                       TIC25920
COMMANDLEVELMESS540 RES 0              HERE TO FREE-UP.                 TIC25930
         LW,#ARG   2,4                 FREE SPACE
         OR,#ARG   =X'80000000'         THE STRING
         #FREE#MAIN#BYTES                IS IN.
*
         LW,8      *4                  GET FLINK TO NEXT GUY
         STW,8     *10                  AND POINT PREVIOUS TO HIM.
*
         LW,#ARG   1,4                 RE-LOAD DSP OF STATION LIST.
         #FREE#MAIN#BYTES              AND FREE THE SPACE.
*
         LW,#ARG   4                   AND THEN
         SLS,#ARG  2                    FREE THIS                       TIC26040
         OR,#ARG   =X'80000000'          THREE WORD                     TIC26050
         #FREE#MAIN#BYTES                 BLOCK.                        TIC26060
*                                                                       TIC26070
COMMANDLEVELMESS550 EQU COMMANDLEVELMESS200
*                                                                       TIC26140
         B         COMMANDLEVELMESS200                                  TIC26150
*                                                                       TIC26160
*                                                                       TIC26170
*                                                                       TIC26180
COMMANDLEVELMESS900 RES 0                                               TIC26190
*                                                                       TIC26200
*        AT COMMAND LEVEL                                               TIC26210
*                                                                       TIC26220
*        AT THIS POINT, WE MUST INSURE THAT THE                         TIC26230
*        STATION IS LOGGED ON.                                          TIC26240
*                                                                       TIC26250
         #T#GET,8  #DEV#LOGON#BLOCK    TEST TO SEE IF LOGGED ON.        TIC26260
         BNEZ      COMMANDLEVELISLOGGEDON OVER IF LOGGED ON.            TIC26270
*                                                                       TIC26280
         LI,6      BA(LOGONTEXT)       POINT TO A FAKE
         LI,7      BA(LOGONTEXT)+6      COMMAND LINE AND
         BAL,15    LOGON               LOG HIM ON.                      TIC26290
         B         COMMANDLEVEL                                         TIC26300
*
         BOUND     8
LOGONTEXT TEXT '!LOGON  '
*                                                                       TIC26310
COMMANDLEVELISLOGGEDON RES 0                                            TIC26320
*                                                                       TIC26323
         LI,10     0                   INDICATE NOT                     TIC26324
         #T#PUT,10 #DEV#DOING           DOING ANYTHING.                 TIC26325
*                                                                       TIC26330
*                                                                       TIC26340
*                                                                       TIC26350
*        AT COMMAND LEVEL:  SEE IF REGULATED.                           TIC26360
*                                                                       TIC26370
         #T#GET,#ARG #DEV#LINE#STATUS#BITS GET STATUS BITS.             TIC26380
         CI,#ARG   #LINE#REGULATED         SEE IF RECENT REGULATION.    TIC26390
         BAZ       COMMANDLEVELREGULATE900 OVER IF NOT.                 TIC26400
*                                                                       TIC26410
         AND,#ARG  =(-#LINE#REGULATED-1)   CLEAR REGULATED BIT.         TIC26420
         #T#PUT,#ARG #DEV#LINE#STATUS#BITS AND PUT BACK.                TIC26430
*                                                                       TIC26440
         BAL,15    PURGEANDDEFINELIST  NEW GET-LIST BASED ON (NEW) REGULTIC26450
*                                                                       TIC26460
COMMANDLEVELREGULATE900 RES 0                                           TIC26470
*                                                                       TIC26480
*        AT COMMAND LEVEL - SEE IF WE SHOULD                            TIC26490
*        DELIVER ANY REPORTS:                                           TIC26500
*                                                                       TIC26510
*        TO HANDLE 'DMODE ONE', WE TEST FOR IT                          TIC26520
*        HREE, BEFORE 'COMMANDLEVELTRYTODELIVER',                       TIC26530
*        AND FORCE A WAIT-FOR-REPORT IF 'DMODE ONE'.                    TIC26540
*        LIKEWISE FOR DMODE ONE.                                        TIC26550
*                                                                       TIC26560
*        (NOTE THAT, AFTER DELIVERING A REPORT, WE                      TIC26570
*        RETURN TO COMMANDLEVELTRYTODELIVER  .. TAAT IS                 TIC26580
*        TO A POINT PAST THIS TESTING)                                  TIC26590
*                                                                       TIC26600
         #T#GET,#ARG #DEV#DMODE        IF DMODE OUT,                    TIC26610
         CI,#ARG   DMODE@OUT+DMODE@ONE  OR ONE, WAIT.                   TIC26620
         BANZ      COMMANDLEVELWAITFORREPORT                            TIC26630
*                                                                       TIC26640
COMMANDLEVELTRYTODELIVER RES 0                                          TIC26650
         #T#GET,#ARG #DEV#DMODE        GET DMODE BITS.                  TIC26660
         CI,#ARG   DMODE@OUT+DMODE@ALT+DMODE@ONE SHOULD WE DELIVER?     TIC26670
         BAZ       COMMANDLEVELGETA    OVER ON DON'T DELIVER.           TIC26680
*                                                                       TIC26690
*        FALL THROUGHT TO DELIVER A REPORT.                             TIC26700
*                                                                       TIC26710
*                                                                       TIC26720
GETAREPORTFROMQUEUE RES 0                                               TIC27090
*                                                                       TIC27100
         #T#GET,7  #DEV#GET#LIST#ID    LIST ID.                         TIC27110
         #GET#MAIN#BYTES 2036          GET A BUFFER.
         LI,6      X'7FFFF'             SPACE FOR POSSIBLE              TIC27130
         AND,6     #ARG                  BXR FROM QUEUE.                TIC27140
         SLS,6     -2                  WA OF THE BUFFER.                TIC27150
         STW,#ARG  14                  REMEMBER BUFFER DSP IN R14.      TIC27160
*                                                                       TIC27170
         M:QUEUE   *7,GET,(BUF,*6),(BSIZE,2036/4) TRY FOR A REPORT.
*                                                                       TIC27190
         BCR,8     GETAREPORTFROMQUEUEGOT OVER IF GOT ONE               TIC27200
*                                                                       TIC27210
         #FREE#MAIN#BYTES              DID NOT GET - SO FREE BUFFER.    TIC27220
         B         COMMANDLEVELNOTHINGTODELIVER AND CONTINUE ON.        TIC27230
         PAGE                                                           TIC27240
*                                                                       TIC27250
GETAREPORTFROMQUEUEGOT RES 0                                            TIC27260
*                                                                       TIC27270
*        HERE WE COULD MOVE THE BXR TO A TIGHT-FITTING BUFFER           TIC27280
*        OR TRUNC THE BUFFER IT IS IN.                                  TIC27290
*
*        HAVE BA OF THE BXR (UN-NEAT) IN R14.
*
         DO        BYTESINSMALLBXR<2036
         LW,6      14                  BA OF BXR.
         SLS,6     -2                  WA OF BXR.
         LW,8      *6                  WORD ZERO OF BXR.
         AND,8     =X'FFFF'            BYTE COUNT OF BXR.
*
         CI,8      BYTESINSMALLBXR     COMPARE AGAINST ARBITRARY
*                                       VALUE TO SEE IF WE SHOULD
*                                        PROCESS IN BIG BUFFER
*                                         OR COPY TO TIGHT-FITTING
         BG        GOTAREPORT2350          BUFFER AND FREE BIG ONE.
*
*        FALL THROUGH TO COPY.
*
         LW,13     14                  COPY DSP OF OLD BUFFER.
         LW,#ARG   8                   GET AN EXACT
         #GET#MAIN#BYTES                BUFFER FIT.
         LW,6      14                  COPY TO
         LW,7      #ARG                 NEW BUFFER
         STW,7     14                    AND RE-ESTABLISH
         MBS678                           R14.
         LW,#ARG   13                  FREE UP OLD
         #FREE#MAIN#BYTES#IF            BUFFER
GOTAREPORT2350 RES 0
         FIN
*
*                                                                       TIC27300
*        GOT REPORT FROM SQM FOR DELIVERY.                              TIC27310
*        SINCE IT IS A REPORT, IT'S BXR IS TYPE 15 (HEX).               TIC27320
*                                                                       TIC27330
         LW,#ARG   14                  COPY (UN-NEAT) BA OF BXR.        TIC27340
         AI,#ARG   1                   POINT TO RECORD TYPE BYTE.       TIC27350
*                                                                       TIC27360
*        USED TO BE A TEST HERE TO INSURE TYPE WAS X'15'.               TIC27370
*        NOW WE FORCE IT TO X'15'.                                      TIC27380
*                                                                       TIC27390
         LI,10     X'15'                                                TIC27400
         STB,10    0,#ARG                                               TIC27410
*
*        ALSO, WORD FOUR OF THE BXR AS RETURNED
*        BY THE SQM DOES NOT CONTAIN THE TRANID.
*        SO WE BUILD THE WORD-FOUR-TRANID FROM THE FQM NAME.
*
*        #ARG POINTS TO BXR BYTE ONE.
*
         AI,#ARG   23-1                POINT TO NAME LENGTH.
         LB,10     0,#ARG              GET NAME LENGTH.
         AW,#ARG   10                  POINT TO LAST BYTE OF NAME.
*                                      (SINCE NAME FOLLOWS LENGTH BYTE)
         LI,10     8                   EIGHT BYTES IN EBCDIC ID
*
         LB,8      0,#ARG              CONVERT
         EOR,8     =X'F0'               EBCDIC
         CI,8      X'F0'                 TO HEX
         BAZ       %+2                    RIGHT
         AI,8      9-48                    TO LEFT.
         SLD,8     -4
         AI,#ARG   -1
         BDR,10    %-7
*
         LW,#ARG   14                  BA OF BXR.
         SLS,#ARG  -2                  WA OF BXR.
         STW,9     4,#ARG              TRANID --> BXR WORD FOUR.
*                                                                       TIC27440
GOTAREPORT RES     0                                                    TIC27450
*                                                                       TIC27452
         LI,10     #DOING#REPORT       INDICATE WE'RE                   TIC27453
         #T#PUT,10 #DEV#DOING           DELIVERING A REPORT.            TIC27454
*                                                                       TIC27460
*        BUILD OUTPUT TFD KEY IN REGISTERS 9,10, 11, 12, AND 13.        TIC27470
         LCI       5                   MOVE PROTOTYPE KEY               TIC27480
         LM,9      TFDOUTKEYPROTO       TO THE REGISTERS.               TIC27490
TFDOUTKEYPROTO EQU TFDINKEYPROTO                                        TIC27500
*                                                                       TIC27510
*                                                                       TIC27520
*                                                                       TIC27530
*        WE MUST REMMMBER WHERE THE FQM, ESPECIALLY THE FQM TEST,       TIC27540
*        IS FOR THE SCAMMING ROUNTNES.  SINCE WE DON'T ACQUIRE          TIC27550
*        '#ENTRY#SPACE' STORAGE UNTIL WE HAVE A TFD FOR                 TIC27560
*        THE REPORT, WE MUST REMEMBER WHERE THE FQM IS IN               TIC27570
*        A REGISTER.                                                    TIC27580
*                                                                       TIC27590
*        DSP OF BXR IS IN R14.                                          TIC27600
*        LEAVE IT THERE.                                                TIC27610
*                                                                       TIC27620
         LW,7      14                  COPY OF BXR DSP.                 TIC27630
         AI,7      4+4+4+4+4+4         BUMPED TO UN-NEAT BA OF NAME.    TIC27640
*                                                                       TIC27650
*        REGISTER 7 NOW POINTS TO THE NAME OF THE                       TIC27660
*        FQM THAT IS TO BE SENT.                                        TIC27670
*                                                                       TIC27680
*        FIRST MOVE THE FIRST CHARACTER OF THE FQM                      TIC27690
*        NAME TO THE FIRST CHARACTER POSITION OF THE                    TIC27700
*        KEY WE ARE BUILDING TO USE TO FIND A TFD:                      TIC27710
*                                                                       TIC27720
         LB,8      0,7                 GET FIRST CHARACTER              TIC27730
         STB,8     9                   STORE FIRST BYTE INTO R9 H.O.BYTETIC27740
*                                                                       TIC27750
*        WE USE THE SECOND FIELD FROM THE LEFT                          TIC27760
*        IN THE NAME AS PART OF THE TFD KEY.                            TIC27770
*                                                                       TIC27780
         LW,6      14                  BA OF BXR                        TIC27790
         AI,6      4+4+4+4+4+3         IN TO NAME LENGTH.               TIC27800
         LB,6      0,6                 GET NAME LENGTH.                 TIC27810
*                                                                       TIC27820
REPORTOUTKEY270 RES 0                                                   TIC27830
         LB,8      0,7                 GET A CHARACTER.                 TIC27840
         AI,7      1                   (AND BUMP SCAN)                  TIC27850
         CI,8      '.'                 IS IT A PERIOD?                  TIC27860
         BE        REPORTOUTKEY300     OVER IF SO.                      TIC27870
         BDR,6     REPORTOUTKEY270     LOOP IF NOT.                     TIC27880
*                                                                       TIC27890
*        WHEN HERE, HAS REPORT WITH ILLEGALLY CONSTRUCTED NAME.         TIC27900
         B         REPORTOUTKEYFAIL
*                                                                       TIC27920
REPORTOUTKEY300 RES 0                  HERE WITH R7 POINTING TO 2ND FIELTIC27930
*                                                                       TIC27940
         LI,5      4*9+1               POINT R5 TO WHERE TO PUT NAME PARTIC27950
*                                                                       TIC27960
REPORTOUTKEY320 RES 0                                                   TIC27970
         LB,8      0,7                 GET A CHARACTER.                 TIC27980
         CI,8      '.'                 IS IT A PERIOD?                  TIC27990
         BE        REPORTOUTKEY400     DONE IF SO.                      TIC28000
         CI,5      4*9+13              SEE IF KEY FULL.
         BGE       %+2                 NO STORE IF IT IS.
         STB,8     0,5                 STORE INTO KEY IF NOT.           TIC28010
         AI,7      1                   BUMP POINTER TO CLERK'S TRANCODE.TIC28020
         AI,5      1                   BUMP POINTER INTO ABUILDIN KEY.  TIC28030
         BDR,6     REPORTOUTKEY320     AND LOOP.                        TIC28060
*                                                                       TIC28070
*        FALL THRU ON ONE PERIOD = NO 2ND NAME PART.                    TIC28080
*                                                                       TIC28090
         LW,7      14                  RE-CREATE NAME POINTER           TIC28100
         AI,7      4+4+4+4+4+4+01      FROM R14 POINTER TO BXR.         TIC28110
*                                     (& TO SECOND CRARACTER)           TIC28120
        LI,6      16                  (SCAN TO INFINITY -- WE KNOW      TIC28130
*                                      THERE IS A PERIOD OUT THERE)     TIC28140
         B         REPORTOUTKEY300     BACK TO GET FIRST NAME PART.     TIC28150
*                                                                       TIC28160
REPORTOUTKEY400 RES 0                                                   TIC28170
         #T#GET,6  #DEV#STATION#TYPE   GET 'STATION TYPE' CHARS.        TIC28180
         SLS,6     8                   ALIGN THEM AND                   TIC28190
         LW,7      =X'00FFFF00'         STORE THEM INTO                 TIC28200
         STS,6     12                    THE KEY THAT'S IN REGISTERS.   TIC28210
*                                                                       TIC28220
         BAL,15    POINTTOTFDCODE      GO GET THE TFD.                  TIC28230
         BNEZ      TSOGOTTFD           AND OVER IF GOT ONE.             TIC28240
*                                                                       TIC28250
*        DID NOT FIND TFD.
*        SO TRY AGAIN WITH ALTERNATE KEY.
*
*        (ORIGINAL KEY STILL IN R9 - R13)
*
         AND,12    =X'FF0000FF'        REPLACE STATION TYPE
         OR,12     =X'00F0F000'         WITH ZEROES AND ..
*
         BAL,15    POINTTOTFDCODE      TRY AGAIN FOR TFD.
         BNEZ      TSOGOTTFD           AND OVER IF GOT ONE.
*                                                                       TIC28270
*        WHEN HERE, NO TFD FOR REPORT.                                  TIC28280
*        SO MARK THE REPORT AS FAILED.                                  TIC28290
*                                                                       TIC28300
*        R14 CONTAINS THE BA OF THE BXR.                                TIC28310
*                                                                       TIC28320
*                                                                       TIC28330
REPORTOUTKEYFAIL RES 0
         LI,8      X'7FFFF'            COPY BA
         AND,8     14                   OF BXR                          TIC28390
         SLS,8    -2                   MAKE IT A WA.                    TIC28400
         OR,8      =X'B0000000'        OR IN FAILED ETC BITS.           TIC28410
*                                                                       TIC28420
REPORTOUTKEY470 RES 0                                                   TIC28430
         #T#GWA,9  #DEV#ECB            POINT TO AN ECB.                 TIC28440
         M:QUEUE   8,PUT,(LSIZE,1),HIGH,(ECB,*9) ISSUE SQM REQUEST.     TIC28450
         BCR,12    REPORTOUTKEY479     OVER IF GOOD REQUEST.            TIC28460
*                                                                       TIC28470
         LW,#ARG   9                   GET ECB ADDRESS                  TIC28480
         #WAIT#ON                       AND WAIT.                       TIC28490
         B         REPORTOUTKEY470     AND TRY AGAIN.                   TIC28500
*                                                                       TIC28510
REPORTOUTKEY479 RES 0                  HERE WHEN REPORT MARKED FAILED.  TIC28520
         LW,#ARG   14                  BA OF BXR.                       TIC28530
         OR,#ARG   =X'80000000'        INSERT DSP BIT.                  TIC28540
         #FREE#MAIN#BYTES              AND FREE THE SPACE.              TIC28550
*                                                                       TIC28560
         B         COMMANDLEVELPOSTREPORT                               TIC28570
         PAGE                                                           TIC28580
*                                                                       TIC28590
*                                                                       TIC28600
*                                                                       TIC28610
COMMANDLEVELPOSTREPORT RES 0                                            TIC28620
         #T#GET,9  #DEV#LINE#STATUS#BITS AFTER REPORT DELIVER,
         LW,8      9                      (REMEMBER AND) CLEAR
         AND,9     =(-#LINE#ATTENTION-1)   ANY ATTENTION BIT,
         #T#PUT,9  #DEV#LINE#STATUS#BITS    AND IF ATTENTION
         CI,8      =(#LINE#ATTENTION)        WAS ON, GO DIRECTLY
         BANZ      COMMANDLEVELREAD           TO OUR READ.
*
         #T#GET,#ARG #DEV#DMODE        GET DMODE BITS AND SEE           TIC28630
         CI,#ARG   DMODE@OUT+DMODE@ALT  IF WE SHOULD DELIVER MORE.      TIC28640
         BAZ       COMMANDLEVELGETATRANORCOMMAND OVER IF NOT.           TIC28650
         B         COMMANDLEVELTRYTODELIVER BACK IF SO.                 TIC28660
         PAGE                                                           TIC28670
*                                                                       TIC28680
*                                                                       TIC28690
*                                                                       TIC28700
OVERREPORT RES     0                                                    TIC28710
COMMANDLEVELNOTHINGTODELIVER RES 0                                      TIC28720
         MTW,0     #X#ED               SEE IF XED BY OPERATOR.
         BNEZ      COMMANDLEVEL        #EXIT IF SO.
*
         #T#GET,#ARG #DEV#DMODE        GET DMODE BITS.                  TIC28730
         CI,#ARG   DMODE@OUT           CONTINUOUS DELIVERIES?           TIC28740
         BAZ       COMMANDLEVELGETATRANORCOMMAND OVER IF NOT.           TIC28750
*                                                                       TIC28760
COMMANDLEVELWAITFORREPORT RES 0        HERE TO WAIT FOR SOMETHING TO DELTIC28770
*                                                                       TIC28780
         #T#GET,7  #DEV#GET#LIST#ID    OBTAIN SQM LIST ID NUMBER.       TIC28840
         #GET#MAIN#BYTES 2036          GET BUFFER FOR POSSIBLE REPORT.
         LI,6      X'7FFFF'            COPY BXR BUFFER                  TIC28860
         AND,6     #ARG                 BYTE ADDRESS.                   TIC28870
         SLS,6     -2                  WA OF THE BUFFER.                TIC28880
         STW,#ARG  14                  REMEMBER BUFFER DSP.             TIC28890
         #T#GWA,9  #DEV#ECB            POINT TO AN ECB.                 TIC28900
         M:QUEUE   *7,GET,(BUF,*6),(BSIZE,2036/4),(ECB,*9)
         BCR,12    GETAREPORTFROMQUEUEGOT IF GOT REPORT, GO PROCESS IT.
         BCS,4     COMMANDLEVELWAIT400 OVER TO WAIT ON ECB.             TIC28930
*                                                                       TIC28940
         #SNAP,30  'Q/GET/ECB ERROR CC12=10'                            TIC28950
         #ABORT                                                         TIC28960
*                                                                       TIC28970
COMMANDLEVELWAIT400 RES 0                                               TIC28980
         #FREE#MAIN#BYTES              NO REPORT SO FREE BUFFER.        TIC28990
         #T#GET,8  #DEV#LINE#STATUS#BITS  OR IN TO INDICATE             TIC29000
         OR,8      =#LINE#AWAITING#REPORT  (TO SIGNALATTENTION          TIC29010
         #T#PUT,8  #DEV#LINE#STATUS#BITS    THAT WE ARE WAITING         TIC29020
*                                            FOR A REPORT.              TIC29030
         #T#GWA,#ARG #DEV#ECB          GET ECB ADDRESS                  TIC29040
         #WAIT#ON                       AND WAIT.                       TIC29050
*                                                                       TIC29060
         #T#GET,8  #DEV#LINE#STATUS#BITS     RESET SINCE WE ARE         TIC29070
         AND,8     =-#LINE#AWAITING#REPORT-1  NO LONGER WAITING         TIC29080
         #T#PUT,8  #DEV#LINE#STATUS#BITS       FOR A REPORT.            TIC29090
*                                                                       TIC29100
         CI,8      #LINE#ATTENTION     SEE IF WE FELL THROUGH WITH AN   TIC29110
*                                       ATTENTION INDICATED.  IF SO, IT TIC29120
*                                        MAY (REPEAT MAY) INDICATE THAT TIC29130
*                                         SQM DOESN'T REALLY HAVE A     TIC29140
*                                          REPORT BUT RATHER WE DID A   TIC29150
*                                           PURGE.  BUT WHETHER THIS    TIC29160
*                                            IS SO OR NOT, OUR ACTIONS  TIC29170
*                                             ARE THE SAME:             TIC29180
         BAZ       COMMANDLEVELWAITFORREPORT IF NOT ATTN, GO GET IT AGAI
*                                                                       TIC29200
         AND,8     =-#LINE#ATTENTION-1 WAS ATTN:  RESET IT              TIC29210
         #T#PUT,8  #DEV#LINE#STATUS#BITS AND TEMPORARILY STOP REPORTING.TIC29220
*                                                                       TIC29230
*        IF WE DID A Q/PURGE, THEN WE NEED TO                           TIC29240
*        DO ANOTHER Q/DEFINELIST:                                       TIC29250
*                                                                       TIC29260
         BAL,15    DEFINELISTIF        IF LIST WAS PURGED, REMKAE IT.   TIC29270
*
         MTW,0     #X#ED               SEE IF OPERATOR HAS X'ED.
         BNEZ      COMMANDLEVELXED      DONE IF SO.
*                                                                       TIC29280
*        AND FALL THRU TO GET A (SINGLE) COMMAND LINE.                  TIC29290
*                                                                       TIC29300
COMMANDLEVELGETA RES 0                                                  TIC29310
COMMANDLEVELGETATRANORCOMMAND RES 0                                     TIC29320
         #T#GET,6  #DEV#COMMAND#LINE#RECORD#BA ANY Y-STRING BA TO R6.
         BNEZ      COMMANDLEVELGOTATRANORCOMMAND OVER IF PREVIOUS Y USE.TIC29340
*                                                                       TIC29350
COMMANDLEVELREAD RES 0
         LI,6      BA(=0)
         #EXU#ON#TYPE#INDEX
         B         COMMANDPROMPT2200   UNKNOWN.
         BAL,#BAL  COMMANDPROMPT2200   OWNCODE.
         LI,6      BA(=0)              UNIT RECORD.
         LI,6      BA(PROMPTTTY)       TTY.
         LI,6      BA(PROMPT3270)      3270.
*
COMMANDPROMPT2200 RES 0
         LB,9      0,6                 GET BYTE COUNT
         AI,6      1                   PUSH BA TO TEXT.
         #T#PUT,6  #DEV#RECORD#BA      STORE THE BA AND
         #T#PUT,9  #DEV#RECORD#LENGTH   COUNT AND GO PROMPT:
         #INITIATE#WRITE#READ          OBTAIN A TRANCODE/COMMAND        TIC29400
         #CHECK#WRITE#READ COMMANDLEVELERROR AND CHECK IT               TIC29410
*
         IFATTENTION COMMANDLEVELBREAK TREAT ATTN AS I/O ERROR.
*                                                                       TIC29420
         LI,6      0                   CLEAR AND GET THE                TIC29430
         #T#XCA,6  #DEV#RECORD#BA       BA OF THE RECORD.               TIC29440
         #T#PUT,6  #DEV#COMMAND#LINE#RECORD#BA                          TIC29450
*
         LI,8      0                   GET THEN CLEAR                   TIC29460
         #T#XCA,8  #DEV#RECORD#LENGTH   THE LENGTH TOO.                 TIC29480
         #T#PUT,8  #DEV#COMMAND#LINE#RECORD#LENGTH                      TIC29490
*
*        SKIP OVER DEVICE-DEPENDENT MESSAGE PREFIX:
*
         #EXU#ON#TYPE#INDEX
         B         COMMANDPROMPT3200   UNKNOWN.
         B         COMMANDPROMPT3200   OWN-CODE.
         B         COMMANDPROMPT3200   UNIT RECORD.
         B         COMMANDPROMPT3200   TTY.
         B         COMMANDPROMPT3150   3270.
*
COMMANDPROMPT3150 RES 0                HERE TO ADJUST 3270 BUFFER.
*                                      (WE NEED TO ADJUST THE ACTUAL
*                                      BUFFER, RATHER THAN JUST THE
*                                      BUFFER POINTER, BECAUSE
*                                      WE MAY HAVE A @0,N LATER.)
         LB,9      0,6                 REMEMBER FIRST 'AID'.
         LW,7      6                   POINT R7 TO BUFFER.
         AI,6      3                   POINT R6 PAST THREE BYTE PREFIX.
         AI,8      -3                  R8 HAS LENGTH TO MOVE
         #T#PUT,8  #DEV#COMMAND#LINE#RECORD#LENGTH
*
         MBS678
*
         #T#GET,6  #DEV#COMMAND#LINE#RECORD#BA
         #T#GET,8  #DEV#COMMAND#LINE#RECORD#LENGTH
*
         LW,7      8                   COPY NEW LENGTH
         AW,7      6                   POINT TO CELL PAST 'END'.
         STB,9     0,7                 REMEMBER FIRST 'AID'.
*
COMMANDPROMPT3200 RES 0
*
         AI,8      0                   SEE IF NULL LENGTH RECORD
         BLEZ      COMMANDLEVELPOSTCOMMAND A NOP IF SO.
*
*
*        SKIP ANY FIELD FORMATTER:
*
         LB,9      0,6                 GET NEXT BYTE.
         CI,9      X'11'               SEE IF (3270) FIELD.
         BNE       %+3                 OVER IF NOT.
         AI,6      3                   SKIP FIELD PREFIX IF SO.
*
         LB,9      0,6                 RE-LOAD BYTE.
         CI,9      X'6F'               SEE IF IT IS QUESTION MARK.
         BNE       %+2                 OVER IF NOT.
         AI,6      1                   SKIP QUESTION MARK IF SO.
*
*        WHEN HERE, R6 HAS THE BA OF WHERE
*        WE SHOULD BE SCANNING FROM.
*
*        AND #DEV#COMMAND#LINE#RECORD#BA HAS THE
*        BA OF THE START OF THE SUPPLIED RECORD.
*
COMMANDLEVELGOTATRANORCOMMAND RES 0
         AND,6     =X'7FFFF'           MAKE R6 A BARE BA.
*
         #T#GET,7  #DEV#COMMAND#LINE#RECORD#LENGTH POINT R7
         #T#GET,#ARG #DEV#COMMAND#LINE#RECORD#BA     TO BA OF
         AND,#ARG  =X'7FFFF'                          RECORD
         AW,7      #ARG                                END+1.
         CW,7      6                   IF ZERO OR LESS BYTES,
         BLE       COMMANDLEVELPOSTCOMMAND THEN ITS A NOP NOW.
*
         LB,8      0,6                 GET THE FIRST BYTE               TIC29700
         CI,8      X'4F'               COMPARE WITH XOS AND OS BANG     TIC29710
         BE        CLBANG              OVER IF BANG TYPE ONE            TIC29720
         CI,8      X'5A'               COMPARE WITH ANOTHER XOS BANG    TIC29730
         BNE       XACTION             NOT COMMAND - MUST BE XACTION    TIC29740
*                                                                       TIC29750
CLBANG   RES       0                                                    TIC29760
         AI,6      1                   WAS '!', MOVE TO NEXT BYTE       TIC29770
         LB,8      0,6                  AND GET BYTE FROM BUFFER        TIC29780
*                                                                       TIC29790
*        SET UP REGISTERS 6 AND 7 TO POINT TO                           TIC29800
*        FIRST BYTE AND LAST BYTE + 1 OF COMMAND:                       TIC29810
*                                                                       TIC29820
         AI,6      -1                  R6 BACK TO THE BANG.
*                                                                       TIC29870
         LI,10     COMMANDTABLESIZE    LENGTH OF TABLE                  TIC29880
         LI,9      COMMANDLETTERTABLE  TABLE WHICH TELLS WHERE TO GO.   TIC29890
         CB,8      *9                  SEE IF INITIAL LETTER MATCHES    TIC29900
         BE        COMMANDBAL          OUT IF MATCH.                    TIC29910
         AI,9      1                   BUMP TO NEXT TABLE ENTRY.        TIC29920
         BDR,10    %-3                 LOOP UNTIL TABLE EXAUSTED.       TIC29930
*                                                                       TIC29940
*        FALL THROUGH ON BAD COMMAND                                    TIC29950
*                                                                       TIC29960
COMMANDNOT RES     0                                                    TIC29970
COMMANDBAD RES     0                   HERE ON BAD COMMAND SYNTAX.      TIC29980
         BAL,13    ERRORBUFFERCREATE
         LI,12     BA(COMMANDBADMESSAGE)
         BAL,14    ERRORBUFFERTEXTC
*E*  MESSAGE:     'BAD COMMAND SYNTAX'
*E*  DESCRIPTION: SYNTAX ERROR DISCOVERED IN COMMAND LEVEL SCAN.
*E*               THIS MESSAGE IS SENT TO ORIGINATING STATION.
         BAL,13    ERRORBUFFERFLUSH
         B         COMMANDLEVELPOSTCOMMAND                              TIC30070
*
*
*
BUMPR6OVERMESSAGEPREFIX RES 0
         AI,6      0                   UNKNOWN.
         AI,6      0                   OWNCODE.
         AI,6      0                   UNIT RECORD.
         AI,6      0                   TTY.
         AI,6      3                   3270.
*                                                                       TIC30080
COMMANDBADMESSAGE TEXTC 'BAD COMMAND SYNTAX'
*                                                                       TIC30100
COMMANDLETTERTABLE RES 0                                                TIC30110
         GEN,8,24  'D',DMODE                                            TIC30120
         GEN,8,24  'E',ECHO                                             TIC30130
         GEN,8,24  'L',LOGON                                            TIC30140
         GEN,8,24  'S',STATUS                                           TIC30150
         GEN,8,24 'T',TS
COMMANDTABLESIZE EQU %-COMMANDLETTERTABLE                               TIC30210
*                                                                       TIC30220
*                                                                       TIC30230
*                                                                       TIC30240
COMMANDBAL RES     0                                                    TIC30250
         LW,9      *9                  GET ADDRESS OF COMMAND HANDLER.  TIC30260
         BAL,15    *9                  AND GO THERE.                    TIC30270
         B         COMMANDLEVELPOSTCOMMAND                              TIC30280
*                                                                       TIC30290
*                                                                       TIC30300
*                                                                       TIC30310
COMMANDLEVELERROR RES 0
COMMANDLEVELREADERROR RES 0            HERE ON (READ) I/O ERROR.
         CI,#ARG   X'1FF'              SEE IF DCB CLOSED.
         BNE       %+2                 OVER IF NOT CLOSED.
*
COMMANDLEVELBREAK RES 0
         #FREE#DEV#BUFFER                                               TIC30330
         B         COMMANDLEVELSURVEY                                   TIC30340
*                                                                       TIC30350
*                                                                       TIC30360
*                                                                       TIC30370
COMMANDLEVELPOSTCOMMAND RES 0                                           TIC30380
         LI,#ARG   0                   GET THEN CLEAR LOCATION          TIC30390
         #T#XCA,#ARG #DEV#COMMAND#LINE#RECORD#BA WHERE THE COMMAND LINE TIC30400
         #FREE#MAIN#BYTES#IF           WAS (IF DYN) AND THEN
         B         COMMANDLEVEL        WE ARE AT COMMAND LEVEL.
         PAGE                                                           TIC30470
*        HERE ON A TRANSACTION NAME                                     TIC30480
*                                                                       TIC30490
TFDINKEYPROTO TEXT '?            XX01'                                  TIC30500
TFDINKEYPROTO3 TEXT '?000000000000XX01'                                 TIC30510
*                                                                       TIC30520
XACTION  RES       0                                                    TIC30530
*
*        HERE WITH R6 CONTAINING BARE BA OF WHERE TO SCAN TRANCODE
*        STRING AND WITH R7 BARE BA OF END+1 OF THAT RECORD.
*
*        MUST REMEMBER R6-R7 INFO IN R14 TO PRESERVE IT UNTIL
*        WE GET TO 'TSIGOTTFD'.
*
         LW,14     7
         SW,14     6
         SLS,14    19
         OR,14     6
*
         #T#GET,9  #DEV#REGULATION     SEE IF STATION IS                TIC30540
         CI,9      #REGULATE#QUESTION   ALLOWED TO SUBMIT XACTOONS.     TIC30550
         BANZ      COMMANDBAD          CRYPTIC COMPLAINT IF NOT.        TIC30560
*                                                                       TIC30562
         LI,10     #DOING#ACCEPT       INDICATE WE'RE                   TIC30563
         #T#PUT,10 #DEV#DOING           PROCESSING XACTION.
*                                                                       TIC30580
*        CREATE FULL KEY TO FIND APPROPRIETE TFD                        TIC30590
*                                                                       TIC30600
*        CREATE THE KEY IN REGISTERS 9, 10, 11, 12, AND 13.             TIC30610
*                                                                       TIC30620
         LCI       5                   COPY FIVE WORDS OF KEY PROTOTYPE.TIC30630
         LM,9      TFDINKEYPROTO       COPY INTO THE REGISTERS.         TIC30640
*                                                                       TIC30650
         LI,5      4*9+1               POINT R5 INTO REGISTER KEY.
*                                                                       TIC30670
*        R7 POINTS TO RECORD END+1.
*        R6 POINTS TO WHERE TO START SCAN.
*
XACTION275 RES     0                                                    TIC30700
         LB,8      0,6                 SCAN NPUT RECORD.
         CI,8      X'11'               FOR AND END-OF-TRANCODE.
         BE        XACTION300
         CI,8      ' '
         BE        XACTION300                                           TIC30730
         CI,8      X'0D'                                                TIC30740
         BE        XACTION300                                           TIC30750
         CI,8      X'15'                                                TIC30760
         BE        XACTION300                                           TIC30770
*        NOT AT END, SO                                                 TIC30780
         STB,8     0,5                 CHARACTER INTO KEY.
         AI,5      1                   BUMP R5 POINTER.
         CI,5      4*9+1+12            SEE IF LONG.
         BGE       XACTION300          OVER IF VERY LONG.               TIC30820
*                                                                       TIC30830
         AI,6      1                   BUMP SCAN.
         CW,6      7                   COMPARE WITH END+1.
         BL        XACTION275          LOOP IF NOT AT END.
XACTION300 RES     0                                                    TIC30860
*                                                                       TIC30870
*        WHEN HERE, WE HAVE BUILT THE 'KEY' IN REGISTERS.               TIC30880
*                                                                       TIC30890
*        THUS WE HAVE THE TRANCODE, BLANK FILLED, STARTING              TIC30900
*        AT BYTE 37.                                                    TIC30910
*                                                                       TIC30920
*        SO WE CAN COMPARE AGAINST ANY ? AND % RESTRICTIONS.            TIC30930
*                                                                       TIC30940
         #T#GET,7  #DEV#DOLLARS#LAL    GET NUMBER AND WA OF %-TYPE.     TIC30950
         LB,8      7                   COPY HOW MANY TO BDR REGGISTER.
         BEZ       XACTION340          OVER IF NONE.                    TIC30970
*                                                                       TIC30980
         SLS,7     2                   TO BA OF TEST.                   TIC30990
*                                                                       TIC31000
*        (NOTE THAT WE CAN'T COMPARE THE INITIAL CHARACTERS)            TIC31010
*                                                                       TIC31020
XACTION312 RES     0                                                    TIC31030
         LI,15     11                  BYTE COUNT.                      TIC31040
         LI,6      9*4+1               BA OF TRANCODE.                  TIC31050
XACTION315 AI,7    1                   BUMP OVER % OR BUMP IN LOOP.     TIC31060
         LB,5      0,7                 GET BYTE OF TEST.                TIC31070
         CI,5      '#'                 IS IT A #.                       TIC31080
         BNE       %+5                 # MATCHES ANYTHING ...           TIC31090
         LB,5      0,6                  EXCEPT                          TIC31100
         CI,5      ' '                   FOR                            TIC31110
         BE        XACTION325             BLANK.                        TIC31120
         B         XACTION320                                           TIC31130
*                                                                       TIC31140
         CB,5      0,6                 DOES IT MATCH?                   TIC31150
         BNE       XACTION325          OVER ON NO MATCH.                TIC31160
*                                                                       TIC31170
XACTION320 RES     0                   HERE ON MATCHED SO FAR.          TIC31180
*                                                                       TIC31190
         AI,6      1                   BUMP POINTER (OTHER BUMPED ABOVE)TIC31200
         BDR,15    XACTION315          AND CONTINUE COMPARISON.         TIC31210
*                                                                       TIC31220
*        FALL THROUGH ON COMPLETE MATCH WITH A %-TYPE.                  TIC31230
*                                                                       TIC31240
         B         XACTIONBAD                                           TIC31250
*                                                                       TIC31260
XACTION325 RES     0                   HERE ON A NON-COMPARISON         TIC31270
         AW,7      15                  BUMP TO START OF NEXT %-TYPE.    TIC31280
         BDR,8     XACTION312          AND DO NEXT %-TYPE.
*                                                                       TIC31300
*        FALL THROUGH ON DID ALL %-TYPES AND NONE MATCHED.              TIC31310
*                                                                       TIC31320
XACTION340 RES     0                                                    TIC31330
         #T#GET,7  #DEV#QUESTIONS#LAL  GET NUMBER AND WA OF QUESTION-TYPTIC31340
         LB,8      7                   ISOLATE COUNT IN BDR REGISTER.
         BEZ       XACTIONGOOD         OVER IF NONE.                    TIC31360
*                                                                       TIC31370
         SLS,7     2                   TO BA OF TEST.                   TIC31380
*                                                                       TIC31390
*        (NOTE THAT WE DON'T COMPARE INITIAL CHARS, ALTHOUGH WE COULD)  TIC31400
*                                                                       TIC31410
XACTION352 RES     0                                                    TIC31420
         LI,15     11                  BYTE COUNT.                      TIC31430
         LI,6      9*4+1               BA OF TRANCODE.
XACTION355 RES     0                                                    TIC31450
         AI,7      1                   BUMP OVER FIRST CHAR OR BUMP IN LTIC31460
         LB,5      0,7                 GET BYTE OF TEST.                TIC31470
         CI,5      '#'                 IS IT A #.                       TIC31480
         BNE       XACTION358          # MATCHES ANYTHING ...           TIC31490
         LB,5      0,6                  EXCEPT                          TIC31500
         CI,5      ' '                   FOR                            TIC31510
         BE        XACTION365             BLANK.                        TIC31520
         B         XACTION360                                           TIC31530
XACTION358 RES     0                                                    TIC31540
*                                                                       TIC31550
         CB,5      0,6                 DOES IT MATCH?                   TIC31560
         BNE       XACTION365          OVER ON NO MATCH.                TIC31570
*                                                                       TIC31580
XACTION360 RES     0                   HERE ON MATCHED SO FAR.          TIC31590
         AI,6      1                   BUMP POINTER (OTHER BUMPED ABOVE)TIC31600
         BDR,15    XACTION355          AND CONTINUE COMPARISON          TIC31610
*                                                                       TIC31620
*        FALL THROUGH ON COMPLETE MATCH WITH QUESTION-TYPE.             TIC31630
*                                                                       TIC31640
         B         XACTIONGOOD                                          TIC31650
*                                                                       TIC31660
XACTION365 RES     0                   HERE ON A NON-COMPARISON.        TIC31670
         AW,7      15                  BUMP TO START OF NEXT NPS.       TIC31680
         BDR,8     XACTION352          AND DO NEXT ONE.
*                                                                       TIC31700
*        FALL THROUGH ON NO QUESTION-TYPE MATCHED.                      TIC31710
*                                                                       TIC31720
XACTIONBAD RES     0                                                    TIC31730
         BAL,13    ERRORBUFFERCREATE
         LI,12     BA(XACTIONBADMESSAGE)
         BAL,14    ERRORBUFFERTEXTC
*E*  MESSAGE:     'ILLEGAL TRANCODE'
*E*  DESCRIPTION: DURING COMMAND LEVEL SCAN, ATTEMPT TO MATCH ?-TYPE
*E*               TRANCODE WITH TFD UNSUCCESSFUL.
*E*               THIS MESSAGE IS SENT TO ORIGINATING STATION.
         BAL,13    ERRORBUFFERFLUSH
         B         COMMANDLEVELPOSTCOMMAND
*
XACTIONBADMESSAGE TEXTC 'ILLEGAL TRANCODE'
*                                                                       TIC31790
*                                                                       TIC31800
*                                                                       TIC31810
XACTIONGOOD RES    0                                                    TIC31820
*                                                                       TIC31830
         #T#GET,6  #DEV#STATION#TYPE   GET 'STATION TYPE' CHARS.        TIC31840
         SLS,6     8                   ALINN THEM AND                   TIC31850
         LW,7      =X'00FFFF00'         STORE THEM INTO THE             TIC31860
         STS,6     12                    KEY THAT'S IN THE REGISTERS.   TIC31870
*                                                                       TIC31880
         BAL,15    POINTTOTFDCODE      GO GET THE TFD                   TIC31890
         BNEZ      TSIGOTTFD            AND OVER IF GOT ONE             TIC31900
*                                                                       TIC31910
         LW,6      =X'00F0F000'        LOAD A 'STATION TYPE' OF '00'.   TIC31920
         LW,7      =X'00FFFF00'        AND STORE IT OVER THE TRUE       TIC31930
         STS,6     12                    STATION TYPE IN THE KEY IN REGSTIC31940
         BAL,15    POINTTOTFDCODE      AND TRY FOR THAT TFD.            TIC31950
         BNEZ      TSIGOTTFD           AND OUT IF SUCCESSFUL.           TIC31960
*                                                                       TIC31970
         LCI       5                   HERE MAKE THE THIRD TRY FOR A TFDTIC31980
         LM,9      TFDINKEYPROTO3      LOAD THE MOSTLY-ZERO KEY.        TIC31990
         #T#GET,6  #DEV#STATION#TYPE   AND THEN                         TIC32000
         SLS,6     8                    PUT THE                         TIC32010
         LW,7      =X'00FFFF00'          STATION TYPE                   TIC32020
         STS,6     12                     IN LIKE ABOVE.                TIC32030
         BAL,15    POINTTOTFDCODE      THIRD TRY FOR TFD.               TIC32040
         BNEZ      TSIGOTTFD           OVER IF SUCCESSFUL.              TIC32050
*                                                                       TIC32060
         BAL,13    ERRORBUFFERCREATE
         LI,12     BA(XACTIONNOTMESSAGE)
         BAL,14    ERRORBUFFERTEXTC
*E*  MESSAGE      'NON-EXISTENT TRANCODE'
*E*  DESCRIPTION: DURING COMMAND LEVEL SCAN, ORIGINATING STATION
*E*               ASSOCIATED WITH A TRANCODE DID NOT MATCH WITH ANY
*E*               ALLOWED TFD PREVIOUSLY DEFINED FOR THAT STATION.
*E*               THIS MESSAGE IS SENT TO ORIGINATING STATION.
         BAL,13    ERRORBUFFERFLUSH
         B         COMMANDLEVELPOSTCOMMAND
*
XACTIONNOTMESSAGE TEXTC 'NON-EXISTENT TRANCODE'
         TITLE     'TIC - DEV-TASK - TRANSACTION SCAN VIA TFD'
*                                                                       TIC32130
*                                                                       TIC32140
*                                                                       TIC32150
*        SPECIAL SOURCE HERE DUE TO META-SYMBOL ERROR.                  TIC32160
*                                                                       TIC32170
*        META-SYMBOL CURRENTLY DOES NOT CORRECTLY HANDLE THE CASE       TIC32180
*        OF  OP,R1 SETT  WHERE 'SETT' IS DEFINED BY  SETT SET %,4.      TIC32190
*        OCCASIONALLY, A USAGE GENERATES AN INDIRECT BIT IN             TIC32200
*        THE INSTRUCTION.                                               TIC32210
*                                                                       TIC32220
*        BECAUSE OF THE ABOVE, WE RE-DEFINE ALL OF THE                  TIC32230
*        OPERATIONS THAT ARE USED WITH #DSS-TYPE SYMBOLS.               TIC32240
*                                                                       TIC32250
*        WE RE-DEFINE THEM USING THE COM PSEUDO, SINCE IT IS            TIC32260
*        THE S:SYN PSEUDO THAT IS THE PROBLEM.                          TIC32270
*                                                                       TIC32280
*        NOTA BENE:  THE OPERATIONS RE-DEFINED BELOW ARE THE ONLY       TIC32290
*        ONES THAT CAN SAFELY BE USED WITH #DSS-TYPE ARGUMENTS!         TIC32300
*                                                                       TIC32310
*                                                                       TIC32320
*                                                                       TIC32330
*        THIS META-SYMBOL ERROR TO BE CORRECTED IN RELEASE I00.         TIC32340
*        AT THAT TIME, THIS PAGE OF SOURCE SHOULD BE REMOVED.           TIC32350
*                                                                       TIC32360
*                                                                       TIC32370
*                                                                       TIC32380
*                                                                       TIC32390
         OPEN      STW                                                  TIC32400
         OPEN      LW                                                   TIC32410
         OPEN      AW                                                   TIC32420
         OPEN      CW                                                   TIC32430
         OPEN      SW                                                   TIC32440
         OPEN      AWM                                                  TIC32450
         OPEN      MTW                                                  TIC32460
         OPEN      XW                                                   TIC32470
*                                                                       TIC32480
STW      CNAME     X'35'                                                TIC32490
LW       CNAME     X'32'                                                TIC32500
AW       CNAME     X'30'                                                TIC32510
CW       CNAME     X'31'                                                TIC32520
SW       CNAME     X'38'                                                TIC32530
AWM      CNAME     X'66'                                                TIC32540
MTW      CNAME     X'33'                                                TIC32550
XW       CNAME     X'46'                                                TIC32560
         PROC                                                           TIC32570
         LOCAL     AGA,AG                                               TIC32580
AGA      SET       AFA                                                  TIC32590
AG       SET       AF                                                   TIC32600
LF       RES       0                                                    TIC32610
         GEN,1,7,4,3,17 AGA,NAME,CF(2),AG(2),AG(1)                      TIC32620
         PEND                                                           TIC32630
         PAGE                                                           TIC32640
*                                                                       TIC32650
*        HERE WE HAVE OU MAIN TRANSACTION                               TIC32660
*        SCAN ON INPUT (TSI) ROUTINE                                    TIC32670
*                                                                       TIC32680
         #DSS                          DEFINE DYNAMIC STORAGE           TIC32690
TSIZEROORONE       #DSSWORD            ZERO IF TSI.  ONE IF TSO.        TIC32700
*                                                                       TIC32710
TSICURRENTR #DSSWORD                   CURRENT 'ROW' ON I/O MEDIUM.     TIC32720
TSICURRENTC #DSSWORD                   CURRENT 'COLUMN' ON I/O MEDIUM.  TIC32730
*                                                                       TIC32740
TSORECORDBA #DSSWORD                   SEE TSO - USED IN TSI FOR PROMPTSTIC32750
TSORECORDENDBA #DSSWORD                SEE TSO - USED IN TSI FOR PROMPTSTIC32760
TSORECORDSIZE #DSSWORD                 SEE TSO - USED IN TSI FOR PROMPTSTIC32770
*
TSOFIELDSSINCEAT   #DSSWORD            COUNTS FIELDS - RESET BY AT.
*                                                                       TIC32780
TSIYSTRINGBA #DSSWORD                  BA OF Y-STRING.                  TIC32790
TSIYSTRINGLENGTH #DSSWORD              LENGTH OF Y-STRING.              TIC32800
*                                                                       TIC32810
TSIBXR   #DSSWORD                      HOLDS DSA OF BXR, OR BXR START.  TIC32820
*                                                                       TIC32830
TSITRANID #DSSWORD                     HOLDS TRANID OF THIS TRAN, OR A ZTIC32840
*
TSITFDSCAN         #DSSWORD            CURRENT WORD'S WA IN TFD.
*                                                                       TIC32850
*        ABOVE WORDS MUST MATCH: TSI & TSO.                             TIC32860
*                                                                       TIC32870
TSIRECORDBA #DSSWORD                   BEGINNING OF STATION'S RECORD    TIC32880
TSIRECORDCURRENTBA #DSSWORD            OUR POSITION IN THAT RECORD.     TIC32890
TSIRECORDENDBA #DSSWORD                END+1 OF THAT RECORD             TIC32900
*                                                                       TIC32920
TSIFQMTEXTBA #DSSWORD                  FQM TEXT STRING LOC              TIC32930
TSIFQMTEXTENDBA #DSSWORD               END+1 BARE BYTE ADDRESS.         TIC32940
TSIFQMTEXTHIGHWATERMARKBA #DSSWORD     BA OF LAST (HIGHEST) BYTE STORED.TIC32950
TSIFQMFIELDPTR #DSSWORD                BA OF CURRENT FIELD              TIC32960
*                                      (R7 STORED AT PRIMITIVE START)   TIC32970
*                                                                       TIC32980
TSICURRENTFIELDC #DSSWORD               WHERE CURRENT FIELD BEGINS      TIC32990
TSILASTFIELDSUM #DSSWORD               HOLDS SUM-OF-CHAR FOR K PRIM POSSTIC33000
         #DSS                                                           TIC33010
*                                                                       TIC33020
*                                                                       TIC33030
*                                                                       TIC33040
TSIGOTTFD RES      0                                                    TIC33050
         #ENTRY#SPACE#CLEAR
*                                                                       TIC33070
         #T#GET,8  #DEV#USING#TFD      GET TFD LOCATION.                TIC33110
         AI,8      @TFD@PREFIX@TEXTBYTECOUNT POINT TO                   TIC33120
         LI,10     X'FFFF'               BYTE COUNT AND                 TIC33130
         AND,10    *8                     GET IT CLEAN                  TIC33140
         AI,8      @TFD@PREFIX@LENGTH-@TFD@PREFIX@TEXTBYTECOUNT         TIC33150
         STW,8     TSITFDSCAN          AND STORE AS CURRENT POSITION    TIC33160
*                                                                       TIC33170
         LI,9      10001               SET TO
         STW,9     TSICURRENTR          UNDEFINED
         STW,9     TSICURRENTC           ROW & COLUMN.
*                                                                       TIC33340
         AI,10     3                   ROUND BYTE AMOUNT IN             TIC33350
         AND,10    =X'7FFFC'            R10 UP TO EVEN WORDS.           TIC33360
         BNEZ      %+2                 OVER IF A BYTE COUNT WAS IN TFD. TIC33370
         LI,10     XACTIONTEXTINCREMENT OTHERWISE USE DEFAULT.          TIC33380
*                                                                       TIC33390
         #T#GET,#ARG #DEV#OUTPUT#TRL   GET SIZE WE CAN SEND.            TIC33400
         STW,#ARG  TSORECORDSIZE       AND STORE AS MAX SIZE.           TIC33410
*                                                                       TIC33420
         LW,#ARG   10                 RETRIEVE BYTES OF FQM TEXT        TIC33430
         AI,#ARG   4+4+4+4+4+4+32+4    PLUS ROOM FOR BXR STUFF.         TIC33440
         STW,#ARG  11                    (REMEMBER FOR A LITTLE WHILE)  TIC33450
         #GET#MAIN#BYTES                 AND GET 'EM                    TIC33460
         STW,#ARG  TSIBXR              STORE DYNAMIC BA OF BXR BLOCK.   TIC33470
         AND,#ARG  =X'7FFFF'              NEATEN                        TIC33480
         AI,#ARG   4+4+4+4+4+4+32      OVER BXR STUFF                   TIC33490
         STW,#ARG  TSIFQMTEXTBA            AND                          TIC33500
         AW,#ARG   10                  TEXT START PLUS TEXT LENGTH.     TIC33520
         STW,#ARG  TSIFQMTEXTENDBA     IS TEXT END+1.                   TIC33530
*                                                                       TIC33540
         LW,#ARG   TSIBXR              DSP OF BXR.                      TIC33550
         SLS,#ARG  -2                  WA OF BXR.                       TIC33560
         STW,11    0,#ARG              STORE BYTE COUNT OF BXR.         TIC33570
*                                                                       TIC33580
         LW,#ARG   TSIFQMTEXTBA        GET TEXT START BA.               TIC33590
         SLS,#ARG  -2                  TEXT START WA.                   TIC33600
         LW,#BAL   10                  COPY TEXT LENGTH                 TIC33610
         SLS,#BAL  -2                   INTO WORDS.                     TIC33620
         LW,6      ='    '             GET SOME BLANKS.                 TIC33630
         STW,6     0,#ARG              AND BLANK                        TIC33640
         AI,#ARG   1                    THE TEXT                        TIC33650
         BDR,#BAL  %-2                   BUFFER.                        TIC33660
         STW,#BAL  0,#ARG              AND ZERO OUT LINK WORD.          TIC33670
*                                                                       TIC33740
         LW,5      TSIBXR              BA OF XR.
         AND,5     =X'7FFFF'           NEATENED.
         SLS,5     -2                  INTO A WA.
*                                                                       TIC33820
         LW,#ARG   10                  RE-COMPUTE THE LENGTH            TIC33830
         AI,#ARG   4+4+4+4+4+4+32+4     OF THE BXR BLOCK.               TIC33840
         STW,#ARG  *5                  STORE IT INTO BXR.
*                                                                       TIC33860
         AI,5      1+1+1+1+1           BUMP TO TEXT LENGTH WORD.
         STH,10    *5                  AND STORE BYTE COUNT.
*                                                                       TIC33890
         AI,5      1                   BUMP TO WHERE NAME IS.
         SLS,5     2                   BA OF NAME PLACE.
*                                                                       TIC33920
*        GET BA OF TRANCODE SCANNER IN R6.
*        AND BA OF END-OF-RECORD PLUS ONE IN R7.
*
*        THIS INFO WAS REMEMBERED IN R14 BACK AT 'XACTION'.
*
         LW,7      14
         SLS,7     -19
         LI,6      X'7FFFF'
         AND,6     14
         AW,7      6
*                                                                       TIC33950
TSIGOTPROTO LI,8   '?'                 START WITH A QUESTION MARK.      TIC33960
*                                                                       TIC33970
TSIGOTTRAN250 RES  0                                                    TIC33980
         STB,8     0,5                 BYTE --> FQM.
         AI,5      1
         LB,8      0,6                 GET NEXT BYTE OF TRANCODE.
         CI,8      ' '                 SEE IF BLANK = END OF TRANCODE.  TIC34020
         BE        TSIGOTTRANCODEIN    OVER IF SO.                      TIC34030
         CI,8      X'0D'               OTHER TRANCODE ENDS:             TIC34040
         BE        TSIGOTTRANCODEIN                                     TIC34050
         CI,8      X'15'                                                TIC34060
         BE        TSIGOTTRANCODEIN                                     TIC34070
         AI,6      1
         CW,6      7
         BLE       TSIGOTTRAN250
*                                                                       TIC34100
TSIGOTTRANCODEIN RES 0                                                  TIC34110
*        HAVE COPIED THE TRANCODE TO THE NAME -                         TIC34120
*        NOW WE MUST ADD THE STATION NAME:                              TIC34130
*                                                                       TIC34140
         LI,8      '.'                 GET A PERIOD AND                 TIC34150
         STB,8     0,5                 PUT IT INTO FQM NAME.
         AI,5      1                   BUMP INDEX INTO FQM NAME.
*                                                                       TIC34180
         #T#GET,6  #DEV#AT#NAME#LAL    GET ORIGINATING NAME POINTER.
         BEZ       TSIGOTATNAMEIN      OVER IF NONE.                    TIC34210
*                                                                       TIC34220
         LB,12     6                   ISOLATE BYTE COUNT.
*                                                                       TIC34240
         LB,8      0,6                 COPY
         AI,6      1                    THE
         STB,8     0,5                   NAME.
         AI,5      1
         BDR,12    %-4                                                  TIC34290
         CI,8       '.'                 SEE IF NAME ENDED IN A PERIOD.  TIC34300
         BE         TSIGOTATNAMEPERIOD DON'T ADD ONE IF SO.             TIC34310
*                                                                       TIC34320
TSIGOTATNAMEIN RES 0                                                    TIC34330
         LI,8      '.'                 PUT THE PERIOD AT                TIC34340
         STB,8     0,5                  THE END OF THE NAME.
         AI,5      1
*                                                                       TIC34370
*        WHEN HERE, WE CAN CALCULATE HOW MANY BYTES                     TIC34380
*        THERE WILL BE IN THE FQM NAME.                                 TIC34390
*                                                                       TIC34400
TSIGOTATNAMEPERIOD RES 0                                                TIC34410
         LW,#ARG   TSIBXR              DSP OF BXR.                      TIC34420
         AND,#ARG  =X'7FFFF'           BA OF BXR.                       TIC34430
         LW,8      5                   BA OF WHERE WE ARE.
         SW,8      #ARG                MINUS START OF BXR.              TIC34450
         AI,8      -24+8               LESS 6 WORDS PLUS ROOM FOR HEXID.TIC34460
         LW,#ARG   TSIBXR              DSP OF BXR.                      TIC34470
         SLS,#ARG  -2                  ON-NEAT WA OF BXR                TIC34480
         STW,8     5,#ARG              STORE NAME LENGTH (8 CLEAR TEXT LTIC34490
*                                                                       TIC34500
         LI,8      ' '                 BLANK OUT THE                    TIC34510
         STB,8     0,5                  REST OF THE NAME.
         AI,5      1                   BUMP OUR POINTER.
         CW,5      TSIFQMTEXTBA        AT END YET.
         BL        %-3                 NO, KEEP GOING.                  TIC34550
*                                                                       TIC34560
         LI,5      0                   THROUGHOUT THE REST OF THIS      TIC34570
*                                      ROUTINE, R5 IS A POINTER TO      TIC34580
*                                      THE 'NEXT' BYTE IN THE STATION'S TIC34590
*                                      OUTPUT BUFFER.  IF C(R5) = 0,    TIC34600
*                                      THEN THERE IS NO BUFFER.         TIC34610
*                                                                       TIC34620
         LW,7      TSIFQMTEXTBA        THROUGHOUT THESE ROUTINES,
*                                      R7 IS A POINTER TO THE 'NEXT'
*                                      BA OF FQM TEXT TO BE STORED INTO.
*
         B         TSIGETPRIM                                           TIC34630
         PAGE                                                           TIC34640
*                                                                       TIC34650
*        HERE WE HAVE AN OUTPUT REPORT TO PRINT                         TIC34660
*        UNDER THE CONTROL OF AN OUTPUT TFD.                            TIC34670
*                                                                       TIC34680
*                                                                       TIC34690
         #DSS                          DEFINE DYNAMIC STORAGE.          TIC34700
TSOZEROORONE       #DSSWORD            ZERO IF TSI.  ONE IF TSO.        TIC34710
*                                                                       TIC34720
TSOCURRENTR #DSSWORD                   CURRENT 'ROW' ON I/O MEDIUM.     TIC34730
TSOCURRENTC #DSSWORD                   CURRENT 'COLUMN' ON I/O MEDIUM.  TIC34740
*                                                                       TIC34750
TSORECORDBA #DSSWORD                   BEGINNING OF RECORD WE'RE BUILDINTIC34760
TSORECORDENDBA #DSSWORD                CLEAN BA OF END-OF-BUFFER        TIC34770
TSORECORDSIZE #DSSWORD                 MAX BYTES IN ONE WRITE.          TIC34780
*
TSOFIELDSSINCEAT   #DSSWORD            COUNTS FIELDS - RESET BY AT.
*                                                                       TIC34790
TSOYSTRINGBA #DSSWORD                  BA OF Y-STRING.                  TIC34800
TSOYSTRINGLENGTH #DSSWORD              LENGTH OF Y-STRING.              TIC34810
*                                                                       TIC34820
TSOBXR   #DSSWORD                      HOLDS DSA OF BXR.                TIC34830
*                                                                       TIC34840
TSOTRANID #DSSWORD                     HOLDS TRANID OF THIS REPORT.     TIC34850
*
TSOTFDSCAN #DSSWORD                    CURRENT WA POSITION IN TFD.
*                                                                       TIC34860
*        ABOVE WORDS MUST MATCH: TSI & TSO.                             TIC34870
*                                                                       TIC34880
TSOFQMTEXTBA #DSSWORD                  FQM TEXT STRING LOCATION.        TIC34900
TSOFQMTEXTENDBA #DSSWORD               END+1 OF FQM TEXT.               TIC34910
         #DSS                                                           TIC34920
*                                                                       TIC34930
*                                                                       TIC34940
*                                                                       TIC34950
TSOGOTTFD RES      0                                                    TIC34960
         #ENTRY#SPACE#CLEAR
*                                                                       TIC34980
         LI,8      1                   IMMEDIATELY IDENTIFY             TIC34990
         STW,8     TSOZEROORONE         OURSELVES AS OUTPUT.            TIC35000
*                                                                       TIC35010
         STW,14    TSOBXR              STORE BXR BA WE WERE HOLDING.    TIC35020
*                                                                       TIC35030
         AI,14     4+4+4+4+4+4+32      BUMP TO TEXT IN BXR.             TIC35040
         AND,14    =X'7FFFF'           NEATEN TO BARE BA.               TIC35050
         STW,14    TSOFQMTEXTBA        AND STORE BA OF TEXT.            TIC35060
*                                                                       TIC35070
         AI,14     -32-4               BACK TO TEXT LENGTH WORD.        TIC35080
         SLS,14    -2                  INTO A WA.                       TIC35090
         LH,8      *14                 GET THE TEXT LENGTH.             TIC35100
         AW,8      TSOFQMTEXTBA        LENGTH PLUS START                TIC35110
         STW,8     TSOFQMTEXTENDBA      IS END+1.                       TIC35120
*                                                                       TIC35130
         #T#GET,8  #DEV#USING#TFD      GET TFD LOCATION.                TIC35140
         AI,8      @TFD@PREFIX@LENGTH  BUMP ADDRESS OVER PREFIX STUFF.  TIC35150
         STW,8     TSOTFDSCAN          AND STORE AS CURRENT TFD POSITIONTIC35160
*                                                                       TIC35200
         LI,9      10001               SET UP
         STW,9     TSOCURRENTR          UDDEFINED
         STW,9     TSOCURRENTC           ROW & COLUMN.
*                                                                       TIC35240
         LW,9      TSOBXR              WA OF BXR.
         SLS,9     -2                  WA OF BXR.
         AI,9      4                   WA OF TRANID.
         LW,9      *9                  LOAD TRANID OF REPORT.
         STW,9     TSOTRANID           AND STORE IT.                    TIC35260
*                                                                       TIC35270
         #T#GET,#ARG #DEV#OUTPUT#TRL GET SIZE WE CAN SEND.              TIC35280
         STW,#ARG  TSORECORDSIZE       AND STORE AS MAX SIZE.           TIC35290
*                                                                       TIC35300
         LI,5      0                   THROUGHOUT THE REST OF THE TFD   TIC35310
*                                      PROCESSING, R5 IS A POINTER TO   TIC35320
*                                      THE 'NEXT' BYTE IN THE STATION'S TIC35330
*                                      OUTPUT BUFFER.  IF C(R5)=0,      TIC35340
*                                      THEN THERE IS NO BUFFER.         TIC35350
*                                                                       TIC35360
         LW,7      TSOFQMTEXTBA        THROUGHOUT THE REST OF THE       TIC35370
*                                      REPORT DELIVERY, R7 HOLDS THE    TIC35380
*                                      BA OF THE 'NEXT' BYTE IN         TIC35390
*                                      THE BUFFER WHICH CONTAINS        TIC35400
*                                      THE TEXT OF THE FORMAL QUEUE     TIC35410
*                                      MESSAGE.                         TIC35420
*                                                                       TIC35430
         B         TSOGETPRIM          GO TO IT!  PROCESS THE REPORT!   TIC35440
         PAGE                                                           TIC35450
*                                                                       TIC35460
*        DEFINITION OF FIELDS IN MAIN STORAGE                           TIC35470
*        REPRESENTATION OF A TFD:                                       TIC35480
*                                                                       TIC35490
@TFD@PREFIX@TEXTBYTECOUNT EQU 5        (AND IN RIGHT HALF)              TIC35500
@TFD@PREFIX@LENGTH EQU 6               (WHERE PRIMS START)              TIC35510
         PAGE                                                           TIC35690
*                                                                       TIC35700
*        COMMENTARY HERE FOR THE 'PRIMLOC' ROUTINES WHICH FOLLOW.       TIC35710
*                                                                       TIC35720
*        EACH 'PRIMLOC' ENTRY POINT HANDLES ONE TFD                     TIC35730
*        PRIMITIVE FOR EITHER INPUT OR OUTPUT.                          TIC35740
*                                                                       TIC35750
*        HOWEVER SEVERAL ENTRY POINTS MAY SHARE CODE -                  TIC35760
*        MAY BE IN THE SAME ROUTINE.                                    TIC35770
*                                                                       TIC35780
*        THE 'PRIMLOC' ENTRY POINTS ARE BRANCHED TO FROM A              TIC35790
*        'COMPUTED GO TO' EITHER IN 'TSIGETPRIM' (INPUT) OR             TIC35800
*        'TSOGETPRIM' (OUTPUT).                                         TIC35810
*                                                                       TIC35820
*        WHEN A 'PRIMLOC' ENTRY POINT IS BRANCHED TO,                   TIC35830
*        CERTAIN REGISTERS ARE SET:                                     TIC35840
*                                                                       TIC35850
*                  R5 = STANDARD POINTER TO BUFFER WHICH                TIC35860
*                       CONTAINS OUTPUT MEDIUM RECORD.                  TIC35870
*                  R6 = 0 FOR INPUT   1 FOR OUTPUT.                     TIC35880
*                  R7 = STANDARD POINTER TO BUFFER WHICH                TIC35890
*                       CONTAINS THE TEXT FO THE FQM.                   TIC35900
*                  R8 = WA OF THE PRIMITIVE BEING PROCESSED.            TIC35910
*                  R12 & R13 = RESULT OF AN INT,12 *8                   TIC35920
*                                                                       TIC35930
*        REGISTERS R5 AND R7 MUST BE PRESERVED.                         TIC35940
*                                                                       TIC35950
*        WHEN IT IS FINISHED PROCESSING THE PRIMITIVE, THE              TIC35960
*        ROUTINE MUST BRANCH TO 'TSINEXTPRIM' (INPUT) OR TO             TIC35970
*        'TSONEXTPRIM' (OUTPUT).  (THUS IF ONE ROUTINE HAS              TIC35980
*        BOTH INPUT AND OUTPUT ENTRY POINTS, IT BEHOOVES IT             TIC35990
*        TO PRESERVE R6.)                                               TIC36000
         PAGE                                                           TIC36010
*                                                                       TIC36020
*        HERRE ON I - INTEGER FIELD                                     TIC36030
*                                                                       TIC36040
TSIPRIMLOC(TFDI) SET %                                                  TIC36050
         LI,6      0                   SET FIXED FIELD LENGTH.          TIC36060
TSII200  RES       0                                                    TIC36070
         LI,8      0                   CLEAR OUT THE SUM-OF-FIELD.      TIC36080
         STW,8     TSILASTFIELDSUM                                      TIC36090
*                                                                       TIC36100
TSII220  BAL,15    TSIGETCHAR          GET CLERK'S CHARACTER.           TIC36110
         CLM,8     ZEROANDNINE         SEE IF ITS A DIGIT               TIC36120
         BCR,9     TSII300             OVER IF GOOD DIGIT               TIC36130
         CI,8      '-'                 NOT DIGIT, MUST BE MINUS         TIC36140
         BE        TSII300             OVER IF SO                       TIC36150
*                                                                       TIC36160
*        BAD CHARACTER ENCOUNTERED.                                     TIC36170
*                                                                       TIC36180
         B         %+1,6               SEE IF FIXED OR VARIABLE FIELD.  TIC36190
         B         TSIBADCHARACTER     ERROR IF FIXED                   TIC36200
TSII240  LI,8      ' '                 BLANK FILL                       TIC36210
         BAL,15    TSIPUTFQMCHAR        IF VARIABLE LENGTH              TIC36220
         BDR,13    TSII240               FIELD.                         TIC36230
         B         TSINEXTPRIM                                          TIC36240
*                                                                       TIC36250
TSII300  RES       0                                                    TIC36260
         BAL,15    TSIPUTFQMCHAR       CHARACTER TO FQM TEXT            TIC36270
         AND,8     =X'0F'              KILL ZONE AND                    TIC36280
         AWM,8     TSILASTFIELDSUM      ADD INTO SUM.                   TIC36290
         BDR,13    TSII220             AND BACK.                        TIC36300
         B         TSINEXTPRIM         AND BACK                         TIC36310
*                                                                       TIC36320
         BOUND     8                                                    TIC36330
         PAGE                                                           TIC36360
*                                                                       TIC36370
*        HERE ON G - GENERAL FIELD                                      TIC36380
*                                                                       TIC36390
TSIPRIMLOC(TFDG) SET %                                                  TIC36400
TSIG200  BAL,15    TSIGETCHAR          GET CHARACTER FROM MEDIUM        TIC36410
         BAL,15    TSIPUTFQMCHAR       CHARACTER TO FQM TEXT            TIC36420
         BDR,13    TSIG200             LOOP FOR 'W' CHARACTERS          TIC36430
*                                                                       TIC36440
         B         TSINEXTPRIM         AND BACK                         TIC36450
         PAGE                                                           TIC36460
*                                                                       TIC36470
*        HERE ON A - ALPHABETIC FIELD - INPUT SCAN                      TIC36480
*                                                                       TIC36490
TSIPRIMLOC(TFDA) SET %                                                  TIC36500
         LI,11     TSIBAOK             GET BIT - ALLOWED A'S.           TIC36510
*                                                                       TIC36520
*                                                                       TIC36530
*                                                                       TIC36540
*        GENERAL ROUTINE FOR FIXED-WIDTH INPUT FIELD.                   TIC36550
*        USES 'ALLOWED BIT' IN R11.                                     TIC36560
*                                                                       TIC36570
TSIA200  LI,8      0                   CLEAR OUT THE SUM-OF-FIELD.      TIC36580
         STW,8     TSILASTFIELDSUM                                      TIC36590
*                                                                       TIC36600
TSIA222  BAL,15    TSIGETCHAR          GET CHARACTER FROM MEDIUM.       TIC36610
*                                                                       TIC36620
         CH,11     TSIBTABLE,#ARG      TEST LEGAL-FOR-PRIM BIT.         TIC36630
*                                                                       TIC36640
         BAZ       TSIBADCHARACTER     OUT IF ILLEGAL.                  TIC36650
*                                                                       TIC36660
         BAL,15    TSIPUTFQMCHAR       CHARACTER TO FQM TEXT            TIC36670
         BDR,13    TSIA222             LOOP FOR W CHARACTERS.           TIC36680
         B         TSINEXTPRIM         AND OUT WHEN DONE.               TIC36690
         PAGE                                                           TIC36700
*                                                                       TIC36710
*        BIT TABLE GENERATION.                                          TIC36720
*                                                                       TIC36730
*        BIT TABLE IS USED TO SEE IF A CHARACTER IS LEGAL               TIC36740
*        FOR A PARTICULAR TFD PRIMITIVE.                                TIC36750
*                                                                       TIC36760
TSIBTABLEZERO SET  0                   SPECIAL LIST(0)                  TIC36770
*                                                                       TIC36780
I        DO        255                 SET UP & CLEAR TABLE VALUES.     TIC36790
TSIBTABLELIST(I) SET 0                                                  TIC36800
         FIN                                                            TIC36810
*                                                                       TIC36820
SETOK    CNAME                         PROC WHICH PUTS BITS INTO LIST.  TIC36830
         PROC                                                           TIC36840
I        DO        NUM(AF)                                              TIC36850
TSIBTABLELIST(AF(I)+0) SET TSIBTABLELIST(AF(I)+0)|CF(2)                 TIC36860
         FIN                                                            TIC36870
         PEND                                                           TIC36880
*                                                                       TIC36890
TSIBAOK  SET       1                   DEFINE A BIT FOR THE 'A' PRIMITIVTIC36900
TSIBBOK  SET       1                   SAME SET OF LEGALS FOR 'B' PRIM. TIC36910
         SETOK,TSIBAOK ' '                                              TIC36920
         SETOK,TSIBAOK 'A','B','C','D','E','F','G','H','I'              TIC36930
         SETOK,TSIBAOK 'J','K','L','M','N','O','P','Q','R'              TIC36940
         SETOK,TSIBAOK 'S','T','U','V','W','X','Y','Z'                  TIC36950
*                                                                       TIC36960
TSIBIOK  SET       2                   ALLOWED BIT FOR 'I' PRIMITIVE.   TIC36970
         SETOK,TSIBIOK '+'                                              TIC36980
         SETOK,TSIBIOK '0','1','2','3','4','5','6','7','8','9','-'      TIC36990
*                                                                       TIC37000
TSIBCOK  SET       4                   ALLOWED BIT FO  'C' PRIMITIVE.   TIC37010
TSIBDOK  SET       4                   ALLOWED BIT FOR 'D' PRIMITIVE.   TIC37020
         SETOK,TSIBCOK ' ','!','"','#','%','%','&',''''                 TIC37030
         SETOK,TSIBCOK '(',')','*','+',',','-','.','/'                  TIC37040
         SETOK,TSIBCOK '0','1','2','3','4','5','6','7'                  TIC37050
         SETOK,TSIBCOK '8','9',':',';','<','=','>','?'                  TIC37060
         SETOK,TSIBCOK '@','A','B','C','D','E','F','G'                  TIC37070
         SETOK,TSIBCOK 'H','I','J','K','L','M','N','O'                  TIC37080
         SETOK,TSIBCOK 'P','Q','R','S','T','U','V','W'                  TIC37090
         SETOK,TSIBCOK 'X','Y','Z'                                      TIC37100
         SETOK,TSIBCOK  X'B4',X'B1',X'B5',X'6A',X'6D'                   TIC37110
         SETOK,TSIBCOK      X'81',X'82',X'83'                           TIC37120
         SETOK,TSIBCOK  X'84',X'85',X'86',X'87'                         TIC37130
         SETOK,TSIBCOK X'88',X'89',X'91',X'92'                          TIC37140
         SETOK,TSIBCOK  X'93',X'94',X'95',X'96'                         TIC37150
         SETOK,TSIBCOK X'97',X'98',X'99',X'A2'                          TIC37160
         SETOK,TSIBCOK  X'A3',X'A4',X'A5',X'A6'                         TIC37170
         SETOK,TSIBCOK X'A7',X'A8',X'A9',X'B2'                          TIC37180
         SETOK,TSIBCOK  X'4F',X'B3',X'5F'                               TIC37190
*                                                                       TIC37200
TSIB9OK  SET       8                   JUST THE DIGITS.                 TIC37210
         SETOK,TSIB9OK '0','1','2','3','4','5','6','7','8','9'          TIC37220
*                                                                       TIC37230
TSIBLOK  SET       16                                                   TIC37240
         SETOK,TSIBLOK '+','-',' '                                      TIC37250
         SETOK,TSIBLOK '0','1','2','3','4','5','6','7','8','9'          TIC37260
*                                                                       TIC37270
TSIBBLANKOK SET    32                                                   TIC37280
         SETOK,TSIBBLANKOK ' '                                          TIC37290
*                                                                       TIC37300
TSIBSIGNOK SET     64                                                   TIC37310
         SETOK,TSIBSIGNOK '+','-'                                       TIC37320
*                                                                       TIC37330
TSIBPOINTOK SET    128                                                  TIC37340
         SETOK,TSIBPOINTOK '.'                                          TIC37350
*                                                                       TIC37360
TSIBDIGITOK SET    TSIB9OK                                              TIC37370
*                                                                       TIC37380
*                                                                       TIC37390
TSIBFDELIM SET 256
         SETOK,TSIBFDELIM ',',';',':','/'
         SETOK,TSIBFDELIM '*'
*                                                                       TIC37400
*        NOW GENARATE THE ACTUAL TABLE:                                 TIC37410
*                                                                       TIC37420
         BOUND     4                                                    TIC37430
TSIBTABLE GEN,16   TSIBTABLEZERO                                        TIC37440
I        DO        255                                                  TIC37450
         GEN,16    TSIBTABLELIST(I)                                     TIC37460
         FIN                                                            TIC37470
         PAGE                                                           TIC37480
*                                                                       TIC37490
*        HERE ON B - ALPHABETIC FIELD                                   TIC37500
*                                                                       TIC37510
TSIPRIMLOC(TFDB) SET %                                                  TIC37520
         LI,11     TSIBBOK             GET BIT - ALLOWED B'S.           TIC37530
*                                                                       TIC37540
*                                                                       TIC37550
*                                                                       TIC37560
*        GENERAL ROUTINE FOR NON-FIXED-WIDTH INPUT FIELD.               TIC37570
*        USES 'ALLOWED BIT' IN R11.                                     TIC37580
*                                                                       TIC37590
TSIB200  LI,8      0                   CLEAR OUT THE SUM-OF-FIELD.      TIC37600
         STW,8     TSILASTFIELDSUM                                      TIC37610
*                                                                       TIC37620
TSIB222  BAL,15    TSIGETCHAR          GET CHARACTER FROM MEDIUM.       TIC37630
*                                                                       TIC37640
         CH,11     TSIBTABLE,#ARG      TEST LEGLL-FOR-PRIM BIT.         TIC37650
         BAZ       TSIB300             OVER IF ILLEGAL.                 TIC37660
*                                                                       TIC37670
         BAL,15    TSIPUTFQMCHAR       CHARACTER TO FQM TEXT            TIC37680
         BDR,13    TSIB222             LOOP FRO W CHARACTERS.           TIC37690
*                                                                       TIC37700
         B         TSINEXTPRIM         AND OUT WHEN DONE.               TIC37710
*                                                                       TIC37720
TSIB300  LI,8      ' '                 BLANK FILL                       TIC37730
         BAL,15    TSIPUTFQMCHAR        REST OF                         TIC37740
         BDR,13    TSIB300               THE FIELD                      TIC37750
         B         TSINEXTPRIM                                          TIC37760
         PAGE                                                           TIC37770
*                                                                       TIC37780
*        HERE ON C - ALL GRAPHICS                                       TIC37790
*                                                                       TIC37800
TSIPRIMLOC(TFDC) SET %                                                  TIC37810
*                                                                       TIC37820
         LI,11     TSIBCOK             LOAD BIT WHICH TELLS LEGAL CHARS.TIC37830
*                                                                       TIC37840
         B         TSIA200             AND SHARE COMMON CODE.           TIC37850
         PAGE                                                           TIC37860
*                                                                       TIC37870
*        HERE ON D - ALL GRAPHICS.                                      TIC37880
*                                                                       TIC37890
TSIPRIMLOC(TFDD) SET %                                                  TIC37900
*                                                                       TIC37910
         LI,11     TSIBDOK             LOAD BIT WHICH DEFINES LEGAL CHARTIC37920
*                                                                       TIC37930
         B         TSIB200             AND GO TO COMMAN CODE.           TIC37940
         PAGE                                                           TIC37950
*                                                                       TIC37960
*        HERE ON E - FLOATING                                           TIC37970
*                                                                       TIC37980
TSIPRIMLOC(TFDE) SET %                                                  TIC37990
*                                                                       TIC38000
         LI,11     TSIBSIGNOK+TSIBBLANKOK+TSIBPOINTOK+TSIBDIGITOK       TIC38010
*                                                                       TIC38020
TSIE200  RES       0                   FIRST SCAN FOR LEADING BLANKS.   TIC38030
         BAL,15    TSIGETCHAR          GET A CHAR.                      TIC38040
         CI,8      ' '                 IS IT A BLANK.                   TIC38050
         BANZ      TSIE228             ENTER MAIN LINE IF NOT.          TIC38060
         BAL,15    TSIPUTFQMCHAR       STORE LEADING BLANK.             TIC38070
         BDR,13    TSIE200             AND GO FOR ANOTHER MAYBE.        TIC38080
         B         TSINEXTPRIM         OR DONE -- FIELD ALL BLANK.      TIC38090
*                                                                       TIC38100
TSIE222  BAL,15    TSIGETCHAR          GET A CHARACTER.                 TIC38110
TSIE228  CH,11     TSIBTABLE,#ARG      IS IS LEGAL.                     TIC38120
         BAZ       TSIE300             OVER IF NOT.                     TIC38130
*                                                                       TIC38140
         LH,12     TSIBTABLE,#ARG      GET WHAT KIND OF CHAR.           TIC38150
*                                                                       TIC38160
         CI,12     TSIBSIGNOK          IS IT A SIGN.                    TIC38170
         BAZ       %+2                 OVER IF NOT.                     TIC38180
         AND,11    =(-TSIBSIGNOK-1)    SIGNS NO LONGER LEGAL.           TIC38190
*                                                                       TIC38200
         CI,12     TSIBPOINTOK         IS IT A POINT.                   TIC38210
         BAZ       %+2                 OVER IF NOT.                     TIC38220
         AND,11    =(-TSIBPOINTOK-TSIBSIGNOK-1) POINTS AND SIGNS ILLEGALTIC38230
*                                                                       TIC38240
         CI,12     TSIBDIGITOK         IS IT A DIGIT.                   TIC38250
         BAZ       %+2                 OVER IF NOT.                     TIC38260
         AND,11    =(-TSIBSIGNOK-1)    IF SO SIGNS NO LONGER LEGAL.     TIC38270
*                                                                       TIC38280
         CI,12     TSIBBLANKOK         IS IT A BLANK.                   TIC38290
         BAZ       %+2                 OVER IF NOT.                     TIC38300
         LI,11     TSIBBLANKOK         IF SO, ONLY TRAILINGS LEGAL.     TIC38310
*                                                                       TIC38320
         BAL,15    TSIPUTFQMCHAR       STORE THE LEGAL CHAR.            TIC38330
         BDR,13    TSIE222             AND BACK FOR MORE.               TIC38340
         B         TSINEXTPRIM         OR WERE DONE.                    TIC38350
*                                                                       TIC38360
TSIE300  RES       0                   HERE ON ILLEGLL CHARACTER.       TIC38370
*                                                                       TIC38380
         AI,6      0                   TEST ARE WE DOING E OR F PRIM.   TIC38390
         BGEZ      TSIBADCHARACTER     ILLEGAL IF E PRIM.               TIC38400
*                                                                       TIC38410
         LI,11     TSIBFDELIM          SEE IF OK DELIMETER
         CH,11     TSIBTABLE,#ARG       FOR THE F PRIMITIVE.
         BAZ       TSIBADCHARACTER     ERROR IF NOT.
*                                                                       TIC38420
         LI,8      ' '                 BLANK FILL
         BAL,15    TSIPUTFQMCHAR        THE REST OF
         BDR,13    %-2                   THE FIELD.
         B         TSINEXTPRIM                                          TIC38430
         PAGE                                                           TIC38440
*                                                                       TIC38450
*        HERE ON F - FLOATING FREE FIELD                                TIC38460
*                                                                       TIC38470
TSIPRIMLOC(TFDF) SET %                                                  TIC38480
*                                                                       TIC38490
         LI,11     TSIBSIGNOK+TSIBPOINTOK+TSIBDIGITOK (NO BLANKS)       TIC38500
         OR,6      =X'80000000'        SET F PRIM BIT.                  TIC38510
         B         TSIE200             AND PROVESS WITH E PRIM CODE.    TIC38520
         PAGE                                                           TIC38530
*                                                                       TIC38540
*        HERE ON J - VARIABLE LENGTH INTEGER.                           TIC38550
*                                                                       TIC38560
TSIPRIMLOC(TFDJ) SET %                                                  TIC38570
*                                                                       TIC38580
         LI,6      1                   SET VARIABLE FIELD.              TIC38590
*                                                                       TIC38600
         B         TSII200             AND GO TO PROCESS INTEGER.       TIC38610
         PAGE                                                           TIC38620
*                                                                       TIC38630
*        HERE ON K - CHECK DIGIT.                                       TIC38640
*                                                                       TIC38650
TSIPRIMLOC(TFDK) SET %                                                  TIC38660
*                                                                       TIC38670
         LW,11     TSILASTFIELDSUM     SUM OF PREVIOUS FIELD.           TIC38680
         LI,10     0                   DIVIDE TO FORM CORRECT           TIC38690
         DW,10     13                   REMAINDER IN R10                TIC38700
*                                                                       TIC38710
         BAL,15    TSIGETCHAR          GET CHECK CHARACTER.             TIC38720
         EOR,10    8                   COMBINE WITH REMAINDER.          TIC38730
         CI,10     X'0F'               SEE IF IT AGREES.                TIC38740
         BANZ      TSIBADCHARACTER     OUT IF NO MATCH.                 TIC38750
*                                                                       TIC38760
         BAL,15    TSIPUTFQMCHAR       STORE GOOD CHARACTER             TIC38770
         B         TSINEXTPRIM         AND WE'RE DONE.                  TIC38780
         PAGE                                                           TIC38790
*                                                                       TIC38800
*        HERE ON L (AND M) PRIMS - UNPACKED DECIMAL RESULT.             TIC38810
*                                                                       TIC38820
TSIPRIMLOC(TFDL) SET %                                                  TIC38830
         LI,6      0                   SET FIXED FORMAT.                TIC38840
*                                                                       TIC38850
TSIL200  RES       0                                                    TIC38860
         LI,8      0                   CLEAR OUT SUM-OF-FIELD.          TIC38870
         STW,8     TSILASTFIELDSUM                                      TIC38880
*                                                                       TIC38890
         LI,11     TSIBLOK             ALLOW +- 0123456789              TIC38900
         LW,#ARG   13                  COPY 'W' = BYTE COUNT.           TIC38910
         LW,14     13                  TWO COPIES.                      TIC38920
         #GET#MAIN#BYTES                  GET WORKING BYTES.            TIC38930
         LW,10     #ARG                COPY BA OF WORKING.              TIC38940
         LW,12     #ARG                COPY BA OF WORKING.              TIC38950
*                                                                       TIC38960
TSIL300  RES       0                                                    TIC38970
         BAL,15    TSIGETCHAR          GET A CHARACTER.                 TIC38980
         B         TSIL600             AND GO CHECK IT                  TIC38990
*                                                                       TIC39000
*        HERE WEEN WE HAVE COLLECTED THE CHARACTERS                     TIC39010
*        IN WORKING STORAGE .  WE MUST NOW MOVE THEM TO                 TIC39020
*        THE FQM TEXT WITH FORMATTING.                                  TIC39030
TSIL400  RES       0                                                    TIC39040
*                                                                       TIC39050
*        WHEN HERE:                                                     TIC39060
*                                      C(R13) = ORIGINAL W = WIDTH.     TIC39070
*                                      C(R14) = REMAINING W.            TIC39080
*                                      C(R10) = DSP TO WORKING STORAGE. TIC39090
*                                      C(R12) = BUMPED DSA TO WORKING.  TIC39100
*                                                                       TIC39110
*        WORKING STORAGE CONTAINS NO BLANKS.                            TIC39120
*                                                                       TIC39130
         LW,11     14                  REMAINING WIDTH.                 TIC39140
         BEZ       %+4                 OVER IF NOT.                     TIC39150
         LI,8      X'F0'               SET IN                           TIC39160
         BAL,15    TSIPUTFQMCHAR        LEADING                         TIC39170
         BDR,11    %-2                   XEROES.                        TIC39180
*                                                                       TIC39190
         LW,9      10                  COPY DSP OF WORKING.             TIC39200
         CW,9      12                  COMPARE WITH BUMPED DSP.         TIC39210
         BE        TSIL665             OUT IF NO DIGITS.                TIC39220
         AI,12     -1                  R12 BACK TO LAST CHAR.           TIC39230
         CW,9      12                  SEE IF ONLY ONE DIGIT.           TIC39240
         BE        TSIL450             OVER IF SO.                      TIC39250
*                                                                       TIC39260
TSIL440  LW,#ARG   9                   INTO AN INDEX REGISTER AND       TIC39270
         LB,8      0,#ARG               GET A CHAR FROM WORKING.        TIC39280
         BAL,15    TSIPUTFQMCHAR       INTO FQM TEXT.                   TIC39290
         AI,9      1                   BUMP TO NEXT CHAR IN WORKING.    TIC39300
         CW,9      12                  SEE IF AT LAST CHARACTER.        TIC39310
         BNE       TSIL440             BACK IF NOT YET.                 TIC39320
*                                                                       TIC39330
*        WE ARE NOW AT THE LAST CHARACTER.                              TIC39340
*                                                                       TIC39350
TSIL450  RES       0                                                    TIC39360
         LW,#ARG   9                   INTO AN INDEX REGISTER AND       TIC39370
         LB,8      0,#ARG               GET LAST CHAR FROM WORKING.     TIC39380
         AI,6      0                   SEE IF WE ENCOUNTERED A MINUS.   TIC39390
         BGEZ      TSIL460             OVER IF NOT.                     TIC39400
         AND,8     =X'DF'              SET NEGATIVE ZONE.               TIC39410
TSIL460  BAL,15    TSIPUTFQMCHAR       AND STORE LAST CHAR.             TIC39420
*                                                                       TIC39430
         LW,#ARG   10                  RECOVER THE DSP OF WORKING.      TIC39440
         #FREE#MAIN#BYTES              AND FREE IT.                     TIC39450
         B         TSINEXTPRIM         AND WE'RE DONE.                  TIC39460
*                                                                       TIC39470
*                                                                       TIC39480
*                                                                       TIC39490
TSIL600  RES       0                   HERE ON NON-BLANK.               TIC39500
         CH,11     TSIBTABLE,#ARG      SEE IF LAGAL.                    TIC39510
         BAZ       TSIL650,6           BRANCH IF NOT.                   TIC39520
         CI,#ARG   ' '                 IS IT A (LEGAL) BLANK?           TIC39530
         BE        TSIL620             OVER IF SO.
         LI,11     TSIB9OK             NON-BLANK:  NO MORE BLANKS OR SIGTIC39570
         CI,#ARG   '+'                 IS IT A PLUS?                    TIC39580
         BE        TSIL620             DON'T SAVE SIGNS.                TIC39590
         CI,#ARG   '-'                 IS IT A MINUS?                   TIC39600
         BNE       TSIL625             OVER IF NOT.                     TIC39610
         OR,6      =X'80000000'        SET MINUS ENCOUNTERED FLAG.      TIC39620
TSIL620  RES       0                                                    TIC39630
         LI,8      X'F0'               STORE ZERO INDTEAD OF SIGN.      TIC39640
TSIL625  RES       0                                                    TIC39650
         LW,#ARG   12                  DSP INTO WORKING TO A XR.        TIC39660
         STB,8     0,#ARG              STORE BYTE INTO WORKING.         TIC39670
         AI,12     1                   BUMP WORKING POINTER.            TIC39680
*                                                                       TIC39690
         AND,8     =X'0F'              KILL THE ZONE.                   TIC39700
         AWM,8     TSILASTFIELDSUM     ADD INTO FIELD SUM.              TIC39710
*                                                                       TIC39720
TSIL640  BDR,14    TSIL300             BACK FOR ANOHTER.                TIC39730
*        FALL THROUGH ON W CHARS READ.                                  TIC39740
         LH,14     11                  RECORER POSSIBLE TRAILING ' ' COU
         B         TSIL400             PHASE TWO COPY.                  TIC39750
*                                                                       TIC39760
*                                                                       TIC39770
*                                                                       TIC39780
TSIL650  B         TSIL665             FIXED FIELD BAD CHAR IS ERROR.   TIC39790
         B         TSIL400             FREE FIELD BAD CHAR MEANS END.   TIC39800
TSIL665  RES       0                   HERE ON 'ILLEGAL' CHAR & L PRIM.
         CI,8      ' '                 SEE IFR REALLY A TRAILING BLANK.
         BNE       TSIL672             OVER IF TRUE ILLEGAL.
*
         AND,11    =X'FFFF0000'        MAKE EVERYTHING 'ILLEGAL'.
         AI,11     X'10000'            COUNT THE TRAILING BLANK.
         B         TSIL640             AND CONTINUE.
*
TSIL672  RES       0
         LW,#ARG   10                  HERE ON TRUE ILLEGAL CHAR.
         #FREE#MAIN#BYTES              FREE OUR WORKING.                TIC39820
         B         TSIBADCHARACTER     AND INDICATE BADNESS.            TIC39830
         PAGE                                                           TIC39840
*                                                                       TIC39850
*        HERE ON M PRIMITIVE                                            TIC39860
*                                                                       TIC39870
TSIPRIMLOC(TFDM) SET %                                                  TIC39880
         LI,6      1                   SET VARIABLE FORMAT.             TIC39890
         B         TSIL200             AND ENTER COMMON CODE.           TIC39900
         PAGE                                                           TIC39910
*                                                                       TIC39920
*        HERE ON # - FQM TEXT POSITIONING                               TIC39930
*                                                                       TIC39940
TSIPRIMLOC(TFD#) SET %                                                  TIC39950
*        (PRIMITIVE HAS BEEN INT'ED INTO R12 AND R13)                   TIC39960
         CI,13     X'8000'             SEE IF PLUS-TYPE                 TIC39970
         BAZ       TSI#400             OVER IF NOT                      TIC39980
*        FALL THROUGH ON PLUS-TYPE                                      TIC39990
         AND,13    =X'7FFF'            CLEAN OUT THE PLUS BIT           TIC40000
         BEZ       TSINEXTPRIM         DONE IF +0.                      TIC40010
TSI#300  BAL,15    TSIDONOTPUTFQMCHAR  SKIP AS MANY BYTES               TIC40020
         BDR,13    %-1                  AS IS INDICATED.                TIC40030
         B         TSINEXTPRIM         AND WE'RE DONE.                  TIC40040
*                                                                       TIC40050
*        HERE ON ABSOLUTE-TYPE                                          TIC40060
TSI#400  RES       0                                                    TIC40070
         LW,9      TSIBXR              ADJUST
         SLS,9     -2                   ENDBA
         AND,9     =X'1FFFF'             TO END
         LI,10     X'FFFF'                OF FIRST
         AND,10    *9                      BLOCK.
         SLS,9     2
         AW,9      10
         AI,9      -4
         STW,9     TSIFQMTEXTENDBA
         LW,7      TSIFQMTEXTBA        RESET TO START OF FQM            TIC40080
         AI,13     -1                  ADJUST R13 SINCE FIRST CHAR IS #1TIC40090
         BGZ       TSI#300             AND GO SKIP FORWARD IF NECESSARY.TIC40100
         B         TSINEXTPRIM         AND WE'RE DONE.                  TIC40110
         PAGE                                                           TIC40120
*                                                                       TIC40130
*        HERE ON Z = END OF TFD                                         TIC40140
*                                                                       TIC40150
TSIPRIMLOC(TFDZ) SET %                                                  TIC40160
         AI,13     0                   SEE IF A 'Z00'.                  TIC40170
         BEZ       TSIZ500             OVER IF SO.                      TIC40180
*                                                                       TIC40190
*        FALL THROUGH ON NON-Z0 PRIMITIVE.                              TIC40200
*                                                                       TIC40210
         INT,12    *8                  RE-INT THE PRIMITIVE.            TIC40220
         BCR,1     TSIZ300             OVER IF TYPE ZERO.               TIC40230
*                                                                       TIC40240
         CI,13     17                  TYPE ONE, SO MUST BE 17 CHARS.   TIC40250
         BNE       TSIBADPRIMITIVE     OUT IF ERRONEOUS.                TIC40260
*                                                                       TIC40270
         BAL,15    DONEWITHTFDCODE     GIVE UP OLD TFD.                 TIC40280
*                                                                       TIC40290
         LW,8      TSITFDSCAN          RE-LOAD WA OF THE PRIMITIVE.     TIC40300
         INT,12    *8                  RE-INT.
         BCR,2     %+2                 IF FLAG WORD PRESENT,
         AI,8      1                    BUMP R8 OVER FLAGS.
         AI,8      1                   PUSH R8 TO WA OF STRING.         TIC40310
         LCI       5                   17 CHARS = 5 WORDS.              TIC40320
         LM,9      *8                  LOAD TFD KEY INTO REGISTERS.     TIC40330
*                                                                       TIC40340
TSIZ220  RES       0                                                    TIC40350
         BAL,15    POINTTOTFDCODE      GO GET NEW TFD.                  TIC40360
         BEZ       TSIBADPRIMITIVE     OUT OF NO SUCH TFD.              TIC40370
*                                                                       TIC40380
         AI,8      @TFD@PREFIX@LENGTH  PUSH TFD WA TO FIRST PRIM.       TIC40390
         STW,8     TSITFDSCAN          AND STORE AS WHERE WE WRE.       TIC40400
*                                                                       TIC40410
         B         TSIGETPRIM          AND AWAY WE GO.                  TIC40420
*                                                                       TIC40430
*                                                                       TIC40440
*                                                                       TIC40450
TSIZ300  RES       0                   HERE ON THPE ZERO I.E. 'Z12'.    TIC40460
         LI,12     0                   DIVIDE TO                        TIC40470
         DW,12     =10                 S EPARATE OUT THE                TIC40480
         SLS,13    8                     NEW SEQUENCE                   TIC40490
         OR,13     12                     NIMBER.                       TIC40500
         OR,13     =X'F0F0'                                             TIC40510
         SLS,13    16                  ALIGN FOR LATER.                 TIC40520
*                                                                       TIC40530
         #T#GET,8  #DEV#USING#TFD      GET OLD TFD LOCATION.            TIC40540
         AI,8      1                   BUMP TO LOCATION OF OLD NAME.    TIC40550
         LCI       4                   LOAD 15 CHARACTERS               TIC40560
         LM,9      *8                   OF THE OLD NAME.                TIC40570
         SLS,12    -8                  SHIFT IN THE NEW                 TIC40580
         SLD,12    8                    SEQUENCE NUMBER.                TIC40590
*                                                                       TIC40600
         BAL,15    DONEWITHTFDCODE     GIVE UP THE OLD TFD.             TIC40610
         B         TSIZ220             AND GO GET THE NEW ONE.          TIC40620
*                                                                       TIC40630
*                                                                       TIC40640
*                                                                       TIC40650
TSIZ500  RES       0                   HERE ON Z0.                      TIC40660
         BAL,15    TSOPUTBUFFER        DUMP ANY OUTPUT.                 TIC40670
*                                                                       TIC40680
         LW,#ARG   TSIYSTRINGBA        SWAP Y-STRING BA FOR             TIC40710
         B         %+2
TSIZ512  LI,#ARG   0                   (SPECIAL CLEAN-UP ENTRY)
         #T#XCA,#ARG #DEV#COMMAND#LINE#RECORD#BA THE @0 LINE'S BA       TIC40720
         #FREE#MAIN#BYTES              AND FREE THE @0 LINE.            TIC40730
*
         LW,#ARG   TSIRECORDBA         MAYBE FREE A
         #FREE#MAIN#BYTES#IF            CUFRENT BUFFER.
*                                                                       TIC40740
         LW,9      TSIYSTRINGLENGTH    THEN COPY THE                    TIC40750
         #T#PUT,9  #DEV#COMMAND#LINE#RECORD#LENGTH Y-STRING LENGTH.     TIC40760
*
         BAL,15    DONEWITHTFDCODE
*
         BAL,15    FREEBXRSPACE
*                                                                       TIC40770
         #EXIT#SPACE                   RETURN 'SUBROUTINE' LOCAL SPACE. TIC40780
*                                      (AND RESTORE REGS .. ALTHO THE   TIC40790
*                                      REG SAVE FEATURE NOT USED HERE.) TIC40800
*                                                                       TIC40810
         B         COMMANDLEVEL        AND WE'RE DONE                   TIC40820
         PAGE                                                           TIC40830
*                                                                       TIC40840
*        HERE ON X = CREATE PORMAL TRANSACTION                          TIC40850
*                                                                       TIC40860
TSIPRIMLOC(TFDX) SET %                                                  TIC40870
*
         BAL,15    TSOPUTBUFFER        DUMP ANY OUTPUT.
*                                                                       TIC40880
*        THE FIRST THING WE DO IS TO COMBINE THE BXR BLOCK OF           TIC40890
*        MAIN STORAGE AND ITS CHAINED EXTENSIONS INTO ONE NEW           TIC40900
*        COMPACT BXR BLOCK:                                             TIC40910
*                                                                       TIC40920
         LW,9      TSIBXR              BA OF BXR.                       TIC40930
         SLS,9     -2                  WA OF BXR.                       TIC40940
         AND,9     =X'1FFFF'           NEATENED.                        TIC40950
*                                                                       TIC40960
         LI,10     X'FFFF'             ISOLATE THE                      TIC40970
         AND,10    *9                  'RECORD LENGTH IN BYTES'.        TIC40980
         LW,11     10                  REMEMBER FOR RUNNING SUM.        TIC40990
         SLS,10    -2                  INTO NUMBER OF WORDS IN BXR BLOCKTIC41000
*                                                                       TIC41010
         AW,9      10                  CREATE WA OF LAST                TIC41020
        AI,9      -1                   WORD IN THE BXR BLOCK.           TIC41030
*                                                                       TIC41040
         LW,9      *9                  IS IT ZERO?                      TIC41050
         BEZ       TSIX500             OVER AND AVOID ALL OF THE        TIC41060
*                                      FOLLOWING PUT-EM-TOGETHER CODE   TIC41070
*                                      WHEN THE BXR IS ALREADY IN ONE   TIC41080
*                                      PIECE.                           TIC41090
*                                                                       TIC41100
*        FALL THROUGH WHEN ADDITIONAL TEXT BLOCKS ARE CHAINED           TIC41110
*        TO THE BXR BLOCK.                                              TIC41120
*                                                                       TIC41130
TSIX325  RES       0                                                    TIC41140
         LW,#ARG   9                   COPY THE BA OF THE NEXT BLOCK.   TIC41150
         SLS,#ARG  -2                  MAKE IT A WA.                    TIC41160
*                                                                       TIC41170
         LW,9      (XACTIONTEXTINCREMENT/4)+1-1,#ARG LAST WORD.         TIC41180
         BEZ       TSIX335             OVER IF LAST INCREMENTAL BLOCK.  TIC41190
         AI,11     XACTIONTEXTINCREMENT BUMP RUNNING SIZE OF COMBINED.  TIC41200
         B         TSIX325                                              TIC41210
*                                                                       TIC41220
TSIX335  RES       0                   HERE WHEN WE GET TO LAST BLOCK.  TIC41230
*                                      #ARG HAS WA OF THE LAST BLOCK.   TIC41240
         SLS,#ARG  2                   CONVERT TO BA OF BLOCK.          TIC41250
         AND,#ARG  =X'7FFFF'           NEATEN. (UNNECESSAIRILY)         TIC41260
*                                                                       TIC41270
         LW,10     TSIFQMTEXTHIGHWATERMARKBA                            TIC41280
         SW,10     #ARG                CALCULATE GOOD BYTES IN LAST BLOCTIC41290
         BLEZ      %                   MUST BE SOME.                    TIC41300
         CI,10     XACTIONTEXTINCREMENT                                 TIC41310
         BG        %                   BUT CAN'T BE LOTS.               TIC41320
*                                                                       TIC41330
         AW,11     10                  ADD PARTIAL BLOCK INTO RUNNING.  TIC41340
*                                                                       TIC41350
         LW,14     10                  REMEMBER FOR LATER THE SIZE OF   TIC41360
*                                      THE PARTIAL BLOCK -- TO AVOID    TIC41370
*                                      RECALCULATING ITS SIZE.          TIC41380
*
*        WHEN HERE, WE HAVE A BYTE COUNT IN R11 WHICH
*        MAY NOT BE A MULTIPLE OF FOUR, SINCE WE CHOSE TO
*        CALCULATE IT FROM THE HIGH WATER MARK RATHER THAN
*        FROM THE SIZE OF THE LAST BXR BLOCK.
*        TO KEEP THE SIZE (EG AS REFLECTED IN WORD ZERO) OF
*        THE NEW BXR A MULTIPLE OF FOUR BYTES, WE HERE ROUND UP.
*        THE NECESSITY OF THIS WAS POINTED OUT IN SIDR #27432:
*        CALLING THE CHECKSUM ROUTINE WHEN THE BYTE-LENGTH IN
*        WORD ZERO IS NOT A MULTIPLE OF FOUR WAS
*        DAMAGING THE END BYTES OF THE FQM TEXT.
*
         AI,11     3                   ROUND THE COUNT IN R11
         AND,11    =X'FFFFC'            UP TO A MULTIPLE OF FOUR.
*                                                                       TIC41390
         LW,#ARG   11                  GET STORAGE FOR NEW BXR.         TIC41400
         #GET#MAIN#BYTES                                                TIC41410
         LW,7      #ARG                COPY THE BA OF NEW BXR.          TIC41420
*                                                                       TIC41430
*        NOW WE MUST MOVE THE OLD CHAINED PEECES                        TIC41440
*        INTO THE ONE-PIECE BXR.                                        TIC41450
*                                                                       TIC41460
         LW,8      TSIBXR              BA OF OLD BXR.                   TIC41470
         STW,7     TSIBXR              BA OF NEW BXR.                   TIC41480
*                                                                       TIC41490
         LI,6      X'7FFFF'            ISOLATE THE                      TIC41500
         AND,6     8                    BA OF SOURCE.                   TIC41510
*                                                                       TIC41520
         LW,12     8                   BA OF OLD BXR.                   TIC41530
         SLS,12    -2                  INTO WA.                         TIC41540
         LI,5      X'FFFF'                                              TIC41550
         AND,5     *12                 R5 HAS BYTE COUNT                TIC41560
         SLS,5     -2                  INTO WORD COUNT.                 TIC41570
         AW,5      12                  WA OF LAST+1 WORD.               TIC41580
         LW,5      -1,5                POINTER TO NEXT BLOCK.           TIC41590
*                                                                       TIC41600
         LW,10     8                   BA OF LLD BXR.                   TIC41610
         SLS,10    -2                  WA OF OLD BXR.                   TIC41620
         LW,#ARG   *10                 BYTE COUNT OF OLD BXR.           TIC41630
         AI,#ARG   -4                  LESS THE CHAIN WORD.             TIC41640
         STB,#ARG  7                   IS THE COUNT FOR THE MBS.        TIC41650
*                                                                       TIC41660
         STW,11    *10                 NEW BYTE COUNT INTO OLD BXR      TIC41670
*                                      BEFORE THE UPCOMING MOCE.        TIC41680
         MBS,6     0                   MOVE THE BLOCK.                  TIC41690
*                                                                       TIC41700
*        NOTE THAT AFTER THE MOVE, R7 IS SET FOR THE                    TIC41710
*        NEXT MOVE -- SO WE JUST LEAVE R7 ALONE IN                      TIC41720
*        THE SUBSEQUENT CODE.                                           TIC41730
*                                                                       TIC41740
         LW,#ARG   8                   R8 RETAINS OLD BXR DSP.          TIC41750
         #FREE#MAIN#BYTES              FREE OLD BXR.                    TIC41760
*                                                                       TIC41770
*        R5 CONTAINS BA OF THE NEXT BLOCK.                              TIC41780
*                                                                       TIC41790
TSIX320  RES       0                                                    TIC41800
         AND,5     =X'7FFFF'           NEATEN BA OF BLOCK.              TIC41810
*                                                                       TIC41820
         LW,6      5                   BA OF BLOCK TO R6.               TIC41830
         LI,#ARG   XACTIONTEXTINCREMENT COUNT IF FULL BLOCK             TIC41840
         STB,#ARG  7                     INTO THE MBS COUNT.            TIC41850
*                                                                       TIC41860
         SLS,5     -2                  MAKE WA OF BLOCK AND             TIC41870
         MTW,0     (XACTIONTEXTINCREMENT/4)+1-1,5 SEE IF LAST BLOCK.    TIC41880
         BNEZ      %+2                 OVER IF NOT LAST BLOCK.          TIC41890
         STB,14    7                   IS LAST BLOCK -- USE ITS COUNT.  TIC41900
*                                                                       TIC41910
         MBS,6     0                   MOVE THE BYTES.                  TIC41920
*                                                                       TIC41930
         LW,#ARG   5                   COPY WA OF THE OLD BLOCK.        TIC41940
         SLS,#ARG  2                   INTO A BA.                       TIC41950
         OR,#ARG   =X'80000000'        OR IN DYNAMIC BIT.               TIC41960
*                                                                       TIC41970
         LW,5      (XACTIONTEXTINCREMENT/4)+1-1,5 GET NEXT BLOCK BA.    TIC41980
*                                                                       TIC41990
*        NOTE THAT WE MOST GET THE POINTER TO THE NEXT                  TIC42000
*        BLOCK BEFORE WE RELEASE THE SPACE ITS CONTAINED IN.            TIC42010
*                                                                       TIC42020
         #FREE#MAIN#BYTES              FREE THE OLD BLOCK.              TIC42030
*                                                                       TIC42040
         AI,5      0                   SEE IF IT WAS THE LAST BLOCK.    TIC42050
         BNEZ      TSIX320             BACK IF NOT.                     TIC42060
*                                                                       TIC42070
*        FALL THROUGH WHEN ALL BLOCKS HAVE BEEN                         TIC42080
*        COPIED TO THE NEW CONTIGUOUS AREA AND RELEASED.                TIC42090
*                                                                       TIC42100
*        SINCE WE AHVE MOVED THE BXR, WE NEED TO                        TIC42110
*        RE-CALCULATE WHERE THE FQM TEXT IS:                            TIC42120
*                                                                       TIC42130
         LW,8      TSIBXR              DSP IF THE BXR.                  TIC42140
         AND,8     =X'7FFFF'           BA OF THE BXR.                   TIC42150
         AI,8      4+4+4+4+4+4+32      DOWN TO THE TEXT.                TIC42160
         STW,8     TSIFQMTEXTBA        STORE AS WHERE THE TEXT IS.      TIC42170
*                                                                       TIC42180
*        R7 STILL HAS THE BA+1 OF THE LSST BYTE WE MOVED.               TIC42190
*                                                                       TIC42200
         AND,7     =X'7FFFF'           NEATEN. (UNNECESSARY?)           TIC42210
         STW,7     TSIFQMTEXTHIGHWATERMARKBA                            TIC42220
*                                                                       TIC42230
         LW,8      7                   ROUND UP TO
         AI,8      3                    NEXT HIGHEST WORD.
         SLS,8     -2                  THEN ZERO OUT (R5 CONTAINS ZERO)
         STW,5     *8                   POINTER TO 'NEXT FQM BLOCK'.
*                                                                       TIC42280
         SLS,8     2                   AND STORE ITS BA AS
         STW,8     TSIFQMTEXTENDBA      THE END+1 OF NEW BLOCK.
*                                                                       TIC42290
*                                                                       TIC42300
*                                                                       TIC42310
TSIX500  RES       0                   HERE POST-ANY-COMBINING.         TIC42320
*
*        SET IN CORRECT RECORD TYPE
*
         LW,#ARG   TSIBXR              BA OF BXR.
         AI,#ARG   1                   BA OF TYPE BYTE.
         LI,10     X'10'               RECORD TYPE.
         STB,10    0,#ARG              INTO BXR.
*                                                                       TIC42330
*        STORE 'LENGTH OF TRANSACTOON TEXT' INTO BXR:                   TIC42340
*                                                                       TIC42350
         LW,8      TSIBXR              BA OF BXR.                       TIC42360
         SLS,8     -2                  WA OF BXR.                       TIC42370
         AI,8      5                   WA OF LENGTH HALFWORD.           TIC42380
         LW,9      TSIFQMTEXTHIGHWATERMARKBA LAST BYTE + 1.             TIC42390
         BEZ       %+2                 (ZERO MEANS ZERO BYTES)          TIC42400
         SW,9      TSIFQMTEXTBA        MINUS FIRST IS LENGTH.           TIC42410
         STH,9     *8                  STORE THE LENGTH OF THE TEXT.    TIC42420
*                                                                       TIC42430
*        PUT TRANID INTO THE BXR:                                       TIC42440
*                                                                       TIC42450
         BAL,15    OBTAINTRANIDINR9    GET A TRANID.                    TIC42460
*                                                                       TIC42470
         LW,#ARG   TSIBXR              BA OF BXR.
         SLS,#ARG  -2                  WA OF BXR.
         STW,9     4,#ARG              STORE TRANID.
         LI,8      0                   AND SET NO
         STW,8     1,#ARG               SPAWNER.
*                                                                       TIC42520
         LW,6      TSIBXR              BA OF BXR.
         AI,6      23                  BA OF NAME SIZE BYTE.
         LB,8      0,6                 NAME SIZE.
         AW,6      8                   BA OF LAST BYTE IN NAME.
*                                      (SINCE NAME SIZE BYTE IS JUST
*                                      AHEAD OF THE NAME ITSELF)
         AI,6      -7                  BA OF WHERE TO PUT ID.
*                                                                       TIC42600
*        (BA OF WHERE TO PUT EBCDIC TRANID IS IN R6)
*                                                                       TIC42620
         LI,12     8                   DO EIGHT DIGITS.                 TIC42630
         LI,8      0                                                    TIC42640
         SLD,8     4                   SLIDE A DIGIT OVER.              TIC42650
         LW,#ARG   8                   LOAD ITS                         TIC42660
         LB,8      HEXTABLE,#ARG        EBCDIC REPRESENTATION.          TIC42670
         STB,8     0,6                 AND STORE INTO NAME.
         AI,6      1                   AND BUMP TO NEXT NAME BYTE.
         BDR,12    %-6                 AND LOOP.                        TIC42700
*
         STW,12    TSITRANID           AND CLEAR OUT THE 'USED' ID.
*                                                                       TIC42710
*                                                                       TIC42780
*                                                                       TIC42790
         LW,8      TSITFDSCAN          RECONSTRUCT R12 & R13            TIC42800
         INT,12    *8                   AS THEY WERE ON ENTRY.          TIC42810
          LI,12     0                                                   TIC42820
          DW,12     =10                 SEPARATE TENS & UNITS DIGITS.   TIC42830
*                                                                       TIC42840
         AND,12    =1                   ISOLATE JOURNAL BIT.            TIC42850
          SLS,12    26                  SHIFT INTO H.O.BYTE.            TIC42860
         LW,11     12                  PUT INTO R11.                    TIC42870
         AND,13     =1                  ISOLATE ENQUEUE BIT.            TIC42880
          SLS,13    31                  SHIFT INTO H.O.BYTE.            TIC42890
         OR,11     13                  AND PUT INTO R11.                TIC42900
*
         LW,#ARG   TSIBXR              BA OF BXR.
         SLS,#ARG  -2                  WA OF BXR.  (UN-NEAT)
         LB,8      11                  Q/JRNL BITS BYTE.
         STB,8     *#ARG               STORE Q/JRNL BYTE.
*
         LW,13     #ARG                (REMEMBER BXR WA FOR BELOW)
*
         CW,11     =X'04000000'        SEE IF WE SHOULD JOURNAL.        TIC42920
         BAZ       TSIX522             OVER IF NOT.                     TIC42930
*                                      R13 STILL HAS WA OF BXR.
*
         LW,8      13                  COPY BXR WA TO R8.AND ...
         BAL,15    WRITEJOURNALRECORD   GO WRITE JOURNAL RECORD.
TSIX522  RES        0                                                   TIC43020
         CW,11     =X'80000000'        SEE IF WE SHOULD ENQUEUE.        TIC43030
          BAZ       TSIX580             OVER IF NOT.                    TIC43040
*                                                                       TIC43050
         LW,8      TSIBXR              BA OF BXR.                       TIC43060
          SLS,8     -2                  INTO WA OF BXR.                 TIC43070
          AND,8     =X'1FFFF'           NEATENED.                       TIC43080
         OR,8      11                  PLUS J & Q H. O. BITS.           TIC43090
*                                                                       TIC43100
         #T#GWA,9  #DEV#ECB             NEED AN ECB.                    TIC43110
*                                                                       TIC43120
TSIX556   M:QUEUE   8,PUT,(LSIZE,1),(ECB,*9) QUEUE IT.                  TIC43130
         BCR,12     TSIX580             OVER IF GOOD ENQUEUE.           TIC43140
         BCS,4     TSIX570             OVER IF MUST WAIT.               TIC43150
*                                                                       TIC43160
         #SNAP,30  'Q/PUT ERROR CC12=10'                                TIC43170
         #ABORT                                                         TIC43180
TSIX570  RES       0                                                    TIC43190
          LW,#ARG   9                   ECB ADDRESS TO WAIT ON.         TIC43200
         #WAIT#ON                       WAIT.                           TIC43210
         B         TSIX522             AND TRY AGAIN.                   TIC43220
*                                                                       TIC43230
TSIX580   RES       0                                                   TIC43240
         LW,13     TSIBXR              BA OF BXR.
         SLS,13    -2                  WA OF BXR.
         LI,12     X'FFFF'             LOAD BYTE
         AND,12    *13                  COUNT AND MAKE
         SLS,12    -2                    IT A WORD COUNT.
         AW,13     12                  WA OF LAST WORD PLUS ONE.
         AI,13     -1                  WA OF CHECKSUM/LINK WORD.
         LI,12     0                   STORE A ZERO
         STW,12    *13                  BXR FORWARD LINK.
*                                                                       TIC43250
         B         TSINEXTPRIM                                          TIC43360
         PAGE                                                           TIC43510
*                                                                       TIC43520
*        HERE ON @ = MEDIUM POSITIONING                                 TIC43530
*                                                                       TIC43540
TSIPRIMLOC(TFD@) SET %                                                  TIC43550
TSOPRIMLOC(TFD@) SET %                                                  TIC43560
         LI,14     X'FF'               ALIGN THE COLUMN INFO            TIC43570
         AND,14    13                   IN R14 AND THE ROW              TIC43580
         SLS,13    -8                    INFO IN R13                    TIC43590
*                                                                       TIC43600
         AI,13     0                   SEE IF @0.                       TIC43630
         BNEZ      TSI@160             OVER IF NOT.                     TIC43640
*                                                                       TIC43650
*        HERE ON @0.                                                    TIC43660
*                                                                       TIC43670
         B         %+1,6               TEST FOR INPTT VS OUTPUT.        TIC43680
         B         %+3                 NORMAL IF INPUT.                 TIC43690
         LI,13     1                   IF OUTPUT, THEN                  TIC43700
         B         TSI@160              TREAT AS @1.                    TIC43710
*                                                                       TIC43720
         LI,#ARG   0                   OBTAIN AND CLEAR
         XW,#ARG   TSIRECORDBA          INPUT BUFFER PTR.
         #FREE#MAIN#BYTES#IF             AND FREE IF DYNAMIC
*                                                                       TIC43740
         #T#GET,8  #DEV#COMMAND#LINE#RECORD#BA BA OF COMMAND LINE.      TIC43750
         AND,8     =X'7FFFF'           NEATENED.                        TIC43760
         STW,8     TSIRECORDBA         AND                              TIC43770
         STW,8     TSIRECORDCURRENTBA  STORED.                          TIC43780
*                                                                       TIC43790
         #T#GET,8  #DEV#COMMAND#LINE#RECORD#LENGTH LENGTH               TIC43800
         AW,8      TSIRECORDBA          PLUS RECORD START               TIC43810
         STW,8     TSIRECORDENDBA        IS RECORD EDN+1.               TIC43820
*                                                                       TIC43830
         LI,8      10001               BIG NUMBER
         STW,8     TSICURRENTR          AS CURRENT ROW.                 TIC43850
*                                                                       TIC43860
         B         TSI@490             AND OVER TO COLUMN CODE.         TIC43870
*                                                                       TIC43880
TSI@160  RES       0                   HERE ON NORMAL @ (NOT @0).
*
*        MAKE R13 AND R14 ABSOLUTE ROW AND COLUMN*
*        BY FIXING UP ANY +R OR +C:
*
         CI,13     X'80'
         BAZ       %+3
         AND,13    =X'7F'
         AW,13     TSICURRENTR
         CI,14     X'80'
         BAZ       %+3
         AND,14    =X'7F'
         AW,14     TSICURRENTC
*
*        SEE IF THIS @ IS DOWN-THE-PAGE OR TO-THE-RIGHT - IE FORWARD:
*
TSI@200  RES       0
         CW,13     TSICURRENTR         SEE IF DOWN-THE-PAGE             TIC44000
         BG        TSI@300             OVER IF SO                       TIC44010
         BL        TSI@220             NEW PAGE IF UP-THE-PAGE.         TIC44020
*        FALL THRU IF SAME ROW.                                         TIC44030
         CW,14     TSICURRENTC         SEE IF LEFT OF WHERE WE ARE.     TIC44060
         BGE       TSI@300             IF NOT, OVER TO MOVE FORWARD CODE
*        FALL THRU ON NEW PAGE.                                         TIC44080
TSI@220  RES       0                                                    TIC44090
         BAL,15    TSI@KILLINPUTBUFFER6,6 KILL ANY INPUT BUFFER.        TIC44100
*                                                                       TIC44110
         #EXU#ON#TYPE#INDEX
         B         TSI@250             UNKNOWN TYPE GETS TTY.
         BAL,#BAL  TSI@250             NO OWNCODE ROUTINE YET.
         B         TSI@240             UNIT RECORD.
         B         TSI@250             TTY.
         B         TSI@260             3270.
*
TSI@240  RES       0                   HERE FOR NEW PAGE ON UNIT RECORD.
         #T#GET,#ARG #DEV#DCB#POINTER  GET THE STATION'S
         LW,8      *#DCB#TABLE#IW,#ARG  DCB LOCATION AND
         M:DEVICE  *8,(PAGE)             DO THE NEW PAGE.
         B         TSI@283
*
TSI@250  RES       0                   HERE FOR NEW PAGE ON TTY.
         LI,8      X'0D'               NEEDS TO GO COL ONE IN UTS.   ***TIC44120
         BAL,15    TSOPUTCHAR          'CAUS OF UTS PLATEN CONTROL.  ***TIC44130
         LI,8      X'0C'               FORM FEED.                       TIC44140
         AI,14     0                   TEST FOR SPECIAL                 TIC44150
         BNEZ      %+2                  @R,0.  IF SO,                   TIC44160
         LI,8      X'08'                 JUST DO A HOME.             ***TIC44170
         BAL,15    TSOPUTCHAR          SEND IT.                         TIC44180
         B         TSI@283
*
TSI@260  RES       0                   HERE FOR NEW PAGE ON 3270.
         DO        DO#3270
         AI,14     0                   SEE IF NEW PAGE (IMPLIES ERASE).
         BEZ      TSI@266           OVER IF NOT.
         #T#GET,#ARG  #DEV#PLATEN#R    MAX ROWS
         #T#GET,9    #DEV#PLATEN#C  MAX COLUMNS
         MW,9     #ARG              MAX SCREEN SIZE
         LI,6     0
TSI@264  RES      0
         LW,8     RATABLE,6
         BAL,15   TSOPUTWORD        SET BUFFER ADDRESS
         LW,8     RATABLE+1,6
         BAL,15   TSOPUTWORD        RA BLANKS
         AI,6     2
         AI,9     -480              480 BUFFER POSITIONS AT A TIME
         BGZ      TSI@264
         LW,6     TSIZEROORONE
*
TSI@266  RES       0
         LW,8      =X'11404013'        DO THE @1,1
         BAL,15    TSOPUTWORD           WITH SBA AND IC.
         FIN
*                                                                       TIC44190
TSI@283  RES       0
         LI,8      1                   WE ARE BACK                      TIC44200
         STW,8     TSICURRENTR          TO ROW ONE.                     TIC44210
         STW,8     TSICURRENTC           COLUMN ONE.                    TIC44220
*
         CI,14     10000               IF COLUMN WAS UNDEFINED,
         BL        %+2                  IT IS NOW CHANGED TO
         AI,14     -10000                BE DEFINED.
*
         CI,14     1                   ELIMINATE
         BGE       TSI@200              ANY FAKE
         LI,14     1                     ZERO ROW.
         B         TSI@200             AND RE-DO THE ROW TESTS.         TIC44230
*
TSI@300  RES       0                   HERE ON @-ING FORWARD ON MEDIUM.
*
         #EXU#ON#TYPE#INDEX
         B         TSI@370             UNKNOWN.
         B         TSI@370             OWNCODE IS LACKING.
         B         TSI@370             UNIT RECORD.
         B         TSI@370             TTY.
         B         TSI@327             3270.
*
TSI@327  RES       0                   HERE ON @-ING FORWARD ON 3270.
*
         DO        DO#3270
*
         AI,6      0                   SEE IF REPORTING.
         BGZ       TSI@3400            OVER IF SO.
         MTW,0     TSIRECORDCURRENTBA  SEE IF NO INPUT BUFFER.
         BEZ       TSI@3400            OVER IF SO.
*
*        FALL THROUGH IF ACCEPTING A TRANSACTION
*        AND SCANNING AN EXISTING INPUT BUFFER.
*
*        NOTE THAT WE ASSUME IN THIS CODE THAT ALL
*        3270 BUFFER-LOADS OF INPUT REPRESENT THE
*        WHOLE SCREEN.  THEREFORRE THIS @ WILL NOT
*        CAUSE US TO 'READ OFF THE END' AND THEN
*        BEGIN WRITING.
*
*        DESIRED R&C ARE IN R13 AND R14.
*        CURRENT R&C ARE IN TSICURRENTR AND TSICURRENTC.
*        BUFFER POINTERS ARE IN THE 'TSI' ENTRY-SPACE.
*
TSI@3290 RES       0
*
*        SEE IF WE ARE DONE `-ING:
*
         CW,13     TSICURRENTR
         BNE       TSI@3320
         CW,14     TSICURRENTC
         BE        TSINEXTPRIM
*
TSI@3320 RES       0
         LW,#ARG   TSIRECORDCURRENTBA  CURRENT BUFFER POINTER.
         CW,#ARG   TSIRECORDENDBA      STILL WITHIN BUFFER.
         BL        TSI@3340            OVER IF SO.
*
*        FALL THROUGH WHEN INPUT BUFFER EXAUSTED.
*
*        SINCE 'ENTER' KEY ON A 3270 XMITS US THE WHOLE PAGE,
*        THIS @-FORWARD IS STILL AN @ INTO THE CLERK'S PAGE IMAGE.
*        THEREFORE, WE DO NOT FREE THE EXAUSTED BUFFER (WHICH
*        WOULD IMPLICITLY GGET ANOTHER), BUT RATHER SPIN AT
*        THE END OF THIS BUFFER, WAITING FOR AN @ UP-THE-PAGE.
*
         B         TSI@3377
*
TSI@3340 RES       0                   HERE ON WITHIN BUFFER.
         LB,8      0,#ARG              GET A CHARACTER.
         CI,8      X'11'               IS IT A SBA.
         BE        TSI@3350            OVER IF SO.
*
*        FALL THROUGH ON NORMAL CHARACTER IN BUFFER.
*
TSI@3345 RES       0
         MTW,1     TSICURRENTC         ADJUST R&C OVER CHARACTER:
         LW,#ARG   TSICURRENTC
         #T#GET,#BAL  #DEV#PLATEN#C
         CW,#ARG  #BAL
         BLE       %+4
         LI,#ARG   1
         STW,#ARG  TSICURRENTC
         MTW,1     TSICURRENTR
         MTW,1     TSIRECORDCURRENTBA  AND BUMP BUFFER POINTER.
         B         TSI@3290
*
TSI@3350 RES       0                   HERE ON SB IN BUFFER>
         AI,#ARG   2                   SEE IF ROOM IN BUFFER
         CW,#ARG   TSIRECORDENDBA       FOR R&C WITH THE X'11'.
         BGE       TSI@3345            TREAT AS NORMAL IF NOT.
*
         BAL,#BAL  TSIODDRANDC         FIGURE OUT ROW AND COLUMN.
*
         CW,9      13                  COMPARE R&C.
         BL        TSI@3387             TO DESIRED.
         BG        TSI@3377
         CW,8      14
         BLE       TSI@3387
*
TSI@3377 RES       0                   HERE WHEN SBA HIGHER THAN R&C.
         STW,13    TSICURRENTR         SO SET WE ARE THERE
         STW,14    TSICURRENTC          AND DON'T LEAVE THE SBA.
         B         TSINEXTPRIM
*
TSI@3387 RES       0                   HERE WHEN SBA NOT HIGHER THAN R&C
         MTW,3     TSIRECORDCURRENTBA  OVER THE SBA AND STUFF.
*
         STW,9     TSICURRENTR         SAY WE'VE COME
         STW,8     TSICURRENTC          THIS FAR.
         B         TSI@3290              AND CONTINUE.
*
*
*
TSI@3400 RES       0                   HERE WHEN OUTPUTTING.
*
         STW,13    TSICURRENTR
         STW,14    TSICURRENTC
*
         BAL,15    3270RANDCTOSBA      CONVERT TO SBA STUFF.
*
         LI,8      X'13'               POSITION SBA
         OR,8      12                   AND CURSOR
         BAL,15    TSOPUTWORD            THERE.
*
         LI,8      -1                  INDICATE THAT NEXT PRIMITIVE
         STW,8     TSOFIELDSSINCEAT     NEEDS TO PUT ATTRIBUTE IN.
*
         AI,14     -1                  AND RE-POSITION
         BAL,15    3270RANDCTOSBA       SBA TO WHERE
         LW,8      12                    THE ATTRIBUTE
         BAL,15    TSOPUTWORD             WILL GO.
*
         B         TSXNEXTPRIM,6
         FIN
*
TSI@370  RES       0
*                                                                       TIC44240
*
         SW,13     TSICURRENTR         SEE HOW MANY ROWS DOWN.
         BEZ      TSI@500           (ZERO LOOPS IF ROW OK.)
         BAL,15    TSI@980,6           DOWN AN INPUT OR OUTPUT LINE.    TIC44260
         BDR,13    %-1                  AT A TIME                       TIC44270
*                                                                       TIC44280
TSI@480  RES       0                                                    TIC44290
TSI@490  RES       0                   HERE AFTER PLAYING ROW GAMES     TIC44300
         LI,8      1                   SET BACK TO COLUMN ONE           TIC44310
         STW,8     TSICURRENTC         IN THE NEW ROW WE'RE AT          TIC44320
*
         CI,14     10000               IF COLUMN WAS UNDEFINED,
         BL        %+2                  WE CHANGE IT HERE
         AI,14     -10000                TO BE DEFINED.
*                                                                       TIC44330
*                                                                       TIC44340
TSI@500  RES       0                   HERE WE HANDLE THE COLUMN PART   TIC44350
         AI,14     0                   CLEAN UP                         TIC44360
         BGZ       %+2                  ANY SPECIAL                     TIC44370
         LI,14     1                     COLUMN INFO.                   TIC44380
*                                                                       TIC44460
TSI@700  RES       0                   THIS CODE FOR C PARALLELS R CODE TIC44470
         CW,14     TSICURRENTC         SEE IF COLUMN TO-THE-RIGHT       TIC44480
         BG        TSI@800             OVER IF TO-THE-RIGHT             TIC44490
         BE        TSI@950             DONE IF EQUAL                    TIC44500
         B         TSXNEXTPRIM,6       (REALLY IS TFD ERROR.)           TIC44510
*                                                                       TIC44520
TSI@800  SW,14     TSICURRENTC        SEE HOW MANY COLS OVER            TIC44530
         LI,8      ' '                 LOAD A BLANK FOR OUTPUT CASE AND TIC44540
         BAL,15    TSI@982,6           OVER AN INPUT OR OUTPUT COLUMN.  TIC44550
         BDR,14    %-1                  ONE BY ONE                      TIC44560
         B         TSXNEXTPRIM,6       AND THEN WE'RE DONE.             TIC44570
TSI@900  SET       TSXNEXTPRIM,6                                        TIC44580
TSI@950  SET       TSXNEXTPRIM,6                                        TIC44590
*                                                                       TIC44600
*                                                                       TIC44610
*                                                                       TIC44620
TSI@980  B         TSIGETORPUTEOL                                       TIC44630
         B         TSOPUTEOL                                            TIC44640
*                                                                       TIC44650
TSI@982  B         TSIGETORPUTCHAR                                      TIC44660
         B         TSOPUTCHAR                                           TIC44670
*                                                                       TIC44680
TSI@984  B         TSINEXTPRIM                                          TIC44690
         B         TSONEXTPRIM                                          TIC44700
*                                                                       TIC44710
TSI@KILLINPUTBUFFER6 B %+2                                              TIC44720
         B         *15                 NO ACTION IF OUTPUT.             TIC44730
         LI,#ARG   0                   FREE UP
         XW,#ARG   TSIRECORDBA          ANY IN-USE
         #FREE#MAIN#BYTES#IF             INPUT BUFFER.
         LI,#ARG   0
         STW,#ARG  TSIRECORDCURRENTBA                                   TIC44760
         B         *15                                                  TIC44770
         DO       DO#3270
RATABLE  DATA,4   X'11404000'       SBA, POSITION 0
         DATA,4   X'3CC75F40'       RA BLANKS TO POSITION 479
         DATA,4   X'11C76000'       SBA, POSITION 480
         DATA,4   X'3C4E7F40'       RA BLANKS TO POSITION 959
         DATA,4   X'114F4000'       SBA, POSITION 960
         DATA,4   X'3CD65F40'       RA BLANKS TO POSITION 1439
         DATA,4   X'11D66000'       SBA, POSITION 1440
         DATA,4   X'3C5D7F40'       RA BLANKS TO POSITION 1919
         FIN
         PAGE                                                           TIC44780
*                                                                       TIC44790
*        HERE ON # = POSITION IN FQM TEXT                               TIC44800
*                                                                       TIC44810
TSOPRIMLOC(TFD#) SET %                                                  TIC44820
         CI,13     X'8000'             SEE IF PLUS-TYPE.                TIC44830
         BAZ       TSO#400             OVER IF ABSOLUTE.                TIC44840
*                                                                       TIC44850
         AND,13    =X'7FFF'            ISOLATE THE AMOUNT TO BUMP.      TIC44860
         AW,7      13                  AND BUMP IT.                     TIC44870
         B         TSONEXTPRIM         AND WE'RE DONE.                  TIC44880
*                                                                       TIC44890
TSO#400  RES       0                   HERE ON ABS #.                   TIC44900
         LW,7      TSOFQMTEXTBA        GET CLEAN BA START OF TEXT.      TIC44910
         AI,7      -1                  CORRECT FOR POSITION ONE.        TIC44920
         AW,7      13                  ADD IN ABS VALUE.                TIC44930
         B         TSONEXTPRIM         AND WE'RE DONE.                  TIC44940
         PAGE                                                           TIC44950
*                                                                       TIC44960
*        HERE ON P = PROMPT                                             TIC44970
*                                                                       TIC44980
TSIPRIMLOC(TFDP) SET %
*
         BAL,15    TSIKILLBUFFERIF     KILL ANY WORKING BUFFER.
*
TSOPRIMLOC(TFDP) SET %                                                  TIC44990
*                                                                       TIC45010
         BAL,14    TSOANOTHERFIELD
*
         LW,8      TSITFDSCAN          (RE-LOAD R8)
         INT,12    *8                  RE-INT THE PRIMITIVE.            TIC45020
         BCR,1     TSOP400             OVER IF TYPE ZERO.               TIC45030
*
*        FALL THROUGH FOR NORMAL PROMPTING OF A STRING.                 TIC45040
*        R8 STILL HAS POINTER TO CURRENT TFD POSITION.                  TIC45050
*
         BCR,2     %+2                 IF FLAG WORD PRESENT,
         AI,8      1                    BUMP R8 OVER FLAGS.
         AI,8      1                   BUMP R8 OVER THE CONTROL WORD.   TIC45060
         SLS,8     2                   AND CONVERT IT TO A BA.          TIC45070
*                                                                       TIC45080
         LW,14     8                   COPY THE BA (NO INDEX REG AVAIL).TIC45090
TSOP340  LW,#ARG   14                  COPY BA TO TEMP INDEX REGISTER.  TIC45100
         LB,8      0,#ARG              GET A CHARACTER FROM P STRING.   TIC45110
         AI,14     1                   BUMP PROMPT STRING POINTER.      TIC45120
         BAL,15    TSOPUTCHAR          STUFF IT INTO OUTPUT BUFFER.     TIC45130
         BDR,13    TSOP340             LOOP FOR C.C. OF STRING.         TIC45140
         B         TSXNEXTPRIM,6       AND RETURN TO TSI OR TSO NEXTPRIMTIC45150
*                                                                       TIC45160
TSOP400  AI,13     0                   TEST FOR SPECIAL P0.             TIC45170
         BEZ       TSOP600             OVER IF SO.                      TIC45180
*                                                                       TIC45190
         LI,8      ' '                  ON PN, GET A BLANK              TIC45200
TSOP430  BAL,15    TSOPUTCHAR          STUFF INTO BUFFER                TIC45210
         BDR,13    TSOP430              AS MANY AS W OF THEM.           TIC45220
         B         TSXNEXTPRIM,6       AND RETURN TO TSI OR TSO NEXTPRIMTIC45230
*                                                                       TIC45240
TSOP600  RES       0                   HERE ON SPECIAL P0.              TIC45250
         BAL,15    OBTAINTRANIDINR9    GET THE TRANID.                  TIC45260
         LI,13     8                   SEND EIGHT DIGITS.               TIC45270
         LI,8      0                   ISOLATE FOUR
         SLD,8     4                    HEX BITS.
         LW,#ARG   8                   GET EBCDIC
         LB,8      HEXTABLE,#ARG        HEX CHARACTER.
         BAL,15    TSOPUTCHAR          SEND IT.                         TIC45300
         BDR,13    %-5
         B         TSXNEXTPRIM,6       AND RETURN.                      TIC45320
         PAGE                                                           TIC45330
*                                                                       TIC45340
*        HERE ON G = GENERAL FIELD   OUTPUT                             TIC45350
*                                                                       TIC45360
TSOPRIMLOC(TFDG) SET %                                                  TIC45370
TSOPRIMLOC(TFDE) SET %                                                  TIC45380
TSOPRIMLOC(TFDF) SET %                                                  TIC45390
TSOG200  RES       0                                                    TIC45400
*
         BAL,14    TSOANOTHERFIELD
*
TSOG450  RES       0
         BAL,15    TSOGETFQMCHAR       GET A CHAR FROM THE TEXT.        TIC45410
         BAL,15    TSOPUTCHAR          STUFF BYTE INTO THE OUTPUT BUFFERTIC45420
         BDR,13    TSOG450             AND PROCESS W BYTES.
*                                                                       TIC45440
         B         TSONEXTPRIM         THEN WE ARE DONE WITH THIS ONE.  TIC45450
         PAGE                                                           TIC45460
*                                                                       TIC45470
*        HERE ON A.  OUTPUT.                                            TIC45480
*                                                                       TIC45490
TSOPRIMLOC(TFDA) SET %                                                  TIC45500
         LI,11     TSIBAOK             LOAD LEGAL CHARACTERS BIT.       TIC45510
*                                                                       TIC45520
*        AND FALL INTO COMMON CODE.                                     TIC45530
*                                                                       TIC45540
TSOA200  RES       0                                                    TIC45550
*
         BAL,14    TSOANOTHERFIELD
*
TSOA450  RES       0
         BAL,15    TSOGETFQMCHAR       GET CHARACTER FROM REPORT.       TIC45560
         CH,11     TSIBTABLE,#ARG      TEST LEGAL-FOR-PRIM BIT.         TIC45570
         BAZ       TSOBADCHARACTER     OUT IF ILLEGAL CHARACTER.        TIC45580
         BAL,15    TSOPUTCHAR          LEGAL CHAR --> OUTPUT BUFFER.    TIC45590
         BDR,13    TSOA450             AND PROCESS W CHARACTERS
*                                                                       TIC45610
         B         TSONEXTPRIM         AND BACK WHEN DONE.              TIC45620
         PAGE                                                           TIC45630
*                                                                       TIC45640
*        HERE ON B.  OUTPUT.                                            TIC45650
*                                                                       TIC45660
TSOPRIMLOC(TFDB) SET TSOPRIMLOC(TFDA)  B IDENTICAL TO A ON OUTPUT.      TIC45670
         PAGE                                                           TIC45680
*                                                                       TIC45690
*        HERE ON C.  OUTPUT.                                            TIC45700
*                                                                       TIC45710
TSOPRIMLOC(TFDC) SET %                                                  TIC45720
         LI,11     TSIBCOK             LOAD LEGAL-FOR-C-PRIM BIT.       TIC45730
         B         TSOA200             AND BRANCH TO COMMON CODE.       TIC45740
         PAGE                                                           TIC45750
*                                                                       TIC45760
*        HERE ON D.  OUTPUT.                                            TIC45770
*                                                                       TIC45780
TSOPRIMLOC(TFDD) SET TSOPRIMLOC(TFDC)  D SAME AS C ON OUTPUT.           TIC45790
         PAGE                                                           TIC45800
*                                                                       TIC45810
*        HERE ON I.  OUTPUT.                                            TIC45820
*                                                                       TIC45830
TSOPRIMLOC(TFDI) SET %                                                  TIC45840
         LI,11     TSIBIOK             LOAD LEGAL-FOR-I-PRIM BIT.       TIC45850
         B         TSOA200             AND BRANCH TO COMMON CODE.       TIC45860
         PAGE                                                           TIC45870
*                                                                       TIC45880
*        HERE ON J.  OUTPUT.                                            TIC45890
*                                                                       TIC45900
TSOPRIMLOC(TFDJ) SET TSOPRIMLOC(TFDI)  J SAME AS I ON OUTPUT.           TIC45910
         PAGE                                                           TIC45920
*                                                                       TIC45930
*        HERE ON K - ACTS LIKE G1 ON OUTPUT.                            TIC45940
*                                                                       TIC45950
TSOPRIMLOC(TFDK) SET %                                                  TIC45960
         LI,13     1                   FORCE FIELD WIDTH TO ONE.        TIC45970
         B         TSOG200             AND PROCESS AS G.                TIC45980
         PAGE                                                           TIC45990
*                                                                       TIC46000
*        HERE ON L AND M - OUTPUT.                                      TIC46010
*                                                                       TIC46020
TSOPRIMLOC(TFDL) SET %                                                  TIC46030
TSOPRIMLOC(TFDM) SET %                                                  TIC46040
*
         BAL,14    TSOANOTHERFIELD
*
         LW,6      7                   GET BA OF 'NEXT' CHAR IN FQM.    TIC46050
         AW,6      13                  PLUS FIELD WIDTH.                TIC46060
         AI,6      -1                  MINUS ONE IS BA OF LAST CHAR.    TIC46070
*                                                                       TIC46080
         CW,6      TSOFQMTEXTENDBA     SEE IF OFF END OF FQM.           TIC46090
         BGE       TSOBADCHARACTER     OUT IF SO.                       TIC46100
*                                                                       TIC46110
         LB,8      0,6                 GET THE LAST CHARACTER.          TIC46120
         AND,8     =X'F0'              ISOLATE ZONE.                    TIC46130
         CI,8      X'D0'               TEST FOR MINUS.                  TIC46140
         BE        TSOL222             TO MINUS CODE IF SO.             TIC46150
         CI,8      X'B0'               TEST FOR OTHER MINUS             TIC46160
         BNE       TSOL288             OVER IF NOT.                     TIC46170
*                                                                       TIC46180
TSOL222  RES       0                   HERE ON MINUS.                   TIC46190
         BAL,15    TSOGETFQMCHAR       GET FIRST DIGIT.                 TIC46200
         CI,8      X'F0'               MUST BE ZERO FOR ROOM FOR MINUS.
         BNEZ      TSOBADCHARACTER     WASN'T.                          TIC46220
*                                                                       TIC46230
         LI,8      '-'                 MINUS TO                         TIC46240
         BAL,15    TSOPUTCHAR           REPORT.                         TIC46250
*                                                                       TIC46260
         AI,13     -1                  DECREMENT FOR FIRST (ZERO) DIGIT.TIC46270
TSOL288  RES       0                                                    TIC46280
TSOL310  RES       0                                                    TIC46290
         BAL,15    TSOGETFQMCHAR       GET A DIGIT.                     TIC46300
         OR,8      =X'F0'              NEATEN THE ZONE.                 TIC46310
         CI,8      X'F9'               MAKE SURE RESULT                 TIC46320
         BG        TSOBADCHARACTER      IS A DIGIT.                     TIC46330
         BAL,15    TSOPUTCHAR          DIGIT --> REPORT.                TIC46340
         BDR,13    TSOL310             AND LOOP FOR W DIGITS.           TIC46350
*                                                                       TIC46360
         B         TSONEXTPRIM         AND WE'RE DONE.                  TIC46370
         PAGE                                                           TIC46380
*                                                                       TIC46390
*        X = NOP ON OUTPUT.                                             TIC46400
*                                                                       TIC46410
TSOPRIMLOC(TFDX) SET TSONEXTPRIM                                        TIC46420
         PAGE                                                           TIC46430
*                                                                       TIC46440
*        Y = REMEMBER COMMAND LINE                                      TIC46450
*                                                                       TIC46460
TSIPRIMLOC(TFDY) SET %                                                  TIC46470
TSOPRIMLOC(TFDY) SET %                                                  TIC46480
*                                                                       TIC46490
         LW,#ARG   TSIYSTRINGBA        GET OLD LINE'S DSP, IF ANY.
         #FREE#MAIN#BYTES#IF           FREE ANY OLD LINE.
*                                                                       TIC46530
TSIY030  RES       0                                                    TIC46540
         LW,#ARG   13                  INT'ED R13 HAS BYTE LENGTH.      TIC46550
         #GET#MAIN#BYTES                                                TIC46560
         STW,#ARG  TSIYSTRINGBA        STORE BA OF NEW STRING.          TIC46570
         STW,13    TSIYSTRINGLENGTH    STORE LENGTH TOO.                TIC46580
*                                                                       TIC46590
         INT,12    *8                  RE-INT THE PRIMITIVE.            TIC46600
         BCR,1     TSIY400             OVER IF TYPE ZERO.               TIC46610
*                                                                       TIC46620
         BCR,2     %+2                 IF FLAG WORD PRESENT,
         AI,8      1                    BUMP R8 OVER FLAGS.
*
         LW,#BAL   8                   DEVELOP BA OF STRING             TIC46630
         AI,#BAL   1                    IN VERY TEMP REGISTER.          TIC46640
         SLS,#BAL  2                     (BE CAREFUL)                   TIC46650
*                                                                       TIC46660
         LB,8      0,#BAL              COPY BYTES                       TIC46670
         STB,8     0,#ARG               FROM PRIMITIVE                  TIC46680
         AI,#ARG   1                     STRING TO                      TIC46690
         AI,#BAL   1                      Y-STRING                      TIC46700
         BDR,13    %-4                     STORAGE.                     TIC46710
*                                                                       TIC46720
         B         TSXNEXTPRIM,6       AND WE'RE DONE.                  TIC46730
*                                                                       TIC46740
TSIY400  RES       0                                                    TIC46750
         LW,14     #ARG                COPY BA OF STORAGE.              TIC46760
*                                                                       TIC46770
         LW,12     13                  CLEAR THE                        TIC46780
         LI,8      ' '                  Y-STRING STORAGE                TIC46790
         STB,8     0,#ARG                IN CASE THE                    TIC46800
         AI,#ARG   1                      REPORT                        TIC46810
         BDR,12    %-2                     ENDS EARLY.                  TIC46820
*                                                                       TIC46830
         BAL,15    TSIY920,6           GET CHARACTER FROM CLERK OR REPORTIC46840
         LW,#ARG   14                  STORE INTO                       TIC46850
         STB,8     0,#ARG               STORAGE AND                     TIC46860
         AI,14     1                     BUMP POINTER.                  TIC46870
         BDR,13    %-4                 LOOP.                            TIC46880
*                                                                       TIC46890
         B         TSXNEXTPRIM,6       AND WE'RE DONE.                  TIC46900
*                                                                       TIC46910
*                                                                       TIC46920
*                                                                       TIC46930
TSIY920  B         TSIGETCHAR          GET CHAR FROM CLERK.             TIC46940
         B         TSOGETFQMCHAR       OR GET CHAR FROM REPROT.         TIC46950
         PAGE                                                           TIC46960
*                                                                       TIC46970
*        HERE ON Z = END OF TFD   OUTPUT                                TIC46980
*                                                                       TIC46990
TSOPRIMLOC(TFDZ) SET %                                                  TIC47000
         AI,13     0                   SEE IF A 'Z00'.                  TIC47010
         BEZ       TSOZ500             OVER IF SO.                      TIC47020
*                                                                       TIC47030
*        FALL THROUGH ON NON-Z0 PRIMITIVE.                              TIC47040
*                                                                       TIC47050
         INT,12    *8                  RE-INT THE PRIMITIVE             TIC47060
         BCR,1     TSOZ300             OVER IF TYPE ZERO.               TIC47070
*                                                                       TIC47080
         CI,13     17                  TYPE ONE, SO MUST BE 17 CHARS.   TIC47090
         BNE       TSOBADPRIMITIVE     OUT IF ERRONEOUS.                TIC47100
*                                                                       TIC47110
         BAL,15    DONEWITHTFDCODE     GIVE UP OLD TFD.                 TIC47120
*                                                                       TIC47130
         LW,8      TSITFDSCAN          RELOAD TFD WA.
         INT,12    *8                  RE-INT.
         BCR,2     %+2                 IF FLAG WORD PRESENT,
         AI,8      1                    BUMP R8 OVER FLAGS.
         AI,8      1                   PUSH R8 TO WA OF STRING.         TIC47150
         LCI       5                   17 CHARS = 5 WORDS.              TIC47160
         LM,9      *8                  LOAD TFD KEY INTO REGISTERS.     TIC47170
*                                                                       TIC47180
TSOZ220  RES       0                                                    TIC47190
         BAL,15    POINTTOTFDCODE      GO GET NEW TFD.                  TIC47200
         BEZ       TSOBADPRIMITIVE     OUT IF NO SUCH TFD.              TIC47210
*                                                                       TIC47220
         #T#GET,8  #DEV#USING#TFD      INITIALIZE                       TIC47230
         AI,8      @TFD@PREFIX@LENGTH   POINTER TO                      TIC47240
         STW,8     TSOTFDSCAN            THE NEW TFD.                   TIC47250
*                                                                       TIC47260
         B         TSOGETPRIM           AND AWAY WE GO.                 TIC47270
*                                                                       TIC47280
*                                                                       TIC47290
*                                                                       TIC47300
TSOZ300  RES       0                   HERE ON TYPE ZERO I.E.'Z12'.     TIC47310
         LI,12     0                   DIVIDE TO                        TIC47320
         DW,12     =10                  FORM THE                        TIC47330
         SLS,13    8                     EBCDIC OF                      TIC47340
         OR,13     12                     THE TWO-DIGIT                 TIC47350
         OR,13     =X'F0F0'                SEQUENCE NUMBER.             TIC47360
         SLS,13    16                  ALIGN FOR LATER.                 TIC47370
*                                                                       TIC47380
         #T#GET,8  #DEV#USING#TFD      GET WHERE OLD TFD IS.            TIC47390
         AI,8      1                   BUMP TO WHERE NEME IS.           TIC47400
         LCI       4                   LOAD 15 CHARACTERS               TIC47410
         LM,9      *8                   OF OLD NAME.                    TIC47420
         SLS,12    -8                  SHIFT TO SHIFT IN                TIC47430
         SLD,12    8                    THE NEW SEQUENCE NUMBER.        TIC47440
*                                                                       TIC47450
         BAL,15    DONEWITHTFDCODE     GIVE UP OLD TFD.                 TIC47460
         B         TSOZ220             AND GO GET NEW ONE.              TIC47470
*                                                                       TIC47480
TSOZ500  RES       0                   HERE TO END NORMAL DELIVERY.     TIC47490
         LW,11     =X'10000000'        CLEAR PUT-BACK-INTO-Q BIT.
         B         TSOZ510                                              TIC47510
*                                                                       TIC47520
ENDERROREDDELIVERY RES 0               HERE TO END A BAD DELIVERY.      TIC47530
*
         LI,#ARG   0                   ON ERRORED DELIVERY,
         XW,#ARG     TSIYSTRINGBA       THROW AWAY ANY
         #FREE#MAIN#BYTES#IF                Y-STRING.
*
         LW,11     =X'90000000'        LOAD PUT-BACK-INTO-Q BIT.
*                                                                       TIC47550
TSOZ510  BAL,15    DONEWITHTFDCODE     WE ARE THROUGH WITH THE TFD.     TIC47560
         BAL,15    TSOPUTBUFFER        FLUSH OUTPUT BUFFER.             TIC47570
*                                                                       TIC47580
         LW,#ARG   TSIYSTRINGBA        GET Y-STRING DSP OR ZERO         TIC47590
         #T#XCA,#ARG #DEV#COMMAND#LINE#RECORD#BA AND SWAP WITH CMD LINE.TIC47600
         BEZ       TSOZ530             OVER IF WAS NOTHING THERE.       TIC47610
         #FREE#MAIN#BYTES              OR FREE OLD LINE.                TIC47620
TSOZ530  RES       0                                                    TIC47630
         LW,8      TSIYSTRINGLENGTH    COPY ANY Y-STRING LENGTH, TOO.   TIC47640
         #T#PUT,8  #DEV#COMMAND#LINE#RECORD#LENGTH                      TIC47650
*
*
*
         LW,6      TSOBXR              CHECK BXR TYPE
         AI,6      1                    BYTE TO SEE IF
         LB,#ARG   0,6                   WE ARE JOURNALING
         CI,#ARG   X'16'                  DELIVERY.
         BNE       TSOZ585
*
*        HERE TO JOURNAL END-DELIVERY.
*
         MTB,1     0,6                 TYPE X'16' --> TYPE X'17'.
*
         LW,8      TSOBXR              DSP OF BXR.
         AND,8     =X'7FFFF'           BA OF BXR.
         SLS,8     -2                  WA OF BXR.
*
         BAL,15    WRITEJOURNALRECORD
*                                                                       TIC47660
TSOZ585  RES       0                                                    TIC47670
         LW,8      TSOBXR              GET DSP OF BXR.                  TIC47740
         AND,8     =X'7FFFF'           MAKE BA.                         TIC47750
         SLS,8     -2                  MAKE WA.                         TIC47760
         OR,8      11                  MAYBE OR IN PUT-BACK-INTO-Q BIT. TIC47780
*                                                                       TIC47790
TSOZ589  RES       0                                                    TIC47800
         #T#GWA,9  #DEV#ECB            POINT TO AN ECB.                 TIC47810
         M:QUEUE   8,PUT,(LSIZE,1),HIGH,(ECB,*9) ISSUE SQM REQUEST.     TIC47820
         BCR,12    TSOZ592             OVER IF GOOD REQUEST.            TIC47830
         BCS,4     TSOZ591             OVER IF MUST WAIT.               TIC47840
*                                                                       TIC47850
*E*  MESSAGE:     'Q-PUT ERROR CC12=10'
*E*  DESCRIPTION: WHILE PROCESSING THE Z PRIMITIVE DURING TRANSACTION
*E*               SCAN FOR A TFD, CONDITION CODES FOLLOWING M:QUEUE
*E*               WERE = 10 (QUEUE UNABAILABLE OR REQUEST CANNOT BE
*E*               SATISFIED).
         #SNAP,30  'Q/PUT ERROR CC12=10'                                TIC47860
         #ABORT                                                         TIC47870
*                                                                       TIC47880
TSOZ591  RES       0                                                    TIC47890
         LW,#ARG   9                   MUST WAIT - GET ECB              TIC47900
         #WAIT#ON                       ADDRESS AND WAIT.               TIC47910
         B         TSOZ585             AND TRY AGAIN.                   TIC47920
*
*
*
TSOZ592  RES       0                                                    TIC47930
         LW,#ARG   TSOBXR              GET DSP OF THE REPORT BXR.       TIC47940
         #FREE#MAIN#BYTES              AND FREE IT.                     TIC47950
*
*        NOTE THAT IF THE OUTPUT DELIVERY
*        WAS 'BROKEN' BY AN ATTENTION, THEN
*        THE ATTENTION BIT IS STILL ON.
*
         #EXIT#SPACE                   RETURN SPACE WE WERE USING.      TIC47970
*                                                                       TIC47980
         B         COMMANDLEVELPOSTREPORT AND WE'RE DONE.               TIC47990
         PAGE                                                           TIC48000
*                                                                       TIC48010
*        INPUT FORMATTING ERROR: SEND CANNED ERROR MESSAGE              TIC48020
*                                                                       TIC48030
TSIBADCHARACTER RES 0                                                   TIC48040
         #FREE#DEV#BUFFER              RELEASE OLD STUFF                TIC48050
         LI,13     0                    AND INDICATE NO                 TIC48060
          STW,13    TSIRECORDCURRENTBA  CURRENT RECORD.                 TIC48070
*                                                                       TIC48080
         BAL,15    TSOPUTBUFFER
*
*        NOTE THAT, INDISE THIS ERROR MESSAGE ROUTINE,
*        R5 WILL BE USED FOR OUR OWN BUFFERING.
*
         BAL,13    ERRORBUFFERCREATE
*
         LI,12     BA(BADMESS#1)       SEND START
*E*  MESSAGE:     'BAD FIELD AT ROW XXX COL YYY'
*E*  DESCRIPTION: DURING TRANSACTION SCAN VIA TFD, A FIELD DID NOT
*E*               AGREE WITH THE TFD.
         BAL,14    ERRORBUFFERTEXTC     OF MESSAGE.
*                                                                       TIC48120
         LW,11     TSICURRENTR         ROW WE'RE AT.                    TIC48130
         BAL,14    BCDOFR11            AND SEND IT.                     TIC48140
*                                                                       TIC48150
         LI,12     BA(BADMESS#2)       SEND MORE OF
         BAL,14    ERRORBUFFERTEXTC     THE MESSAGE.
*                                                                       TIC48190
         LW,11     TSICURRENTFIELDC    START OF BAD FIELD.              TIC48200
         BAL,14    BCDOFR11            AND SEND IT.                     TIC48210
*                                                                       TIC48220
         BAL,13    ERRORBUFFERFLUSH    OUTPUT MESSAGE AND RE-ZERO R5.
*
         #EXU#ON#TYPE#INDEX
         B         TSIBAD5000          UNKNOWN.
         B         TSIBAD5000          OWN-CODE.
         B         TSIBAD5000          UNIT RECORD.
         B         TSIBAD3800          TTY.
         B         TSIBAD4000          3270.
*
TSIBAD3800 RES     0                   HERE ON TTY.
         BAL,15    TSOPUTEOL           ADN TO A NEW LINE.               TIC48230
*                                                                       TIC48240
         MTW,-1    TSICURRENTR         AND CORRENT FOR THE MESSAGE LINE.TIC48250
*                                                                       TIC48260
         LI,12     1                   RESET US TO                      TIC48270
         STW,12    TSICURRENTC          COLUMN ONE.                     TIC48280
*                                                                       TIC48290
         LW,12     TSICURRENTFIELDC    MOVE BACK IN TABLES              TIC48300
         AI,12     -1                  (ADJUST FOR COLUMN ONE.)         TIC48310
         BLEZ      TSIBADCHAR2233      OVER IF NO SPACING NEEDED.
*
         CI,12     10000               IF 'UNDEFINED',
         BL        %+3                  DONT COUNT
         AI,12     -10000                THE 10000.
         BLEZ      TSIBADCHAR2233
*                                                                       TIC48330
         LI,8      ' '                 SEND SPACES                      TIC48340
         BAL,15    TSOPUTCHAR           TO REPOSITION                   TIC48350
         BDR,12    %-1                   THE MEDIUM.                    TIC48360
*                                                                       TIC48370
TSIBADCHAR2233 EQU TSIBAD8000
         B         TSIBAD8000
*
*
TSIBAD4000 RES     0                   HERE ON 3270.
         DO        DO#3270
         LW,14     TSICURRENTFIELDC    STARTING COLUMN OF FIELD.
         STW,14    TSICURRENTC          IS NOW AGAIN CURRENT.
*
         LW,13     TSICURRENTR         ABOVE COL AND THIS ROW
         BAL,15    3270RANDCTOSBA      AND RE-POSITION
         LI,8      X'13'                THE CURSOR TO
         OR,8      12                    THE BAD FIELD.
         BAL,15    TSOPUTWORD
         FIN
TSIBAD5000 RES     0
*
*
TSIBAD8000 RES     0                   HERE AFTER ALL MESSAGES.
         LW,7      TSIFQMFIELDPTR      RE-POSITION IN FQM TEXT.         TIC48380
*                                                                       TIC48390
         B         TSIGETPRIM          AND TRY IT AGAIN                 TIC48400
*                                                                       TIC48410
*                                                                       TIC48420
*                                                                       TIC48430
*        OUTPUT (FORMATTING) ERROR:  SEND MASSAGE.                      TIC48440
*                                                                       TIC48450
TSOBADPRIMITIVE RES 0                  HERE ON BAD PRIM:  Z'Q'          TIC48460
TSOBADCHARACTER RES 0                  HERE ON BAD CHAR:  I1 & A Z.     TIC48470
*                                                                       TIC48480
         BAL,15    TSOPUTBUFFER
*
         BAL,13    ERRORBUFFERCREATE
         LI,12     BA(BADMESS#6)
         BAL,14    ERRORBUFFERTEXTC
*E*  MESSAGE:     '** BAD CHARACTER OR PRIMITIVE **'
*E*  DESCRIPTION: A FIELD DID NOT AGREE WITH THE REPORT TFD,
*E*               OR THE REPORT TFD IS INCORRECT.
         BAL,13    ERRORBUFFERFLUSH
*
         LW,11     =X'B0000000'        AND THEN MARK IT
         B         TSOZ510              AS 'FAILED' IN THE QUEUE.
*                                                                       TIC48550
*                                                                       TIC48560
*                                                                       TIC48570
*                                                                       TIC48580
*        ERROR IN INPUT TFD:  SEND MESSAGE.                             TIC48590
*                                                                       TIC48600
TSIBADPRIMITIVE RES 0                                                   TIC48610
*                                                                       TIC48620
         BAL,15    TSOPUTBUFFER
*
         BAL,13    ERRORBUFFERCREATE
         LI,12     BA(BADMESS#7)
*E*  MESSAGE:     '** BAD PRIMITIVE ENCOUNTERED **'
*E*  DESCRIPTION: THE TFD CORRESPONDING TO A TRANSACTION IS INCORRECT.
         BAL,13    ERRORBUFFERFLUSH
*                                                                       TIC48660
         B         TSIZ500                                              TIC48670
*                                                                       TIC48680
*                                                                       TIC48690
*                                                                       TIC48700
BADMESS#1 TEXTC    'BAD FIELD AT ROW '
BADMESS#2 TEXTC    ' COL '
BADMESS#6 TEXTC    '** BAD CHARACTER OR PRIMITIVE **'
BADMESS#7 TEXTC    '** BAD PRIMITIVE ENCOUNTERED **'
*                                                                       TIC48790
*                                                                       TIC48800
*                                                                       TIC48810
BCDOFR11 RES       0                   PRINTS C(R11) IN EBCDIC DECIMAL. TIC48820
*                                      WITH NO LEADING ZEROES.          TIC48830
         LI,8      4                   AND MAX OF FOUR DIGITS.          TIC48840
         LI,9      0                   (>9999 PRINTS AS 0000)           TIC48850
*                                                                       TIC48860
         LI,10     0                                                    TIC48870
         DW,10     =10                                                  TIC48880
         OR,10     =X'F0'                                               TIC48890
         SLS,9     -8                                                   TIC48900
         STB,10    9                                                    TIC48910
         AI,11     0                                                    TIC48920
         BEZ       %+2                                                  TIC48930
         BDR,8     %-7                                                  TIC48940
*                                                                       TIC48950
         SLD,8     8                                                    TIC48960
         BAL,13    ERRORBUFFERR8
         AI,9      0                                                    TIC48980
         BNEZ      %-3                                                  TIC48990
*                                                                       TIC49000
         B         *14                                                  TIC49010
         PAGE                                                           TIC49150
*                                                                       TIC49160
*        CLEAN UP FOLLOWING AN ATTENTION DURING TRANSACTION INPUT/OUTPUTTIC49170
*                                                                       TIC49180
TSIATTENTION RES 0                     THESE MUST BE THE SAME PLACE     TIC49190
TSOATTENTION RES 0                     BECAUSE 'TSOPUTCHAR' CAN DISCOVERTIC49200
*                                      THE ATTN AND HE DOESN'T TRY TO   TIC49210
*                                      DISTINGUISH INPUT VS. OUTPUT.    TIC49220
*                                                                       TIC49230
         BAL,15    TSOKILLBUFFER       KILL ANY PENDING OUTPUT.         TIC49240
*                                                                       TIC49250
*        SO SEE HERE WHETHER INPUT OR OUTPUT.                           TIC49260
*                                                                       TIC49270
         MTW,0     TSIZEROORONE        TEST TSI VS TSO.                 TIC49280
         BNEZ      ENDERROREDDELIVERY  OUTPUT CLEANUP IF TSO            TIC49290
*                                                                       TIC49300
*        FALL THROUGH IF ATTENTION WHILE INPUTTING.                     TIC49310
*                                                                       TIC49320
         B         TSIZ512             GO CLEAN EVERYTHING UP.
         PAGE                                                           TIC49390
*                                                                       TIC49400
*        FREES SPACE OCCUPIED BY FQM.                                   TIC49410
*                                                                       TIC49420
*        BAL'ED TO ON R15.                                              TIC49430
*                                                                       TIC49440
*        DESTROYS #ARG AND #BAL                                         TIC49450
*                                                                       TIC49460
*        DESTROYS R8 AND R9.                                            TIC49470
*                                                                       TIC49480
FREEBXRSPACE RES 0                                                      TIC49490
         LW,#ARG   TSIBXR              GET DSP OF BXR.                  TIC49500
         BEZ       *15                 DONE IF NONE.                    TIC49510
*                                                                       TIC49520
         LI,8      X'7FFFF'            MASK TO GET                      TIC49530
         AND,8     #ARG                 BARE BA OF BXR.                 TIC49540
         SLS,8     -2                  WA OF BXR.                       TIC49550
         LI,9      X'FFFF'                                              TIC49560
         AND,9     *8                  BYTES IN BXR BLOCK.              TIC49570
         SLS,9     -2                  WORDS IN BXR BLOCK.              TIC49580
         AW,8      9                   POINT R8 TO                      TIC49590
         AI,8      -1                   LAST WORD IN BXR BLOCK.         TIC49600
         LW,8      *8                  GET CHAIN POINTER.               TIC49610
*                                                                       TIC49620
         #FREE#MAIN#BYTES              FREE BXR SPACE (#ARG SET ABOVE)  TIC49630
*                                                                       TIC49640
         LI,#ARG   0                   BXR BLOCK IS GONE SO             TIC49650
         STW,#ARG  TSIBXR               ZERO OUT OLD DSP.               TIC49660
*                                                                       TIC49670
FREEBXRSPACE200 RES 0                                                   TIC49680
         AI,8      0                   SEE IF CHAINED BLOCK.            TIC49690
         BEZ       *15                 DONE IF NOT.                     TIC49700
*                                                                       TIC49710
         LW,#ARG  8                 BA OF CHAINED BLOCK.
         SLS,8    -2
         OR,#ARG   =X'80000000'        DSP OF BLOCK (THIS UNNECESSARY)  TIC49740
*                                                                       TIC49750
         AI,8      (XACTIONTEXTINCREMENT/4)+1-1 POINT TO LAST WORD.     TIC49760
         LW,8      *8                  GET CHAIN POINTER.               TIC49770
*                                                                       TIC49780
*        (NOTE THAT WE MUST OF COURSE GET THE POINTER FROM THE          TIC49790
*        BLOCK BEFORE WE FREE THE BLOCK'S STORAGE!)                     TIC49800
*                                                                       TIC49810
         #FREE#MAIN#BYTES              FREE THE BLOCK.                  TIC49820
*                                                                       TIC49830
         B         FREEBXRSPACE200     BACK TO SEE IF MORE CHAINED BLOCKTIC49840
         PAGE                                                           TIC49850
*
*
*
TSINEXTPRIM RES    0
         BAL,15    TSXBUMPTOPRIM
*
TSIGETPRIM RES     0                                                    TIC49860
         IFATTENTION TSIATTENTION      OUT ON AN ATTENTION.             TIC49870
         LW,8      TSICURRENTC         COPY LOCATION OF                 TIC49880
         STW,8     TSICURRENTFIELDC     UPCOMING FIELD                  TIC49890
*                                                                       TIC49900
         STW,7     TSIFQMFIELDPTR      STORE FQM POINTER TO THIS FIELD. TIC49910
*                                                                       TIC49920
         LW,8      TSITFDSCAN          RETRIEVE LOC OF NEXT PRIMITIVE   TIC49930
         INT,12    *8                  AND INT IT INTO R12 AND R13      TIC49940
*                                                                       TIC49950
         LI,6      0                   SET R6=0 TO INPICATE INPUT PROCESTIC49960
*                                                                       TIC49970
         CI,12     X'400'               SEE IF A MYPRIM.                TIC49980
         BAZ       %+5                 OVER IF NOT
         LI,#ARG   X'1FFFF'            IF NO T:MYPRIM,
         AND,#ARG  %+2                  THEN WE REPORT
         BAZ       TSIBADPRIMITIVE       AN ERROR.
         B         T:MYPRIM            NORMAL MYPRIM EXIT.
*                                                                       TIC50000
         AI,12     %+2                 CONVERT PRIM NUMBER TO GOTO()    TIC50010
         B         *12                 AND COMPUTED-GO-TO               TIC50020
*        HERE USE METASYM LIST TO SET UP THE GO TO TRA LIST             TIC50030
         B         %+1                 (REALLY ZERO PRIM # IS ERROR)    TIC50040
I        DO        NUM(TSIPRIMLOC)                                      TIC50050
         B         TSIPRIMLOC(I)                                        TIC50060
         FIN                                                            TIC50070
         PAGE                                                           TIC50230
*                                                                       TIC50240
*        ROUTINE WHICH, NORMALLY, GETS A CHARACTER                      TIC50250
*        FROM THE CLERK'S INPUT BUFFER.                                 TIC50260
*                                                                       TIC50270
TSIGETORPUTCHAR RES 0                                                   TIC50280
*                                                                       TIC50290
*        THIS SPECIAL ENTRY POINT ACTS AS FOLLOWS:  IF                  TIC50300
*        THERE IS A CURRENT INPUT RECORD FROM THE CLERK,                TIC50310
*        (R5 NON-ZERO) IT GETS A CHARACTER FROM THAT RECORD.            TIC50320
*        IF THERE IS NO SUCH RECORD (R5 = 0), THEN IT 'PUTS'            TIC50330
*        A CHARACTER TO THE CLERK.  USED BY TFD@ ROUTINE                TIC50340
*        TO SKIP COLUMNS.                                               TIC50350
*                                                                       TIC50360
         MTW,0     TSIRECORDCURRENTBA  SEE IF AN INPUT RECORD.          TIC50370
         BEZ       TSOPUTCHAR          OVER IF NOT.                     TIC50380
*        FALL THROUGH IF RECORD.                                        TIC50390
*                                                                       TIC50400
TSIGETCHAR RES     0                                                    TIC50410
         IFATTENTION TSIATTENTION      OUT ON AN ATTENTION.             TIC50420
         LW,#ARG   TSIRECORDCURRENTBA  SEE IF AN INPUT RECORD.          TIC50430
         BNEZ      TSIGETCHAROK        OVER IF SO                       TIC50440
*                                                                       TIC50450
*        POINTER IN R5 WAS ZERO - SIGNAL                                TIC50460
*        THAT WE NEED TO ACQUIRE ANOTHER PHYSICAL                       TIC50470
*        RECRRD FROM THES STATION                                       TIC50480
*                                                                       TIC50490
         LW,8      15                  SAVE LINK REGISTER.              TIC50520
         BAL,15    TSOPUTBUFFER        DUMP OUT ANY PROMPTS.            TIC50530
         LW,15     8                   RESTORE LINK REGISTER.           TIC50540
TSIGETREAD         #INITIATE#READ                                       TIC50550
         #CHECK#READ TSIIOERROR                                         TIC50560
TSIGETDIDIO RES    0                                                    TIC50570
         LI,8      0                   COPY RECORD BA AND LENGTH:
         #T#XCA,8  #DEV#RECORD#BA
         STW,8     TSIRECORDBA
         AND,8     =X'7FFFF'
         #T#GET,#ARG #DEV#RECORD#LENGTH
         AW,#ARG   8
         STW,#ARG  TSIRECORDENDBA
*
*        R8 HAS BARE BA OF RECORD..  NEED TO BUMP IT OVER ANY PREFIX.
*
         XW,8      6                   SWAP REGISTERS.
         #EXU#TABLE#ON#TYPE#INDEX BUMPR6OVERMESSAGEPREFIX BUMP.
         XW,6      8                   AND SWAP BACK.
         STW,8     TSIRECORDCURRENTBA  (BUMPED) R8 IS WHERE WE ARE.
*                                                                       TIC50660
         IFATTENTION TSIATTENTION      OUT ON AN ATTENTION.             TIC50670
*                                                                       TIC50680
TSIGETCHAROK RES   0                                                    TIC50690
*                                                                       TIC50710
TSIGET2222 RES     0
         LW,#ARG   TSIRECORDCURRENTBA  RETRIEVE POINTER INTO BUFFER.    TIC50720
         CW,#ARG   TSIRECORDENDBA      SEE IF 'OFF THE END'.            TIC50730
         BGE       TSIGETBLANK          IF SO RETURNA BLANK             TIC50740
*                                                                       TIC50750
         LB,8      0,#ARG              GET THE CHARACTER.               TIC50760
         CI,8      X'0D'               SEE IF AT END-OF-LINE            TIC50770
         BE        TSIGETBLANK         IF SO RETURN BLANK               TIC50780
         CI,8      X'25'               TEST FOR                         TIC50790
         BE        TSIGETBLANK          LOTS OF                         TIC50800
         CI,8      X'15'                 POSSIBLE                       TIC50810
         BE        TSIGETBLANK            LINE ENDERS                   TIC50820
*
         DO        DO#3270
         CI,8      X'11'               SEE IF FIELD START.
         BE        TSIGET3200          GO PROCESS R&C IF SO.
         FIN
*
TSIGETNORMAL RES   0
         MTW,1     TSIRECORDCURRENTBA  BUMP SCAN OVER GOOD CHARACTER.   TIC50830
TSIGETEXIT RES     0
         MTW,1     TSICURRENTC         BUMP CURRENT 'COLUMN' POSITION.
         LW,#ARG   8                   COPY CHARACTER TO INDEX REGISTER TIC50840
         B         *15                 AND RETURN WITH CAH IN R8        TIC50850
*                                                                       TIC50860
TSIGETBLANK LI,8   ' '                 RETURN A BLANK                   TIC50870
         B         TSIGETEXIT
*                                                                       TIC50900
         DO        DO#3270
TSIGET3200 RES     0
         AI,#ARG   2                   SEE IF CAN BE R&C FOLLOWING
         CW,#ARG   TSIRECORDENDBA       THE X'11' IN THE BUFFER.
         BGE       TSIGETNORMAL        RETURN THE ELEVEN IF NOT.
*
         BAL,#BAL  TSIODDRANDC         R AND C TO R9 AND R8.
*
         CW,9      TSICURRENTR         COMPARE WITH SHOULD-BE ROW.
         BG        TSIGETBLANK         IF NOT THIS FAR, RETURN A BLANK.
         BL        TSIGET3300          IF PAST HERE, SCAN UP.
*
         CW,8      TSICURRENTC         COMPARE WITH SHOULD-BE COLUMN.
         BG        TSIGETBLANK         IF NOT THIS FAR, RETRUN A BLANK.
         BL        TSIGET3300          IF PAST HERE, SCAN UP.
*
*
*        THE INTERNAL R&C MATCH THE R&C (OF ATTRIBUTE PLUS ONE)
*        IN THE BUFFER.  SO WE ARE READY TO PROCESS THAT FIELD.
*
         MTW,3     TSIRECORDCURRENTBA  SKIP X'11' AND R&C.
         B         TSIGET2222          AND GO PROCESS.
*
*
*
TSIGET3300 RES     0                   HERE TO SCAN TO A R&C.
*
         MTW,3     TSIRECORDCURRENTBA  BUMP OVER THE X'11' AND R&C.
*
TSIGET3322 RES     0
         LW,#ARG   TSIRECORDCURRENTBA  CURRENT BUFFER POINTER.
         CW,#ARG   TSIRECORDENDBA      SEE IF STILL WITHIN BUFFER.
         BGE       TSIGETBLANK         OUT OK IF HAVE SCANNED TO END.
*
         LB,#BAL   0,#ARG              GET CHAR FROM BUFFER.
         CI,#BAL   X'11'               IS IT AN SBA.
         BE        TSIGET3200          TO SBA CODE (AGAIN) IF SO.
*
         MTW,1     TSIRECORDCURRENTBA  BUMP OVER NORMAL CHARACTER.
*
         AI,8      1                   ADJUST R9-R8.
         #T#GET,#BAL  #DEV#PLATEN#C
         CW,8     #BAL
         BLE       %+3                   COLUMN.
         LI,8      1
         AI,9      1
*
         CW,9      TSICURRENTR         RE-COMPARE:
         BL        TSIGET3322           ROW AND COLUMN:
         BG        %
*
         CW,8      TSICURRENTC
         BL        TSIGET3322
         BE        TSIGET2222
         B         %
         FIN
*
*                                                                       TIC50910
*                                                                       TIC50920
TSIGETORPUTEOL RES 0                                                    TIC50930
*                                                                       TIC50940
*        THIS SPECIAL ENTRY POINT WORKS AS FOLLOWS:  IF                 TIC50950
*        THERE IS A CURRENT INPUT RECORD (R5 NON-ZERO),                 TIC50960
*        THEN IT SKIPS FORWARD A LINE IN THET RECORD.                   TIC50970
*        OTHERWISE, IT PROMPTS WITH A NEW LINE.                         TIC50980
*        USED BY TFD@ ROUTINE.                                          TIC50990
*                                                                       TIC51000
         MTW,0     TSIRECORDCURRENTBA  SEE IF AN INPUT RECORD.          TIC51010
         BEZ       TSOPUTEOL           OVER IF NOT.                     TIC51020
*        FALL THROUGH IF SO.                                            TIC51030
*                                                                       TIC51040
TSIGETEOL RES      0
TSIBUMPLINE RES    0                   HERE TO KILL REMAINDER           TIC51050
*                                      (IF ANY) OF THE CURRENT LINE AND TIC51060
*                                      GO TO THE NEXT LINE.  BUT NOTE   TIC51070
*                                      THAT WE DON'T DO A ACTUAL READ   TIC51080
*                                      UNTIL THE LAST POSSIBLE TIME     TIC51090
*                                      TO AID IN FINDING ALL            TIC51100
*                                      THE TFD'S PROMPTS.               TIC51110
*                                                                       TIC51120
         MTW,1     TSICURRENTR         BUMP CURRENT 'ROW' POSITION.     TIC51130
         LI,#ARG   1                   GET A ONE AND                    TIC51140
         STW,#ARG  TSICURRENTC          SET AS CURRENT 'COLUMN'.        TIC51150
*                                                                       TIC51160
         LW,#ARG   TSIRECORDCURRENTBA  GET POINTER INTO RECORD.         TIC51170
         BEZ       TSIBUMPZERO         OUT IF OO RECORD.                TIC51180
         CW,#ARG   TSIRECORDENDBA      SEE IF RECORD EXAUSTED.          TIC51190
         BE        TSIBUMPZERO         IF SO, SET TO KILL RECORD.       TIC51200
         BG        %                   (CAN'T BE PAST THE END)          TIC51210
*                                                                       TIC51220
TSIBUMPRET LB,8    0,#ARG              SCAN
         CI,8      X'15'                FOR
         BE        TSIBUMPEOL            AN
         CI,8      X'0D'                  END-OF-LINE.
         BE        TSIBUMPEOL
         AI,#ARG   1                   BUMP POINTER IN REGISTER.        TIC51260
         CW,#ARG   TSIRECORDENDBA      LOOP IF NOT.                     TIC51270
         BL        TSIBUMPRET           YET AT END-OF-RECORD.
*
*        OR FALL THROUGH TO KILL THE INPUT BUFFER.
*                                                                       TIC51290
TSIBUMPZERO RES    0
TSIKILLBUFFERIF RES 0                  KILL ANY INPUT BUFFER.
*
         LI,#ARG   0                   OBTAIN AND CLEAR
         XW,#ARG   TSIRECORDBA          INPUT BUFFER PTR.
         #FREE#MAIN#BYTES#IF             AND FREE IF DYNAMIC.
         LI,#ARG   0                   INDICATE NO                      TIC51310
         STW,#ARG  TSIRECORDCURRENTBA   CURRENT RECORD.                 TIC51320
         B         *15                  AND RETURN                      TIC51330
*                                                                       TIC51340
TSIBUMPEOL RES     0                   HERE ON E-O-L FOUND              TIC51350
         AI,#ARG   1                   BUMP (IN REG) TO CHAR PAST THE E-TIC51360
         CW,#ARG   TSIRECORDENDBA      SEE IF E-O-L WAS LAST.           TIC51370
         BGE       TSIBUMPZERO         IF SO, KILL THE RECORD           TIC51380
*
         CI,8      X'0D'               SPECIAL SCAN FOR A RETURN
         BNE       %+4                  LINEFEED SEQUENCE, WHICH IS
         LB,8      0,#ARG                TREATED AS ONE LINE ENDER.
         CI,8      X'15'
         BE        TSIBUMPEOL
*
         STW,#ARG  TSIRECORDCURRENTBA  OTHERWISE STORE GOOD POINTER.    TIC51390
         B         *15                 OTHERWISE RETURN, POINTING OK    TIC51400
*
*
*
*        ODD-BALL SUBROUTINE TO CALCULATE
*        3270 R&C GIVEN BA(X'11'+2) IN BUFFER.
*
TSIODDRANDC RES    0
         LB,9      0,#ARG              GET THE
         AI,#ARG   -1                   TWO R&C
         LB,8      0,#ARG                CHARACTERS.
         AND,9     =X'3F'              CALCULATE
         AND,8     =X'3F'               BYTE POSITION
         SLS,8     6                     WHERE SCAN
         OR,9      8                      IS AT.
         LI,8      0
         #T#GET,#ARG  #DEV#PLATEN#C
         DW,8     #ARG
         AI,8      1
         AI,9      1
         B         *#BAL
*                                                                       TIC51410
*                                                                       TIC51420
*                                                                       TIC51430
*        JUST LIKE TSIPUTFQMCHAR EXCEPT THAT IT DOESN'T STORE           TIC51440
*        INTO THE FQM, BUT JUST BUMPS ONE CHARACTER POSITION:           TIC51450
*                                                                       TIC51460
TSIDONOTPUTFQMCHAR RES 0                                                TIC51470
         OR,15     =X'80000000'        INDICATE THIS ENTRY POINT.       TIC51480
*                                      AND FALL THROUGH.                TIC51490
*                                                                       TIC51500
*                                                                       TIC51510
*                                                                       TIC51520
*        PUTS CHARACTER IN R8 INTO THE ABUILDIN' FQM.                   TIC51530
*                                                                       TIC51540
*        BAL'ED TO ON R15.                                              TIC51550
*                                                                       TIC51560
*        DOES NOT DAMAGE R4,5,6,8,9,10,11,12,13,14.                     TIC51570
*                                                                       TIC51580
TSIPUTFQMCHAR RES  0                                                    TIC51590
         CW,7      TSIFQMTEXTENDBA     SEE IF WE'RE OFF END.            TIC51600
         BL        TSIFQMPUT330        OVER IF NOT.                     TIC51610
*                                                                       TIC51620
         BG        %                   CAN'T BE OTHER THAN EXACTLY AT ENTIC51630
*                                                                       TIC51640
*        WE ARE AT THE END OF A FQM BLOCK.  HOWEVER
*        IT MAY NOT BE THE LAST BLOCK DUE TO THE # PRIMITIVE.
*        SO WE TEST TO SEE IF IT IS LAST:
*
         LW,#ARG   7                   POINT #ARG
         AI,#ARG   3                    TO WORD AFTER
         SLS,#ARG  -2                    LAST CHARAC<ER.
         LW,#ARG   *#ARG               GET THAT WORD.
         BEZ       TSIFQMPUT240        OVER IF AT LAST BLOCK.
*
*        FALL THROUGH ON THERE IS A CHAINED FQM BLOCK.
*
*        #ARG CONTAINS THE BA OF THE BLOCK.
*
         AND,#ARG  =X'7FFFF'           NEATEN.  (PROBABLY NOT NECESSARY)
         LW,7      #ARG                NEW BUFFER ADDRESS TO R7.
         AI,#ARG   XACTIONTEXTINCREMENT ADD TEXT LENGTH AND
         STW,#ARG  TSIFQMTEXTENDBA       STORE AS END OF THIS BLOCK.
         B         TSIFQMPUT330        AND PROCESD.
*
TSIFQMPUT240 RES   0
         LI,#ARG   XACTIONTEXTINCREMENT+4 SPACE FOR TEXT AND LINK WORD. TIC51670
         #GET#MAIN#BYTES                 GET IT.                        TIC51680
         AND,#ARG  =X'7FFFF'           NEATEN THE BA.                   TIC51690
*                                                                       TIC51700
         SLS,7     -2                  R7 NOW POINTS TO WA OF OLD LINK WTIC51710
         STW,#ARG  0,7                 STORE BA OF NEXT BUFFER INTO LINKTIC51720
*                                                                       TIC51730
         LW,7      #ARG                NEW ADDRESS OF BUFFER TO R7.     TIC51740
         AI,#ARG   XACTIONTEXTINCREMENT ADD TEXT LENGTH                 TIC51750
         STW,#ARG  TSIFQMTEXTENDBA     STORE AS END+1 OF TEXT BUFFER.   TIC51760
*                                                                       TIC51770
         LI,#ARG   XACTIONTEXTINCREMENT/4 WORDS OF TEXT IN BUFFER.      TIC51780
         LW,#BAL   ='    '             GET FOUR BLANKS.                 TIC51790
         SLS,7     -2                  WA OF BUFFER IN R7.              TIC51800
         STW,#BAL  0,7                 CLEAR                            TIC51810
         AI,7      1                    OUT THE                         TIC51820
         BDR,#ARG  %-2                   BUFFER.                        TIC51830
         STW,#ARG  0,7                 AND ZERO LINK WORD.              TIC51840
*                                                                       TIC51850
         AI,7      -XACTIONTEXTINCREMENT/4 R7 BACK TO START OF TEXT.    TIC51860
         SLS,7     2                   R7 BACK TO A BA.                 TIC51870
*                                                                       TIC51880
         STW,7     TSIFQMTEXTHIGHWATERMARKBA REMEMBER AS NEW H-W MARK.  TIC51890
*                                                                       TIC51900
TSIFQMPUT330 RES   0                                                    TIC51910
         AI,15     0                   SEE IF WE SHOULD STORE ANYTHING. TIC51920
         BLZ       %+2                 OVER IF TSIDONOTPUTFQMCHAR ENTRY.TIC51930
         STB,8     0,7                 STROE THE CALLER'S BYTE.         TIC51940
         AI,7      1                   AND BUMP TO NEXT BYTE.           TIC51950
*                                                                       TIC51960
         LW,#ARG   TSIFQMTEXTENDBA     GET BA OF LINK WORD IN BUFFER.   TIC51970
         SLS,#ARG  -2                  CONVERT TO A WA.                 TIC51980
         MTW,0     0,#ARG              SEE IF THIS IS LAST BUFFER.      TIC51990
         BNEZ      *15                 DONE IF NOT.                     TIC52000
*                                                                       TIC52010
         CW,7      TSIFQMTEXTHIGHWATERMARKBA SEE IF NEW MAX LENGTH.     TIC52020
         BLE       *15                 DONE IF NOT.                     TIC52030
*                                                                       TIC52040
         STW,7     TSIFQMTEXTHIGHWATERMARKBA STORE NEW LAST BYTE+1 ADDRETIC52050
         B         *15                 AND WE'RE DONE.                  TIC52060
         PAGE                                                           TIC52070
*                                                                       TIC52080
*                                                                       TIC52090
*                                                                       TIC52100
TSXBUMPTOPRIM RES  0                   BUMPS TSOTFDSCAN TO NEXT PRIM.
         LW,8      TSOTFDSCAN          RE-OBTAIN OLD PRIM LOCATION.     TIC52130
         INT,12    *8                  RE-INT THE OLD PRIMITIVE.        TIC52140
*
         BCR,2     %+3                 OVER IF NO FLAG WORD.
         MTW,1     TSOTFDSCAN          OR BUMP OVER FLAG WORD.
         INT,12    *8                  AND RE-ESTABLISH CC.
*                                                                       TIC52150
         BCR,1     TSONEXTPRIMZERO     OVER IF TYPE ZERO.               TIC52160
*                                                                       TIC52170
         AI,13     3                   ROUND UP TYPE ONE BYTES.         TIC52180
         SLS,13    -2                  INTO WORDS OF PRIMITIVE.         TIC52190
         AWM,13    TSOTFDSCAN          PND BUMP POINTER.                TIC52200
*                                                                       TIC52210
TSONEXTPRIMZERO MTW,1 TSOTFDSCAN       BUMP FOR ONE WORD PRIM HEADER.   TIC52220
         B         *15
*                                                                       TIC52240
*                                                                       TIC52250
*                                                                       TIC52260
TSXNEXTPRIM B      TSINEXTPRIM
TSONEXTPRIM RES    0
*
         BAL,15    TSXBUMPTOPRIM
*
TSOGETPRIM RES     0                                                    TIC52270
         LW,8      TSOTFDSCAN          RETRIEVE WA OF NEXT PRIMITIVE.   TIC52280
         INT,12    *8                  AND INT IT INTO R12 AND R13.     TIC52290
*                                                                       TIC52300
         LI,6      1                   SET R6=1 TO INDICATE OUTPUT PROCETIC52310
*                                                                       TIC52320
         CI,12     X'400'               SEE IF A MYPRIM.                TIC52330
         BAZ       %+5                 OVER IF NOT.
         LI,#ARG   X'1FFFF'            MAKE SURE T:MYPRIM
         AND,#ARG  %+2                  LOADED; ERROR
         BAZ       TSOBADPRIMITIVE       IF NOT.
         B         T:MYPRIM            NORMAL T:MYPRIM EXIT.
*                                                                       TIC52350
         LW,#ARG   12                  COPY PRIM NUMBER TO INDEX REG.   TIC52360
         B         TSOGETPRIMGOTOLIST,#ARG AND COMPUTED GOTO.           TIC52370
*                                                                       TIC52380
TSOGETPRIMGOTOLIST B TSONEXTPRIM       IGNORE ZERO PRIM NUMBER.         TIC52390
I        DO        NUM(TSOPRIMLOC)                                      TIC52400
         B         TSOPRIMLOC(I)                                        TIC52410
         FIN                                                            TIC52420
         PAGE                                                           TIC52430
*                                                                       TIC52440
*        HERE TO PUT A CHARACTER INTO THE OUTPUT BUFFER.                TIC52450
*                                                                       TIC52460
*       USED WHEN SENDUNG REPORTS UNDER CONTROL OF TFDS.                TIC52470
*                                                                       TIC52480
*        BAL'ED TO ON R15                                               TIC52490
*        CHARACTER TO PUT IN BUFFER IS IN R8                            TIC52500
*        BUFFER POINTER IS IN R5.                                       TIC52510
*                                                                       TIC52520
*        ROUTINE DESTROYS REGISTER #ARG.                                TIC52530
*        ROUTINE ADJUSTS R5, THE BUFFER POINTER.                        TIC52540
*                                                                       TIC52550
*        DOES NOT DAMAGE R4, 6, 7, 8, 9, 10, 11, 12, 13, 14.            TIC52560
*                                                                       TIC52570
TSOPUTCHAR RES     0                                                    TIC52580
         IFATTENTION TSIATTENTION      OUT ON AN ATTENTION.             TIC52590
        AI,5      0                   SEE IF WE HAVE A BUFFER.          TIC52600
        BNEZ      TSOPUTCHAR450       OVER IF WE DO.                    TIC52610
*                                                                       TIC52620
*        NO BUFFER: SO GET ONE.                                         TIC52630
*                                                                       TIC52640
         AI,15     -1                  ALTER R15 SO 'B *15' WILL RE-BAL.
         B         TSOMAKEBUFFER       AND GO GET A BUFFER.
*                                                                       TIC52730
TSOPUTCHAR450 RES  0                                                    TIC52740
         MTW,1     TSOCURRENTC         BUMP CURRENT 'COLUMN' POSITION.  TIC52750
*                                                                       TIC52760
         STB,8     0,5                 STORE CALLER'S BYTE TN THE BUFFERTIC52770
         AI,5      1                   AND BUMP BUFFER POINTER.         TIC52780
*                                                                       TIC52790
         CW,5      TSORECORDENDBA      DID WE STORE INTO LAST BUFFER BYTTIC52800
         BL        TSOPUTEXIT          RETURN TO CALLER IF NOT.         TIC52810
*                                                                       TIC52820
*       HIT END OF OUR IN-CORE BUFFER - SO WE MUST                      TIC52830
*       WRITE IT OUT TO THE STATION ( WE COULD WAIT TIL THE             TIC52840
*       NEXT CHARACTER ARRIVES):                                        TIC52850
*                                                                       TIC52860
         LW,5      TSORECORDSIZE       SET SIZE = MAX SIZE (SINCE FULL).TIC52870
*                                      AND ENTER COMMON WRITE CODE.     TIC52880
*                                                                       TIC52890
*        R5 HERE HOLDS # CHARS TO WRITE   NO REAL CONFLICT WITH         TIC52900
*        THE BUFFER-POINTING OF RS SINCE WE ZERO IT BELOW.              TIC52910
*                                                                       TIC52920
TSOPUTWRITE RES    0                                                    TIC52930
         LI,#ARG   0                   GET FULL DYNAMIC
         XW,#ARG   TSORECORDBA          ADDRESS OF BUFFER.
        #T#PUT,#ARG #DEV#RECORD#BA    AND PUT INTO TABLE.               TIC52950
         #T#PUT,5  #DEV#RECORD#LENGTH  CORRECT SIZE --> TABLE.          TIC52960
         LI,5      0                   CLEAR R5 IN CASE OF ERROR.
*                                                                       TIC52970
         #INITIATE#WRITE                                                TIC52980
         #CHECK#WRITE TSOIOERROR                                        TIC52990
*                                                                       TIC53000
         MTW,0     TSOZEROORONE        SEE IF TSI OR TSO.               TIC53010
         BEZ       TSOPUT680           OVER IF INPUTTING.               TIC53020
*                                                                       TIC53030
         LW,#ARG   TSOBXR              GET BA OF BXR.                   TIC53040
         LB,#ARG   0,#ARG              GET FIRST BYTE OF BXR.           TIC53050
         CI,#ARG   X'02'               SEE IF SHOULD JOURNAL.           TIC53060
         BAZ       TSOPUT680           OVER IF NOT.                     TIC53070
*                                                                       TIC53080
         LW,#ARG   TSOBXR              GET BA OF BXR.                   TIC53090
         AI,#ARG   1                   POINT TO TYPE BYTE.              TIC53100
         LB,#ARG   0,#ARG              GET TYPE BYTE.                   TIC53110
         CI,#ARG   X'15'               SEE IF NOT YET BEGIN-JOURNALED.  TIC53120
         BNE       TSOPUT680           OVER IF ALREADY BEGIN-JOURNALED. TIC53130
*                                                                       TIC53140
*        HERE TO JOURNAL BEGIN-DELIVERY.                                TIC53150
*                                                                       TIC53160
         LW,5      TSOBXR              GET BA OF BXR.                   TIC53170
         #ENTRY#SPACE 0                AND SAVE REGISTERS.              TIC53180
*                                      (WE NEED SEVERAL REGISTERS BELOW)TIC53190
*                                      (NOTE THAT DUE TO THE #ENTRY#SPACTIC53200
*                                      WE CAN NOT, INSIDE THIS SORT-OF- TIC53210
*                                      SUBROUTINE, USE THE TSO-DYNAMIC  TIC53220
*                                      STORAGE - SUCH AS TSOBXR)        TIC53230
*                                                                       TIC53240
         LI,6      X'7FFFF'            DEVELOP CLEAN                    TIC53250
         AND,6     5                    BA OF BXR.                      TIC53260
         SLS,6     -2                  TO WA OF BXR.                    TIC53270
         MTH,1     *6                  BUMP TYPE FROM REPORT TO DELIVERYTIC53280
*
         LI,#ARG   X'F0000'            CHANGE LENGTH
         AND,#ARG  *6                   TO LENGTH OF
         OR,#ARG   =60                   JOURNAL RECORD.
         STW,#ARG  *6                  (OK AS OTHERS USE TEXT LENGTH)
*
         LW,13     14,6                SAVE WORD CLOBBERED BY CHECKSUM.
*
         LW,8      6                   COPY BXR WA FOR CALL AND ...
         BAL,15    WRITEJOURNALRECORD   GO WRITE JOURNAL RECORD.
*
         STW,13    14,6                RESTORE WORD CLOBBERED BY CKSUM.
*                                                                       TIC53410
         #EXIT#SPACE                   ON GOOD I/O, RESTORE REGS        TIC53420
*                                                                       TIC53510
TSOPUT680 RES      0                                                    TIC53520
         LI,5      0                   INDICATE NO CURRENT BUFFER.      TIC53530
TSOPUTEXIT RES     0                                                    TIC53540
        B         *15                 AND RETIRN TO CALLER.             TIC53550
*
*
*
*        HERE TO PUT A SET OF CHARACTERS INTO AN OUTPUT BUFFER.
*
*        USED SIMILARLY TO TSOPUTCHAR, BUT WHEN ONE WANTS TO
*        PLACE UP TO FOUR CHARACTERS INTO THE SAME (REPEAT: SAME)
*        OUTPUT BUFFER.  THIS FACILITY IS NEEDED FOR 3270 SUPPORT.
*
*        BAL'ED TO ON R15 -- MUST BE AN ACTUAL BAL.
*
*        CHARACTERS TO PUT INTO BUFFER ARE
*        LEFT-JUSTIFIED IN R8.
*
*        BUFFER POINTER IS IN R5.
*
*        DOES NOT DAMAGE R4, 6, 7, 9, 10, 11, 12, 13, 14.
*
TSOPUTWORD RES     0
         AI,5      0                   SEE IF WE HAVE BUFFER.
         BNEZ      TSOPUTWORD450       OVER IF WE DO.
*
*        NO BUFFER.  SO MAKE OE.
*
         AI,15     -1                  ALTER R15 SO 'B *15' WILL RE-BAL.
         B         TSOMAKEBUFFER       AND GO GET A BUFFER.
*
TSOPUTWORD450 RES  0
         LW,#ARG   5                   COPY BUFFER BA.
         AI,#ARG   4                   SEE IF FOUR CHARACTERS
         CW,#ARG   TSORECORDENDBA       WILL FIT INTO BUFFER.
         BL        TSOPUTWORD620       OVER IF WILL FIT.
*
*        NOT ENOUGH ROOM IN CURRENT BUFFER.
*        SO DUMP IT AND TRY AGAIN.
*
         AI,15     -1                  ALTER R15 SO 'B *15' WILL RE-BAL.
         B         TSOPUTBUFFER        AND GO DUMP BUFFER.
*
TSOPUTWORD620 RES  0                   HERE WITH GOOD BUFFER.
TSOPUTWORD626 RES  0
         SCS,8     8                   SHIFT IN A BYTE.
         CI,8      X'FF'               SEE IF OUT OF BYTES.
         BAZ       *15                 DONE IF SO.
*
         STB,8     0,5                 BYTE TO BUFFER.
         AI,5      1                   BUMP BUFFER POINTER.
         AND,8     =X'FFFFFF00'        KILL STORED BYTEIN R8.
         B         TSOPUTWORD626       AND LOOP.
*
*
*
*        MAKES A R5 BUFFER.
*
*        BAL'ED TO ON R15.
*
TSOMAKEBUFFER RES  0
         LW,#ARG   TSORECORDSIZE       SIZE OF BUFFER TO GET.
         #GET#MAIN#BYTES                AND GET IT.
         STW,#ARG  TSORECORDBA         STORE RETURNED DSP.
         LI,5      X'7FFFF'            CREATE CLEAN BA
         AND,5     #ARG                 IN REGISTER FIVE.
         LW,#ARG   TSORECORDSIZE       ADD SIZE TO GET THE BA
         AW,#ARG   5                    OF (LAST BYTE + 1).
         STW,#ARG  TSORECORDENDBA      AND STORE IT.
*
         #EXU#ON#TYPE#INDEX            MAYBE PUT DEVICE-DEPENDENT PREFIX
         B         *15                 UNKNOWN.
         B         *15                 OWN-CODE.
         B         *15                 UNIT RECORD.
         B         *15                 TTY.
         B         TSOMAKEBUFFER3270   3270.
*
TSOMAKEBUFFER3270 RES 0
         DO        DO#3270
         LI,#ARG   X'F1'               3270 PREFIX TO BUFFER:
         STB,#ARG  0,5
         AI,5      1
         LI,#ARG   X'C2'
         STB,#ARG  0,5
         AI,5      1
         FIN
         B         *15
*                                                                       TIC53560
*                                                                       TIC53570
*                                                                       TIC53580
TSOPUTBUFFER RES  0                   HERE TO FLUSH BUFFER.             TIC53590
        AI,5      0                   SEE IF THERE IS A BUFFER.         TIC53600
         BEZ       TSOPUTEXIT          IMMEDIATER ETURN IF NOT.         TIC53610
*                                                                       TIC53620
         LW,#ARG   TSORECORDBA         GET BUFFER LOC & DYN BIT.        TIC53630
        AND,#ARG  =X'7FFFF'           ISOLATE BA OF BUFFER.             TIC53640
        SW,5      #ARG                (POSITION - START) IS LENGTH.     TIC53650
         B         TSOPUTWRITE         GO WRITE THE BUFFER.             TIC53660
*                                                                       TIC53670
*                                                                       TIC53680
*                                                                       TIC53690
TSOKILLBUFFER RES  0                   HERE TO JUST RELEASE BUFFER.     TIC53700
         AI,5      0                   SEE IF A BUFFER.                 TIC53710
         BEZ       *15                 IMMEDIATE RETURN IF NOT.         TIC53720
*                                                                       TIC53730
         LI,#ARG   0                   FREE
         XW,#ARG   TSORECORDBA          THE
         #FREE#MAIN#BYTES                BUFFER.                        TIC53750
*                                                                       TIC53760
         LI,5      0                   INDICATE NO BUFFER.              TIC53770
         B         *15                 AND RETURN.                      TIC53780
*                                                                       TIC53790
*                                                                       TIC53800
*                                                                       TIC53810
TSOPUTEOL RES      0                   HERE TO PUT AN END-OF-LINE       TIC53820
*                                      INTO THE STATION'S OUTPUT.       TIC53830
         MTW,1     TSOCURRENTR         BUMP CURRENT 'ROW' POSITION.     TIC53840
         LI,#ARG   1                   GET A ONE AND                    TIC53850
         STW,#ARG  TSOCURRENTC          STORE AS CURRENT 'COLUMN'.      TIC53860
*                                                                       TIC53870
*
         #EXU#ON#TYPE#INDEX
         B         TSOPUTEOL275        UNKNOWN TYPE GETS TTY.
         BAL,#BAL  TSOPUTEOL275        NO OWNCODE ROUTINE YET.
         B         TSOPUTEOL270        UNIT RECORD.
         B         TSOPUTEOL275        TTY.
         B         TSOPUTEOL275        3270 IS TTY FOR NOW.
*
TSOPUTEOL270 RES   0                   HERE ON UNIT RECORD.
         AI,5      0                   SEE IF BUFFER PRESENT.
         BNEZ      TSOPUTBUFFER        IF SO, JUST DUMP IT.
*
         LW,8      15                  IF NO BUFFER,
         SLS,8     8                    CREATE ONE WITH
         AI,8      ' '                   A BLNAK IN IT.
         BAL,15    TSOPUTCHAR
         LW,15     8
         SLS,15    -8
         B         TSOPUTBUFFER        AND THEN DUMP THE BLANK.
*
TSOPUTEOL275 RES   0                   HERE ON NORMAL STATION.
         LW,8      15                  SAFE-STORE THE RETURN ADDRESS    TIC53880
         SLS,8     8                   IN UPPER PART OF REGISTER 8.     TIC53890
*                                                                       TIC53900
         AI,8      X'15'               OR IN NEW-LINE.
         BAL,15    TSOPUTCHAR          AND 'PUT' IT.                    TIC53920
         SLS,8     -8                  RE-ALIGN THE RETURN ADDRESS.     TIC53960
        B         *8                  AND RETURN.                       TIC53970
*                                                                       TIC53980
*                                                                       TIC53990
*                                                                       TIC54000
TSOGETFQMCHAR RES  0                   HERE TO GET 'NEXT' CHARACTER     TIC54010
*                                      FROM THE FQM TEXT.               TIC54020
         CW,7      TSOFQMTEXTENDBA     SEE IF PAST END.                 TIC54030
         BGE       TSOENDOFFQMTEXT     OUT IF SO.                       TIC54040
*                                                                       TIC54050
         LB,8      0,7                 NOT AT END; GET CHAR.            TIC54060
         LW,#ARG   8                    AND COPY CHAR.
         AI,7      1                   BUMP POINTER.                    TIC54070
         B         *15                 AND RETURN.                      TIC54080
*                                                                       TIC54090
TSOENDOFFQMTEXT EQU TSOZ500            WHERE TO GO ON END-OF-TEXT.      TIC54100
         PAGE
*
*
*
*        ROUTINE CALLED (BAL,14) BY A 'PRIMLOC' WHICH
*        IS ABOUT TO PUT A FIELD ONTO THE I/O MEDIUM.
*
*        ROUTINE PERFORMS ANY NECESSARY ACTIONS.
*
TSOANOTHERFIELD RES 0
*
         MTW,1     TSOFIELDSSINCEAT    COUNT FIELD.
         BGZ       *14                 AND RETURN IF NO NEEDED ACTION.
*
*        FALL THROUGH WHEN THIS FIELD IS THE FIRST
*        FIELD SINCE AN @ MOVED US FORWARD.
*        WE MAY HAVE TO PUT IN SOME FIELD-DEFINITION STUFF.
*
         #EXU#ON#TYPE#INDEX
BSTAR14  B         *14                 UNKNOWN.
         BAL,#BAL  O:SETOUTPUTFIELD    OWN-CODE.
         B         *14                 UNIT RECORD.
         B         *14                 TTY.
         B         TSOANOTHERFIELD3000 3270.
*
         DO        DO#3270
TSOANOTHERFIELD3000 RES 0
         LI,#ARG   X'00'               SET NO ATTRIBUTE BITS YET.
         LW,8      TSITFDSCAN          RE-INT THE PRIMITIVE
         INT,12    *8                  TO SEE IF ANY FLAGS.
         BCR,2     TSOANOTHERFIELD3090 OVER IF NOT.
*
         AI,8      1                   POINT R8 TO WORD OF FLAGS.
         LW,8      *8                  LOAD THE WORD OF FLAGS.
*
         CI,8      X'00040000'         TEST FOR 'M' FLAG.
         BAZ       %+2                 IF PRESENT, THEN
         OR,#ARG   =X'01'               OR IN MODIFIED BIT.
         CW,8      =X'00400000'        TEST FOR 'I' FLAG.
         BAZ       %+2                 IF PRESENT, THEN
         OR,#ARG   =X'08'               OR IN INTENSE BIT.
         CI,8      X'00008000'         TEST FOR 'P' FLAG.
         BAZ       %+2                 SKIP IF NOT.
         OR,#ARG   =X'20'              OR IN PROTECTED BIT.
         CI,8      X'00020000'         TEST FOR 'N' FLAG.
         BAZ       %+2                 IF PRESENT, THEN
         OR,#ARG   =X'0C'               OR IN NON-DISPLAY BITS.
         CI,8     X'00000200'       TEST FOR 'U' FLAG.
         BAZ      %+2               IF PRESENT, THEN OR IN
         OR,#ARG  =X'10'              FORCE UPPER CASE SHIFT FLAG.
*
TSOANOTHERFIELD3090 RES 0
         LB,8      3270BUFFERADDRESSTABLE,#ARG LOAD EBCDIC BIT BYTE.
         SLS,8     16                  POSITION IT.
         OR,8      =X'1D000000'        OR IN OTHER BYTE.
         BAL,15    TSOPUTWORD          ATTRIBUTE TO BUFFER.
         B         *14                 AND RETURN.
*
         ELSE
TSOANOTHERFIELD3000 EQU BSTAR14
         FIN
         PAGE                                                           TIC54110
TSOIOERROR RES     0                                                    TIC54120
         #SNAP,2   'AT TSOIOERROR'                                      TIC54130
         MTW,0     TSIZEROORONE        SEE IF WHILE INPUTTING OR OUTPUTTTIC54140
         BNEZ      ENDERROREDDELIVERY  OUT IF WAS OUTPUTTING.           TIC54150
*                                                                       TIC54160
*                                                                       TIC54170
TSIIOERROR RES     0                   HERE ON I/O ERROR ACCEPTING      TIC54180
         #SNAP     'AT TSIIOERROR'                                      TIC54190
         B         COMMANDLEVELPOSTCOMMAND
         TITLE     'TIC - DEV-TASK - UTILITY SUBROUTINES'
*                                                                       TIC54220
*                                                                       TIC54230
*                                                                       TIC54240
*        RETURNS THE TRANID OF THE TRANSACTION IN PROGRESS              TIC54250
*        (OF INPUT OR OUTPUT) IN R9.  IF NO TRANID (ON INPUT),          TIC54260
*        GETS ONE.                                                      TIC54270
*                                                                       TIC54280
*        BAL'ED TO ON R15                                               TIC54290
*                                                                       TIC54300
*        DOES NOT DAMAGE R4,5,6,7,8,10,11,12,13,14.                     TIC54310
*                                                                       TIC54320
OBTAINTRANIDINR9 RES 0                                                  TIC54330
         LW,9      TSITRANID           GET TRANID THAT MAY BE THERE.    TIC54340
         BNEZ      *15                 AND RETURN IF THERE WAS ONE.     TIC54350
*                                                                       TIC54360
         XW,9      8                   OTHERWISE, GET
         M:GETID                        AN ID INTO
         XW,9      8                     R9.
         BEZ       %+3                 OVER IF GOT A ZERO ID.
*
         STW,9     TSITRANID           REMEMBER IT.                     TIC54380
         B         *15                 AND RETURN.                      TIC54390
*
*
*
*E*  MESSAGE:     'GOT A ZERO FROM GETID'
*E*  DESCRIPTION: DURING TRANSACTION SCAN VIA TFD, M:GETID YIELDED
*E*               ZERO ID.
*E*  REGISTERS:   0-15
         #SNAP,30  'GOT A ZERO FROM GETID'
         #ABORT
         PAGE
*
*
*        THE ROUTINES HANDLE DEVICE-SPECIFIC THINGS,
*        ESPECIALLY MESSAGE POSITIONING.
*
*        THEY USE THE BUFFERING ROUTINES DEVELOPED FOR
*        THE ECHO COMMAND TO DO MESSAGE BUILDING.
*
*        ROUTINES ARE BAL'ED TO ON R13 OR R14.
*
*        R5 IS USED FOR BUFFER INFO.
*
*        ROUTINES DESTROY R14 AND R13.
*
*
*
*        ROUTINE TO GET A BUFFER AND INITIALIZE IT
*        WITH POSITIONING CHARACTERS.
*
*        BAL'ED TO ON R13.
*
ERRORBUFFERCREATE RES 0
         #T#GET,#ARG #DEV#OUTPUT#TRL   SEE HOW BIG TO BUFFER.
         CI,#ARG   80                  BUT SET A
         BLE       %+2                  MAX OF
         LI,#ARG   80                    EIGHTY.
         LW,5      #ARG                REMEMBER SIZE.
         #GET#MAIN#BYTES                GET A BUFFER.
         AND,#ARG  =X'7FFFF'           NEATEN BA OF BUFFER.
         SLS,5     20                  SLIDE COUNT LEFT.
         OR,5      #ARG                AND OR THE BA IN.
*
*        HAVE A EMPTY BUFFER.
*
         #EXU#ON#TYPE#INDEX            BRANCH ON TYPE OF DEVICE.
         B         *13                 UNKNOWN TYPE GETS NO POSITIONING.
         BAL,#BAL  *13                 NO OWNCODE ROUTINE YET.
         B         *13                 UNIT RECORD NEEDS NO PREFACE.
         B         ERRORBUFFER3600     TTY.
         B         ERRORBUFFER3500     3270.
*
ERRORBUFFER3500 RES 0                  HERE TO PREFACE A 3270 MESSAGE.
*
         DO        DO#3270
*        SLIGHTLY SNEAKY CODE HERE.
*        WE KNOW WE ARE AT THE BEGINNING OF
*        A GETMAIN BLOCK SO WE KNOW R5 POINTS
*        TO A BA WHICH IS ON A WA BOUNDARY.
*  TO CONVERT R&C TO NNNN=3270 BUF ADDR,
*        MULTIPLY ROW * MAX COL;
*        ADD COL;
*        SUBTRACT MAX COL;
*        SUBTRACT 1 TO ADJUST FOR R&C STARTING AT 1;
*        CREATE IN #ARG & #BAL THE BASE 64 OF THE BUF POSITION.
*
*  FIRST, CONVERT ROW MAX, COL 1 TO NNNN=3270 BUF ADDR.
         #T#GET,#BAL  #DEV#PLATEN#R  ROW = ROW MAX
         #T#GET,#ARG  #DEV#PLATEN#C  COL MAX
         MW,#BAL  #ARG              ROW * COL MAX
         SW,#BAL  #ARG              SUBTRACT COL MAX
*                                   NOTE: COL=1. NO NEED TO ADD & SUBTRACT.
         LW,#ARG  #BAL              CREATE IN #ARG & #BAL THE
         SLS,#ARG -6                 BASE 64 OF THE
         AND,#BAL =X'3F'             BUF POSITION.
         LB,#ARG  3270BUFFERADDRESSTABLE,#ARG
         LB,#BAL  3270BUFFERADDRESSTABLE,#BAL
         SLS,5     -2                  R5 --> WA.
         OR,#ARG  =X'F1C21100'
         STW,#ARG  0,5                 STORE PART OF PREFIX.
         SCS,#BAL -8                X'NN000000'
         SLD,#ARG -24
         INT,#BAL #BAL
         OR,#BAL  =X'40110000'  TO FORM X'4011NNNN', WHERE NNNN=R MAX, C 1
         STW,#BAL 2,5
         LI,#ARG  3
         LB,#BAL  #BAL,#ARG
         SCS,#BAL -8                SAVE LAST BYTE OF BUF ADDR
         OR,#BAL  =X'3C0000'        WANT X'NN3C0000' IN 1,5 TEMPORARILY
         STW,#BAL 1,5
*  SECOND ADDRESS TO CONVERT IS ROW MAX, COL MAX.
         #T#GET,#BAL  #DEV#PLATEN#R
         #T#GET,#ARG  #DEV#PLATEN#C
         MW,#BAL  #ARG              THIS ROW * MAX COL
*                                   NOTE: COL=MAX COL. NO NEED TO ADD & SUB.
         AI,#BAL  -1                SUBTRACT 1 FOR R&C STARTING AT 1.
         LW,#ARG  #BAL
         SLS,#ARG -6
         AND,#BAL =X'3F'
         LB,#ARG  3270BUFFERADDRESSTABLE,#ARG
         LB,#BAL  3270BUFFERADDRESSTABLE,#BAL
         SLS,#ARG 8
         OR,#ARG  #BAL              X'0000NNNN' IN #ARG
         LI,#BAL  X'FFFF'
         STS,#ARG 1,5     X'NN3CNNNN' WHERE 1ST NN IS FROM OLD ADDR.
         SLS,5     2                   R5 --> BA AND COUNT.
         AW,5      =X'FF40000C'        ADJUST R5 FOR TWELVE CHARACTERS.
         B         *13                 AND RETURN.
         FIN
*
ERRORBUFFER3600 RES 0                  HERE TO PREFACE A TTY MESSAGE.
         LI,#ARG   X'0D'               JUST A CARRIAGE RETURN
         STB,#ARG  0,5                  GOES INTO THE
         AW,5      =X'FFF00001'          BUFFER.
         B         *13                 AND RETURN.
*
*
*
*        COPIES TEXTC STRING TO ERROR BUFFER.
*
*        BA OF TEXTC IN R12.  BAL'ED TO ON R14.
*
ERRORBUFFERTEXTC EQU BUFFERTEXTCR12
*
*
*
*        FLUSH ERROR BUFFER.
*
*        BAL'ED TO ON R13.
*
ERRORBUFFERFLUSH EQU BUFFERFLUSHSPECIAL
         PAGE
*
*
*
*        WRITES RECORD TO THE JOURNAL.
*
*        BAL'ED TO ON R15.
*
*        WITH WA OF BXR TO WRITE IN R8.
*
*        MAY USE #ARG, #BAL, R8, R9, R10.
*
WRITEJOURNALRECORD RES 0
*
         LW,#ARG   8                   WA OF BXR TO #ARG.
*
         M:TIME    FOURWORDSFORMTIME,TMS BXR NEEDS DATA & TIME.
         STW,8     2,#ARG              SO STORE
         STW,9     3,#ARG               THEM IN.
*
         BAL,#BAL  CHECKSUM            MUST (RE)CHECKSUM.
*
         LW,8      #ARG                WA OF BXR BACK TO R8.
         LI,9      X'FFFF'             LOAD, FROM FIRST WORD OF BXR,
         AND,9     *8                   THE RECORD'S BYTE COUNT.
*
         #T#GWA,10 #DEV#ECB            POINT TO TASK'S ECB.
*
         M:WRITE   F:JRNL,(BUF,*8),(SIZE,*9),(ECB,*10)
         LW,#ARG   10                  COPY ECB LOCATION AND
         #WAIT#ON                       WAIT FOR THE JRNL I/O.
         #PUSH,8,8                     SAVE R8 AROUND THE M:CHECK.
         M:CHECK   F:JRNL,(ECB,*10),(ERR,WRITEJOURNALERR),;
                                    (ABN,WRITEJOURNALABN)
         #PULL,8,8                     RESTORE CALLER'S R8.
*
         B         *15                 IF ALL GOOD, RETURN.
*
*
*
WRITEJOURNALERR RES 0                  ALL JOURNAL ERR ARE FATAL.
*                                      REMEMBER: CALLER'S R8 HAS BEEN
*                                      PUSHED INTO THE STACK AT
*                                      THIS POINT (JUST AFTER M:CHECK)
*E*  MESSAGE:     'JRNL WRITE ERR'
*E*  DESCRIPTION: I/O ERROR OCCURRED ATTEMPTING TO WRITE TO THE
*E*               JOURNAL, F:JRNL.
*E*  REGISTERS:   0-15
         #SNAP,27  'JRNL WRITE ERR'
         #PULL,8,8                     (MUST NEATEN R8 OUT OF STACK)
         #ABORT
*
*
*
WRITEJOURNALABN RES 0                  ALL JOURNAL ABN ARE TRY-AGAIN.
*                                      REMEMBER: CALLER'S R8 HAS BEEN
*                                      PUSHED INTO THE STACK AT
*                                      THIS POINT (JUST AFTER M:CHECK)
         DO        DO#CHECKOUT
         LB,#ARG   10                  ONLY LEGAL ABN CODE
         CI,#ARG   X'1C'                IS X'1C' ... IF CHECKOUT,
         BNE       -1                    INSURE NO OTHER.
         FIN
         #PULL,8,8                     RESTORE CALLER'S R8.
         #CLEAR#ECB #TIMESUP#ECB       WAIT FOR
         #WAIT#ON  #TIMESUP#ECB         AWHILE
         B         WRITEJOURNALRECORD  AND THEN TRY AGAIN.
         PAGE                                                           TIC54400
*                                                                       TIC54410
*        THIS CODE POINTS THE '@DEV@USING@TFD' TABLE                    TIC54420
*        TO THE IN-CORE COPY OF THE TFD WHICH HAS ITS JEY               TIC54430
*        AS DEFINED BY C(R9-R13)                                        TIC54440
*                                                                       TIC54450
*        THIS ROUTINE IS BAL'ED TO ON R15.                              TIC54460
*                                                                       TIC54470
*        MUST PRESERVE:  (R1), R4, R5, R14.                             TIC54480
*                                                                       TIC54490
POINTTOTFDCODE RES 0                                                    TIC54500
         #ENTRY#SPACE 0                SAVE REGISTERS.                  TIC54510
*
         DO        DO#CORETFDS
*                                                                       TIC54520
         LI,8      @TFD@CHAIN          START SCANNING TFDS              TIC54530
*                                                                       TIC54540
POINTNEXT LW,8     *8                  DOWN A TFD                       TIC54550
*                                                                       TIC54560
         LI,6      X'1FFFF'            EXTRACT THE WA                   TIC54570
         AND,6     8                    OF THE TFD.                     TIC54580
         BNEZ      POINTTRIAL
         FIN
*
*        FALL THROUGH TO FETCH TFD FROM FILE.
*
         LI,5      #INFOBLOCK#TFDI
         BAL,15    OBTAININTERNALFILERECORD
         BEZ       POINTTONOT          OVER IF NO RECORD.
         SLS,8     -2                  IF RECORD FOUND,
         AND,8     =X'1FFFF'            MAKE A NEAT WA.
*
         DO        DO#CORETFDS
         LW,7      @TFD@CHAIN          IF KEEPING TRACK OF TFDS IN
         STW,8     @TFD@CHAIN           CORE, PUT THIS ONE ONTO
         STW,7     *8                    THAT CHAIN OF TFDS.
         FIN
         B         POINTFOUND
*                                                                       TIC54600
         DO        DO#CORETFDS
POINTTRIAL RES     0
         SLS,6     2                   MAKE BA POINTER TO TRIAL TFD.    TIC54610
         LW,7      =X'11000024'        MBS WORD TO POINT TO R9.         TIC54620
         CBS,6     4                   COMPARE 4 BYTES INTO TRIAL TFD.  TIC54630
         BNEZ      POINTNEXT           IF NOT EQUAL, TRY AGAIN          TIC54640
         FIN
*                                                                       TIC54650
POINTFOUND RES     0                                                    TIC54660
         #T#PUT,8  #DEV#USING#TFD      WA OF GOOD TFD INTO TABLE.       TIC54670
         STW,8     RETURNR8            STORE 'ANSWER' FOR THE RETURN.   TIC54680
         #EXIT#SPACE                   RESTORE REGISTERS.               TIC54690
         AI,8      0                   SET CC APPROPRIATELY.            TIC54700
         B         *15                 AND RETURN                       TIC54710
*                                                                       TIC54720
POINTTONOT RES     0                                                    TIC54730
         LI,8      0                   RETURN A ZERO                    TIC54740
         #T#PUT,8  #DEV#USING#TFD       IF NO SUCH TFD.                 TIC54750
         STW,8     RETURNR8            STORE FOR THE RETURN.            TIC54760
         #EXIT#SPACE                   RESTORE REGISTERS.               TIC54770
         AI,8      0                   SET CC APPROPRIATELY.            TIC54780
         B         *15                                                  TIC54790
*                                                                       TIC54800
*                                                                       TIC54810
*                                                                       TIC54820
DONEWITHTFDCODE RES 0                                                   TIC54830
*                                                                       TIC54840
*        MUST PRESERVE:  (R1), R4, R5, R7.                              TIC54850
*                                                                       TIC54860
*        MUST PRESERVE:  R9, R10, R11, R12, R13.                        TIC54870
*                                                                       TIC54880
         #T#GET,8  #DEV#USING#TFD      LOCATION OF HIS TFD.             TIC54890
         BEZ       *15                 ROUTINE IS NOP IF NONE.          TIC54900
*                                                                       TIC54910
         LI,6      0                   ZERO OUT - HE'S NO               TIC54920
         #T#PUT,6  #DEV#USING#TFD       LONGER USING TFD.               TIC54930
*                                                                       TIC54940
         DO        DO#CORETFDS
         LW,6      #BIGGEST#TIC#TASK   SCAN ALL DEV-TASKS TO            TIC54950
DONEWITHTFDCODE222 RES 0                SEE IF ANY OF THEM              TIC54960
         #T#GET,14,6 #DEV#USING#TFD      IS USING THIS TFD.             TIC54970
         CW,14     8                   IS HE ISING THIS TFD.            TIC54980
         BE        *15                 OUT IF TFD STILL IN USE.         TIC54990
         BDR,6     DONEWITHTFDCODE222                                   TIC55000
*                                                                       TIC55010
*        FALL THROUGH WHEN NO ONE USING THE TFD.                        TIC55020
*                                                                       TIC55030
*        WA OF TFD TO FREE IS IN R8.                                    TIC55040
*                                                                       TIC55050
         LI,6      @TFD@CHAIN          CHAIN HEAD.                      TIC55060
DONEWITHTFDCODE662 RES 0                                                TIC55070
         LW,14     6                   REMEMBER WHERE PREVIOUS GUY IS.  TIC55080
         LW,6      *6                  DOWN CHAIN.                      TIC55090
         AND,6     =X'1FFFF'           CLEAN UP LOCATION.               TIC55100
         BEZ       DONEWITHTFDCODEERROR ERROR IF OFF END OF CHAIN.      TIC55110
         CW,6      8                   ARE WE AT RIGHT GUY.             TIC55120
         BNE       DONEWITHTFDCODE662  CONTINUE SCAN IF NOT.            TIC55130
*                                                                       TIC55140
*        FALL THROUGH ON FOUND CHAIN ENTRY.                             TIC55150
*                                                                       TIC55160
         LW,6      *6                  NEXT CHAIN POINTER.              TIC55170
         AND,6     =X'1FFFF'           NEATENED.                        TIC55180
         STW,6     *14                 INTO PREVIOUS ENTRY.             TIC55190
         FIN
*                                                                       TIC55200
         LW,#ARG   8                   WA OF GUY TO FREE.               TIC55210
         SLS,#ARG  2                   INTO BA.                         TIC55220
         OR,#ARG   =X'80000000'        RE-MAKE IT DYNAMIC POINTER.      TIC55230
         #FREE#MAIN#BYTES              AND FREE IT.                     TIC55240
         B         *15                 AND RETURN.                      TIC55250
*                                                                       TIC55260
         DO        DO#CORETFDS
DONEWITHTFDCODEERROR RES 0                                              TIC55270
         #SNAP,30  'TFD NOT IN TFD CHAIN'                               TIC55280
         #ABORT                                                         TIC55290
         FIN
         PAGE                                                           TIC55570
*                                                                       TIC55580
*                                                                       TIC55590
*        ROUTINE TO CALCULATE CHECKSUMS OF BXR RECORDS.                 TIC55600
*        CALCULATES ADD-AND-CARRY-LOGICAL CHECKSUM 'WITHOUT             TIC55610
*        OVERFLOWS) AND PUTS IT IN RECORD.                              TIC55620
*                                                                       TIC55630
*        BAL'ED TO ON #BAL, WITH WA OF BXR IN #ARG.                     TIC55640
*        DAMAGES NO REGOSTERS.                                          TIC55650
*                                                                       TIC55660
CHECKSUM RES       0                                                    TIC55670
         #PUSH,6,11                                                     TIC55680
*                                                                       TIC55690
         LI,6      X'FFFF'             EXTRACT FROM WORD ZERO           TIC55700
         AND,6     *#ARG               BYTE COUNT OF RECORD.            TIC55710
         SLS,6     -2                  INTO WORD COUNT.                 TIC55720
         AI,6      -1                  -1 FOR DON'T ALL THE CHECKSUM WORTIC55730
         LW,7      6                   (REMEMBER VALUE FOR CHECKSUM STORTIC55740
         AI,6      -1                  -1 FOR BDR LOOP LESS WORD ZERO.  TIC55750
*                                                                       TIC55760
*        FOLLOWING CODE FROM TP DESIGN FILE #73-29.                     TIC55770
*                                                                       TIC55780
         LI,8      0                                                    TIC55790
         LW,9      *#ARG                                                TIC55800
         LI,10     0                                                    TIC55810
         LW,11     *#ARG,6                                              TIC55820
         AD,8      10                                                   TIC55830
         BDR,6     %-2                                                  TIC55840
         LW,11     8                                                    TIC55850
         LI,8      0                                                    TIC55860
         AD,8      10                                                   TIC55870
         LW,11     8                                                    TIC55880
         AD,8      10                                                   TIC55890
*                                                                       TIC55900
         STW,9     *#ARG,7             CHECKSUM --> BXR'S CHECKSUM WORD.TIC55910
*                                                                       TIC55920
         #PULL,6,11                                                     TIC55930
         B        *#BAL                                                 TIC55940
         PAGE
*
*
*
*        CONVERTS TIC'S ROW & COLUMN POSITION
*        ON A 3270 SCREEN TO THE EBCDIC THAT THE
*        3270 WANTS.
*
*        (COLUMN ZERO IS ACCEPTED AND TREATED
*        LIKE THE LAST COLUMN OF PREVIOUS ROW.)
*
*        BAL'ED TO ON R15.
*
*        ENTER WITH R&C IN R13 & R14.
*
*        RETURNS R12 AS X'11NNNN00' WHERE NNNN
*        IS THE 3270 EBCDIC BUFFER POSITION.
*
         DO        DO#3270
3270RANDCTOSBA RES 0
         LW,12     =X'11000000'        INITIALIZE RETURN REGISTER.
*
         LW,#BAL   13                  COPY ROW.
         CI,#BAL   10000               SEE IF 'UNDEFINED'
         BL        %+2                 OVER IF NOT.
         AI,#BAL   -10000              ADJUST IF SO.
*
         #T#GET,#ARG  #DEV#PLATEN#R COMPARE WITH SCREEN SIZE
         CW,#BAL  #ARG
         BLE       %+3                 MOD DOWN
         SW,#BAL  #ARG               BY SCREEN
         B         %-3                   SIZE.
*
         #T#GET,#ARG  #DEV#PLATEN#C CALCULATE MAX COL * R + C.
         MW,#BAL  #ARG
         AW,#BAL   14                  ADD IN THE COLUMN.
         CI,14     10000               SEE IF 'UNDEFINED' COLUMN.
         BL        %+2                 OVER IF NOT.
         AI,#BAL   -10000              ADJUST SUM IF SO.
*
         SW,#BAL  #ARG              ADJUST FOR R&C STARTING AT ONE.
         AI,#BAL  -1
         BGEZ      %+2                 IF BEFORE START, THEN
         LI,#BAL   0                    FORCE TO SBA OF 0,0.
*
         LW,#ARG   #BAL                CREATE, IN #ARG AND
         SLS,#ARG  -6                   #BAL, THE BASE 64
         AND,#BAL  =X'3F'                OF THE BUFFER POSITION.
*
         LB,#ARG   3270BUFFERADDRESSTABLE,#ARG
         LB,#BAL   3270BUFFERADDRESSTABLE,#BAL
*
         SLS,#ARG  16                  SLIDE
         OR,12     #ARG                 EBCDIC
         SLS,#BAL  8                     OVER AND
         OR,12     #BAL                   STORE.
*
         B         *15                 AND RETURN.
*
*
*
3270BUFFERADDRESSTABLE RES 0
         GEN,32,32 X'40C1C2C3',X'C4C5C6C7'
         GEN,32,32 X'C8C94A4B',X'4C4D4E4F'
         GEN,32,32 X'50D1D2D3',X'D4D5D6D7'
         GEN,32,32 X'D8D95A5B',X'5C5D5E5F'
         GEN,32,32 X'6061E2E3',X'E4E5E6E7'
         GEN,32,32 X'E8E96A6B',X'6C6D6E6F'
         GEN,32,32 X'F0F1F2F3',X'F4F5F6F7'
         GEN,32,32 X'F8F97A7B',X'7C7D7E7F'
         FIN
         PAGE                                                           TIC55950
*                                                                       TIC55960
*                                                                       TIC55970
*                                                                       TIC55980
*        ROUTINE TO READ A (KEYED) RECORD FROM ONE OF OUR               TIC55990
*        INTERNAL FILES.                                                TIC56000
*                                                                       TIC56010
*        WE HAVE ARRANGED SO THAT WHICH INTERNAL IS DESCRIBED           TIC56020
*        TO THE ROUTINE AND THEREFORE ONE ROUTINE SUFFICES.             TIC56030
*                                                                       TIC56040
*        ENTER WITH R5 POINTING TO THE 'INFOBLOCK' OF THE               TIC56050
*        FILE THAT SHOULD BE READ.                                      TIC56060
*                                                                       TIC56070
*        ENTER WITH THE 'KEY' OF THE RECORD IN R9-R13.  (WHETHER        TIC56080
*        OR NOT R11-R13 ARE USED DEPENDS ON WHICH FILE IT IS)           TIC56090
*                                                                       TIC56100
*        RETURNS A DSP TO THE RECORD IN R8, OR A ZERO IF THERE          TIC56110
*        IS NO SUCH RECORD.  ON RETURN, THE CC REFLECT C(R8).           TIC56120
*                                                                       TIC56130
OBTAININTERNALFILERECORD RES 0                                          TIC56140
         DO        DO#GATEOBTAININTERNAL
OBTAININTERNAL120 RES 0
         MTW,0     GATEOBTAININTERNALCOUNT ROUTINE IN USE.
         BEZ       OBTAININTERNAL160   OVER IF NOT.
         #CLEAR#ECB GATEOBTAININTERNALECB IN USE .. SO
         LI,#ARG   GATEOBTAININTERNALECB SO MUST WAIT.
         #WAIT#ON
         B         OBTAININTERNAL120
OBTAININTERNAL160 RES 0
         MTW,1     GATEOBTAININTERNALCOUNT SET IN USE.
         FIN
*                                                                       TIC56150
         #ENTRY#SPACE 0                SAVE THE REGISTERS.              TIC56160
*                                                                       TIC56170
         LW,8      5                   START AT HEAD OF KEY CHAIN.      TIC56190
*                                                                       TIC56200
OBTAININTERNAL200 RES 0                                                 TIC56210
         LW,8      *8                  CHAIN DOWN TO ITS KEY.           TIC56230
         BEZ       OBTAININTERNALNOT   OUT IF OFF END OF CHAIN.         TIC56240
*                                                                       TIC56250
         LW,6      8                    CREATE BA OF CHAIN ENTRY.       TIC56260
         SLS,6     2                    FOR A LATER CBS.                TIC56270
*                                                                       TIC56280
         LW,7      1,5                 GET LENGTH OF KEY.
         SLS,7     24                  TO CBS COUNT POSITION.           TIC56300
         OR,7      =X'24'               POINT TO KEY IN R9.             TIC56310
*                                                                       TIC56320
         CBS,6     8                   COMPARE.  (8 INTO CHAIN ENTRY)
         BL        OBTAININTERNAL200   BACK FOR NEXT IF LESS.           TIC56340
*                                                                       TIC56350
*        FALL THROUGH IF RECORD SHOULD BE IN THIS GRANULE.              TIC56360
*                                                                       TIC56370
         LW,6      8                   (CHAIN ENTRY WA TO INDEX)
         LW,14     1,6                 LOAD CORRECT GRANULE NUMBER.
*
         #GET#MAIN#BYTES BYTESPERRANDOMBLOCK GET A GRANULE BUFFER.
         LW,15     #ARG                REMEMBER DSP OF BUFFER.          TIC56410
         LI,8      X'7FFFF'            WA OF                            TIC56420
         AND,8     #ARG                 BUFFER                          TIC56430
         SLS,8     -2                    TO R8.                         TIC56440
*                                                                       TIC56450
         LW,7      1,5                 GET DCB LOCATION.                TIC56460
*                                                                       TIC56470
*        GET ADDRESS OF ECB IN DCB OR USE OURS.
*                                                                       TIC56490
         DO        DO#UTS
         LI,6      X'1FFFF'            CREATES POINTER TO               TIC56500
         AND,6     6,7                  VARIABLE LENGTH PARAMETERS.     TIC56510
OBTAININTERNAL245 RES 0                                                 TIC56520
         LB,#ARG   *6                  GET PARAMETER NUMBER.            TIC56530
         CI,#ARG   X'13'               IS IT THE ECB.                   TIC56540
         BE        OBTAININTERNAL285   OVER IF SO.                      TIC56550
*                                                                       TIC56560
         LW,#ARG   *6                  WAS NOT ECB.  LOAD CONTROL WORD. TIC56570
         CI,#ARG   X'10000'            IS THIS THE LAST PARAMETER.      TIC56580
         BANZ      -1                  IF SO, TIC LOGIC ERROR.
         AND,#ARG  =X'FF'              ISOLATE PARAMETER SIZE.          TIC56600
         AI,#ARG   1                   PLUS ONE FOR CONROL WORD.        TIC56610
         AW,6      #ARG                BUMPS US TO THE NEXT PARAMETER.  TIC56620
         B         OBTAININTERNAL245   CONTINUE TO LOOK FOR ECB.        TIC56630
*                                                                       TIC56640
OBTAININTERNAL285 RES 0                HERE WITH ECB FOUND.             TIC56650
         AI,6      1                   POINT R6 TO ECB.                 TIC56660
*
         ELSE
         #T#GWA,6  #DEV#ECB
         FIN
*                                                                       TIC56670
         M:SETDCB  F:TICI,(ERR,OBTAININTERNALERR),;
                          (ABN,OBTAININTERNALABN)
         DO        DO#UTS
         M:READ    F:TICI,(BUF,*8),(SIZE,BYTESPERRANDOMBLOCK),;
                   (BTD,0),(BLOCK,*14)
         ELSE
         M:READ    F:TICI,(BUF,*8),(SIZE,BYTESPERRANDOMBLOCK),;
                   (BTD,0),(BLOCK,*14),(ECB,*6)
         FIN
*                                                                       TIC56690
         LW,#ARG   6                   POINT #ARG TO THE ECB            TIC56750
         #WAIT#ON                      AND WAIT ON IT.                  TIC56760
*                                                                       TIC56770
OBTAININTERNAL292 RES 0                                                 TIC56780
         DO        DO#UTS
         M:CHECK   F:TICI,(ERR,OBTAININTERNALERR),;
                          (ABN,OBTAININTERNALABN)
         ELSE
         M:CHECK   F:TICI,(ECB,*6),(ERR,OBTAININTERNALERR),;
                                   (ABN,OBTAININTERNALABN)
         FIN
*                                                                       TIC56810
*        WE HAVE THE BLOCK IN CORE THAT SHOULD                          TIC56820
*        CONTAIN THE RECORD THAT WE WANT.                               TIC56830
*                                                                       TIC56840
*        SO SCAN FOR OUT RECORD.                                        TIC56850
*                                                                       TIC56860
*        R8 HAS THE BARE WA OF THE GRANULE BUFFER.                      TIC56870
*                                                                       TIC56880
OBTAININTERNAL400 RES 0                                                 TIC56890
         MTW,0     *8                  SEE IF R8 POINTS TO RECORD.      TIC56900
         BEZ       OBTAININTERNAL600   OUT IF EXAUSTED.                 TIC56910
*                                                                       TIC56920
         LW,6      8                   COMPARE                          TIC56930
         SLS,6     2                    AGAINST                         TIC56940
         LW,7      1,5                  THIS     (GET KEY LENGTH)
         SLS,7     24                     'KEYED'                       TIC56960
         OR,7      =X'24'                   RECORD.                     TIC56970
*                                                                       TIC56980
         CBS,6     4                   COMPARE.
         BE        OBTAININTERNAL700   OUT ON A MATCH.                  TIC57000
         BG        OBTAININTERNAL600   OUT IF ALREADY PAST.             TIC57010
*                                                                       TIC57020
         AH,8      *8                  PUSH TO NEXT RECORD.             TIC57030
         B         OBTAININTERNAL400   AND TRY AGAIN.                   TIC57040
*                                                                       TIC57050
*                                                                       TIC57060
*                                                                       TIC57070
OBTAININTERNAL600 RES 0                HERE ON RECORD NOT IN GRANULE.   TIC57080
         LW,#ARG   15                  FREE THE GRANULE                 TIC57090
         #FREE#MAIN#BYTES               READ-IN BUFFER.                 TIC57100
         B         OBTAININTERNALNOT   AND HEAD FOR THE EXIT.           TIC57110
*                                                                       TIC57120
*                                                                       TIC57130
*                                                                       TIC57140
OBTAININTERNAL700 RES 0                HERE ON FOUND THE RECORD.        TIC57150
         LH,#ARG   *8                  WORDS IN RECORD.                 TIC57160
         SLS,#ARG  2                   INTO BYTES.                      TIC57170
         #GET#MAIN#BYTES                                                TIC57180
*                                                                       TIC57190
         LW,14     #ARG                REMEMBER THIS DSP.               TIC57200
*                                                                       TIC57210
         SLS,#ARG  -2                  WA OF BUFFER                     TIC57220
         LH,6      *8                  WORDS TO MOVE.                   TIC57230
         LW,7      *8                  WE MOVE                          TIC57240
         STW,7     *#ARG                THE RECORD                      TIC57250
         AI,8      1                     TO ITS OWN                     TIC57260
         AI,#ARG   1                      BUFFER.                       TIC57270
         BDR,6     %-4                                                  TIC57280
*                                                                       TIC57290
         LW,#ARG   15                  NOW WE CAN FREE                  TIC57300
         #FREE#MAIN#BYTES               THE GRANULE BUFFER.             TIC57310
*                                                                       TIC57320
         STW,14    RETURNR8            RETURN THE DSP OF RECORD.        TIC57330
         #EXIT#SPACE                   RESTORE REGS AND ABOVE R8.       TIC57340
         B         OBTAININTERNAL990
*                                                                       TIC57370
*                                                                       TIC57380
*                                                                       TIC57390
OBTAININTERNALNOT RES 0                HERE TO RETURN SANS RECORD.      TIC57400
         #EXIT#SPACE                   RESTORE REGISTERS.               TIC57410
         LI,8      0                   SET NO RECORD.                   TIC57420
*
OBTAININTERNAL990 RES 0
         DO        DO#GATEOBTAININTERNAL
         MTW,-1    GATEOBTAININTERNALCOUNT FREE UP ROUTINE.
         #POST#ECB GATEOBTAININTERNALECB AND START UP WAITERS.
         FIN
*
         AI,8      0
         B         *15                 RETURN.                          TIC57430
*                                                                       TIC57440
*                                                                       TIC57450
*                                                                       TIC57460
OBTAININTERNALERR RES 0                                                 TIC57470
OBTAININTERNALABN RES 0                                                 TIC57480
*E*  MESSAGE:     'ERR/ABN READING INTERNAL FILE'
*E*  DESCRIPTION: ATTEMPT TO READ F:TICI RECORD RESULTED IN I/O ERROR
*E*               OR ABNORMAL RETURN.
*E*  REGISTERS:   0-15
         #SNAP,22  'ERR/ABN READING INTERNAL FILE'
         #ABORT                                                         TIC57500
         PAGE                                                           TIC57530
*                                                                       TIC57540
*        ROUTINE(S) WHICH DO A Q/DEFINELIST.                            TIC57550
*                                                                       TIC57560
*        CALLED BY LOGON (INITIALLY) AND BY                             TIC57570
*        COMMANDLEVEL TO RESTORE THINGS AFTER A Q/PURGE                 TIC57580
*        DUE TO AN ATTENTION OR TO CHANGE THINGS DUE TO                 TIC57590
*        AN OPERATOR REGULATE.                                          TIC57600
*                                                                       TIC57610
*        DESTROY:  (R2), (R3), R8, R9, R10.                             TIC57620
*                                                                       TIC57630
*        ALSO USE THE ECB AT #DEV#ECB.                                  TIC57640
*                                                                       TIC57650
PURGEANDDEFINELIST RES 0                                                TIC57660
*                                                                       TIC57670
*        DESTROYS:  (R2), (R3), R8, R9, R10.                            TIC57680
*                                                                       TIC57690
*        USES #DEV#ECB.                                                 TIC57700
*                                                                       TIC57710
         #T#GET,8  #DEV#GET#LIST#ID    IS THERE A LIST TO PURGE.        TIC57770
         BEZ       DEFINELIST          OVER IF NOT.                     TIC57780
*                                                                       TIC57790
         #T#GWA,9  #DEV#ECB            GET ADDRESS OF AN ECB.           TIC57800
         M:QUEUE   *8,PURGE,(ECB,*9)   PURGE OLD LIST.                  TIC57810
         BCR,12    DEFINELIST          OVER ON GOOD PURGE.              TIC57820
         BCS,4     PURGEANDWAIT        OVER TO WAIT FOR QUEUE.          TIC57830
*                                                                       TIC57840
         #SNAP,30  'Q/PURGE ERROR CC12=10'                              TIC57850
         #ABORT                                                         TIC57860
*                                                                       TIC57870
PURGEANDWAIT RES   0                                                    TIC57880
         LW,#ARG   9                   COPY ECB ADDRESS.                TIC57890
         #WAIT#ON                      AND WAIT.                        TIC57900
         B         PURGEANDDEFINELIST  AND TRY AGAIN.                   TIC57910
*                                                                       TIC57920
DEFINELISTIF RES   0                                                    TIC57930
         #T#GET,8  #DEV#GET#LIST#ID    SEE IF HAVE A LIST ID.           TIC57940
         BNEZ      *15                 RETURN IF SO.                    TIC57950
*                                                                       TIC57960
DEFINELIST RES     0                                                    TIC57970
*                                                                       TIC57980
*        DESTROYS:  (R2), (R3), R8, R9, R10.                            TIC57990
*                                                                       TIC58000
*        USES #DEV#ECB.                                                 TIC58010
*                                                                       TIC58020
         #T#GET,8  #DEV#GET#LIST#LENGTH COUNT OF CRITERIA (@ AND #).    TIC58080
         BEZ        DEFINELISTGOOD     IF ZERO, ZERO IS LIST-ID.        TIC58090
         #T#GWA,10 #DEV#AT#NAME#LAL    WHERE FIRST CRITERION IS IN LOGONTIC58100
*                                                                       TIC58110
         #T#GET,#ARG #DEV#REGULATION   GET REGULATIONS.                 TIC58120
         CI,#ARG    #REGULATE#CRUNCH   SEE IF NO #-TYPE REPORTS.        TIC58130
         BAZ        %+2                OVER ON #-TYPE OK.               TIC58140
         LI,8       1                  IF NO #, ONLY ONE CRITERION.     TIC58150
         CI,#ARG    #REGULATE#AT       SEE IF NO @-TYPE REPORTS.        TIC58160
         BAZ        %+4                OVER ON @-TYPE OK.               TIC58170
         AI,8       -1                 BUMP COUNT DOWN.                 TIC58180
         BEZ        DEFINELISTGOOD     (IF ZERO, ZERO IS LIST-ID.)      TIC58190
         AI,10      1                  BUMP ADDRESS PAST @-CRITERION.   TIC58200
*                                                                       TIC58210
         #T#GWA,9  #DEV#ECB            USE DEV-TASK'S NORMAL ECB (CAREFUTIC58220
         M:QUEUE   *10,DEFINELIST,(LSIZE,*8),(ECB,*9) AND DEFINE A LIST.TIC58230
         BCR,12    DEFINELISTGOOD      OVER ON GOOD DEFINELIST.         TIC58240
         BCS,4     DEFINELISTWAIT      OVER TO WAIT FOR QUEUE.          TIC58250
*                                                                       TIC58260
         #SNAP,30  'Q/DEFINELIST ERROR CC12=10'                         TIC58270
         #ABORT                                                         TIC58280
*                                                                       TIC58290
DEFINELISTWAIT RES 0                                                    TIC58300
         LW,#ARG   9                   COPY ECB ADDRESS.                TIC58310
         #WAIT#ON                      AND WAIT.                        TIC58320
         B         DEFINELIST          AND TRY AGAIN.                   TIC58330
*                                                                       TIC58340
DEFINELISTGOOD RES 0                   ON GOOD DEFINELIST,              TIC58350
         #T#PUT,8  #DEV#GET#LIST#ID    STORE RETURNED LIST-ID,          TIC58360
         B         *15                 AND WE'RE DONE.                  TIC58370
         PAGE
*
*  HERE TO EFFECT A SWITCH FROM TP TO TIME-SHARE
*
TS       RES      0
         #T#GET,#ARG #DEV#LINE#STATUS#BITS
         CI,#ARG   #LINE#SWITCHABLE    IF LINE NOT SWITCHABLE,
         BAZ       COMMANDBAD           DON'T LET HIM.
*
         BAL,15    LOGOFF
*
         #T#GET,#ARG #DCB#TABLE
         M:SETDCB *#ARG,(ERR,TSERRABN),(ABN,TSERRABN)
         M:CLOSE  *#ARG
TSERRABN RES      0
         M:SETDCB *#ARG,(ERR,COCLINEERR),(ABN,COCLINEABN)
         #T#GWA,#ARG  #DEV#LINE#IDENTIFIER
         M:RLSLINE  *#ARG
         #T#GET,#ARG  #DEV#LINE#STATUS#BITS
         OR,#ARG  =#LINE#UNACQUIRED
         #T#PUT,#ARG  #DEV#LINE#STATUS#BITS
         B        COMMANDLEVELSURVEY
         TITLE     'TIC - DEV-TASK - COMMAND PROCESSORS - LOGON'
*                                                                       TIC58390
*        HERE TO LOG THE STATION OFF.                                   TIC58400
*                                                                       TIC58410
*        BAL'ED TO ON R15.                                              TIC58420
*                                                                       TIC58430
LOGOFF   RES       0                                                    TIC58440
         #T#GET,#ARG #DEV#LOGON#BLOCK  SEE IF LOGGED ON.                TIC58450
         BEZ       *15                 DONE IF NOT.                     TIC58460
*                                                                       TIC58470
         #T#GET,#ARG #DEV#AT#NAME#LAL  GET NAME POINTER, IF ANY.        TIC58480
         BEZ       LOGOFF2150          OVER IF NONE.                    TIC58490
         OR,#ARG   =X'80000000'        MAKE INTO A DSP.                 TIC58500
         #FREE#MAIN#BYTES              FREE NAME SPACE.                 TIC58510
LOGOFF2150 RES     0                                                    TIC58520
*                                                                       TIC58530
         #T#GET,#ARG #DEV#CRUNCH#NAME#LALS GET BA OF #-TYPE SPACE.      TIC58540
         BEZ       LOGOFF2160          OVER IF NONE.                    TIC58550
         OR,#ARG   =X'80000000'        MAKE BA A DSP.                   TIC58560
         #FREE#MAIN#BYTES              AND FREE THE SPACE.              TIC58570
LOGOFF2160 RES     0                                                    TIC58580
*                                                                       TIC58590
         LI,#ARG   0                   LOAD A ZERO AND                  TIC58600
LOGOFF2222 #T#XCA,#ARG #DEV#LOGON#BLOCK WA OF (/CD) LOGON BLOCK & CLEAR.TIC58610
         SLS,#ARG  2                   INTO A BA.                       TIC58620
         OR,#ARG   =X'80000000'        MAKE A DSP.                      TIC58630
         #FREE#MAIN#BYTES              AND FREE IT.                     TIC58640
         B         *15                 AND RETURN.                      TIC58650
         PAGE                                                           TIC58660
*                                                                       TIC58670
*        LOGON PROCESSOR.                                               TIC58680
*                                                                       TIC58690
         #DSS                                                           TIC58700
LOGSTAIRECORDDSP   #DSSWORD                                             TIC58710
LOGSCANPOINTER     #DSSWORD                                             TIC58720
LOGSTAIRECORDEND   #DSSWORD                                             TIC58730
LOGATSIGNCOUNT     #DSSWORD                                             TIC58740
LOGATNAMEBA        #DSSWORD                                             TIC58750
LOGDOLLARCOUNT     #DSSWORD                                             TIC58760
LOGQUESTIONCOUNT   #DSSWORD                                             TIC58770
LOGTRIES           #DSSWORD                                             TIC58780
LOGCRITERIACOUNT   #DSSWORD                                             TIC58790
LOGCRITERIABYTES   #DSSWORD                                             TIC58800
LOGDELIVERIESCHAINHEAD #DSSWORD                                         TIC58810
LOGCOMMANDLINER6   #DSSWORD
LOGCOMMANDLINER7   #DSSWORD
         #DSS                                                           TIC58820
LOGON    RES       0                   HERE ON 'LOGON'                  TIC58830
         #ENTRY#SPACE#CLEAR
*
*        REMEMBER COMMAND LINE SCAN REGISTERS
*
         FIELD6789LOADAAAAAAAA,LOGONBADCOMMAND SKIP !LOGON FIELD.
*
         STW,6     LOGCOMMANDLINER6
         STW,7     LOGCOMMANDLINER7
*                                                                       TIC58850
         BAL,15    LOGOFF              FIRST LOG HIM OFF. (NOP IF OFF)  TIC58860
*                                                                       TIC58870
LOGON2010 RES      0                                                    TIC58880
         BAL,14    LOGONGETSTAIBUFFER
*
*        R6 HAS BA OF FIRST BYTE OF TEXT.                               TIC59260
*        R7 HAS BA OF LAST BYTE OF TEXT.                                TIC59270
*                                                                       TIC59280
         LI,11     2                   ALLOW ONLY TWO                   TIC59370
         STW,11    LOGTRIES             TRIES PER LOGON.                TIC59380
*                                                                       TIC59390
LOGON2108 RES      0                                                    TIC59400
         LB,9      0,6                 GET BYTE OF TEXT.                TIC59410
         CI,9      ' '                 IS IT A BLANK?                   TIC59420
         BNE       LOGON2138           OVER IF NOT.                     TIC59430
*                                                                       TIC59440
         AI,6      1                   BUMP TO BYTE AFTER BLANK.        TIC59450
         LB,9      0,6                 GET BYTE AFTER BLANK.            TIC59460
         CI,9      '@'                 IS IT AN AT-SIGN?                TIC59470
         BNE       LOGON2139           OVER IF NOT.
*
         STW,6    LOGATNAMEBA       REMEMBER IN CASE OF ONLY ONE.
         MTW,1     LOGATSIGNCOUNT      COUNT IF SO.                     TIC59490
*                                                                       TIC59500
LOGON2138 AI,6     1                   BUMP                             TIC59510
LOGON2139 CW,6     7                    AND
         BL        LOGON2108             LOOP.                          TIC59530
*                                                                       TIC59540
         LW,11     LOGATSIGNCOUNT      GET AT-NAME COUNT.               TIC59550
         CI,11     1                   SEE HOW MANY @-NAMES.            TIC59560
         BE        LOGON2200           OVER IF ONE.
         BL        LOGONBADNPS         ERROR IF NONE.
*                                                                       TIC59580
*        FALL THROUGH ON MORE THAN ONE @-NPS.                           TIC59590
*        SO WE MUST ASK CLERK FOR NAME.                                 TIC59600
LOGON2145 RES      0                                                    TIC59610
*
*        FIRST SEE IF NAME IN COMMAND LINE.
*
         LW,6      LOGCOMMANDLINER6
         LW,7      LOGCOMMANDLINER7
         FIELD6789POINTTOSTRING,LOGON2155
*
*        FALL THROUGH WITH NAME FROM COMMAND LINE
*
         STW,6     LOGCOMMANDLINER6
*
         B         LOGON2163           GO SET UP COMPARISON.
*
LOGON2155 RES      0
*
         DO        DO#STAIPROMPTS      IF INDICATED,
*                                      SCAN FOR PROMPT INFO:
         LW,6      LOGSTAIRECORDDSP
         AND,6     =X'7FFFF'
         AI,6      4                   (OVER LENGTH TO TEXT)
         LW,7      LOGSTAIRECORDEND
LOGON2156 FIELD6789POINTTOSTRING,LOGON2158
         LW,#ARG   8
         LB,10     0,#ARG              BET FIRST FIELD BYTE.
         CI,10     'P'                 IS IT A 'P'.
         BNE       LOGON2156           IF NOT, NOT RIGHT FIELD.
         AI,#ARG   1
         LB,10     0,#ARG              GET SECOND BYTE OF FIELD.
         CI,10     '1'                 IS IT A ONE.
         BNE       LOGON2156           IF NOT, NOT PROMPT FIELD.
*
*        HERE HAVE 'P1' STRING TO PROMPT WITH.
*
         AI,8      3                   OVER 'P' AND '1' AND QUOTE.
         AI,9      -4                  MINUS 'P' AND '1' AND QUOTES.
*
*        IF WE ARE NOT KEEPING THE STAI RECORD IN MEMORY
*        WHILE THE CLERK ANSWERS THE QUESTION, THEN WE
*        MUST COPY THE P1 STRING TO SOME OTHER DYNAMIC SPACE.
*
         DO        DO#HOLDSTAIDURINGLOGON
         ELSE
         LW,#ARG   9                   COPY BYTE COUNT.
         #GET#MAIN#BYTES                AND GET SPACE.
         LW,10     #ARG                (REMEMBER DSP)
         LW,6      8                   SOURCE.
         LW,7      10                  DESTINATION.
         LW,8      9                   COUNT.
         MBS678                        MOVE THE BYTES.
         LW,8      10                  DSP TO R8 FOR BELOW.
         FIN
*
         B         LOGON2159           AND GO PROMPT.
         FIN
*
LOGON2158 RES      0
*
         #EXU#TABLE#ON#TYPE#INDEX LOGONPROMPTTEXTCBATOR8
         LW,#ARG   8                   TURN BA OF TEXTC
         LB,9      0,#ARG               INTO COUNT.
         AI,8      1                     AND BA(TEXT).
*
LOGON2159 RES      0
         #T#PUT,8  #DEV#RECORD#BA
         #T#PUT,9  #DEV#RECORD#LENGTH
*
         DO        DO#HOLDSTAIDURINGLOGON
         ELSE
         BAL,14    LOGONFREESTAIBUFFER
         FIN
*
         #INITIATE#WRITE#READ                                           TIC59660
         #CHECK#WRITE#READ LOGONIOERROR                                 TIC59670
*                                                                       TIC59680
         DO        DO#HOLDSTAIDURINGLOGON
         ELSE
         BAL,14    LOGONGETSTAIBUFFER
         FIN
*
         #T#GET,6  #DEV#RECORD#BA      SETUP AND SCAN
         AND,6     =X'7FFFF'            FOR FIRST FIELD
         #T#GET,7  #DEV#RECORD#LENGTH    OF CLERK'S REPLY.
         AW,7      6
*
         #EXU#TABLE#ON#TYPE#INDEX BUMPR6OVERMESSAGEPREFIX
*
         LB,#ARG   0,6                 SEE IF CLERK SUPPLIED
         CI,#ARG   '@'                  THE INITIAL @ OF NAME.
         BNE       %+2                 IF SO, SKIP THE
         AI,6      1                    SCAN OVER THE @.
*
         FIELD6789POINTTOSTRING,LOGONDIDNOTMATCH
*
LOGON2163 RES      0
         LW,13     8                   SET UP FOR
         STB,9     13                   COMPARE.
*
LOGON2170 RES      0
*                                                                       TIC59700
         LW,6      LOGSTAIRECORDDSP    RE-CREATE (UN-NEAT) BA OF        TIC59710
         AI,6      4                   BEGINNING OF STAI TEXT.          TIC59720
         AND,6     =X'7FFFF'           AND MAKE IT NEAT.                TIC59730
*                                                                       TIC59740
         LW,11     LOGATSIGNCOUNT      RE-LOAD @-TYPE NPS COUNT.        TIC59750
*                                                                       TIC59760
LOGON2165 RES      0                                                    TIC59770
         LB,9      0,6                 SCAN                             TIC59780
         CI,9      ' '                  FOR                             TIC59790
         BE        %+3                   @-TYPE                         TIC59800
         AI,6      1                      NPS.                          TIC59810
         B         LOGON2165                                            TIC59820
         AI,6      1                                                    TIC59830
         LB,9      0,6                                                  TIC59840
         CI,9      '@'                                                  TIC59850
         BNE       LOGON2165                                            TIC59860
*                                                                       TIC59870
*        FALL THROUGH WITH R6 POINTING TO AN @-TYPE NPS.                TIC59880
*                                                                       TIC59890
*        BUILD CBS DW AND COMPARE.                                      TIC59900
*                                                                       TIC59910
         LW,9      13                  LOAD LAL OF CLERK'S NAME CLAIM.
         LW,8      6                   COMPARE AGAINST @-TYPE NPS.      TIC59960
         AI,8      1                   BUT NOT AGAINST THE @.           TIC59970
*                                                                       TIC59980
         CBS,8     0                   COMPARE.                         TIC59990
         BNE       LOGON2181           OVER ON NO MATCH.                TIC60000
*                                                                       TIC60010
*        FALL THROUGH ON MATCH.                                         TIC60020
*                                                                       TIC60030
*        WHEN HERE, CLERK'S REPLY MATCHES START OF THE NPS.             TIC60040
*        TO BE A TRUE MATCH, THE 'NEXT' CHARACTER AFTER THE             TIC60050
*        MATCHED PART OF THE NPS MUST BE A BLANK (NORMAL)               TIC60060
*        OR AN @ (NPS WITH PASSWORD).                                   TIC60070
*
         STW,6     LOGATNAMEBA         REMEMBER PLACE IN CASE THIS
*                                       TURNS OUT TO BE THE RIGHT NAME.
*
         LW,7      8                   PLACE TO INDEX.
         LB,10     0,7                 GET 'NEXT' RECORD TEXT BYTE.
         CI,10     ' '                 IS IT A BLANK?                   TIC60100
         BE        LOGON2210           OUT WITH R6 POINTING TO NAME IF STIC60110
         CI,10     '@'                 IS IT AN @?                      TIC60120
         BNE       LOGON2181           IF NOT, WASN'T MATCH, CONTINUE.  TIC60130
*                                                                       TIC60140
*        SEE IF NULL PASSWORD (IMPLIES T:LOGON CALL)                    TIC60150
*                                                                       TIC60160
         AI,7      1                   BUMP TO CHAR AFTER SECOND AT.
         LB,10     0,7                 GET THAT CHARACTER.
         CI,10     ' '                 IS IT A BLANK.                   TIC60190
         BNE       LOGON2172           NO:  GO CHECK PASSWORD.          TIC60200
*                                                                       TIC60210
*        FALL THROUGH TO CALL T:LOGON.                                  TIC60220
*                                                                       TIC60230
         LW,10     LOGSTAIRECORDDSP    SET UP REGISTERS                 TIC60240
         LW,11     LOGSTAIRECORDEND     8-11 LIKE WE PROMISE.           TIC60250
         AND,10    =X'7FFFF'                                            TIC60260
         AND,11    =X'7FFFF'                                            TIC60270
         AI,10     4                   (OVER FIRST WORD OF CONTROLS)    TIC60280
         SW,11     10                  (END-START IS COUNT)             TIC60290
         #T#GET,8  #DEV#RECORD#BA                                       TIC60300
         AND,8     =X'7FFFF'                                            TIC60310
         #T#GET,9  #DEV#RECORD#LENGTH                                   TIC60320
*                                                                       TIC60330
         BAL,15    T:LOGON                                              TIC60340
*                                                                       TIC60350
         BCR,12    LOGON2210           OK IF HE SAYS ITS OK.            TIC60360
         B         LOGONDIDNOTMATCH    OTHERWISE TREAT AS ERROREOUS.    TIC60370
*                                                                       TIC60380
LOGON2172 RES      0                                                    TIC60390
*                                                                       TIC60400
         #FREE#DEV#BUFFER              FREE NAME BUFFER.                TIC60410
*
         #EXU#TABLE#ON#TYPE#INDEX LOGONPSWPROMPTTEXTCBATOR8
         LW,#ARG   8
         LB,9      0,#ARG
         AI,8      1
*
         #T#PUT,8  #DEV#RECORD#BA
         #T#PUT,9  #DEV#RECORD#LENGTH
*
         #INITIATE#WRITE#READ              PASSWORD                     TIC60460
         #CHECK#WRITE#READ LOGONIOERROR                                 TIC60470
*                                                                       TIC60480
*        HAVE JUST READ CLERK'S PASSWORD.                               TIC60490
*                                                                       TIC60500
*        WHEN HERE, R7 HAS THE BA OF THE FIRST CHARACTER OF
*        THE PASSWORD IN THE F:STAX RECORD (COPIED FROM R8 AND
*        THEN BUMPED ONCE BACK BEFORE THE T:LOGON CALL).
*                                                                       TIC60520
         #T#GET,6  #DEV#RECORD#BA      BA OF PASSWORD REPLY.
         #EXU#TABLE#ON#TYPE#INDEX BUMPR6OVERMESSAGEPREFIX
         DO        DO#3270             IF 3270S IN TIC,
         LB,#ARG   0,6                  SKIP ANY FIELD
         CI,#ARG   X'11'                 DEFINERS.
         BNE       %+2
         AI,6      3
         FIN
LOGON2176 RES      0                                                    TIC60550
         LB,10     0,7                 GET STAI CHARACTER.
         CI,10     ' '                 IF BLANK, WE'RE AT END           TIC60580
         BE        LOGON2210            AND SO CLERK MATCHED.           TIC60590
         CB,10     0,6                    COMPARE PASSWORD CHARACTERS.
         BNE       LOGONDIDNOTMATCH    OVER IF BAD.                     TIC60610
         AI,6      1                   LOOP IF
         AI,7      1                    GOOD.
         B         LOGON2176
*
LOGON2181 RES      0                                                    TIC60640
         BDR,11    LOGON2165           LOOP ON @ COUNT.                 TIC60650
*                                                                       TIC60660
*        FALL THROUGH WHEN CLERK'S ENTERED NAME                         TIC60670
*        DOESN'T MATCH ANY NPS.                                         TIC60680
*                                                                       TIC60690
LOGONDIDNOTMATCH RES 0                                                  TIC60700
         #FREE#DEV#BUFFER                                               TIC60710
*                                                                       TIC60720
         MTW,-1    LOGTRIES            DECREMENT TRY-COUNT.             TIC60730
         BGZ       LOGON2145           EITHER GIVE HIM ANOTHER TRY.     TIC60740
*                                      OR FALL THROUAH AND GIVE UP.     TIC60750
         BAL,14    LOGONFREESTAIBUFFER
*
         BAL,13    ERRORBUFFERCREATE
         LI,12     BA(UNABLEMESSAGE)
         BAL,14    ERRORBUFFERTEXTC
*E*  MESSAGE:     'UNABLE TO LOG YOU ON'
*E*  DESCRIPTION: THE USER GAVE TWO INCORRECT REPLIES TO LOGON QUESTIONS.
         BAL,13    ERRORBUFFERFLUSH
*
         LI,#ARG   0                   COPY AND CLEAR
         #T#XCA,#ARG #DEV#COMMAND#LINE#RECORD#BA CMD BUFFER PTR
         #FREE#MAIN#BYTES#IF           AND FREE IF WAS ONE.
LOGONWASUNABLE RES 0
         #EXIT#SPACE
         #T#GET,#ARG #DEV#LINE#STATUS#BITS IF HE IS SWITCHABLE,
         CI,#ARG   #LINE#SWITCHABLE     THEN LET HIM TRY TS:
         BANZ      TS
         B         COMMANDLEVELWAITFORATTENTION                         TIC60820
*                                                                       TIC60830
UNABLEMESSAGE TEXTC 'UNABLE TO LOG YOU ON'
*
*
*
LOGONBADCOMMAND RES 0
         #EXIT#SPACE
         B         COMMANDBAD
*                                                                       TIC60850
*                                                                       TIC60860
*                                                                       TIC60870
LOGON2200 RES      0                   HERE ON EXACTLY ONE @-TYPE NPS.
*                                                                       TIC60890
*        MUST POINT R6 TO THE (ONLY) @-NPS.
*
*        IF JUST ONE @-NPS, ITS BA IS IN R12,
*        LEFT THERE FROM THE CODE JUST BEFORE
*        LOCATION 'LOGON2138'.
*
         LW,6      12
*                                                                       TIC60900
*                                                                       TIC60910
*                                                                       TIC60920
*                                                                       TIC60930
*                                                                       TIC60940
LOGON2210 RES      0                   HERE ON CLERK SUPPLIED GOOD NAME.TIC60950
         #FREE#DEV#BUFFER              FREE NAME OR PASSWORD BUFFER.    TIC60960
*
         LI,#ARG   0                   FREE ANY DYNAMIC
         #T#XCA,#ARG #DEV#COMMAND#LINE#RECORD#BA COMMAND LINE
         #FREE#MAIN#BYTES#IF           THAT MAY EXIST NOW (THIS
*                                      IS DONE HERE TO ALLOW FOR
*                                      Y'STRING' IN THE LOGON).
*                                                                       TIC60970
         LW,6      LOGATNAMEBA         RETRIEVE BA OF MATCHED NAME.
*
*7049              #C01D  RMA  17 DEC 74
*
*        WE MUST SCAN FROM HERE TO THE NEXT @ OR TO THE                 TIC61010
*        END, ACCUMULATING % AND ? FIELDS.                              TIC61020
*                                                                       TIC61030
*        FIRST WE JUST SCAN AND COUNT EM.                               TIC61040
*                                                                       TIC61050
         LW,7      LOGSTAIRECORDEND    RETRIEVE BA OF END-OF-RECORD.
         FIELD6789POINTTOSTRING        SKIP NAME FIELD.                 TIC61090
*                                                                       TIC61100
LOGON2233 RES      0                                                    TIC61110
         FIELD6789POINTTOSTRING,LOGON2275                               TIC61120
         LW,#ARG   8                   GET FIRST                        TIC61130
         LB,#ARG   0,#ARG               BYTE OF FIELD.                  TIC61140
         CI,#ARG   '@'                 SEE IF @.                        TIC61150
         BE        LOGON2275            OVER IF @.                      TIC61160
*                                                                       TIC61170
         CI,#ARG   '%'                 SEE IF %.                        TIC61180
         BNE       %+3                  OVER IF NOT.                    TIC61190
         MTW,1     LOGDOLLARCOUNT      COUNT DOLLAR SIGN FIELD.         TIC61200
         B         LOGON2233           AND LOOP.                        TIC61210
*                                                                       TIC61220
         CI,#ARG   '?'                 SEE IF ?.                        TIC61230
         BNE       %+3                  OVER IF NOT.                    TIC61240
         MTW,1     LOGQUESTIONCOUNT    COUNT QUESTION MARK FIELD.       TIC61250
         B         LOGON2233           AND LOOP.                        TIC61260
*                                                                       TIC61270
*        HERE ON NON-@ NON-% NON-?.                                     TIC61280
*                                                                       TIC61290
         B         LOGON2233           JUST IGNORE IT.                  TIC61300
*                                                                       TIC61310
*                                                                       TIC61320
*                                                                       TIC61330
LOGON2275 RES      0                   HERE AFTER COUNTING % AND QUESTIOTIC61340
*                                                                       TIC61350
*        NOW WE MUST SCAN FOR #-TYPE AND Y-TYPE NPS'S.                  TIC61360
*                                                                       TIC61370
*        THIS IS A GLOBAL SCAN - THAT IS THROUGHOUT THE                 TIC61380
*        STATION NAMES RECORD RATHER THAN JUST THE PORTION              TIC61390
*        FOLLOWING THE CLERK'S NAME.                                    TIC61400
*                                                                       TIC61410
         LW,6      LOGSTAIRECORDDSP    BACK ONCE                        TIC61420
         AI,6      4                    AGAIN TO START OF               TIC61430
         AND,6     =X'7FFFF'             RECORD'S FIELDS.               TIC61440
         LW,7      LOGSTAIRECORDEND
*
LOGON2280 RES      0                                                    TIC61450
         FIELD6789POINTTOSTRING,LOGON2295 GET A FIELD.                  TIC61460
         LW,#ARG   8                   GET FIELD'S                      TIC61470
         LB,#ARG   0,#ARG               FIRST CHARACTER.                TIC61480
*                                                                       TIC61490
         CI,#ARG   '#'                 IS IT A CRUNCH.                  TIC61500
         BNE       LOGON4350           OVER IF NOT.                     TIC61510
*                                                                       TIC61520
*        HERE ON HAVE FOUND A #-TYPE NPS.                               TIC61530
*                                                                       TIC61540
*        THE NPS IS C(R9) CHARACTERS BEGINNING AT C(R8).                TIC61550
*                                                                       TIC61560
         STW,6     LOGSCANPOINTER      REMEMBER WHERE WE ARE IN STAI RECTIC61570
*                                                                       TIC61580
         CI,9      9                   SEE IF LOCATION STATION NAME     TIC61590
         BGE       LOGONBADNPS          IS TOO BIG - OUT IF SO.         TIC61600
*                                                                       TIC61610
         LW,6      8                   SET UP TO MOVE                   TIC61620
         LI,7      9*4                  THE #-TYPE STRING               TIC61630
         STB,9     7                     TO REGISTERS.                  TIC61640
         LW,9      ='    '             FIRST CLEAR TO
         LW,10     ='    '              BLANKS, THEN
         MBS,6     0                   MOVE TO R9 ETC.                  TIC61650
*                                                                       TIC61660
         LI,5      #INFOBLOCK#DELI     POINT TO (INTERNAL) DELIVERIES FITIC61670
         BAL,15    OBTAININTERNALFILERECORD AND GET A RECORD OF CRITERIATIC61680
         BNEZ      LOGON2292           OVER ON GOT RECORD.              TIC61690
*                                                                       TIC61700
*        FALL THROUGH ON NO DELIVERIES FILE RECORD                      TIC61710
*        MATCHING A LOCATION STATION NAME.                              TIC61720
*                                                                       TIC61730
*E*  MESSAGE:     'NO DELIVERIES RECORD'
*E*  DESCRIPTION: DURING PROCESSING OF !LOGON COMMAND, NO DELIVERIES
*E*               FILE RECORD WAS FOUND TO MATCH A LOCATION STATION
*E*               NAME.
*E*  REGISTERS:   0-15
         #SNAP,12  'NO DELIVERIES RECORD'                               TIC61740
         #EXIT                                                          TIC61750
*                                                                       TIC61760
LOGON2292 RES      0                   HERE WITH DSP OF DELI            TIC61770
*                                       RECORD IN R8.                   TIC61780
         LI,5      X'7FFFF'            WA OF                            TIC61790
         AND,5     8                    RECORD                          TIC61800
         SLS,5     -2                    INTO R5.                       TIC61810
*                                                                       TIC61820
         LW,10     LOGDELIVERIESCHAINHEAD PUT RECORD INTO CHAIN.        TIC61830
         STW,5     LOGDELIVERIESCHAINHEAD (NOTE THAT SINCE 'KEY' IS     TIC61840
         STW,10    1,5                     WORDS ONE & TWO, WE CAN USE) TIC61850
*                                                                       TIC61860
         LH,7      *5                  WORD COUNT OF RECORD.            TIC61870
         SLS,7     2                   BYTES IN RECORD.                 TIC61880
*                                                                       TIC61890
         LI,6      X'7FFFF'            INTO R6, BARE                    TIC61900
         AND,6     8                    BA OF RECORD.                   TIC61910
*                                                                       TIC61920
         AW,7      6                   NOW R7 HAS LAST-BYTE-PLUS-ONE BA.TIC61930
*                                                                       TIC61940
         AI,6      12                  SKIP R6 OVER CONTROL & KEY WORDS.TIC61950
*                                                                       TIC61960
*        NOW THAT WE ARE SET UP, WE COUNT THE CRITERIA IN THE RECORD.   TIC61970
*                                                                       TIC61980
LOGON2308 RES      0                                                    TIC61990
         FIELD6789POINTTOSTRING,LOGON2312                               TIC62000
         MTW,1     LOGCRITERIACOUNT    IF GOT STRING, BUMP CRITERIA COUNTIC62010
         AWM,9     LOGCRITERIABYTES    ADD IN CRITERION'S BYTES.        TIC62020
         MTW,3     LOGCRITERIABYTES    PLUS 3 FOR #, ., AND X'00'.      TIC62030
         B         LOGON2308           AND KEEP GOING.                  TIC62040
*                                                                       TIC62050
LOGON2312 RES      0                                                    TIC62060
*                                                                       TIC62070
LOGON2352 RES      0                                                    TIC62080
*                                                                       TIC62090
*        HERE WHEN DELI RECORD IN MEMORY IS ON                          TIC62100
*        THE CHAIN AND WHEN ITS CRITERIA HAVE                           TIC62110
*        BEEN COUNTED AND WHEN THE (BYTES+3) IN                         TIC62120
*        ITS CRITERIA HAVE BEEN COUNTED.                                TIC62130
*                                                                       TIC62140
*                                                                       TIC62150
*                                                                       TIC62160
*        SO RESTORE R6 & R7 (SCAN POINTERS) AND CONTINUE                TIC62170
*                                                                       TIC62180
         LW,6      LOGSCANPOINTER                                       TIC62190
         LW,7      LOGSTAIRECORDEND                                     TIC62200
         B         LOGON2280                                            TIC62210
*                                                                       TIC62220
LOGON4350 RES      0                                                    TIC62230
         CI,#ARG   'Y'                 TEST AGAINST ONLY OTHER LEGAL NPSTIC62240
         BNE       LOGON4700           OVER IF NOT.                     TIC62250
*                                                                       TIC62260
*        MOVE Y-TYPE NPS TO ITS OWN STORAGE                             TIC62270
*        AND POINT TABLE TO IT.                                         TIC62280
*                                                                       TIC62290
*        R8 CONTAINS THE BA OF THE Y.                                   TIC62300
*        R9 CONTAINS THE STRING LENGTH, INCLUDING THE Y AND TWO QUOTES. TIC62310
*                                                                       TIC62320
         LW,#ARG   9                   GET SPACE                        TIC62330
         AI,#ARG   -3                   FOR THE                         TIC62340
         #GET#MAIN#BYTES                 STRING.                        TIC62350
*                                                                       TIC62360
         #T#XCA,#ARG #DEV#COMMAND#LINE#RECORD#BA SWAP NEW WITH (ANY) OLDTIC62370
         BEZ       LOGON2366           OVER IF NO OLD.                  TIC62380
         #FREE#MAIN#BYTES              FREE THE OLD.                    TIC62390
LOGON2366 RES      0                                                    TIC62400
*                                                                       TIC62410
         AI,8      2                   POINT R8 TO CHAR AFTER QUOTE.    TIC62420
         LW,5      8                   POINT R5 TO CHAR AFTER QUOTES.   TIC62430
*                                                                       TIC62440
         #T#GET,#ARG #DEV#COMMAND#LINE#RECORD#BA RE-LOAD BA OF SPACE.   TIC62450
*                                                                       TIC62460
LOGON2370 LB,10    0,5                 GET STRING CHARACTER.            TIC62470
         CI,10     ''''                SEE IF TERMINAL QUOTE.           TIC62480
         BE        LOGON2377           OVER IF TERMINAL QUOTE.          TIC62490
         STB,10    0,#ARG              GOOD CHARACTER --> STORAGE.      TIC62500
         AI,#ARG   1                   BUMP                             TIC62510
         AI,5      1                    POINTERS.                       TIC62520
         BDR,9     LOGON2370           AND LOOP.                        TIC62530
         B         LOGONBADNPS         ERROR IF NO CLOSING QUOTE.       TIC62540
LOGON2377 RES      0                                                    TIC62550
         SW,5      8                   LAST+1 MINUS FIRST IS COUNT.     TIC62560
         #T#PUT,5  #DEV#COMMAND#LINE#RECORD#LENGTH TABLE IT.            TIC62570
*                                                                       TIC62580
         B         LOGON2280           CONTINUE WHOLE-RECORD SCAN.      TIC62590
*                                                                       TIC62600
*                                                                       TIC62610
*                                                                       TIC62620
LOGON2288 RES      0                                                    TIC62630
LOGON4700 RES      0                                                    TIC62640
*                                                                       TIC62650
*                                                                       TIC62660
*                                                                       TIC62670
         B         LOGON2280           CONTINUE WHOLE-RECORD SCAN.      TIC62680
*                                                                       TIC62690
*                                                                       TIC62700
*                                                                       TIC62710
LOGONBADNPS RES    0                   HERE ON ILLEGAL NPS.             TIC62720
*                                                                       TIC62730
         #SNAP,15  'ILLEGAL NPS ENCOUNTERED BY LOGON'                   TIC62740
         #ABORT                                                         TIC62750
*                                                                       TIC62760
LOGON2295 RES      0                   HERE AFTER Y AND # SCAN.         TIC62770
*                                                                       TIC62780
*        BUILD A LAL(LOCATION AND LENGTH) POINTER TO THE CLERK'S NAME:
*
         LW,6      LOGATNAMEBA         RE-LOAD R6 TO POINT TO NAME.
         LW,7      LOGSTAIRECORDEND    RE-LOAD R7 TO POINT TO E-O-R.
*
         FIELD6789POINTTOSTRING        RE-ACQUIRE NAME STRING.
*
*        SCAN TO FIND TRUE NAME LENGTH (THE LENGTH
*        IN R9 MAY INCLUDE A PASSWORD):
*
         LW,5      8                   SCAN
         AI,5      1                    FOR
         LB,10     0,5                   TRUE
         CI,10     ' '                    END
         BE        %+4                     OF
         CI,10     '@'                      @NAME
         BE        %+2                       FIELD.
         BDR,9     %-6
*
         SW,5      8                   CALCULATE NAME LENGTH IN R5.
         LW,#ARG   5                   BYTES FOR @NAME.
         AI,#ARG   1+1                 (+1 FOR PERIOD  +1 FOR SQM ZERO)
         #GET#MAIN#BYTES                GET 'EM.
         LW,9      #ARG                BA OF @NAME SPACE.
         AI,5      1                   (+1 FOR PERIOD)
         STB,5     9                   OR IN THE COUNT.
*
         LW,10     9                   REMEMBER THE @NAME LAL.
*
*                                      R8 STILL POINTS TO @NAME.
         SW,9      =X'01000000'        (PERIOD OSN'T THERE TO MOVE)
         MBS,8     0                   MOVE STAI @NAME TO NEW SPACE.
*
         LW,#ARG   9                   BA OF BYTE JUST AFTER NAME.
         LI,9      '.'                 PUT A PERIOD THERE
         STB,9     0,#ARG               TO MAKE IT A CRITERION.
         AI,#ARG   1                   BUMP TO NEXT BYTE.
         LI,9      0                   PUT A ZERO THERE FOR HOW
         STB,9     0,#ARG               SQM CALLS WORK.
*
*        AND FALL THROUGH WITH @NAME LAL STILL IN R10.
*                                                                       TIC62800
         LW,#ARG   LOGCRITERIACOUNT    ONE WORD PER CRITERION           TIC62810
         BGZ       %+2                 (BUT AT LEAST                    TIC62820
         LI,#ARG   1                    ONE WORD)                       TIC62830
         AI,#ARG   7                   PLUS SEVEN WORDS.                TIC62840
         SLS,#ARG  2                   INTO BYTES.                      TIC62850
         #GET#MAIN#BYTES                GET EM.                         TIC62860
         LI,11     X'7FFFF'            COPY LOGON BLOCK BA.
         AND,11    #ARG                NEAT BA.
         SLS,11    -2                  WA AND LEAVE IT IN R11 FOR NOW.
*
*        AT THIS POINT, WE HAVE A LOGON BLOCK AND WE HAVE
*        THE CLERK'S @NAME LAL.  THIS IS THE POINT WHERE WE
*        CAN CHECK TO MAKE SURE THAT NO OTHER CLERK IS LOGGED
*        ON WITH THE SAME NAME.  WE CAN MAKE THIS CHECK BEFORE
*        WE ACTUALLY TABLE THE INFO BECAUSE NO SYSTEM SERVICES
*        WHICH COULD CAUSE A (TIC)TASK-SWITCH ARE INVOKED BETWEEN
*        HERE AND THE TABLING -- THAT'S WHY WE HAVE ALREADY DONE
*        THE NECESSARY GETMAIN'S, FOR INSTANCE.
*
         #T#PUT,11 #DEV#LOGON#BLOCK    AFTER ANY CHECKING,
         #T#PUT,10 #DEV#AT#NAME#LAL     TABLE THE INFO.
*                                                                       TIC62910
         LW,8      LOGCRITERIACOUNT    # CRITERIA PLUS                  TIC62920
         AI,8      1                    @ CRITERION IS                  TIC62930
         #T#PUT,8  #DEV#GET#LIST#LENGTH  HOW MANY.                      TIC62940
*                                                                       TIC62950
*        GET SPACE FOR DOLLAR-TYPE NPS'S.                               TIC62960
*                                                                       TIC62970
         LW,#ARG   LOGDOLLARCOUNT      THREE                            TIC62980
         AW,#ARG   LOGDOLLARCOUNT       WORDS                           TIC62990
         AW,#ARG   LOGDOLLARCOUNT        PER NPS.                       TIC63000
         SLS,#ARG  2                   INTO BYTES.                      TIC63010
         #GET#MAIN#BYTES                GET SPACE.                      TIC63020
         AND,#ARG  =X'7FFFF'           NEAT BA.                         TIC63030
         SLS,#ARG  -2                  WA.                              TIC63040
         LW,12     LOGDOLLARCOUNT      RETRIEVE COUNT SO:               TIC63050
         STB,12    #ARG                PLUS # IN H.O. BYTE.             TIC63060
         #T#PUT,#ARG #DEV#DOLLARS#LAL  INTO LOGON BLOCK                 TIC63070
*                                                                       TIC63080
*        GET SPACE FOR QUESTION-TYPE NPS'S.                             TIC63090
*                                                                       TIC63100
         LW,#ARG   LOGQUESTIONCOUNT    THREE                            TIC63110
         AW,#ARG   LOGQUESTIONCOUNT     WORDS                           TIC63120
         AW,#ARG   LOGQUESTIONCOUNT      PER NPS.                       TIC63130
         SLS,#ARG  2                   INTO BYTES.                      TIC63140
         #GET#MAIN#BYTES                GET SPACE.                      TIC63150
         AND,#ARG  =X'7FFFF'           NEAT BA.                         TIC63160
         SLS,#ARG  -2                  WA.                              TIC63170
         LW,12     LOGQUESTIONCOUNT    RETRIEVE COUNT AND               TIC63180
         STB,12    #ARG                PUT IT INTO LAL WORD.            TIC63190
         #T#PUT,#ARG #DEV#QUESTIONS#LAL INTO LOGON BLOCK.               TIC63200
*                                                                       TIC63210
*        (NOTE THAT SINCE #GET#MAIN#BYTES DOES AN                       TIC63220
*        IMMEDIATE RETURN ON A REQUEST FOR ZERO BYTES,                  TIC63230
*        WE DON'T NEED A SPECIAL TEST FOR ZERO NPS'S.)                  TIC63240
*                                                                       TIC63250
         LW,6      LOGATNAMEBA         RE-LOAD R6 TO POINT TO NAME.     TIC63260
         FIELD6789POINTTOSTRING        SKIP THE NAME FIELD.             TIC63270
*                                      (R7 STILL POINTS TO LAST TEXT CHATIC63280
         #T#GET,12 #DEV#DOLLARS#LAL    GET WA OF WHERE %-TYPE GO.       TIC63290
         AND,12    =X'1FFFF'           MAKE BARE BA.                    TIC63300
         #T#GET,13 #DEV#QUESTIONS#LAL  GET WA OF WHERE ?-TYPE GO.       TIC63310
         AND,13    =X'1FFFF'           MAKE BARE BA.                    TIC63320
*                                                                       TIC63330
LOGON2310 RES      0                                                    TIC63340
         FIELD6789POINTTOSTRING,LOGON2390                               TIC63350
         LW,#ARG   8                   GET FIRST                        TIC63360
         LB,#ARG   0,#ARG               BYTE OF FIELD                   TIC63370
         CI,#ARG   ' '                 IF BLANK,                        TIC63380
         BE        LOGON2390            DID EM ALL.                     TIC63390
         CI,#ARG   '@'                 IF AT-SIGN,                      TIC63400
         BE        LOGON2390            DID EM ALL.                     TIC63410
         CI,#ARG   '%'                 SEE IF %.                        TIC63420
         BNE       LOGON2345           OVER IF NOT.                     TIC63430
*                                                                       TIC63440
*        MOVE %-TYPE NPS TO LOGON BLOCK:                                TIC63450
*                                                                       TIC63460
*        BA OF NPS IN R8.                                               TIC63470
*        LENGTH OF NPS IN R9.                                           TIC63480
*        BARE AA OF TABLE IN R12.                                       TIC63490
*                                                                       TIC63500
*        BLANK OUT TABLE ENTRY:                                         TIC63510
*                                                                       TIC63520
         LW,#ARG   12                                                   TIC63530
         LW,10     ='    '                                              TIC63540
         STW,10    0,#ARG                                               TIC63550
         STW,10    1,#ARG                                               TIC63560
         STW,10    2,#ARG                                               TIC63570
*                                                                       TIC63580
         SLS,9     22                  MOVE COUNT MOST OF THE WAY OVER. TIC63590
         OR,9      12                  OR DESTINATION IN.               TIC63600
         SLS,9     2                   AA TO BA & ALIGN COUNT.          TIC63610
         MBS,8     0                   MOVE THE STRING.                 TIC63620
*                                                                       TIC63630
         AI,12     3                   BUMP TABLE POINTER.              TIC63640
         B         LOGON2310           AND GO GET NEXT FIELD.           TIC63650
*                                                                       TIC63660
LOGON2345 RES      0                                                    TIC63670
         CI,#ARG   '?'                 SEE IF ?.                        TIC63680
         BNE       LOGON2310           IGNORE FIELD IF NEITHER % NOR ?. TIC63690
*                                                                       TIC63700
*        FOLLOWING CODE PARALLELS THAT FOR %:                           TIC63710
*                                                                       TIC63720
         LW,#ARG   13                                                   TIC63730
         LW,10     ='    '                                              TIC63740
         STW,10    0,#ARG                                               TIC63750
         STW,10    1,#ARG                                               TIC63760
         STW,10    2,#ARG                                               TIC63770
*                                                                       TIC63780
         SLS,9     22                                                   TIC63790
         OR,9      13                                                   TIC63800
         SLS,9     2                                                    TIC63810
         MBS,8     0                                                    TIC63820
*                                                                       TIC63830
         AI,13     3                                                    TIC63840
         B         LOGON2310                                            TIC63850
*                                                                       TIC63860
*                                                                       TIC63870
*                                                                       TIC63880
LOGON2390 RES      0                   HERE AFTER TABLING % AND ? NPS'S.TIC63890
*                                                                       TIC63900
*                                                                       TIC63910
*                                                                       TIC63920
*        GET SPACE FOR THE (LUMP OF) #-TYPE CRITERIA:                   TIC63930
*                                                                       TIC63940
         LW,#ARG   LOGCRITERIABYTES                                     TIC63950
         #GET#MAIN#BYTES                                                TIC63960
*                                                                       TIC63970
         LI,13     X'7FFFF'            REMEMBER IN R13                  TIC63980
         AND,13 #ARG                    THE BA OF THIS PLACE.           TIC63990
*                                                                       TIC64000
         #T#GWA,14 #DEV#CRUNCH#NAME#LALS ALSO GET WHERE CRIT PTRS GO.   TIC64010
         LI,15     0                   (STORE A ZERO HERE IS CASE       TIC64020
         STW,15    *14                  WE FIND BELOW THERE ARENT ANY)  TIC64030
*                                                                       TIC64040
         LW,10     LOGDELIVERIESCHAINHEAD WA OF FIRST DELI RECORD.      TIC64050
         BEZ       LOGON2570           (DO NUTTIN IF NONE)              TIC64060
*                                                                       TIC64070
LOGON2520 RES      0                                                    TIC64080
*                                                                       TIC64090
*        R10 HAS THE WA OF A DELI RECORD.                               TIC64100
*                                                                       TIC64110
         LI,6      X'1FFFF'            HERE SETUP R6 AND R7             TIC64120
         AND,6     10                  FOR THE SCAN PROCS.              TIC64130
         SLS,6     2                   R6 NOW HAS BA OF RECORD START.   TIC64140
         LH,7      *10                 WORD COUNT OF RECORD.            TIC64150
         SLS,7     2                   BYTE COUNT OF RECORD.            TIC64160
         AW,7      6                   PLUS START BA IS END+1.          TIC64170
         AI,6      12                  STRINGS START THREE WORDS IN.    TIC64180
*                                                                       TIC64190
LOGON2530 RES      0                                                    TIC64200
         FIELD6789POINTTOSTRING,LOGON2550                               TIC64210
*                                                                       TIC64220
*        FALL THROUGH WITH R8 AND R9 POINTING (BA AND #BYTES)           TIC64230
*        A CRITERION IN DELI RECORD.                                    TIC64240
*                                                                       TIC64250
*        R14 HAS (WA) WHERE TOINTER TO STRING WILL GO.                  TIC64260
*                                                                       TIC64270
*        R13 HAS (BA) WHERE STRING WILL GO.                             TIC64280
*                                                                       TIC64290
         LW,15     13                  REMEMBER WHERE STRING WILL GO.   TIC64300
*                                                                       TIC64310
         LW,#ARG   13                  COPY BA TO INDEX REGISTER.       TIC64320
         LI,11     '#'                 A CRUNCH                         TIC64330
         STB,11    0,#ARG               TO START STRING.                TIC64340
         AI,13     1                                                    TIC64350
*                                                                       TIC64360
         STB,9     13                  COUNT OF DELI STRING.            TIC64370
         STW,8     12                  BA OF DELI STRING.               TIC64380
         MBS,12    0                   MOVE IT.                         TIC64390
*                                                                       TIC64400
         LW,#ARG   13                  AGAIN BA TO INDEX.               TIC64410
         LI,11     '.'                 PUT A                            TIC64420
         STB,11    0,#ARG               PERIOD AND                      TIC64430
         AI,#ARG   1                     A ZERO                         TIC64440
         LI,11     0                      AFTER THE                     TIC64450
         STB,11    0,#ARG                  STRING                       TIC64460
         AI,13     2                        FOR SQM.                    TIC64470
*                                                                       TIC64480
         AI,9      2                   BUMP COUNT FOR # AND .           TIC64490
         STB,9     15                  AND PUT IT INTO PTR TO STRING WORTIC64500
         STW,15    *14                 AND STORE THE PTR WORD INTO LOGONTIC64510
         AI,14     1                   AND BUNP.                        TIC64520
         B         LOGON2530           AND GO PROCESS NEXT.             TIC64530
*                                                                       TIC64540
LOGON2550 RES      0                   HERE WHEN A DELI RECORD EXAUSTED.TIC64550
         LW,#ARG   10                  COPY WA OF RECORD                TIC64560
*                                                                       TIC64570
         AI,10     1                   CHAIN FLINK IS ONE WORD INTO RECOTIC64580
         LW,10     *10                 DOWN THE CHAIN.                  TIC64590
*                                                                       TIC64600
         SLS,#ARG  2                   WA OF RECORD TO BA.              TIC64610
         OR,#ARG   =X'80000000'        MAKE IT A DSP.                   TIC64620
         #FREE#MAIN#BYTES              AND RETURN THE SPACE.            TIC64630
*                                                                       TIC64640
         AI,10     0                   SEE IF ANOTHER RECORD IN STORAGE.TIC64650
         BNEZ      LOGON2520           AND GO PROCESS IT IF SO.         TIC64660
*                                                                       TIC64670
*                                                                       TIC64680
*                                                                       TIC64690
LOGON2570 RES      0                                                    TIC64700
*                                                                       TIC64710
*        HERE WITH JUST ABOUT EVERYTHING DONE.
*
         BAL,15    DEFINELIST          MAKE STATION'S GET-LIST.
*                                                                       TIC65170
         LI,8      DMODE@ALT           SET DEFAULT                      TIC65180
         #T#PUT,8  #DEV#DMODE           DMODE.                          TIC65190
*                                                                       TIC65200
         LI,8      0                   SET NOT USING                    TIC65210
         #T#PUT,8  #DEV#USING#TFD       A TFD.                          TIC65220
*                                                                       TIC65230
         BAL,14    LOGONFREESTAIBUFFER
*                                                                       TIC65260
         #EXIT#SPACE                                                    TIC65270
         B         COMMANDLEVEL        RETURN DIRECTLY TO COMMAND LEVEL.
*                                      (IN CASE OF Y'STRING')
*                                                                       TIC65290
*                                                                       TIC65300
*                                                                       TIC65310
LOGONPROMPTTEXTCBATOR8 RES 0
         LI,8      BA(=0)              UNKNOWN.
         BAL,#BAL  O:LOGONNAMEPROMPT   OWNCODE.
         LI,8      BA(=0)              UNIT RECORD.
         LI,8      BA(LOGONPROMPTTTY)  TTY.
         LI,8      BA(LOGONPROMPT3270) 3270.
*
LOGONPROMPT3270 RES 0
         DO        DO#3270
         GEN,32    X'24F5C311'
         GEN,32    X'40401DC1'
         TEXT       '@       '
         TEXT       '       E'
         TEXT       'NTER NAM'
         GEN,32    X'C51140C1'
         GEN,32    X'13000000'
         FIN
LOGONPROMPTTTY RES 0
         GEN,32    X'0915D5C1'
         TEXT       'ME = @  '
*
LOGONPSWPROMPTTEXTCBATOR8 RES 0
         LI,8      BA(=0)              UNKNOWN.
         BAL,#BAL  O:LOGONPASSWORDPROMPT OWN-CODE.
         LI,8      BA(=0)              UNIT RECORD.
         LI,8      BA(LOGONPSWTTY)     TTY.
         LI,8      BA(LOGONPSW3270)    3270.
*
LOGONPSW3270 RES   0
         DO        DO#3270
         GEN,32    X'1FF5C311'
         GEN,32    X'40401D4D'
         GEN,32    X'11C1501D'
         GEN,32    X'C1C5D5E3'
         TEXT       'ER PASSWORD '
         GEN,32    X'1140C113'
         FIN
*
LOGONPSWTTY RES    0
         GEN,32    X'0C15D7C1'
         TEXT     'SSWORD = '
*                                                                       TIC65370
*                                                                       TIC65380
LOGONIOERROR RES   0                   HERE ON BAD STATOON I/O.         TIC65390
         BAL,14    LOGONFREESTAIBUFFER
*
         LI,#ARG   0
         #T#XCA,#ARG #DEV#COMMAND#LINE#RECORD#BA
         #FREE#MAIN#BYTES#IF
*                                                                       TIC65420
         #EXIT#SPACE                                                    TIC65430
         B         COMMANDLEVELSURVEY  AND GO WAIT.                     TIC65450
         PAGE
*
*        ROUTINES WHICH GET AND FREE (A BUFFER CONTAINING)
*        THE STATION NAMES FILE RECORD ASSOCIATED WITH THE
*        STATION.
*
*        USED ONLY BY LOGON.
*
*
*
*        FREE BUFFER.  BAL'ED TO ON R14.
*
LOGONFREESTAIBUFFER RES 0
         LI,#ARG   0
         XW,#ARG   LOGSTAIRECORDDSP
         #FREE#MAIN#BYTES#IF
         B         *14
*
*
*
*        READ BUFFER.  BAL'ED TO ON R14.
*        RETURNS R6 AND R7 SET UP FOR SCANNING.
*        USES R8 AND R9 AND R10 AND R15 AND R5.
*
LOGONGETSTAIBUFFER RES 0
         #T#GET,9  #DEV#LINE#IDENTIFIER KEY FOR STATION IS LINEID
         LW,10     ='    '             AND FOUR BLANKS IF POINT-TO-POINT
         #T#GET,5  #DEV#DCB#POINTER    SEE IF POINT-TO-POINT.
         BGZ       LOGON8220           OVER IF SO.
*
         LI,15     4                   FOR
LOGON8206 LI,#ARG  X'F000'              MULTIPOINT
         AND,#ARG  9                     THE KEY IS
         SLS,#ARG  -12                    THE
         LB,#ARG   HEXTABLE,#ARG           LINEID AND
         SLS,10    8                        PHYSICAL
         OR,10     #ARG                      DEVICE
         SLS,9     4                          ADDRESS
         BDR,15    LOGON8206                   EXPRESSED
         #T#GET,9,5 #DEV#LINE#IDENTIFIER       IN HEX.
*
LOGON8220 RES      0
         LI,5      #INFOBLOCK#STAI     POINT TO CORRECT FILE.
         BAL,15    OBTAININTERNALFILERECORD AND GET THE RECORD.
         BNEZ      LOGON8255           OVER IF GOT RECORD.
*
*        FALL THRU ON NO STATION NAMES RECORD FOR THIS STATION.
*
         LW,8      9                   COPY ID TO REGISTERS
         LW,9      10                   8 & 9 FOR PRINTOUT:
         #TYPE89   'NO STATION NAMES RECORD FOR'
         #EXIT
*
LOGON8255 RES      0                   HERE WITH RECORD'S DSP IN R8.
         STW,8     LOGSTAIRECORDDSP    REMEMBER RECORD'S DSP.
*
         LI,6      X'7FFFF'
         AND,6     8                   BA OF RECORD.
         AI,6      4                   BA OF TEXT.
*
         LW,7      8                   DSP OF RECORD.
         SLS,7     -2                  WA OF RECORD.
         LH,7      *7                  WORD COUNT OF RECORD.
         SLS,7     2                   INTO A BYTE COUNT.
         AI,7      -4                  LESS CONTROL WORD.
         AW,7      6                   PLUS START IS ND+1.
         STW,7     LOGSTAIRECORDEND    REMEMBER IT.
*
*        R6 HAS BA OF FIRST BYTE OF TEXT.
*        R7 HAS BA OF LAST BYTE PLUS ONE.
*
         B         *14                 RETURN.
         PAGE
*
*        ROUTINES SUPPLIED SOLELY TO
*        AID T:LOGON USERS IN EFFECTIOG
*        I/O WITH THE STATION OR THE
*        STAI FILE.
*
*
         DO        DO#OWNCODEHELP
*
XREADSTAI RES      0                   HERE TO READ AN STAI RECORD.
*
*        R8 & R9 CONTAIN KEY.
*
*        BAL'ED TO ON R15
*
*        RETURNS BA (DSP) OF RECORD IN R8,
*        OR RETURNS ZERO IF NO RECORD.
*
         LW,10     15                  COPY RETURN ADDRESS.
         LI,5      #INFOBLOCK#STAI     POINT TO FILE.
         BAL,15    OBTAININTERNALFILERECORD GET HIS RECORD.
         B         *10                 AND RETURN.
*
*
*
XDONEWITH RES      0                   FREES A BLOCK.
*
*        R8 HAS DSP OF BLOCK TO FREE.
*        (PRESUMABLY COTTEN FROM XREADSTAI
*        OR FROM XREADSTATION)
*
         #T#GET,9  #DEV#RECORD#BA      SEE IF FREEING
         CW,9      8                    THE CURRENT STATION RECORD.
         BNE       XDONEWITH333        OVER IF NOT.
*
         #FREE#DEV#BUFFER              FREE CORRENT STATION BUFFER
         B         *15                 AND RETURN.
*
XDONEWITH333 RES   0
         LW,#ARG   8                   FREE THE BLOCK THAT
         #FREE#MAIN#BYTES               THE CALLER POINTS TO.
         B         *15                 AND RETURN.
*
*
*
XREADSTATION RES   0                   READ A RECORD FROM STATION.
*
*        RETURNS DSP OF RECORD IN R8.
*
*        RETURNS BYTE COUNT OF RECORD IN R9.
*
         #INITIATE#READ
         #CHECK#READ XREADSTATION777
         #T#GET,8  #DEV#RECORD#BA
         #T#GET,9  #DEV#RECORD#LENGTH
         B         *15
*
XREADSTATION777 RES 0                  HERE ON ERROR.
         LI,8      0                   ON AN SRROR, RETURN ZEROES.
         LI,9      0
         B         *15
*
*
*
XWRITESTATION RES  0                   HERE TO WRITE TO STATION.
*
*        ENTER WITH BA OF STRING IN R8 AND
*        LENGTH OF STRING IN R9.
*
         #T#PUT,8  #DEV#RECORD#BA
         #T#PUT,9  #DEV#RECORD#LENGTH
         #INITIATE#WRITE
         #CHECK#WRITE
         B         *15
*
         FIN
         TITLE     'TIC - DEV-TASK - COMMAND PROCESSORS - DMODE'
*
DMODE    RES       0                   HERE ON DMODE COMMAND            TIC65670
         FIELD6789LOADAAAAAAAA,COMMANDBAD GET COMMAND NAME.
         AND,8    =X'FFFFFF'
         CW,8     =X'C44040'
         BE        DMODE120
         CD,8      DMODENAME
         BNE       COMMANDNOT
*
DMODE120 RES       0
         FIELD6789LOADAAAAAAAA,COMMANDBAD
*                                                                       TIC65770
         LI,7      4                   NUMBER OF DMODES                 TIC65780
         CW,8      DMODEKEYWORDS-1,7   COMPARE TO FIND                  TIC65790
         BE        DMODEGOT             WHICH KEYWORD WES SUPPLIED      TIC65800
         BDR,7     %-2                                                  TIC65810
*                                                                       TIC65820
         BAL,13    ERRORBUFFERCREATE
         LI,12     BA(DMODEMESSAGE)
         BAL,14    ERRORBUFFERTEXTC
*E*  MESSAGE:     'NO SUCH MODE'
*E*  DESCRIPTION: THE !DMODE COMMAND CONTAINS AN INVALID MODE,
*E*               E.G., !DMODE XXX.
         BAL,13    ERRORBUFFERFLUSH
         B         COMMANDLEVELPOSTCOMMAND IF NO MATCH, WE DO NUTTIN.   TIC65890
*                                                                       TIC65900
DMODEGOT LW,9      DMODEKEYBITS-1,7    GET BIT CORRESPONDING TO KEY WORDTIC65910
         #T#PUT,9  #DEV#DMODE           AND PUT INTO TABLE.             TIC65920
         B         COMMANDLEVELPOSTCOMMAND                              TIC65930
*                                                                       TIC65940
DMODEKEYWORDS RES  0                                                    TIC65950
         TEXT      'IN  '
         TEXT      'OUT '
         TEXT      'ALT '
         TEXT      'ONE '
*                                                                       TIC66000
DMODE@IN EQU       128                                                  TIC66010
DMODE@OUT EQU      64                                                   TIC66020
DMODE@ALT EQU      32                                                   TIC66030
DMODE@ONE EQU      16                                                   TIC66040
*                                                                       TIC66050
DMODEKEYBITS RES   0                                                    TIC66060
         GEN,32    DMODE@IN                                             TIC66070
         GEN,32    DMODE@OUT                                            TIC66080
         GEN,32    DMODE@ALT                                            TIC66090
         GEN,32    DMODE@ONE                                            TIC66100
*                                                                       TIC66110
DMODEMESSAGE TEXTC 'NO SUCH MODE'
*
         BOUND     8
DMODENAME  GEN,32 X'00C4D4D6'
           GEN,32 X'C4C54040'
         TITLE     'TIC - DEV-TASK - COMMAND PROCESSORS - STATUS'
*
         BOUND     8
STATUSNAME  GEN,32  X'00E2E3C1'
            GEN,32  X'E3E4E240'
*                                                                       TIC66140
*        HERE ON !STATUS COMMAND.                                       TIC66150
*                                                                       TIC66160
STATUS   RES       0                                                    TIC66170
*                                                                       TIC66180
         FIELD6789LOADAAAAAAAA,COMMANDBAD GET COMMAND NAME.             TIC66190
         AND,8    =X'FFFFFF'
         CW,8     =X'E24040'        MAKE
         BE        STATUS120            SURE                            TIC66210
         CD,8      STATUSNAME            NAME OK.
         BNE       COMMANDNOT                                           TIC66250
STATUS120 RES      0                                                    TIC66260
*                                                                       TIC66270
         FIELD6789POINTTOSTRING,STATUSLAST GET FIRST ARG, OVER IF NONE  TIC66280
*        FALL THROUGH WHEN CLERK IS SUPPLING TRANCODE.                  TIC66290
*                                                                       TIC66300
         CI,9      22                  SEE IF VERY LONG TRANCODE.       TIC66310
         BGE       COMMANDBAD          OUT IF TOO BIG.                  TIC66320
         LW,13     9                   COPY LENGTH TO MORE PERM REGISTERTIC66330
*                                                                       TIC66340
         #GET#MAIN#BYTES 32            GET BYTES FOR TEXTC XACTION NAME.
         LW,11     #ARG                REMEMBER DSP OF WORK SPACE.
         LW,5      #ARG                BA OF SPACE TO INDEX REGISTER.   TIC66400
         AI,5      1                   BUMP OVER WHAT WILL BE TEXTC COUN
*                                                                       TIC66420
         LI,10     '?'                 QUESTION MARK                    TIC66430
         STB,10    0,5                  IS FIRST CHAR                   TIC66440
         AI,5      1                     IN THE NAME.                   TIC66450
*                                                                       TIC66460
         LW,#ARG   8                   BA OF TRANCODE IN COMMAND TO INDETIC66470
         LB,10     0,#ARG              COPY TRANCODE                    TIC66480
         STB,10    0,5                  GIVEN BY CLERK                  TIC66490
         AI,#ARG   1                     TO WORKING                     TIC66500
         AI,5      1                      STORAGE.                      TIC66510
         BDR,9     %-4                 (R8 AND R9 FROM FIELD PROC)      TIC66520
*                                                                       TIC66530
         LI,10     '.'                 ADD THE                          TIC66540
         STB,10    0,5                  PERIOD                          TIC66550
         AI,5      1                     DELIMITER.                     TIC66560
*                                                                       TIC66570
         FIELD6789POINTTOSTRING,STATUSBAD COLLECT NEXT COMMAND FIELD.   TIC66580
*                                                                       TIC66590
*        WHEN HERE, HAVE STATION NAME, OR HEXID IF NO NAME SUPPLIED.    TIC66600
*                                                                       TIC66610
         LW,#ARG   8                   COPY BA INTO AN INDEX.           TIC66620
         LB,10     0,#ARG              GET FIRST BYTE OF FIELD.         TIC66630
         CI,10     '@'                 IS IT AN AT-SIGN?                TIC66640
         BNE       STATUS440           OVER IF NOT.                     TIC66650
*                                                                       TIC66660
         AW,13     9                   ADD NAME TO                      TIC66670
         CI,13     22                   LENGTH CHECK.                   TIC66680
         BGE       STATUSBAD           AND OUT IF TOO LONG.             TIC66690
*                                                                       TIC66700
         LW,#ARG   8                   BA OF @NAME TO AN INDEX REGISTER.TIC66710
         LB,10     0,#ARG              COPY                             TIC66720
         STB,10    0,5                  NAME TO                         TIC66730
         AI,#ARG   1                     ABUILDIN                       TIC66740
         AI,5      1                      CRITERION.                    TIC66750
         BDR,9     %-4                                                  TIC66760
*                                                                       TIC66770
         LI,10     '.'                 ADD A                            TIC66780
         STB,10    0,5                  PERIOD                          TIC66790
         AI,5      1                     DELIMITER.                     TIC66800
*                                                                       TIC66810
         FIELD6789POINTTOSTRING,STATUSBAD GET THE HEXID.                TIC66820
         B         STATUS460           AND GO PROCESS IT.               TIC66830
*                                                                       TIC66840
STATUS440 RES      0                   HERE WHEN WE SHOULD USE NAME OF  TIC66850
*                                      THIS STATION, 'CAUS NONE IN COMMATIC66860
*                                                                       TIC66870
*        WHEN HERE, R8 AND R9 HAVE POINTERS TO THE HEXID THAT WE WILL   TIC66880
*        BE MOVING LATER, SO WE MUST NOT DISTURB THEM.                  TIC66890
*                                                                       TIC66900
         #T#GET,#ARG #DEV#AT#NAME#LAL  GET POINTER TO @-NAME.           TIC66910
         BEZ       STATUSBAD           (IMPOSSIBLE?) ERROR IF NONE.     TIC66920
*                                                                       TIC66930
         LB,12     #ARG                FIRST BYTE OF LAL WORD IS COUNT. TIC66940
*                                                                       TIC66950
         AW,13     12                  BUMP RUNNING LENGTH OF XACTION NATIC66960
         CI,13     22                  SEE IF WOULD BE TOO BIG.         TIC66970
         BGE       STATUSBAD           OVER IF TOO BIG.                 TIC66980
*                                                                       TIC66990
         LB,10     0,#ARG              COPY                             TIC67000
         STB,10    0,5                  STATION'S                       TIC67010
         AI,#ARG   1                     @-NAME                         TIC67020
         AI,5      1                      TO ABUILDIN                   TIC67030
         BDR,12    %-4                     CRITERION.                   TIC67040
*                                      (#DEV#AT#NAME#LAL NAME HAS       TIC67050
*                                       A TRAILING PERIOD, SO WE        TIC67060
*                                        DO NOT ADD ONE)                TIC67070
*                                                                       TIC67080
STATUS460 RES      0                                                    TIC67090
*                                                                       TIC67100
*        NOW IT IS TIME TO PUT THE HEXID IN.                            TIC67110
*                                                                       TIC67120
         CI,9      8                   HEXID MUST BE EIGHT BYTES.       TIC67130
         BNE       STATUSBAD           WASN'T.                          TIC67140
*                                                                       TIC67150
         LW,#ARG   8                   BA OF HEXID TO AN INDEX.         TIC67160
         LB,10     0,#ARG              COPY HEXID                       TIC67170
         STB,10    0,5                  FROM COMMAND                    TIC67180
         AI,#ARG   1                     TO ABUILDIN'                   TIC67190
         AI,5      1                      CRITERION.                    TIC67200
         BDR,9     %-4                                                  TIC67210
*                                                                       TIC67220
*        WE NOW HAVE THE CRITERION THAT WE NEED FOR OUR M:QUEUE/STATUS  TIC67230
*        BUILT IN (THE MIDDLE OF) THE WORKING STORAGE.                  TIC67240
*                                                                       TIC67250
         LI,10     0                   PUT A ZERO AT END OF CRITERION.  TIC67260
         STB,10    0,5                 (THIS MAY NOT BE NECESSARY       TIC67270
*                                       IN THE CASE OF Q/STATS)         TIC67280
*                                                                       TIC67290
STATUS485 RES      0                                                    TIC67300
         LW,9      5                   CALCULATE LENGTH OF CRITERION BY TIC67310
         SW,9      11                  SUBTRACTING DSPS -- SUBTRACT
         AI,9      -1                  ORIGINAL DSP AND MINUS ONE FOR TE
*                                      BECAUSE CRITERION DOESN'T START  TIC67340
*                                      AT THE BEGINNING.                TIC67350
*                                                                       TIC67360
         LI,6      X'7FFFF'            NEATENED DSP OF
         AND,6     11                   TEXTC CRITERION.
         STB,9     0,6                 INSERT TTEXTC COUNT.
         STB,9     6                   SIZE INTO REGISTER FOR CAL.
         AI,6      1                   POINT REGISTER TO TEXT.
         #T#GWA,9  #DEV#ECB            POINT TO AN ECB.
         M:QUEUE 6,STATS,(ECB,*9)      TRY TO GET STATUS.
         BCR,12    STATUS500           OVER IF WE GOT STATUS.           TIC67450
         BCS,4     STATUS489           OVER TO WAIT ON ECB.             TIC67460
*                                                                       TIC67470
         #SNAP,8   'Q/STATS ERROR CC12=10'                              TIC67480
         #ABORT                                                         TIC67490
*                                                                       TIC67500
STATUS489 RES      0                                                    TIC67510
         #SNAP,2   'QUEUE/STATUS WE MUST TRY AGAIN'                     TIC67520
         LW,#ARG   9                   ECB POINTER.                     TIC67530
         #WAIT#ON                      WAIT ON IT.                      TIC67540
         B         STATUS485           AND TRY AGAIN.                   TIC67550
*                                                                       TIC67560
STATUS500 RES      0                   HERE WITH STATUS INFO IN R8.     TIC67570
         SLS,8     -28                 RIGHT-JUSTIFY THE INFO.          TIC67580
*                                                                       TIC67590
*        WHEN HERE, HAVE STATUS IN R8.                                  TIC67600
*                                                                       TIC67610
         LW,#ARG   8
         LB,10     STATUSANSWERSLIST,#ARG LOAD BA OF TEXTC ANSWER
         AI,10     BA(STATUSTEXTCS)        AS OFFSET PLUS BASE.
*                                                                       TIC67800
*        NOW READY TO OUTPUT STATUS ANSWER.
*
         BAL,13    ERRORBUFFERCREATE
         LI,12     BA(STATUSPREFIX)
         BAL,14    ERRORBUFFERTEXTC
         LW,12     11                  BA OF TEXTC XACTION NAME.
         BAL,14    ERRORBUFFERTEXTC    OUTPUT.
         LW,12     10                  BA OF TEXTC STATUS.
         BAL,14    ERRORBUFFERTEXTC    OUTPUT.
         BAL,13    ERRORBUFFERFLUSH
*
         LW,#ARG   11                  DSP OF WORKING STORGAE.
         #FREE#MAIN#BYTES              GIVE IT BACK.
*                                                                       TIC68110
STATUS800 B        COMMANDLEVELPOSTCOMMAND                              TIC68120
*                                                                       TIC68130
*                                                                       TIC68140
*                                                                       TIC68150
STATUSBAD RES      0                                                    TIC68160
         LW,#ARG   11                  COPY DSP OF WROK SPACE.
         #FREE#MAIN#BYTES              AND GIVE IT BACK.                TIC68180
         B         COMMANDBAD          THEN COMPLAIN ABOUT SYNTAX.      TIC68190
*                                                                       TIC68200
*                                                                       TIC68210
*                                                                       TIC68220
STATUSLAST RES     0                   HERE FOR STATUS OF LAST-ENTERED. TIC68230
         B         COMMANDBAD                                           TIC68240
*                                                                       TIC68250
*                                                                       TIC68260
*                                                                       TIC68270
STATUSPREFIX TEXTC 'TRANSACTION '
*                                                                       TIC68290
STATUSANSWERSLIST RES 0                                                 TIC68300
         GEN,8     BA(STATUS#U)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#U)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#U)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#U)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#U)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#U)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#U)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#U)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#Q)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#P)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#F)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#I)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#Q)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#P)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#F)-BA(STATUSTEXTCS)
         GEN,8     BA(STATUS#I)-BA(STATUSTEXTCS)
         BOUND     4                   (NECESSARY 'CAUSE TEXTC BOUNDS)
STATUSTEXTCS RES   0
STATUS#I TEXTC     ' ILLEGAL'
STATUS#P TEXTC     ' IN PROGRESS'
STATUS#Q TEXTC     ' QUEUED'
STATUS#F TEXTC     ' FAILED'
STATUS#U TEXTC     ' UNKNOWN'
         TITLE     'TIC - DEV-TASK - COMMAND PROCESSORS - ECHO'
*                                                                       TIC69060
ECHO    RES       0                                                     TIC69070
ECHOCODE RES       0                                                    TIC69080
*
*                  R6 POINTS TO THE BEGINNING OF THE COMMAND.           TIC69090
*                  R7 POINTS TO THE END PLUS ONE.                       TIC69100
*                                                                       TIC69110
         AI,6      1                   SCAN FOR                         TIC69120
         CW,6      7                    END OF                          TIC69130
         BGE       ECHONOQUOTE           COMMAND                        TIC69140
         LB,8      0,6                    NAME.                         TIC69150
         CI,8      ' '                                                  TIC69160
         BNE       %-5                                                  TIC69170
         AI,6      1                   SEE IF ARGUMENT                  TIC69180
         LB,8      0,6                  OF COMMAND IF QUOTED.           TIC69190
         CI,8      ''''                  STRING.                        TIC69200
         BNE       ECHONOQUOTE         OUT IF NOT.                      TIC69210
         AI,6      1                   POINT F5 TO FIRST                TIC69220
         LW,5      6                    CHAR IN QUOTED STRING           TIC69230
         AI,6      1                   SCAN FOR                         TIC69240
         CW,6      7                    END OF                          TIC69250
         BGE       ECHOQUOTEEND          QUOTED                         TIC69260
         LB,8      0,6                    STRING OR                     TIC69270
         CI,8      ''''                    THE END OF                   TIC69280
         BNE       %-5                      COMMAND.                    TIC69290
ECHOQUOTEEND RES   0                                                    TIC69300
*                  HERE WITH R5 POINTING TO FIRST CHARACTER             TIC69310
*                  IN STRING AND R6 POINTING TO LAST PLUS ONE.          TIC69320
*                                                                       TIC69330
*                                                                       TIC69340
         SW,6      5                   CALCULATE LENGTH.                TIC69350
*                                                                       TIC69360
         AI,5      -1                  POINT TO PREVIOUS BYTE.
         CI,6      80                  SEE IF TOO LONG QUOTE.
         BLE       %+2                 OVER IF OK.
         LI,6      80                  OR SHORTEN R6 TO 80 BYTE MAX.
         STB,6     0,5                 MAKE A TEXTC STRING.
         LW,12     5                   POINT R12 TO BA OF THE STRING.
*
         BAL,13    ERRORBUFFERCREATE
         BAL,14    ERRORBUFFERTEXTC
         BAL,13    ERRORBUFFERFLUSH
         B         COMMANDLEVELPOSTCOMMAND                              TIC69410
*                                                                       TIC69420
ECHONOQUOTE RES 0                                                       TIC69430
*
         BAL,13    BUFFERCREATE        MAKE A R5 BUFFER.
*
         LI,12     BA(ECHO#1)          SEND BEGINNING
         BAL,14    BUFFERTEXTCR12       OF OUR REPLY.
*
         #T#GET,9  #DEV#LINE#IDENTIFIER TRY FOR LINEID.
         #T#GET,4  #DEV#DCB#POINTER    SEE IF WANT MULTIPOINT ID.
         BGZ       ECHO6222            OVER IF NOT.
         #T#GET,9,4 #DEV#LINE#IDENTIFIER GET MULTIPOINT LINEID.
ECHO6222 RES       0
         LI,4      4                   ADD
         SLD,8     8                    LINEID
         BAL,13    BUFFERR8              TO
         BDR,4     %-2                    MESSAGE.
*
         LI,12     BA(ECHO#2)
         BAL,14    BUFFERTEXTCR12
*
         #T#GET,13 #DEV#COMMAND#LINE#RECORD#LENGTH
*
         LI,8      4                   OUTPUT DECIMAL
         LI,9      0                    SIZE OF MESSAGE:
         LI,12     0
         DW,12     =10
         OR,12     =X'F0'
         SLS,9     -8
         STB,12    9
         AI,13     0
         BNEZ      %-6
         SLD,8     8
         BAL,13    BUFFERR8
         AI,9      0
         BNEZ      %-3
*
         LI,12     BA(ECHO#3)
         BAL,14    BUFFERTEXTCR12
*
         #T#GET,6  #DEV#COMMAND#LINE#RECORD#BA RE-OBTAIN
         AND,6     =X'7FFFF'           BA OF THE ECHO COMMAND.
*                  (R7 STILL HAS BA OF END+1.)
*
ECHO6400 RES       0                   HERE ON NEW LINE OF ECHOES.
         BAL,14    BUFFEREOL           GENERATE (MAYBE) A NEW LINE.
*
         LI,10     20                  SET MAX ECHOES PER LINE.
*
ECHO6420 LI,8      ' '                 A BLANK SEPARATES
         BAL,13    BUFFERR8             SUCCESSIVE CHARACTERS.
         LB,8      0,6                 GET CHAR FROM INPUT RECORD
         CI,8      X'C0'               IS IT A GRAPHIC.
         BAZ       ECHO6430            OVER IF NOT.
         BAL,13    BUFFERR8            OUTPUT NORMAL
         B         ECHO6450             CHARACTER.
*
ECHO6430 LB,#ARG   0,6                 OUTPUT THE
         SLS,#ARG  -4                   STRANGE
         LB,8      HEXTABLE,#ARG         CHARACTER
         BAL,13    BUFFERR8               IN HEX.
         LB,#ARG   0,6
         AND,#ARG  =X'0F'
         LB,8      HEXTABLE,#ARG
         BAL,13    BUFFERR8
*
ECHO6450 RES       0
         AI,6      1                   BUMP TO NEXT MESSAGE CHARACTER.
         CW,6      7                   SEE IF OFF END.
         BGE       ECHO6700            OVER IF OFF END.
*
         BDR,10    ECHO6420            MAX CHARACTERS ECHOED PER LINE.
         B         ECHO6400            OR ONTO A NEW LINE.
*
ECHO6700 RES       0
         BAL,13    BUFFERFLUSH
         B         COMMANDLEVELPOSTCOMMAND
*
*
*
ECHO#1   TEXTC     'FROM LINE '
ECHO#2   TEXTC     '  '
ECHO#3   TEXTC     ' CHARACTERS  '
         PAGE
*
*
*
*        THESE BUFFERING ROUTINES, ORIGINALLY DEVELOPED FOR
*        ECHO, MAY BE CALLED BY ANYONE.  NOTE THAT THE ONLY
*        REMEMBERING OF THE BUFFER IS IN R5 -- HENCE ONE SHOULD
*        'LI,5 0', DO YOUR BUFFERING, AND BUFFERFLUSH.  IN OTHER
*        WORDS, THE BUFFER DOESN'T HANG AROUND.
*
*        R5 = BUFFER BA (IN BITS 12-31) AND REMAINING BYTE COUNT (0-11).
*
*        R12, R13, R14 ARE USED.
*
*        #BAL AND #ARG ARE USED.
*
*
*
BUFFERCREATE RES   0
         #T#GET,#ARG #DEV#OUTPUT#TRL
         LW,5      #ARG
         #GET#MAIN#BYTES
         AND,#ARG  =X'7FFFF'
         SLS,5     20
         OR,5      #ARG
         #EXU#ON#TYPE#INDEX
BSTAR13  B         *13                 UNKNOWN.
         B         *13                 OWN-CODE.
         B         *13                 UNIT RECORD.
         B         BUFFERCREATE2500    TTY.
         B         BUFFERCREATE3270    3270.
*
BUFFERCREATE2500 RES 0                 HERE ON TTY BUFFER.
         LW,#ARG   =X'0D0C0000'        GGET THE TWO TTY BYTES.
*        AND FALL INTO COMMON CODE.
BUFFERCREATE2520 RES 0
         SLS,5     -2                  R5 --> WA.
         STW,#ARG  0,5                 TWO BYTES INTO BUFFER.
         SLS,5     2                   R5 --> BA AND COUNT.
         AW,5      =X'FFE00002'        BUMP R5 FOR TWO BYTES.
         B         *13
*
         DO        DO#3270
BUFFERCREATE3270 RES 0                 HERE ON 3270 BUFFER.
         SLS,5     -2
         LW,#ARG   =X'F5C311C1'
         STW,#ARG  0,5
         LW,#ARG   =X'50000000'
         STW,#ARG  1,5
         SLS,5     2
         AW,5      =X'FFB00005'
         B         *13
         ELSE
BUFFERCREATE3270 EQU BSTAR13
         FIN
*
*
*
ERRORBUFFERR8 RES  0
BUFFERR8 RES       0
         STB,8     13                  COPY CALLER'S BYTE.
*                                      (THIS IS DONE SO THAT THE ENTRY
*                                      BELOW CAN BE USED BY SOMEONE WHO
*                                      CAN'T USE R8.)
BUFFERR13 RES      0
         AI,5      0                   SEE IF WE HAVE A BUFFER.
         BNEZ      BUFFERR8PUT         OVER IF SO.
*
         #T#GET,#ARG #DEV#OUTPUT#TRL   FIND OUT HOW BIG A BUFFER.
         LW,5      #ARG                REMEMBER.
         #GET#MAIN#BYTES                GET A BUFFER.
         AND,#ARG  =X'7FFFF'           NEATEN BA OF BUFFER.
         SLS,5     20                  SLIDE COUNT LEFT.
         OR,5      #ARG                AND OR BA IN.
*
         DO        DO#3270             (ALL BUT 3270 ARE NO-OPS BELOW)
         #EXU#ON#TYPE#INDEX
         B         BUFFERR8PUT         UNKNOWN.
         B         BUFFERR8PUT         OWN-CODE.
         B         BUFFERR8PUT         UNIT RECORD.
         B         BUFFERR8PUT         TTY.
         B         BUFFERR83270        3270.
BUFFERR83270 RES   0
         LW,#ARG   =X'F5C30000'
         SLS,5     -2
         STW,#ARG  0,5
         SLS,5     2
         AW,5      =X'FFE00002'
         FIN
*
BUFFERR8PUT RES    0
         LB,#ARG   13                  CALLER'S CHARACTER.
         STB,#ARG  0,5                 CHAR --> BUFFER.
         AW,5      =X'FFF00001'        BUMP BA AND DOWN-COUNT.
         CW,5      =X'FFF00000'        SEE IF COUNT EXAUSTED.
         BANZ      *13                 OUT IF NOT.
         B         BUFFERFLUSH         FLUSH IF SO.
*
BUFFERFLUSHSPECIAL OR,13 =X'80000000'
BUFFERFLUSH RES    0
         AI,5      0                   SEE IF ANY BUFFER.
         BEZ       *13                 OUT IF NOT.
         #T#PUT,5  #DEV#RECORD#LENGTH  ** TEMP STORE BA-IN-BUFFER.
         LW,#ARG   5                   CURRENT BA IN BUFFER.
         SLS,5     -20                 PLUS COUNT.
         AW,5      #ARG                 IS UNNEAT END+1.
         #T#GET,#ARG #DEV#OUTPUT#TRL   GET LENGTH.
*
         AI,13     0                   SEE IF 'ERRORBUFFERFLUSH' CALL.
         BGEZ      BUFFERFLUSH3000     OVER IF NOT.
         CI,#ARG   80                  IF SO, USE MIN OF TRL AND 80.
         BLE       BUFFERFLUSH3000     AS THE BUFFER SIZE.
         LI,#ARG   80
*
BUFFERFLUSH3000 RES 0
         SW,5      #ARG                 AND SUBTRACT TO GET START.
         LW,#ARG   5                   BA OF BUFFER.
         OR,#ARG   =X'80000000'         PLUS DYNAMIC BIT.
         #T#PUT,#ARG #DEV#RECORD#BA    STORE LOAATION OF BUFFER.
         #T#GET,#ARG #DEV#RECORD#LENGTH RETRIEVE OLD BA-IN-BUFFER.
         SW,#ARG   5                    MINUS BAUUFER START IS COUNT.
         AND,#ARG  =X'FFFF'              NEATENED IS
         #T#PUT,#ARG #DEV#RECORD#LENGTH    RECORD LENGTH.
         #INITIATE#WRITE               WRITE IT.
         #CHECK#WRITE
         LI,5      0                   INDICATE NO BUFFER.
         B         *13                 AND RETURN.
*
*
*
*        BAL'ED TO ON R14 WITH BA(TEXTC) IN R12.
*        DESTROYS R13 AND R14.
*
BUFFERTEXTCR12 RES 0
         LW,#ARG   12                  GET CHAR COUNT
         LB,#ARG   0,#ARG               FROM THE TEXTC.
         STB,#ARG  14                  COUNT --> INTERESTING REMEMBERER.
*
         AI,12     1                   BUMP POINTER INTO TEXTC.
         LW,#ARG   12                  GET A CHARACTER
         LB,#ARG   0,#ARG               TO BE BUFFERED.
         LI,13     %+3                 (FAKE A BAL)
         STB,#ARG  13                  WITH CHAR AS ARGUMENT IN BAL REG.
         B         BUFFERR13           (A FAKE BAL)
*
         AW,14     =X'FF000000'        DECREMENT COUNT.
         CW,14     =X'FF000000'        TEST FOR COUNT EXAUSTED.
         BANZ      %-8                 BACK IF NOT.
         B         *14                 DONE IF SO.
*
*
*
BUFFEREOL RES      0                   PUTS AN END-OF-LINE INTO BUFFER.
         #EXU#ON#TYPE#INDEX
         B         *14                 OWN-CODE.
         BAL,13    BUFFERFLUSH         UNIT RECORD.
         B         BUFFEREOL2500       TTY.
         B         *14                 3270.
*
BUFFEREOL2500 RES  0
         LI,8      X'15'
         BAL,13    BUFFERR8
         B         *14
         TITLE     'TIC'
*                                                                       TIC88490
*        DEFS FOR T:MYPRIM USERS ARE HERE AT THE                        TIC88500
*        END SO THERE WILL BE NO FORWARD REFERENCES                     TIC88510
*        TO LISTS TO CONFUSE ANYONE.                                    TIC88520
*                                                                       TIC88530
XDEF     CNAME                                                          TIC88540
         PROC                                                           TIC88550
         LOCAL     AG                                                   TIC88560
AG       SET       AF                                                   TIC88570
LF       SET       AG(1)                                                TIC88580
         DEF       LF                                                   TIC88590
         PEND                                                           TIC88600
*                                                                       TIC88610
XTSIZEROORONE      XDEF TSIZEROORONE                                    TIC88620
XTSICURRENTR      XDEF TSICURRENTR                                      TIC88630
XTSICURRENTC      XDEF TSICURRENTC                                      TIC88640
XTSIYSTRINGBA      XDEF TSIYSTRINGBA                                    TIC88650
XTSIYSTRINGLENGTH  XDEF TSIYSTRINGLENGTH                                TIC88660
XTSIBXR            XDEF TSIBXR                                          TIC88670
XTSITRANID         XDEF TSITRANID                                       TIC88680
XTSIRECORDBA       XDEF TSIRECORDBA                                     TIC88690
XTSIRECORDCURRENTBA XDEF TSIRECORDCURRENTBA                             TIC88700
XTSIRECORDENDBA    XDEF TSIRECORDENDBA                                  TIC88710
XTSITFDSCAN        XDEF TSITFDSCAN                                      TIC88720
XTSIFQMTEXTBA      XDEF TSIFQMTEXTBA                                    TIC88730
XTSIFQMTEXTENDBA   XDEF TSIFQMTEXTENDBA                                 TIC88740
XTSIFQMTEXTHIGHWATERMARKBA XDEF TSIFQMTEXTHIGHWATERMARKBA               TIC88750
XTSIFQMFIELDPTR    XDEF TSIFQMFIELDPTR                                  TIC88760
XTSICURRENTFIELDC  XDEF TSICURRENTFIELDC                                TIC88770
XTSILASTFIELDSUM   XDEF TSILASTFIELDSUM                                 TIC88780
*                                                                       TIC88790
XTSOZEROORONE      XDEF      TSOZEROORONE
XTSOCURRENTR       XDEF      TSOCURRENTR
XTSOCURRENTC       XDEF      TSOCURRENTC
XTSORECORDBA       XDEF      TSORECORDBA
XTSORECORDENDBA    XDEF      TSORECORDENDBA
XTSORECORDSIZE     XDEF      TSORECORDSIZE
XTSOYSTRINGBA      XDEF      TSOYSTRINGBA
XTSOYSTRINGLENGTH  XDEF      TSOYSTRINGLENGTH
XTSOBXR            XDEF      TSOBXR
XTSOTRANID         XDEF      TSOTRANID
XTSOTFDSCAN        XDEF      TSOTFDSCAN
XTSOFQMTEXTBA      XDEF      TSOFQMTEXTBA
XTSOFQMTEXTENDBA   XDEF      TSOFQMTEXTENDBA
*
         DEF       TSIBADCHARACTER
         DEF       TSOBADCHARACTER
         DEF       TSIBADPRIMITIVE
         DEF       TSOBADPRIMITIVE
         DEF       TSINEXTPRIM
         DEF       TSIGETPRIM
         DEF       TSIGETCHAR
         DEF       TSIGETEOL
         DEF       TSIPUTFQMCHAR
         DEF       TSONEXTPRIM
         DEF       TSOGETPRIM
         DEF       TSOPUTCHAR
         DEF       TSOPUTBUFFER
         DEF       TSOPUTEOL
         DEF       TSOGETFQMCHAR
*
*
*
         DO        DO#OWNCODEHELP
         DEF       XREADSTAI
         DEF       XDONEWITH
         DEF       XREADSTATION
         DEF       XWRITESTATION
         FIN
         END

