         TITLE     'TIC - DEFINITIONS'
         PCC       0
*
*
*
         SYSTEM    SIG7                                                 TIC00010
         SYSTEM    BPM                                                  TIC00020
*
DO#UTS   SET       0                   ON TO RUN ON UTS.  OFF FOR CP-V.
*
DO#DEVELOPMENT SET 0                   OFF FOR NOT DEVELOPMENT.
*
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 TOHANDLE IBM 3270 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#HOLDSTAIDURINGLOGON SET 0           ON TO KEEP STATION'S STAI
*                                       RECORD IN CORE WHILE
*                                        CLERK ANSWERS PROMPT.
*
*
*                                                                       TIC00080
TICABORTCOUNT      EQU 9999            NUMBER OF #ABORT'S TO ALLOW.     TIC00090
XACTIONTEXTINCREMENT EQU 76            NUMBER OF CHARS IN TSI FQM PIECESTIC00100
*
BYTESPERRANDOMBLOCK EQU 1000           MAX BYTES IN INTERNAL GRANULES.
*
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
*
*
*
INITBUF2 EQU       X'10000'            DEFINE INITIALIZATION
INITBUF3 EQU       X'10200'             BUFFERS AS FOUR M:GVP-ABLE
INITBUF4 EQU       X'10400'              PAGES OUT IN THE BOONDOCKS.
INITBUF5 EQU       X'10600'
         PAGE                                                           TIC00110
*                                                                       TIC00120
*                                                                       TIC00130
*                                                                       TIC00140
         REF       M:SI                                                 TIC00150
*                                                                       TIC00160
         SREF      M:EI,M:EO
*
         REF       #FIND#DWS,#HIDE#DWS                                  TIC00170
         SREF       T:MYPRIM                                            TIC00180
         SREF      T:LOGON                                              TIC00190
*                                                                       TIC00200
         SREF      F:3000                                               TIC00210
         SREF      F:3001                                               TIC00220
         SREF      F:3002                                               TIC00230
         SREF      F:3003                                               TIC00240
         SREF      F:3004                                               TIC00250
         SREF      F:3005                                               TIC00260
         SREF      F:3006                                               TIC00270
         SREF      F:3007                                               TIC00280
         SREF      F:3008                                               TIC00290
         SREF      F:3009                                               TIC00300
         SREF      F:3010,F:3011,F:3012,F:3013,F:3014
         SREF      F:3015,F:3016,F:3017,F:3018,F:3019
         SREF      F:3020,F:3021,F:3022,F:3023,F:3024
         SREF      F:3025,F:3026,F:3027,F:3028,F:3029
*                                                                       TIC00310
         SREF      F:4000
         SREF      F:4001
         SREF      F:4002
         SREF      F:4003
         SREF      F:4004
         SREF      F:4005
         SREF      F:4006
         SREF      F:4007
         SREF      F:4008
         SREF      F:4009
*                                                                       TIC00420
         DEF       IT                                                   TIC00510
IT       RES       0                   (GIVES US OFFSETTER FOR PATCHES) TIC00520
         PAGE                                                           TIC00530
*        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                                                           TIC00700
*        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
#DEV#EVENT#PTR SET #DEV#EVENT#PTR#IW,4                                  TIC00810
*                                                                       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
*                                                                       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
#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        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                                                           TIC01200
*        THE '#PUSH AND #PULL PROCS PUSH OR PULL THE REGISTERS          TIC01210
*        INDICATED BY THE CF(2) AND CF(3) FIELDS, INCLUSIVE,            TIC01220
*        USING THE TIC-STACK.                                           TIC01230
*                                                                       TIC01240
*        NOTE THAT USE OF THE STACK CAN ONLY BE TASK-LOCAL,             TIC01250
*        THAT IS YOU CANNOT KEEP THINGS IN THE STACK                    TIC01260
*        THROUGH A WAIT.                                                TIC01270
*                                                                       TIC01280
#PUSH    CNAME     0                                                    TIC01290
#PULL    CNAME     1                                                    TIC01300
         PROC                                                           TIC01310
         ERROR,1,CF(2)>15 'BAD REGISTER'                                TIC01320
         ERROR,1,CF(3)>15 'BAD REGISTER'                                TIC01330
LF       RES       0                                                    TIC01340
         DO1       CF(3)>CF(2)                                          TIC01350
         LCI       15&(CF(3)-CF(2)+1)                                   TIC01360
         DO1       CF(3)<CF(2)                                          TIC01370
         LCI       15&(16+CF(3)-CF(2)+1)                                TIC01380
         DO        CF(2)=CF(3)                                          TIC01390
         DO1       1-NAME                                               TIC01400
         PSW,CF(2) #TIC#STACK                                           TIC01410
         DO1       NAME                                                 TIC01420
         PLW,CF(2) #TIC#STACK                                           TIC01430
         ELSE                                                           TIC01440
         DO1       1-NAME                                               TIC01450
         PSM,CF(2) #TIC#STACK                                           TIC01460
         DO1       NAME                                                 TIC01470
         PLM,CF(2) #TIC#STACK                                           TIC01480
         FIN                                                            TIC01490
         PEND                                                           TIC01500
         PAGE                                                           TIC01510
*        THE 'TABLEING' PROCEDURES ENABLE THE USER TO                   TIC01520
*        ACCESS THE TIC TABLES .  THE ONLY LEGAL WAY TO ACCESS          TIC01530
*        THE TIC TALBES IS VIA THESE PROCEDURES.  THIS WILL LET         TIC01540
*        US CHANGE TABLES FORMATS SOMEDAY.                              TIC01550
*                                                                       TIC01560
*        OBTAIN A TABLE ENTRY:                                          TIC01570
#T#GET   CNAME                                                          TIC01580
         PROC                                                           TIC01590
         LOCAL     AG,RX                                                TIC01600
LF       RES       0                                                    TIC01610
AG       SET       AF                                                   TIC01620
RX       SET       #DEV                                                 TIC01630
         DO1       NUM(CF)>2                                            TIC01640
RX       SET       CF(3)                                                TIC01650
         DO1       AG(2)=4                                              TIC01660
         LW,CF(2)  *AG(1),RX                                            TIC01670
         DO1       AG(2)=2                                              TIC01680
         LH,CF(2)  *AG(1),RX                                            TIC01690
         DO1       AG(2)=1                                              TIC01700
         LB,CF(2)  *AG(1),RX                                            TIC01710
         DO        AG(4)>0                                              TIC01720
         DO        AG(4)=4                                              TIC01730
         AI,CF(2)  AG(3)                                                TIC01740
         LW,CF(2)  *CF(2)                                               TIC01750
         FIN                                                            TIC01760
         DO        AG(4)=2                                              TIC01770
         DO        (AG(3)/2)>0                                          TIC01780
         AI,CF(2)  AG(3)/2                                              TIC01790
         FIN                                                            TIC01800
         LW,CF(2)  *CF(2)                                               TIC01810
         DO        AG(3)&1                                              TIC01820
         AND,CF(2) =X'FFFF'                                             TIC01830
         FIN                                                            TIC01840
         DO        1-(AG(3)&1)                                          TIC01850
         SLS,CF(2) -16                                                  TIC01860
         FIN                                                            TIC01870
         FIN                                                            TIC01880
         DO        AG(4)=1                                              TIC01890
         DO        (AG(3)/4)>0                                          TIC01900
         AI,CF(2)  AG(3)/4                                              TIC01910
         FIN                                                            TIC01920
         LW,CF(2)  *CF(2)                                               TIC01930
         DO        (AG(3)&3)=3                                          TIC01940
         AND,CF(2) =X'FF'                                               TIC01950
         FIN                                                            TIC01960
         DO        (AG(3)&3)=2                                          TIC01970
         SLS,CF(2) -8                                                   TIC01980
         AND,CF(2) =X'FF'                                               TIC01990
         FIN                                                            TIC02000
         DO        (AG(3)&3)=1                                          TIC02010
         SLS,CF(2) -16                                                  TIC02020
         AND,CF(2) =X'FF'                                               TIC02030
         FIN                                                            TIC02040
         DO        (AG(3)&3)=0                                          TIC02050
         SLS,CF(2) -24                                                  TIC02060
         FIN                                                            TIC02070
         FIN                                                            TIC02080
         FIN                                                            TIC02090
         PEND                                                           TIC02100
*                                                                       TIC02110
*        STORE A TABLE ENTRY:                                           TIC02120
#T#PUT   CNAME                                                          TIC02130
         PROC                                                           TIC02140
         LOCAL     AG,RX,RW                                             TIC02150
LF       RES       0                                                    TIC02160
AG       SET       AF                                                   TIC02170
RX       SET       #DEV                                                 TIC02180
         DO1       NUM(CF)>2                                            TIC02190
RX       SET       CF(3)                                                TIC02200
         DO        AG(4)>0                                              TIC02210
RW       SET       #ARG                                                 TIC02220
         DO        CF(2)=#ARG                                           TIC02230
RW       SET       #BAL                                                 TIC02240
         FIN                                                            TIC02250
         LW,RW     *AG(1),RX                                            TIC02260
         DO        AG(4)=1                                              TIC02270
         SLS,RW    2                                                    TIC02280
         AI,RW     AG(3)                                                TIC02290
         STB,CF(2) 0,RW                                                 TIC02300
         FIN                                                            TIC02310
         DO        AG(4)=2                                              TIC02320
         SLS,RW    1                                                    TIC02330
         AI,RW     AG(3)                                                TIC02340
         STH,CF(2) 0,RW                                                 TIC02350
         FIN                                                            TIC02360
         DO        AG(4)=4                                              TIC02370
         STW,CF(2) AG(3),RW                                             TIC02380
         FIN                                                            TIC02390
         FIN                                                            TIC02400
         DO        AG(4)=0                                              TIC02410
         DO1       AG(2)=4                                              TIC02420
         STW,CF(2) *AG(1),RX                                            TIC02430
         DO1       AG(2)=2                                              TIC02440
         STH,CF(2) *AG(1),RX                                            TIC02450
         DO1       AG(2)=1                                              TIC02460
         STB,CF(2) *AG(1),RX                                            TIC02470
         FIN                                                            TIC02480
         PEND                                                           TIC02490
*                                                                       TIC02500
*        GET THE WA OF AN ENTRY:                                        TIC02510
#T#GWA   CNAME                                                          TIC02520
         PROC                                                           TIC02530
         LOCAL     AG,RX                                                TIC02540
LF       RES       0                                                    TIC02550
AG       SET       AF                                                   TIC02560
RX       SET       #DEV                                                 TIC02570
         DO1       NUM(CF)>2                                            TIC02580
RX       SET       CF(3)                                                TIC02590
         ERROR,1,AG(2)<4 'BAD USAGE OF TABLE PROC'                      TIC02600
         DO        AG(4)>0                                              TIC02610
         LW,CF(2)  *AG(1),RX                                            TIC02620
         DO1       AG(4)=4                                              TIC02630
         AI,CF(2)  AG(3)                                                TIC02640
         DO1       AG(4)=8                                              TIC02650
         AI,CF(2)  AG(3)+AG(3)                                          TIC02660
         FIN                                                            TIC02670
         DO        AG(4)=0                                              TIC02680
         LW,CF(2)  RX                                                   TIC02690
         AW,CF(2)  AG(1)                                                TIC02700
         DO1       AG(2)=8                                              TIC02710
          AW,CF(2) RX                                                   TIC02720
         FIN                                                            TIC02730
         PEND                                                           TIC02740
*                                                                       TIC02750
*        EXCHANGE WITH A TABLE ENTRY:                                   TIC02760
#T#XCA   CNAME                                                          TIC02770
         PROC                                                           TIC02780
         LOCAL     AG,RX                                                TIC02790
AG       SET       AF                                                   TIC02800
RX       SET       #DEV                                                 TIC02810
         DO1       NUM(CF)>2                                            TIC02820
RX       SET       CF(3)                                                TIC02830
         ERROR,1,AG(2)<4 'BAD USAGE OF TABLE PROC'                      TIC02840
LF       XW,CF(2)  *AG(1),RX                                            TIC02850
         PEND                                                           TIC02860
*                                                                       TIC02870
*        POST A TABLE ENTRY                                             TIC02880
#T#POST  CNAME                                                          TIC02890
         PROC                                                           TIC02900
         LOCAL     AG,RX,RY                                             TIC02910
AG       SET       AF                                                   TIC02920
RX       SET       #DEV                                                 TIC02930
         DO1       NUM(CF)>2                                            TIC02940
RX       SET       CF(3)                                                TIC02950
RY       SET       #ARG                                                 TIC02960
         DO1       NUM(CF)>1                                            TIC02970
RY       SET       CF(2)                                                TIC02980
LF       RES       0                                                    TIC02990
         LW,RY     =X'90000000'                                         TIC03000
         STD,RY    *AG(1),RX                                            TIC03010
         PEND                                                           TIC03020
*                                                                       TIC03030
*        CLEAR A TABLE ENTRY                                            TIC03040
#T#CLEAR CNAME                                                          TIC03050
         PROC                                                           TIC03060
         LOCAL     AG,RX,RY                                             TIC03070
AG       SET       AF                                                   TIC03080
RX       SET       #DEV                                                 TIC03090
         DO1       NUM(CF)>2                                            TIC03100
RX       SET       CF(3)                                                TIC03110
RY       SET       #ARG                                                 TIC03120
         DO1       NUM(CF)>1                                            TIC03130
RY       SET       CF(2)                                                TIC03140
LF       LW,RY     =X'30000000'                                         TIC03150
         STD,RY    *AG(1),RX                                            TIC03160
         PEND                                                           TIC03170
         PAGE                                                           TIC03180
*        PROCEDURES THAT MANAGE DYNAMIC CORE FOR                        TIC03190
*        A TIC-TASK.  ESSENTIALLY THEY ARE GETMAIN                      TIC03200
*        AND FREEMAIN.                                                  TIC03210
*                                                                       TIC03220
#GET#MAIN#BYTES CNAME                                                   TIC03230
         PROC                                                           TIC03240
LF       RES       0                                                    TIC03250
         DO        NUM(AF)=1                                            TIC03260
         LI,#ARG   AF(1)                                                TIC03270
         FIN                                                            TIC03280
         BAL,#BAL  #GET#MAIN#BYTES#CODE                                 TIC03290
         PEND                                                           TIC03300
*                                                                       TIC03310
*                                                                       TIC03320
*                                                                       TIC03330
*        PROC TO FREE THE STORAGE BLOCK POINTED TO BY REGISTER #ARG.
*
#FREE#MAIN#BYTES CNAME                                                  TIC03350
         PROC                                                           TIC03360
LF       RES       0                                                    TIC03370
         BAL,#BAL  #FREE#MAIN#BYTES#CODE                                TIC03380
         PEND                                                           TIC03390
*
*
*
*        PROC TO FREE #ARG BLOCK ONLY IF IT IS 'DYNAMIC'9
*
#FREE#MAIN#BYTES#IF CNAME
         PROC
LF       BAL,#BAL  #FREE#MAIN#BYTES#IF#CODE
         PEND
*
*
*                                                                       TIC03400
*        PROC TO FREE THE STORE POINTED TO BY                           TIC03410
*        THE #DEV#RECORD#BA TABLE ENTRY FOR THIS DEVICE:                TIC03420
#FREE#DEV#BUFFER CNAME                                                  TIC03430
         PROC                                                           TIC03440
LF       BAL,#BAL  #FREE#DEV#BUFFER#CODE                                TIC03450
         PEND                                                           TIC03460
         PAGE                                                           TIC03470
*        PROCEDURE THAT SETS ONE OF OUR ECB'S                           TIC03480
*        TO 'HAPPENED'                                                  TIC03490
*        ABOUT THE SAME AS A SYSTEM M:EVENT                             TIC03500
*                                                                       TIC03510
#POST#ECB CNAME                                                         TIC03520
#POST#WORD CNAME                                                        TIC03530
         PROC                                                           TIC03540
LF       LW,#ARG   =X'90000000'                                         TIC03550
         STW,#ARG  AF                                                   TIC03560
         PEND                                                           TIC03570
*                                                                       TIC03580
*        AND THE CONVERSE OF THE ABOVE                                  TIC03590
*                                                                       TIC03600
#CLEAR#ECB CNAME                                                        TIC03610
#CLEAR#WORD CNAME                                                       TIC03620
         PROC                                                           TIC03630
LF       LW,#ARG   =X'30000000'
         STW,#ARG  AF                                                   TIC03650
         PEND                                                           TIC03660
         PAGE                                                           TIC03670
#GO#TO#ON CNAME                                                         TIC03680
         PROC                                                           TIC03690
LF       RES       0                                                    TIC03700
         BAL,#BAL  #GO#TO#ON#CODE                                       TIC03710
         PEND                                                           TIC03720
         PAGE                                                           TIC03730
#EXIT    CNAME                                                          TIC03740
         PROC                                                           TIC03750
LF       RES       0                                                    TIC03760
         BAL,#BAL  #EXIT#CODE                                           TIC03770
         PEND                                                           TIC03780
         PAGE                                                           TIC03790
*                                                                       TIC03800
*        PROCEDURE THAT 'ABORTS' A TIC-TASK - NOTE NO CLEANUP           TIC03810
*                                                                       TIC03820
#ABORT   CNAME                                                          TIC03830
         PROC                                                           TIC03840
LF       BAL,#BAL  ABORTCODE                                            TIC03850
         PEND                                                           TIC03860
         PAGE                                                           TIC03870
*        PROCEDURES FOR PERFORMING DEVICE I/O                           TIC03880
*        UNDER THE AUSPICES OF THE TIC EXECUTIVE                        TIC03890
*                                                                       TIC03900
*                                                                       TIC03910
*                                                                       TIC03920
#INITIATE#READ CNAME                                                    TIC03930
         PROC                                                           TIC03940
LF       RES       0                                                    TIC03950
         BAL,#BAL  #INITIATE#READ#CODE                                  TIC03960
         PEND                                                           TIC03970
#INITIATE#WRITE CNAME                                                   TIC03980
         PROC                                                           TIC03990
LF       RES       0                                                    TIC04000
          BAL,#BAL #INITIATE#WRITE#CODE                                 TIC04010
         PEND                                                           TIC04020
*        DOES AN 'REFLEXIVE' OR 'CONVERSATIONAL' READ:                  TIC04030
#INITIATE#WRITE#READ CNAME                                              TIC04040
         PROC                                                           TIC04050
LF       BAL,#BAL  #INITIATE#WRITE#READ#CODE                            TIC04060
         PEND                                                           TIC04070
*                                                                       TIC04080
*        THE #CHECK PROCEDURE DOES AN (IN-LINE) WAIT AND                TIC04090
*        THEN DOES A STATUS CHECK OF THE CALLER'S                       TIC04100
*        OUTSTANDING I/O OPERATION.  STATUS IS RETURNED                 TIC04110
*        IN REGISTER #ERR.  A BRANCH TO AF(1) WILL BE                   TIC04120
*        TAKEN IF AF(1) IS SUPPLIED AND THE STATUS                      TIC04130
*        IS BAD.                                                        TIC04140
#CHECK   CNAME                                                          TIC04150
#CHECK#READ CNAME                                                       TIC04160
#CHECK#WRITE CNAME                                                      TIC04170
#CHECK#WRITE#READ CNAME                                                 TIC04180
         PROC                                                           TIC04190
LF       RES       0                                                    TIC04200
         #WAIT#ON#DEVICE                                                TIC04210
         BAL,#BAL  #CHECK#CODE                                          TIC04220
         DO        NUM(AF)>0                                            TIC04230
         BNEZ      AF(1)                                                TIC04240
         FIN                                                            TIC04250
         PEND                                                           TIC04260
         PAGE                                                           TIC04270
*        THE #WAIT AND #WAIT#ON#DEVICE PROCEDURES ALLOW                 TIC04280
*        A TIC-TASK TO 'WAIT' FOR AN EVENT TO OCCUR.  THE #WAIT         TIC04290
*        PROCEDURES ARE SIMILAR TO THE #GO#TO#ON PROCEDURES.            TIC04300
*                                                                       TIC04310
#WAIT#ON CNAME                                                          TIC04320
         PROC                                                           TIC04330
LF       RES       0                                                    TIC04340
         DO1       NUM(AF)>0                                            TIC04350
         LI,#ARG   AF                                                   TIC04360
         BAL,#BAL  #WAIT#ON#CODE                                        TIC04370
         BAL,#BAL  #EXIT#CODE                                           TIC04380
         PEND                                                           TIC04390
*                                                                       TIC04400
#WAIT#ON#DEVICE CNAME                                                   TIC04410
         PROC                                                           TIC04420
LF       RES       0                                                    TIC04430
         BAL,#BAL  #WAIT#ON#DEVICE#CODE                                 TIC04440
         BAL,#BAL  #EXIT#CODE                                           TIC04450
         PEND                                                           TIC04460
         PAGE                                                           TIC04470
*                                                                       TIC04480
*                                                                       TIC04490
*                                                                       TIC04500
*        PROCS THAT ACQUIRE STORAGE FOR A SUBROUTINE.                   TIC04510
*        THEY OPERATE IN A MANNER VERY SIMILAR TO HOW                   TIC04520
*        OS/360 HANDLES ITS 'OWN' STORAGE ALLOCATION                    TIC04530
*        AND CHAINING.                                                  TIC04540
*                                                                       TIC04550
*        USAGE IS AS FOLLOWS:                                           TIC04560
*                  #ENTRY#SPACE N                                       TIC04570
*        WHERE ON RETURN, REGISTER #OWN CONTAINS                        TIC04580
*        A POINTER TO N WORDS OF OWN STORAGE AND                        TIC04590
*        FOURTEEN (NOT #BAL AND #ERR) REGISTERS                         TIC04600
*        HAVE BEEN SAVED.                                               TIC04610
*                                                                       TIC04620
*        REGISTER #OWN MUST BE PRESERVED UNTIL                          TIC04630
*        A MATCHING                                                     TIC04640
*                  #EXIT#SPACE                                          TIC04650
*        IS PERFORMED, WHICH FREES THE SPACE                            TIC04660
*        AND RESTORES THE REGISTERS.                                    TIC04670
*                                                                       TIC04680
#ENTRY#SPACE CNAME                                                      TIC04690
         PROC                                                           TIC04700
         DO        NUM(AF)=1                                            TIC04710
         LI,#ERR   AF(1)                                                TIC04720
         FIN                                                            TIC04730
         DO        NUM(AF)=0                                            TIC04740
         LI,#ERR   JSECT                                                TIC04750
         FIN                                                            TIC04760
         BAL,#BAL  #GET#MAIN#WORDS#SPECIAL#CODE                         TIC04770
         PEND                                                           TIC04780
*                                                                       TIC04790
#EXIT#SPACE CNAME                                                       TIC04800
         PROC                                                           TIC04810
         BAL,#BAL  #FREE#MAIN#WORDS#SPECIAL#CODE                        TIC04820
         PEND                                                           TIC04830
*                                                                       TIC04840
*                                                                       TIC04850
*                                                                       TIC04860
*        SPECIAL PROCS THAT ENABLE ONE TO USE THE                       TIC04870
*        METASYMBOL ASECT AND THUS USE RES'S TO DEFINE                  TIC04880
*        THE LOCATIONS (0,1,2 ETC) OF YOUR 'OWN'                        TIC04890
*        STORAGE RELATIVE TO REGISTER #OWN                              TIC04900
*                                                                       TIC04910
#DEFINE#SPACE#START CNAME                                               TIC04920
         PROC                                                           TIC04930
ISECT    SET       %                                                    TIC04940
         ASECT                                                          TIC04950
         ORG       0                                                    TIC04960
JSECT    SET       %                                                    TIC04970
         PEND                                                           TIC04980
*                                                                       TIC04990
#DEFINE#SPACE#STOP CNAME                                                TIC05000
         PROC                                                           TIC05010
JSECT    SET       %                                                    TIC05020
         ORG       0                                                    TIC05030
         USECT     ISECT                                                TIC05040
         PEND                                                           TIC05050
*                                                                       TIC05060
*                                                                       TIC05070
*                                                                       TIC05080
*        THE #DSS PROC CAN BE USED IN PLACE OF THE                      TIC05090
*        ABOVE TWO PROCS:                                               TIC05100
DSSSWITCH SET      0                                                    TIC05110
#DSS     CNAME                                                          TIC05120
         PROC                                                           TIC05130
         DO        DSSSWITCH=0                                          TIC05140
         #DEFINE#SPACE#START                                            TIC05150
         FIN                                                            TIC05160
         DO        DSSSWITCH=1                                          TIC05170
         #DEFINE#SPACE#STOP                                             TIC05180
         FIN                                                            TIC05190
DSSSWITCH SET      1-DSSSWITCH                                          TIC05200
         PEND                                                           TIC05210
*                                                                       TIC05220
*        TO DEFINE SPACE WITHIN AN ASECT CREATED BY THE                 TIC05230
*        ABOVE, ONE COULD USE LABELLED RES STATEMENTS - BUT             TIC05240
*        THEN YOU WOULD HAVE TO TAG ALL USAGES WITH A                   TIC05250
*        ',#OWN' AND YOU MIGHT FORGET.  SO INSTEAD, WE                  TIC05260
*        DEFINE CELLS WITH THE FOLLOWING PROC, WHICH CREATES            TIC05270
*        LISTS AND THUS 'AUTOMATICALLY' SUPPLIES THE ',#OWN'            TIC05280
*                                                                       TIC05290
#DSSWORD CNAME     4                                                    TIC05320
         PROC                                                           TIC05330
         BOUND     NAME                                                 TIC05340
LF       SET       %,#OWN                                               TIC05350
         RES,NAME  1                                                    TIC05360
         PEND                                                           TIC05370
*                                                                       TIC05380
*                                                                       TIC05390
*                                                                       TIC05400
*        IN CONNEXION WITH #ENTRY#SPACE AND #EXIT#SPACE, A ROUTINE      TIC05410
*        MAY WISH TO RETURN A RESULT IN A REGISTER.  TO DO SO IT        TIC05420
*        NEEDS TO KNOW WHERE THE REGISTERS HAVE BEEN STORED:            TIC05430
*                                                                       TIC05440
RETURNR5 SET       -16+5,#OWN                                           TIC05450
RETURNR6 SET       -16+6,#OWN                                           TIC05460
RETURNR7 SET       -16+7,#OWN                                           TIC05470
RETURNR8 SET       -16+8,#OWN                                           TIC05480
RETURNR9 SET       -16+9,#OWN                                           TIC05490
RETURNR10 SET      -16+10,#OWN                                          TIC05500
RETURNR11 SET      -16+11,#OWN                                          TIC05510
RETURNR12 SET      -16+12,#OWN                                          TIC05520
RETURNR13 SET      -16+13,#OWN                                          TIC05530
RETURNR14 SET      -16+14,#OWN                                          TIC05540
RETURNR15 SET      -16+15,#OWN                                          TIC05550
         PAGE                                                           TIC05750
*                                                                       TIC05760
*        PROCS TO DO BYTE STRING INSTRUCTIONS WITHOUT THE 255 BYTE LIMITTIC05770
*                                                                       TIC05780
*        WORK WITH 'SOURCE' BA IN R6                                    TIC05790
*                  'DESTINATION' BA IN R7                               TIC05800
*                  BYTE COUNT IN R8                                     TIC05810
*                                                                       TIC05820
MBS678   CNAME                                                          TIC05830
         PROC                                                           TIC05840
LF       BAL,#BAL  MBS678CODE
         PEND                                                           TIC05930
*                                                                       TIC05940
TTBS678  CNAME                                                          TIC05950
         PROC                                                           TIC05960
         B         %+5                                                  TIC05970
         AI,8      -252                                                 TIC05980
         OR,7      =252*256*256*256                                     TIC05990
         TTBS,6    0                                                    TIC06000
         BCS,1     %+5                                                  TIC06010
         CI,8      255                                                  TIC06020
         BG        %-5                                                  TIC06030
         STB,8     7                                                    TIC06040
         TTBS,6    0                                                    TIC06050
         PEND                                                           TIC06060
         PAGE                                                           TIC06070
*                                                                       TIC06080
*        PROCS WHICH SCAN CHARACTER STRING.                             TIC06090
*                                                                       TIC06100
*        IN GENERAL, THEY ASSUME THAT R7 POINTS TO                      TIC06110
*        THE CURRENT CHARACTER IN THE STRING AND THAT                   TIC06120
*        A COPY OF THAT CHARACTER IS IN R8.                             TIC06130
*                                                                       TIC06140
PICKUPCHARACTER78 CNAME                                                 TIC06150
         PROC                                                           TIC06160
LF       AI,7      1                                                    TIC06170
         LB,8      0,7                                                  TIC06180
         PEND                                                           TIC06190
*                                                                       TIC06200
*                                                                       TIC06210
PICKUPINTEGER789 CNAME                                                  TIC06220
         PROC                                                           TIC06230
LF       LI,9      0                                                    TIC06240
         CLM,8     ZEROANDNINE                                          TIC06250
         BCS,9     %+7                                                  TIC06260
         MI,9      10                                                   TIC06270
         AW,9      8                                                    TIC06280
         AI,9      -X'F0'                                               TIC06290
         AI,7      1                                                    TIC06300
         LB,8      0,7                                                  TIC06310
         B         %-7                                                  TIC06320
         PEND                                                           TIC06330
          PAGE                                                          TIC06340
*                                                                       TIC06350
*                                                                       TIC06360
*                                                                       TIC06370
*        THE 'FIELD' PROCS SCAN A BYTE STRING, CHECKING FOR             TIC06380
*        OR OBTAINING VARIOUS FIELDS.                                   TIC06390
*                                                                       TIC06400
*        'FIELDS' ARE BLANK-SEPARATED.                                  TIC06410
*                                                                       TIC06420
*        COMMON TO THE PROCS ARE THE FOLLOWING:                         TIC06430
*                                                                       TIC06440
*                  R6 HAS BA OF THE 'CURRENT' BYTE.                     TIC06450
*        R7 HAS BA OF THE LAST BYTE IN THE STRING PLUS ONE.             TIC06460
*                   R8 RETURNS A RESULT, OR IS DESTROYED.               TIC06470
*        R9 IS DESTROYED.                                               TIC06480
*                                                                       TIC06490
*        CF(2) IS BRANCHED TO ON END-OF-STRING ENCOUNTERED,             TIC06500
*        OR PROC+1 IF THERE IS NO CF(2).                                TIC06510
*                                                                       TIC06520
*                   CF(3) IS BRANCHED TO ON BAD CHARACTER, OR           TIC06530
*                   PROC+1 IF THERE IS NO CF(3).                        TIC06540
*                                                                       TIC06550
*                                                                       TIC06560
*                                                                       TIC06570
*        SEE IF NEXT FIELD = SUPPLIED STRING:                           TIC06580
*                                                                       TIC06590
FIELD6789BRANCHIF CNAME                                                 TIC06600
         PROC                                                           TIC06610
         LOCAL     K,L                                                  TIC06620
         LOCAL     Z                                                    TIC06630
Z        SET       L                                                    TIC06640
         DO        NUM(CF)>1                                            TIC06650
Z        SET       CF(2)                                                TIC06660
         FIN                                                            TIC06670
LF       RES       0                                                    TIC06680
         LW,9      6                                                    TIC06690
         CW,6      7                                                    TIC06700
         BGE       Z                                                    TIC06710
         LB,8      0,6                                                  TIC06720
         CI,8      ' '                                                  TIC06730
         BNE       %+3                                                  TIC06740
         AI,6      1                                                    TIC06750
         B         %-6                                                  TIC06760
         CI,8      AF(2)                                                TIC06770
         BNE       K                                                    TIC06780
         AI,6      1                                                    TIC06790
I        DO        NUM(AF)-2                                            TIC06800
         CW,6      7                                                    TIC06810
         BGE       Z                                                    TIC06820
         LB,8      0,6                                                  TIC06830
         CI,8      AF(I+2)                                              TIC06840
         BNE       K                                                    TIC06850
         AI,6      1                                                    TIC06860
         FIN                                                            TIC06870
         B         AF(1)                                                TIC06880
K        LW,6      9                                                    TIC06890
L        RES       0                                                    TIC06900
         PEND                                                           TIC06910
*                                                                       TIC06920
*        RETURNS THE NEXT FIELD - FIRST FOUR CHARS IN                   TIC06930
*        R8, RIGHT JUSTIFIED WITH LEADING ZEROES.                       TIC06940
*                                                                       TIC06950
FIELD6789LOADAAAA CNAME                                                 TIC06960
         PROC                                                           TIC06970
LF       BAL,#BAL  FIELD6789LOADAAAACODE
         DO        NUM(CF)>1
         B         CF(2)
         ELSE
         NOP
         FIN
         PEND                                                           TIC07300
*                                                                       TIC07310
*        LOADS THE NEXT FIELD AS AN INTEGER:                            TIC07320
*                                                                       TIC07330
FIELD6789LOADINTEGER CNAME                                              TIC07340
         PROC                                                           TIC07350
         LOCAL     K,L                                                  TIC07360
         LOCAL     M,N                                                  TIC07370
         LOCAL     Z                                                    TIC07380
Z        SET       L                                                    TIC07390
         DO        NUM(CF)>1                                            TIC07400
Z        SET       CF(2)                                                TIC07410
         FIN                                                            TIC07420
LF       RES       0                                                    TIC07430
         LI,8      0                                                    TIC07440
         CW,6      7                                                    TIC07450
         BGE       Z                                                    TIC07460
         LB,9      0,6                                                  TIC07470
         CI,9      ' '                                                  TIC07480
         BNE       %+3                                                  TIC07490
         AI,6      1                                                    TIC07500
         B         %-6                                                  TIC07510
M        LB,9      0,6                                                  TIC07520
         CLM,9     ZEROANDNINE                                          TIC07530
         BCS,9     N                                                    TIC07540
         LW,9      8                                                    TIC07550
         MI,9      10                                                   TIC07560
         LW,8      9                                                    TIC07570
         LB,9      0,6                                                  TIC07580
         AW,8      9                                                    TIC07590
         AI,8      -X'F0'                                               TIC07600
         AI,6      1                                                    TIC07610
         CW,6      7                                                    TIC07620
         BL        M                                                    TIC07630
         B         K                                                    TIC07640
N        RES       0                                                    TIC07650
         DO        NUM(CF)>2                                            TIC07660
         CI,9      ' '                                                  TIC07670
         BNE       CF(3)                                                TIC07680
         FIN                                                            TIC07690
K        RES       0                                                    TIC07700
L        RES       0                                                    TIC07710
          PEND                                                          TIC07720
*                                                                       TIC07730
*        LOADS BA AND LENGTH OF STRING:                                 TIC07740
*                                                                       TIC07750
FIELD6789POINTTOSTRING CNAME                                            TIC07760
         PROC                                                           TIC07770
LF       BAL,#BAL  FIELD6789POINTTOSTRINGCODE
         DO        NUM(CF)>1
         B         CF(2)
         ELSE
         NOP
         FIN
         PEND                                                           TIC08020
*                                                                       TIC08030
*        LOADS NEXT FIELD INTO R8 AND R9.  LEFT-JUSTIFIED TRAILING BLANKTIC08040
*                                                                       TIC08050
FIELD6789LOADAAAAAAAA CNAME                                             TIC08060
         PROC                                                           TIC08070
LF       BAL,#BAL  FIELD6789LOADAAAAAAAACODE
         DO        NUM(CF)>1
         B         CF(2)
         ELSE
         NOP
         FIN
         PEND                                                           TIC08400
         PAGE                                                           TIC08410
*                                                                       TIC08420
*        PROC TO  INDICATE AN ATTENTION ON THE CURRENT                  TIC08430
*        TIC-TASK'S STATION.  (IF CF(2) PRESENT, ON C(CF(2)) TASK)      TIC08440
*                                                                       TIC08450
SIGNALATTENTION CNAME                                                   TIC08460
         PROC                                                           TIC08470
         DO        NUM(CF)=1
         BAL,#BAL  SIGNALATTENTIONCODE
         ELSE
         LW,#ARG   CF(2)
         BAL,#BAL  SIGNALATTENTIONCODECFTWO
         FIN
         PEND                                                           TIC08940
*                                                                       TIC08950
*        PROC TO TEST FOR AN ATTENTION                                  TIC08960
*                                                                       TIC08970
IFATTENTION CNAME                                                       TIC08980
         PROC                                                           TIC08990
         #T#GET,#ARG #DEV#LINE#STATUS#BITS                              TIC09000
         CI,#ARG   #LINE#ATTENTION                                      TIC09010
         BANZ      AF(1)                                                TIC09020
         PEND                                                           TIC09030
         PAGE
*
*        PROC TO EXU AN INSTRUCTION FROM A LIST
*        BASED ON THE VALUE IN THE DEV-TASKS
*        #DEV#TYPE#INDEX ENTRY.
*
#EXU#ON#TYPE#INDEX CNAME
         PROC
         #T#GET,#BAL #DEV#TYPE#INDEX
         DO        DO#CHECKOUT
         CI,#BAL   #DEV#TYPE#INDEX#BIGGEST
         BG        -1
         FIN
         EXU       %+1,#BAL
         PEND
*
*        NOTE THAT A LIST OF INSTRUCTIONS TO EXU
*        MUST IMMEDIATELY FOLLOW THE PROC USAGE.
         PAGE                                                           TIC09040
*                                                                       TIC09050
*        THE #OUT PROCEDURE IS USED TO PRINT                            TIC09060
*        ONTO LL - TYPICALLY DURING INITIALIZATION                      TIC09070
*                                                                       TIC09080
#OUT     CNAME                                                          TIC09090
         PROC                                                           TIC09100
         LOCAL     K,L                                                  TIC09110
LF       M:PRINT   (MESS,K)                                             TIC09120
         B         L                                                    TIC09130
K        TEXTC     AF                                                   TIC09140
L        RES       0                                                    TIC09150
         PEND                                                           TIC09160
         PAGE
*
*        THE #TYPE89 PROC TYPES A MESSAGE ON THE OPERATOR'S CONSOLE.
*
*        APPENDED TO THE SUPPLIED TEXT ARE R8 AND R9 IN HEX.
*
#TYPE89  CNAME
         PROC
LF       BAL,#BAL  #TYPE89#CODE
         TEXTC     AF
         PEND
         PAGE                                                           TIC09170
*        THE #SNAP PROCEDURE IS USED DURING CHACKOUT                    TIC09180
*        TO PRINT OUT INTERESTING INFORMATION IN THE                    TIC09190
*        'OUT' FILE.  CAN BE NO-OP'ED FOR PRODUCTION.                   TIC09200
*                                                                       TIC09210
#SNAP    CNAME                                                          TIC09220
         PROC                                                           TIC09230
LF       RES       0                                                    TIC09240
         DO        DO#CHECKOUT                                          TIC09250
         #PUSH,0,15                                                     TIC09260
         LI,#ARG   CF(2)+0                                              TIC09270
         BAL,#BAL  #SNAP#CODE                                           TIC09280
         TEXTC     AF                                                   TIC09290
         #PULL,0,15                                                     TIC09300
         FIN                                                            TIC09310
         PEND                                                           TIC09320
         TITLE     'TIC - NUCLEUS'
*
*        THIS ROUTINE IS ENTERED VIA THE #SNAP PROCEDURE.               TIC09340
*        IT PRINTS THE CALLER'S MESSAGE AND THE SIXTEEN                 TIC09350
*        REGISTERS OUT ON THE 'OUT' DEVICE.                             TIC09360
*                                                                       TIC09370
         DO        DO#CHECKOUT                                          TIC09380
#SNAP#CODE RES     0                                                    TIC09390
         LI,8      1                                                    TIC09400
         SLS,8     *#ARG                                                TIC09410
         CW,8      SNAPSWITCHES        SEE IF SNAP # ENABLED.           TIC09420
         BAZ       SNAPRETURN          OVER IF NOT                      TIC09430
*                                                                       TIC09440
         M:PRINT   (MESS,PRINTCODESTAR) A SEPARATOR LINE                TIC09450
         M:PRINT   (MESS,*#BAL)        AND THE CALLER'S MESSAGE         TIC09460
*                                                                       TIC09470
*                                                                       TIC09480
*        BELOW WE CONVERT THE REGISTERS THAT WERE                       TIC09490
*        STUFFED INTO THE STACK BY THE #PRINT PROC INTO                 TIC09500
*        HEX AND PRINT THEM.  TWO LINES OF EIGHT                        TIC09510
*        REGISTERS.                                                     TIC09520
*                                                                       TIC09530
         LW,15     ='    '             SEPARATOR BETWENN REGISTERS ON   TIC09540
         LI,14     2                   NUMBER OF LINES                  TIC09550
*                                                                       TIC09560
         LW,10     #TIC#STACK          GENERATE WA OF THE PUSHED        TIC09570
         AI,10     -15                  REGISTERS IN THE STACK          TIC09580
*                                                                       TIC09590
PRINTCODENEWLINE RES 0                                                  TIC09600
         LI,4      PRINTCODEARRAY+1    RES WHERE WE BUILD LINE IMAGE    TIC09610
         LI,13     8                   NUMBER OF REGS PER LINE          TIC09620
PRINTCODENEWWORD RES 0                                                  TIC09630
         LW,7      *10                 GET A WORD TO CONVERT            TIC09640
*        CONVERT WORD IN R7 TO HEX IN                                   TIC09650
*        R8 AND R9.  USES R5 THROUGH R9.                                TIC09660
         LI,5      8                   BYTES PER WORD                   TIC09670
         LI,6      0                   CLEAR REGISTER SIX               TIC09680
         SLD,6     4                   AND SHIFT A BYTE IN              TIC09690
         LB,6      PRINTCODEBYTES,6    CONVERT IT TO HEX                TIC09700
         SLD,8     8                   SHIFT CONVERTED STRING           TIC09710
         OR,9      6                   AND INSERT NEW CHARACTER         TIC09720
         BDR,5     %-5                 CONVERT ALL EIGHT BYTES          TIC09730
*                                                                       TIC09740
         STW,8     0,4                 COPY THE CONVERTED WORD          TIC09750
         STW,9     1,4                  INTO THE LINE IMAGE             TIC09760
         STW,15    2,4                   AND ADD BLANK SEPATATOR        TIC09770
         AI,4      3                   BUMP IMAGE POINTER UP            TIC09780
         AI,10     1                   BUMP REG-IN-STACK POINTER UP     TIC09790
         BDR,13    PRINTCODENEWWORD    AND BACK FOR ANOTHER REGISTER    TIC09800
*                                                                       TIC09810
         M:PRINT   (MESS,PRINTCODEARRAY) PRINT THE LINE IMAGE           TIC09820
         BDR,14    PRINTCODENEWLINE    AND BACK FOR THE OTHER LINE      TIC09830
*                                                                       TIC09840
SNAPRETURN RES     0                                                    TIC09850
         LB,5      *#BAL               GET THE BYTE COUNT OF THE TEXTC  TIC09860
         AI,5      4                   ROUND UP AND                     TIC09870
         SLS,5     -2                  CONVERT TO WORD COUNT            TIC09880
         B         *#BAL,5             AND RETURN OVER THE TEXTC        TIC09890
*                                                                       TIC09900
*                                                                       TIC09910
*                                                                       TIC09920
PRINTCODESTAR RES  0                                                    TIC09930
         TEXTC     '*'                                                  TIC09940
*                                                                       TIC09950
PRINTCODEBYTES RES 0                                                    TIC09960
         TEXT      '0123456789ABCDEF'                                   TIC09970
*                                                                       TIC09980
PRINTCODEARRAY RES 0                                                    TIC09990
         GEN,8,24  95,'*  '                                             TIC10000
         RES       24                  NOTE WORD OF BLANKS IS PLACED    TIC10010
*                                      INTO WORD 24 OF THIS RES         TIC10020
*                                      AND THEN NOT PRINTED             TIC10030
*                                                                       TIC10040
SNAPSWITCHES GEN,32 X'FFFFFFFE'        SWITCHES ARE 0-35 RIGHT TO LEFT.
         FIN                                                            TIC10060
         PAGE
*
*        ENTERED VIA THE #TYPE89 PROC.
*
*        TYPES CALLER'S MESSAGE AND R8 & R9 TO OPERATOR.
*
#TYPE89#CODE RES   0
         #PUSH,4,12                    SAVE SOME REGISTERS.
*
         LB,5      *#BAL               GET CALLER'S TEXTC COUNT.
*
         SLS,#BAL  2                   POINT #BAL
         AI,#BAL   1                    TO TEXT.
*
         LI,4      BA(#TYPE89#BUFFER)+1
         LB,10     0,#BAL              COPY CALLER'S
         STB,10    0,4                  TEXTC TO
         AI,#BAL   1                     OUR BUFFER.
         AI,4      1
         BDR,5     %-4
*
         LI,10     ' '                 A BLANK FOLLOWS
         STB,10    0,4                  CALLER'S TEXT.
         AI,4      1
*
         LI,11     2                   TWO REGISTERS.
#TYPE89#J LI,12    8                   EIGHT HEX DIGITS EACH.
*
#TYPE89#K SCD,8    4
         LI,7      X'F'                PRINT OUT
         AND,7     9                    REGISTERS
         LB,10     HEXTABLE,7            IN HEX ...
         STB,10    0,4
         AI,4      1
         BDR,12    #TYPE89#K
*
         LI,10     ' '                 ( A BLANK
         STB,10    0,4                  SEPARATES
         AI,4      1                     REGISTERS)
         BDR,11    #TYPE89#J
*
         AI,4      -BA(#TYPE89#BUFFER)-1 COMPUTE OUR
         STB,4     #TYPE89#BUFFER         TEXTC COUNT.
*
         M:TYPE    (MESS,#TYPE89#BUFFER)
*
         AI,#BAL   3                   ROUND TO WORD FOLLOWING
         SLS,#BAL  -2                   THE CALLER'S TEXTC.
*
         #PULL,4,12                    RESTORE REGISTERS.
         B         0,#BAL               AND RETURN.
*
#TYPE89#BUFFER RES 20
         PAGE                                                           TIC10070
*        CODING WHICH HANDLES GETTING AND FREEING OF                    TIC10080
*        DYNAMIC MEMORY FOR TIC-TASKS.  REACHED BY A                    TIC10090
*        BAL FROM WITHING THE #GET#MAIN#BYTES AND                       TIC10100
*        #FREE#MAIN#BYTES PROCEDURES.                                   TIC10110
*                                                                       TIC10120
#GET#MAIN#BYTES#CODE RES 0                                              TIC10130
         AI,#ARG   0                   TEST FOR ZERO REQUEST.           TIC10140
         BEZ       0,#BAL              IMMEDIATE RETURN IF SO.          TIC10150
*                                                                       TIC10160
         #PUSH,#BAL,15                 SAVE REGISTERS                   TIC10170
         #PUSH,#ARG,#ARG                SAME A GOTOON.                  TIC10180
         #PUSH,#BAL,#BAL               SAVE CALLER'S LOCATION.          TIC10190
         LW,5      #ARG                COPY USER'S BYTE COUNT.          TIC10200
         AI,5      7+12                ROUND UP AND ADD THREE WORDS.    TIC10210
         SLS,5     -3                  CONVERT BA TO DA.                TIC10220
*                                                                       TIC10230
         BAL,#BAL  #FIND#DWS           GET THE WORDS.                   TIC10240
*                                                                       TIC10250
         AI,4      0                   SEE IF WE GOT SPACE.             TIC10260
         BEZ       GETMAINBLOCK        OUT IF DIDN'T GET SPACE.         TIC10270
*                                                                       TIC10280
         STD,4     0,4                 SAVE THE DWA & DWS.              TIC10290
*                                                                       TIC10300
         LW,#ARG   #DEV                GET DEV-TASK NUMBER              TIC10310
         SLS,#ARG  16                   AND BUILD THE                   TIC10320
         OR,#ARG   4                     BYTE POINTER                   TIC10330
         SLS,#ARG  3                      THAT WE RETURN                TIC10340
         AI,#ARG   12                      TO THE CALLER.               TIC10350
         OR,#ARG   =X'80000000'             (H.O.B. = DYNAMIC STORAGE)  TIC10360
*                                                                       TIC10370
*        NOTE THAT WE USE THE FIRST THREE WORDS OF THE AREA             TIC10380
*        THAT WE GET FROM XOS FOR OUR OWN PURPOSES:                     TIC10390
*                  WORD 0: DA OF THE BLOCK (I.E. DA(%))                 TIC10400
*                  WORD 1: NUMBER OF DOUBLEWORDS IN BLOCK.              TIC10410
*                  WORD 2:  CHECKOUT COPY OF #BAL                       TIC10420
*        WE USE WORDS 0 & 1 FOR FREEING THE BLOCK IN                    TIC10430
*        #FREE#MAIN#BYTES#CODE.  SINCE THERE WE ARE                     TIC10440
*        REFERENCING RELATIVE TO THE (WA) START OF THE                  TIC10450
*        USER'S BLOCK, THE ABOVE WORDS ARE WORDS -3, -2, & -1.          TIC10460
*                                                                       TIC10470
         #PULL,#BAL,#BAL               RESTORE CALLER'S LOCATION.       TIC10480
         SLS,4     1                   MAKE WA OF THE SPACE.            TIC10490
         STW,#BAL  2,4                 STORE #BAL FOR CHECKOUT.         TIC10500
*                                                                       TIC10510
         #PULL,#BAL,#BAL               DO NOT RESTORE #ARG.             TIC10520
         #PULL,#BAL,15                 RESTORE REGISTERS.               TIC10530
         B         0,#BAL              AND RETURN                       TIC10540
*                                                                       TIC10550
*                                                                       TIC10560
*                                                                       TIC10570
#GET#MAIN#WORDS#SPECIAL#CODE RES 0                                      TIC10580
         #PUSH,#BAL,15                 SAVE REGISTERS SAME              TIC10590
         #PUSH,#ARG,#ARG                AS GOTOON -- MUST               TIC10600
         #PUSH,#BAL,#BAL                MATCH PUSHES IN GETMAINBYTES.   TIC10610
         LI,5      3+16+1              19 MORE THAN REQUESTED & ROUND.  TIC10620
         AW,5      #ARG                INTO THE RIGHT REGISTER AND      TIC10630
         SLS,5     -1                  CONVERTED TO DOUBLEWORDS.        TIC10640
*                                                                       TIC10650
         BAL,#BAL  #FIND#DWS           GET THE SPACE.                   TIC10660
*                                                                       TIC10670
         AI,4      0                   SEE IF WE GOT SPACE.             TIC10680
         BEZ       GETMAINBLOCK         OUT IF WE DIDN'T.               TIC10690
*                                                                       TIC10700
         STD,4     0,4                 SET WORD 0 TO DA(%).             TIC10710
*                                                                       TIC10720
         LI,#ARG   X'FFFF'             CREATE A BARE WA POINTER         TIC10730
         AND,#ARG  4                    TO THE SPACE WE GOT             TIC10740
         SLS,#ARG  1                     (DA TO WA)                     TIC10750
*                                                                       TIC10760
         #PULL,#BAL,#BAL               THROW AWAY A #BAL.               TIC10770
         #PULL,#BAL,#BAL               DO NOT RESTORE #ARG.             TIC10780
         #PULL,#BAL,15                 RESTORE REGISTERS.               TIC10790
*                                                                       TIC10800
         STW,#BAL  2,#ARG              STORE #BAL FOR CHECKOUT.         TIC10810
*                                                                       TIC10820
         LCI       0                   STORE ALL THE CALLER'S REGISTERS TIC10830
         STM,0     3,#ERR               AT THE BEGINNING OF THE STOREGE TIC10840
         LW,#OWN   #ERR                RETRIEVE THE STORAGE OOINTER     TIC10850
         AI,#OWN   3+16                 ADJUST TO POINT TO CALLER'S OWN TIC10860
         B         *#BAL                 AND RETURN                     TIC10870
*                                                                       TIC10880
*                                                                       TIC10890
*                                                                       TIC10900
GETMAINBLOCK RES   0                   HERE TO WAIT FOR STORAGE.        TIC10910
         #CLEAR#ECB GETMAINECB         CLEAR ECB TO WAIT ON.            TIC10920
         #PULL,10,10                   RETRIEVE CALLER'S BAL LOC+1.     TIC10930
*                                                                       TIC10940
         #SNAP,5   'GETMAINBLOCK -- NO STORAGE'                         TIC10950
         AI,10     -1                  PUSH R10 BACK TO BAL LOCATION.   TIC10960
         LI,11     GETMAINECB          LOAD ECB POINTER.                TIC10970
*                                                                       TIC10980
*        TRICKY CODE HERE.                                              TIC10990
*                                                                       TIC11000
*        REGISTERS #BAL-15 AND #ARG ARE IN THE STACK.                   TIC11010
*        THIS IS JUST AS GOTOONCODEMAIN WANTS THEM.  BUT                TIC11020
*        THE #BAL IN THE STACK NEEDS TO BE ADJUSTED TO POINT            TIC11030
*        TO US RATHER THAN TO THE CALLER'S BAL+1.                       TIC11040
*                                                                       TIC11050
         LW,4      #TIC#STACK          POINT TO #ARG IN THE STACK.      TIC11060
         LI,5      %+3                 POINT TO US.                     TIC11070
         STW,5     #BAL-16,4           FAKE A BAL
         B         GOTOONCODEMAIN       TO GOTOON.                      TIC11090
         #EXIT                           AND EXIT.                      TIC11100
*                                                                       TIC11110
*                                                                       TIC11120
*                                                                       TIC11130
         BOUND     8                                                    TIC11140
GETMAINECB RES     2                                                    TIC11150
         PAGE                                                           TIC11160
*        HERE TO FREE THE STORE THAT IS                                 TIC11170
*        POINTED TO BY THE POINTER IN #DEV#RECORD#BA                    TIC11180
*        TABLE.  IF NO SUCH STORE, NO ERROR.  THIS ENTRY                TIC11190
*        IS NORMALLY USED TO FREE THE DYNAMIC BUFFER                    TIC11200
*        ACQUIRED BY #INITIATE#READ - AS WHEN SUCH A READ               TIC11210
*        IS FOLLOWED BY THE WRITE OF SOMETHING LOCAL.                   TIC11220
#FREE#DEV#BUFFER#CODE RES 0                                             TIC11230
         #PUSH,#BAL,8                  SAVE SOME REGISTERS.             TIC11240
*                                                                       TIC11250
         LI,#ARG   0                   CLEAR AND GET THE                TIC11260
         #T#XCA,#ARG #DEV#RECORD#BA     BUFFER POINTER.                 TIC11270
         BEZ       FREERETURN           OVER IF NONE                    TIC11280
         BGZ       FREERETURN            OVER IF NOT DYNAMIC            TIC11290
         B         FREESTORAGE         OVER TO FREE IT                  TIC11300
*                                                                       TIC11310
*                                                                       TIC11320
*                                                                       TIC11330
#FREE#MAIN#BYTES#IF#CODE RES 0
         AI,#ARG   0                   SEE IF 'DYNAMIC'.
         BGEZ      0,#BAL               IF NOT, IMMEDIATE RETURN.
*                                        IF SO, FALL THRU TO FREE BLOCK.
*
#FREE#MAIN#BYTES#CODE RES 0                                             TIC11340
         #PUSH,#BAL,8                  SAVE SOME REGISTERS.             TIC11350
FREESTORAGE RES    0                                                    TIC11360
         LI,6      X'7FFFF'            GET A CLEAN COPY                 TIC11370
         AND,6     #ARG                 OF THE CALLER'S BA.             TIC11380
         CI,6      3                   MAKE SURE EVEN WA                TIC11390
         BANZ      FREESTORAGEXX       BA WASN'T A WA.                  TIC11400
         AI,6      -12                 BACK TO START-OF-BLOCK.          TIC11410
         SLS,6     -3                  CONVERT BA TO A DA.              TIC11420
*                                                                       TIC11430
FREESTORAGEOK RES  0                                                    TIC11440
         LD,4      0,6                 RETRIEVE CHECKING INFO.          TIC11450
         CW,4      6                   ADDRESS MUST AGREE.              TIC11460
         BE        FREESTORAGEDO       OVER IF IT AGREES.               TIC11470
FREESTORAGEXX #ABORT                   TIC-TASK ABORT IF BAD ARG.       TIC11480
FREESTORAGEDO RES  0                                                    TIC11490
         BAL,#BAL  #HIDE#DWS           FREE THE DOUBLEWORDS.            TIC11500
FREERETURN RES     0                                                    TIC11510
         #POST#ECB GETMAINECB          ANNOUNCE WE FREED SOMETHING.     TIC11520
         #PULL,#BAL,8                  RESTORE SOME REGISTERS.          TIC11530
         B         0,#BAL              AND RETURN                       TIC11540
*                                                                       TIC11550
*                                                                       TIC11560
*                                                                       TIC11570
#FREE#MAIN#WORDS#SPECIAL#CODE RES 0                                     TIC11580
         #PUSH,#OWN,#OWN               SAVE POINTER TO SPACE            TIC11590
         #PUSH,#BAL,#BAL               SAVE LINKAGE REGISTER            TIC11600
         LCI       0                   RESTORE                          TIC11610
         LM,0      -16,#OWN            16 REGS                          TIC11620
         #PULL,#BAL,#BAL               RETRIEVE LINKAGE REGISTER        TIC11630
         #PULL,#ERR,#ERR               RETRIEVE STOREGE POINTER (NEW REGTIC11640
         #PUSH,#BAL,8                  SAVE SOME REGISTERS.             TIC11650
         LI,6      -3-16               CREATE THE CORRECT WA OF         TIC11660
         AW,6      #ERR                 THE STORAGE TO RELEASE          TIC11670
         SLS,6     -1                  CONVERT WA TO A DA.              TIC11680
         B         FREESTORAGEOK       AND GO RELEASE IT                TIC11690
         PAGE                                                           TIC11700
*        THIS CODE INITIATES A TAM READ FOR THE CALLER.                 TIC11710
*        CALLED BY USE OF THE '#INITIATE#READ' PROCEDURE.               TIC11720
*        THE DEVICE/LINE INFORMATION USED TO DO THE READ IS             TIC11730
*        OBTAINED FROM THE TABLES USING THE CONTENTS OF                 TIC11740
*        THE '#DEV' REGISTER.                                           TIC11750
*                                                                       TIC11760
*        (NOTE THAT ALL 'INITIATE' ROUTINES USE COMMON RETURN           TIC11770
*        AND COMMON ERROR ROUTINE AND THEREFORE IT IS IMPORTANT         TIC11780
*        THAT THEY ALL PUSH THE SAME REGISTERS AT ENTRANCE)             TIC11790
*                                                                       TIC11800
#INITIATE#READ#CODE RES 0                                               TIC11810
         #PUSH,#BAL,15                                                  TIC11820
*                                                                       TIC11830
         #T#GET,8  #DEV#RECORD#STATUS  SEE IF OUTSTANDING ERROR.        TIC11840
         BNEZ      INITIATERETURN      DO NUTTIN IF SO.                 TIC11850
*
         BAL,15    INITIATEACQUIREDCHECK MAKE SURE STATION IS ACQUIRED.
*                                                                       TIC11860
         LI,4      #CIO#REQD+#CIO#READ COPY TO TABLE                    TIC11870
         #T#PUT,4  #DEV#CURRENT#IO     WHAT WE ARE DOING                TIC11880
*                                                                       TIC11890
         #T#GET,4  #DEV#DCB#POINTER    GET POINTER TO POINTER           TIC11900
         BGZ       INITIATEREADGETDCB  OVER IF NORMAL                   TIC11910
         AI,#DEV   0                   SEE IF SERVICING A MDL-TASK      TIC11920
         BLZ       INITIATEREADGETDCB  OVER IF SO - STILL NORNAL        TIC11930
*                                                                       TIC11940
*        HERE ON CALL FROM A DEV-TASK WHOSE DCB POINTER                 TIC11950
*        INDICATES IT IS SERVICING A MULTI-DROP STATION                 TIC11960
*                                                                       TIC11970
         #T#CLEAR  #DEV#ECB            CLEAR AND
         #T#GWA,8  #DEV#ECB             POINT TO THE
         #T#PUT,8  #DEV#EVENT#PTR        STATION'S ECB.
         B         INITIATERETURN                                       TIC11990
*                                                                       TIC12000
INITIATEREADGETDCB RES 0               HERE ON NORMAL LINE              TIC12010
         LW,5      *#DCB#TABLE#IW,4    GET LOCATION OF DCB              TIC12020
*                                                                       TIC12030
         #T#GET,8  #DEV#INPUT#TRL      GET MAX TRANSFER LENGTH          TIC12040
*                                                                       TIC12050
         DO        DO#FIXEDMDLBUFFERS
         AI,#DEV   0                   SEE IF MDL-TASK
         BGZ       INITIATEREAD250     OVER IF NOT.
         #T#GET,7  #MDL#FIXED#BUFFERS  RETRIEVE BA OF MDL BUFFER.
         B         INITIATEREAD270     (IF USING FIXED ONES)
         FIN
*
INITIATEREAD250 RES 0
         LW,#ARG   8                   GET A LONG ENOUGH                TIC12060
         #GET#MAIN#BYTES                BUFFER FOR THE READ             TIC12070
         LW,7      #ARG                  COPY THE BA OF BUFFER          TIC12080
INITIATEREAD270 RES 0
         #T#PUT,7  #DEV#RECORD#BA         FOR READ AND FOR LATER        TIC12090
*                                                                       TIC12100
         #T#GWA,6  #DEV#EVENT#PTR       ARE LOADED INTO THE REGISTERS   TIC12110
*                                                                       TIC12140
         #SNAP     'IN #INITIATE#READ#CODE'                             TIC12150
         BAL,#BAL  INITIATEDCBCHECK                                     TIC12160
*                                                                       TIC12170
         SLS,7     -2                  CORRECT (BUF) TO A WA.           TIC12180
         #T#GWA,9  #DEV#ECB            GET LOCATION OF AN ECB.          TIC12190
         #T#PUT,9  #DEV#EVENT#PTR      INDICATE WE'RE USING IT.         TIC12200
*                                                                       TIC12210
         LW,#ARG   =X'80000000'        SPECIAL ECB
         STW,#ARG  *9                   CLEAN-UP.
*
         DO        DO#DEVELOPMENT                                       TIC12250
         CI,5      M:UC                                                 TIC12260
         BNE       INITIATEREAD666                                      TIC12270
         M:READ    *5,(BUF,*7),(SIZE,*8)                                TIC12280
*                                                                       TIC12290
         LI,#ARG   0                   SET 'HAPPENED' POINTER           TIC12300
         #T#PUT,#ARG #DEV#EVENT#PTR     INTO THE EXENT POINTER.         TIC12310
*                                                                       TIC12320
         B         INITIATEREADEND                                      TIC12330
INITIATEREAD666 RES 0                                                   TIC12340
         FIN                                                            TIC12350
*                                                                       TIC12360
*        NOTE THAT WE DO SLAVE COC READS AND
*        MULTI-POINT READS THRU THE SAME CAL.
*        THIS IS OK AS (AUTO) IS IGNORED
*        WHEN IT IS NOT APPLICABLE.
*
         M:READ    *5,(BUF,*7),(BTD,0),(SIZE,*8),(ECB,*9),(AUTO)        TIC12420
*                                                                       TIC12430
INITIATEREADEND RES 0                                                   TIC12440
INITIATERETURN RES 0                                                    TIC12450
         #PULL,#BAL,15                                                  TIC12460
         B         0,#BAL              AND RETURN                       TIC12470
        PAGE                                                            TIC12480
#INITIATE#WRITE#CODE RES 0                                              TIC12490
         #PUSH,#BAL,15                                                  TIC12500
*                                                                       TIC12510
         #T#GET,8  #DEV#RECORD#STATUS  SEE IF OUTSTANDING ERROR.        TIC12520
         BNEZ      INITIATERETURN      DO NUTTIN IF SO.                 TIC12530
*
         BAL,15    INITIATEACQUIREDCHECK MAKE SURE STATION IS ACQUIRED.
*                                                                       TIC12540
         LI,4      #CIO#REQD+#CIO#WRITE REMEMBER TYPE OF                TIC12550
         #T#PUT,4  #DEV#CURRENT#IO      THE INPUT/OUTPUT                TIC12560
*                                                                       TIC12570
INITIATEWRITE234 RES 0                                                  TIC12580
         #T#GET,4  #DEV#DCB#POINTER    GET POINTER TO POINTER           TIC12590
         BGZ       INITIATEWRITEGETDCB  OVER IF VERY NORMAL             TIC12600
         AI,#DEV   0                   SEE IF MULTI-DROP                TIC12610
         BLZ       INITIATEWRITEGETDCB  OVER IF NORMAL MDL              TIC12620
*                                                                       TIC12630
*        HERE ON CALL FROM A DEV-TASK WHOSE DCB POINTER                 TIC12640
*        INDICATES IT IS SERVICING A MULTI-DROP STATION                 TIC12650
*                                                                       TIC12660
         #T#CLEAR  #DEV#ECB            CLEAR AND
         #T#GWA,8  #DEV#ECB             POJNT TO THE
         #T#PUT,8  #DEV#EVENT#PTR        STATION'S ECB.
*
         #T#POST,#ARG,4 #MDL#WAKEUP#ECB WAKEUP THE MDL-TASK             TIC12680
         B         INITIATERETURN       THAT'S ALL                      TIC12690
*                                                                       TIC12700
INITIATEWRITEGETDCB RES 0              HERE ON NORMAL COURSE            TIC12710
         LW,5      *#DCB#TABLE#IW,4    GET LOCATION OF DCB              TIC12720
*                                                                       TIC12730
         #T#GWA,6  #DEV#EVENT#PTR       REQUIRED BY THE M:WRITE.        TIC12740
         #T#GET,7  #DEV#RECORD#BA        PUT THEM IN THE EXACT FORMAT   TIC12750
         #T#GET,8  #DEV#RECORD#LENGTH     AND REGISTERS THAT THE        TIC12760
*                                                                       TIC12820
         #SNAP     'IN #INITIATE#WRITE#CODE'                            TIC12830
         BAL,#BAL  INITIATEDCBCHECK                                     TIC12840
*                                                                       TIC12850
         #T#GET,11 #DEV#RECORD#BA      GET RECORD BA.                   TIC12860
         LI,10     X'7FFFF'            COPY TO R10 THE                  TIC12870
         AND,10    11                   CLEAN BA OF THE RECORD          TIC12880
         SLS,10    -2                    AND MAKE IT A WA               TIC12890
         AND,11    =X'3'                  AND BYTE-IN-WORD.             TIC12900
*                                                                       TIC12910
         #T#GET,12 #DEV#RECORD#LENGTH  GET RECORD SIZE.                 TIC12920
*                                                                       TIC12930
         #T#GWA,9  #DEV#ECB            GET LOCATION OF AN ECB.          TIC12940
         #T#PUT,9  #DEV#EVENT#PTR      INDICATE WE'RE USING IT.         TIC12950
*                                                                       TIC12960
         DO        DO#DEVELOPMENT                                       TIC12970
         CI,5      M:UC                                                 TIC12980
         BNE       INITIATEWRITE666                                     TIC12990
         M:WRITE   *5,(BUF,*10),(BTD,*11),(SIZE,*12)                    TIC13000
*                                                                       TIC13010
         LI,#ARG   0                   SET 'HAPPENED' POINTER           TIC13020
         #T#PUT,#ARG #DEV#EVENT#PTR     INTO THE EVENT POINTER.         TIC13030
*                                                                       TIC13040
         B         INITIATERETURN                                       TIC13050
*                                                                       TIC13060
INITIATEWRITE666 RES 0                                                  TIC13070
         FIN                                                            TIC13080
*                                                                       TIC13090
         LW,#ARG   =X'80000000'        SPECIAL ECB                      TIC13100
         STW,#ARG  *9                   CLEAN-UP.                       TIC13110
         M:WRITE   *5,(BUF,*10),(BTD,*11),(SIZE,*12),(ECB,*9)           TIC13120
         B         INITIATERETURN                                       TIC13130
         PAGE                                                           TIC13140
#INITIATE#WRITE#READ#CODE RES 0                                         TIC13150
         #PUSH,#BAL,15                 SAVE REGS LIKE ALL 'INITIATE'S   TIC13160
*                                                                       TIC13170
         #T#GET,8  #DEV#RECORD#STATUS  SEE IF OUTSTANDING ERROR.        TIC13180
         BNEZ      INITIATERETURN      DO NUTTIN IF SO.                 TIC13190
*
         BAL,15    INITIATEACQUIREDCHECK MAKE SURE STATION IS ACQUIRED.
*                                                                       TIC13200
         LI,4      #CIO#REQD+#CIO#WRITE+#CIO#READ SET IN TABLE          TIC13210
         #T#PUT,4  #DEV#CURRENT#IO      WHAT WE ARE DOING               TIC13220
*                                                                       TIC13230
         B         INITIATEWRITE234    AND GO DO THE WRITE.             TIC13240
         PAGE                                                           TIC13250
#CHECK#CODE RES    0                                                    TIC13260
         #PUSH,4,15                                                     TIC13270
         #PUSH,#BAL,#BAL                                                TIC13280
*                                                                       TIC13290
         #T#GET,#ERR #DEV#RECORD#STATUS SEE IF THE I/O IS ALREADY BAD   TIC13300
         BNEZ      CHECKCODEQUICKEXIT  RETURN IF I/O ALREADY BAD        TIC13310
*                                                                       TIC13320
         #T#GET,4  #DEV#DCB#POINTER    GET POINTER TO POINTER           TIC13330
         LW,5      *#DCB#TABLE#IW,4    GET LOCATION OF DCB              TIC13340
*
         AI,#DEV   0                   SEE IF STATION
         BLZ       %+3                  ON MULTI-POINT LINE.
         AI,4      0                     IF SO, DON'T DOOSTUFF
         BLZ       CHECKCODE345           DOME BY THE MDL-TASK.
*                                                                       TIC13350
         #T#GET,6  #DEV#EVENT#PTR      GET ECB LOCATION.                TIC13360
*                                                                       TIC13370
         DO        DO#DEVELOPMENT                                       TIC13380
         CI,5      M:UC                IS IT SPECIAL TS CONSOLE?        TIC13390
         BNE       CHECKCODE222        OVER IF NOT.                     TIC13400
         M:CHECK   *5,(ERR,COCLINEERR),(ABN,COCLINEABN)                 TIC13410
         B         CHECKCODE230                                         TIC13420
CHECKCODE222 RES   0                                                    TIC13430
         FIN                                                            TIC13440
*                                                                       TIC13450
         M:CHECK   *5,(ECB,*6),(INDX,13),;
                   (ERR,COCLINEERR),(ABN,COCLINEABN)
CHECKCODE230 RES   0                                                    TIC13470
*                                                                       TIC13480
*        RELEASE CORE IF APPROPRIATE.  IT IS                            TIC13490
*        APPROPRIATE IF THE CORE IS 'DYNAMIC' AND                       TIC13500
*        WAS BEING USED FOR OUTPUT:                                     TIC13510
         #T#GET,#ARG #DEV#CURRENT#IO   GET I/O TYPE.                    TIC13520
        CI,#ARG   #CIO#WRITE          WAS IT A WRITE?                   TIC13530
         BAZ       CHECKDONTFREE       OVER IF NOT.                     TIC13540
         #FREE#DEV#BUFFER              OTHERWISE FREE ANY DYN. BUFFER.  TIC13550
CHECKDONTFREE RES  0                                                    TIC13560
*                                                                       TIC13570
         LW,12     4,5                                                  TIC13580
         SLS,12    -17                 RIGHT JUSTIFY 'ARS'.             TIC13590
         #T#PUT,12 #DEV#RECORD#LENGTH  STORE CHAR COUNT OF READ         TIC13600
*
CHECKCODE345 RES   0
         LI,#ERR   0                   NEATEN FOR THE SNAP              TIC13610
CHECKCODEQUICKEXIT RES 0                                                TIC13620
         #SNAP     'IN #CHECK#CODE'                                     TIC13630
*                                                                       TIC13640
         #PULL,#BAL,#BAL                                                TIC13650
         STB,13    #BAL                COPY IND INTO #BAL FOR MDL       TIC13660
         #PULL,4,15                                                     TIC13670
         LI,#ERR   0                   CLEAR AND                        TIC13680
         #T#XCA,#ERR #DEV#RECORD#STATUS OBTAIN STATUS                   TIC13690
         BNEZ      CHECKCODEERRORRETURN OVER IF BAD.                    TIC13700
*                                                                       TIC13710
        #T#GET,#ARG #DEV#CURRENT#IO   GET I/O TYPE BITS.                TIC13720
        CI,#ARG   #CIO#REQD+#CIO#WRITE+#CIO#READ SE IF W-THEN-R.        TIC13730
        BNE       CHECKCODEGOODRETURN                                   TIC13740
*                                                                       TIC13750
*        FALL THRU ON POINT-TO-POINT WRITE-THEN-READ.                   TIC13760
*        (MULTI-POINT DOESN'T FALL THRU BECAUSE THE MDL-TASK            TIC13770
*        THAT DID THE I/O CHANGED #DEV#CURRENT#IO APPROPRIATELY.)       TIC13780
*                                                                       TIC13790
        AI,#BAL   -3                  PUSH RETURN REGISTER BACK TO      TIC13800
*                                      POINT TO THE START-1 OF          TIC13810
*                                       THE #CHECK PROC.                TIC13820
*                                                                       TIC13830
         B         #INITIATE#READ#CODE AND GO DO THE READ HALF.         TIC13840
*                                                                       TIC13850
*                                                                       TIC13860
*                                                                       TIC13870
CHECKCODEGOODRETURN RES 0                                               TIC13880
*                                                                       TIC13890
*        BEFORE RETURNING TO CALLER, IF IT WAS A READ,                  TIC13900
*        WE MUST SCAN FOR UP-ARROWS:                                    TIC13910
*                                                                       TIC13920
         #T#GET,#ARG #DEV#CURRENT#IO   GET TYPE OF I/O.                 TIC13930
         CI,#ARG   #CIO#READ           SEE IF A READ.                   TIC13940
         BAZ       CHECKCODEGOOD300    SKIP OVER UP-ARROW STUFF IF NOT. TIC13950
*
         AI,#DEV   0                   EXCEPT THAT, IF MDL READ, WE
         BLZ       CHECKCODEGOOD300     SCAN WHEN DEV-TASK COMES THRU.
*                                                                       TIC13960
         #PUSH,#BAL,8                  SINCE WE ALREADY PULLED OUR
*                                      REGISTERS FOR OUR EXIT, WE MUST  TIC13980
*                                      GO PUSH SOME TO GAIN BACK        TIC13990
*                                      REGISTERS TO WORK IN.            TIC14000
*                                                                       TIC14010
CHECKCODEGOOD110 RES 0                                                  TIC14020
*
         #T#GET,7  #DEV#RECORD#BA      DSP OF RECORD.
         AND,7     =X'7FFFF'           CLEAN BA OF RECORD.
*
CHECKCODEGOOD113 RES 0                 HERE TO CONTINUE UP-ARROW SCAN.
         #T#GET,8  #DEV#RECORD#LENGTH  GET NUMBER OF BYTES.             TIC14030
         AI,8      -2                  DON'T SCAN LAST TWO (SINCE THE   TIC14040
*                                       UP-ARROW SEQUENCES ARE THREE    TIC14050
*                                         CHARACTERS LONG).             TIC14060
         BLEZ      CHECKCODEGOOD190    IF NOT 3 BYTES, CAN'T BE SEQUENCETIC14070
*                                                                       TIC14080
         LW,6      TTBSUPARROW         TTBS WORD FOR UP-ARROW SEARCH.   TIC14120
*                                                                       TIC14130
CHECKCODEGOOD120 RES 0                                                  TIC14140
         #T#GET,8  #DEV#RECORD#BA      (CALCULATE LENGTH
         AND,8     =X'7FFFF'            OF STRING TO CHECK)
         #T#GET,#ARG #DEV#RECORD#LENGTH
         AW,8      #ARG
         SW,8      7
         AI,8      -2
         BLEZ      CHECKCODEGOOD190    (OVER IF NONE LEFT TO CHECK)
*
         TTBS678                       DO A (POSSIBLY LONG, MULTIPLE) TTTIC14150
         BCR,1     CHECKCODEGOOD190    OVER IF NONE / NO MORE.          TIC14160
*                                                                       TIC14170
         LW,5      7                   COPY BA OF UP-ARROW.             TIC14180
         AI,5      1                   TO NEXT CHARACTER.               TIC14190
         LB,4      0,5                 GET THAT CHARACTER.              TIC14200
         AI,5      1                   TO STILL NEXT CHARACTER.         TIC14210
         LB,5      0,5                 GET IT TOO.                      TIC14220
         SLS,4     8                   PUT THE TWO CHARACTERS           TIC14230
         OR,4      5                    TOGETHER FOR COMPARISON.        TIC14240
*                                                                       TIC14250
         LI,5      4                   COMPARE WITH FOUR HALFWORDS.     TIC14260
         CH,4      CHECKUPARROWGUYS,5  COMPARE.                         TIC14270
         BE        CHECKCODEGOOD150    OVER IF MATCH.                   TIC14280
         BDR,5     %-2                                                  TIC14290
*                                                                       TIC14300
*        FALL THROUGH ON NO MATCH.                                      TIC14310
*                                                                       TIC14320
         SLD,4     -8                  CREATE
         EOR,4     =X'F0'               HEX
         CI,4      X'F0'                 BYTE
         BAZ       %+2                    FROM
         AI,4      9-48                    NEXT
         STW,4     6                        TWO
         LI,4      0                         CHARS
         SLD,4     8                          WITHOUT
         EOR,4     =X'F0'                      CHECKING
         CI,4      X'F0'                        FOR
         BAZ       %+2                           ILLEGALS.
         AI,4      9-48
         SLS,6     4
         OR,6      4
*                                                                       TIC14340
         B         CHECKCODEGOOD172                                     TIC14350
*                                                                       TIC14360
*                                                                       TIC14370
*                                                                       TIC14380
CHECKCODEGOOD150 RES 0                 HERE ON FOUND MATCH WITH TABLE.  TIC14390
         B         %,5                                                  TIC14400
         B         CHECKCODEGOOD160    GO BREAK.                        TIC14410
         B         CHECKCODEGOOD160    GO BREAK.                        TIC14420
         B         CHECKCODEGOOD160    GO BREAK.                        TIC14430
         B         CHECKCODEGOOD170    GO INSERT NEW-LINE.              TIC14440
*                                                                       TIC14450
         BOUND     4                                                    TIC14460
CHECKUPARROWGUYS GEN,16 0                                               TIC14470
         GEN,16    'XX'                                                 TIC14480
         GEN,16    'AT'                                                 TIC14490
         GEN,16    'BK'                                                 TIC14500
         GEN,16    'NL'                                                 TIC14510
         BOUND     4                                                    TIC14520
*                                                                       TIC14530
*                                                                       TIC14540
*                                                                       TIC14550
CHECKCODEGOOD160 RES 0                 HERE ON UP-ARROW FOR ATTENTION.  TIC14560
         SIGNALATTENTION                                                TIC14570
*                                                                       TIC14590
*        MUST DELETE THE THREE-CHARACTER                                TIC14600
*        SEQUENCE FROM THE INPUT BUFFER.                                TIC14610
*                                                                       TIC14620
*        BA OF UP-ARROW IS IN R7.                                       TIC14630
*                                                                       TIC14640
*        R8 HAS (#CHARS AFTER UP-ARROW)-2.                              TIC14650
*                                                                       TIC14660
         LW,6      7                   'SOURCE' IS THREE                TIC14670
         AI,6      3                    PAST UP-ARROW.                  TIC14680
*                                                                       TIC14690
         LW,4      7                   REMEMBER IN R4 BA OF NEXT CHAR.
*
         LI,5      3                   COUNT OF KILLED CHARACTERS.
*
         B         CHECKCODEGOOD176    GO COMPACT THE RECORD.
*                                                                       TIC14770
CHECKCODEGOOD170 RES 0                 HERE TO INSERT A NEW-LINE.       TIC14780
         LI,6      X'15'               THE THING WE ARE TO INSERT       TIC14790
*                                                                       TIC14800
CHECKCODEGOOD172 RES 0                 HERE TO REPLACE SEQUENCE WITH RG.TIC14810
*                                                                       TIC14820
*                  BA OF UP-ARROW IS IN R7.                             TIC14830
*                                                                       TIC14840
*                  R8 HAS (#CHARS AFTER UP-ARROW)-2.                    TIC14850
*                                                                       TIC14860
         STB,6     0,7                 NEW CHAR OVER UP-ARROW.          TIC14870
*                                                                       TIC14880
         AI,7      1                   MOVE TO JUST PAST NEW CHAR.      TIC14890
*
         LW,4      7                   REMEMBER IN R4 BA OF NEXT CHAR.
*
         LW,6      7                   MOVE FROM JUST PAST              TIC14900
         AI,6      2                    THREE CHAR SEQUENCE.            TIC14910
*                                                                       TIC14920
         LI,5      2                   COUNT OF NET CHARACTERS LOST.
*
CHECKCODEGOOD176 RES 0
         #T#GET,8  #DEV#RECORD#BA      (CALCULATE LENGTH
         AND,8     =X'7FFFF'            OV STRING TO MOVE)
         #T#GET,#ARG #DEV#RECORD#LENGTH
         AW,8      #ARG
         SW,8      6
*
         MBS678                        COMPACT THE RECORD.              TIC14930
*                                                                       TIC14940
         #T#GET,8  #DEV#RECORD#LENGTH  THEN                             TIC14950
         SW,8      5                    SHORTEN
         #T#PUT,8  #DEV#RECORD#LENGTH    RECORD.                        TIC14970
*                                                                       TIC14980
         LW,7      4                   POINT TO NEXT CHAR TO DO.
         B         CHECKCODEGOOD113    AND CONTINUE SCAN.
*                                                                       TIC15030
CHECKCODEGOOD190 RES 0                                                  TIC15040
         #PULL,#BAL,8                  RESTORE UP-ARROW WORKING REGS.
CHECKCODEGOOD200 RES 0                                                  TIC15060
CHECKCODEGOOD300 RES 0                                                  TIC15070
        LI,#ARG   0                   INDICATE NO I/O HAPPENING.        TIC15080
        #T#PUT,#ARG #DEV#CURRENT#IO    IN THE TABLE.                    TIC15090
        LI,#ARG   0                   RE-SSTABLISH NO ERRORS (IN CC TOO TIC15100
         B         *#BAL               AND RETURN.                      TIC15110
*                                                                       TIC15120
*                                                                       TIC15130
*                                                                       TIC15140
CHECKCODEERRORRETURN RES 0                                              TIC15150
         DO        DO#ARESNAPS
         CI,#ARG   X'5906'             SPECIAL TEST FOR PERFECTLY
         BNE       %+3                  O.K. MOC 'ERROR' RETURN
         AI,#ARG   0                     SO WE DON'T CLUTTER
         B         0,#BAL                 UP THE TIC'S LO.
         FIN
*
         #SNAP,1   'IN #CHECK#CODE WITH AN ERROR'                       TIC15160
         AI,#ERR   0                   RESTORE THE CC                   TIC15170
         B         0,#BAL              AND RETURN TO CALLER             TIC15180
         PAGE                                                           TIC15190
*
*        SPECIAL CODE HERE TO CHECK AND SEE IF THE DCB                  TIC15200
*        IS OPEN, SINCE THAT FACT IS NOT REPORTED BACK                  TIC15210
*        TO ANY ERR/ABN EXIT:                                           TIC15220
*
INITIATEDCBCHECK RES 0                                                  TIC15230
         LW,#ARG   0,5                 OBTAIN DCB BIT WORD.             TIC15240
         CW,#ARG   =X'00200000'        IS THE DCB OPEN?                 TIC15250
         BAZ       INITIATEERROR       OUT IF NOT                       TIC15260
         B         0,#BAL              OK: BACK TO INITIATE SOMETHING   TIC15270
*
*        CODE TO ERROR ATTEMPTED I/O IF
*        THE STATION IS UNACQUIRED.
*
INITIATEACQUIREDCHECK RES 0
         #T#GET,#ARG #DEV#LINE#STATUS#BITS
         CI,#ARG   #LINE#UNACQUIRED    SEE IF ACQUIRED.
         BAZ       *15                 CONTINUE IF ACQUIRED.
*
*        FALL THRU TO GIVE X'01FF' ERROR ON UNACQUIRED.
*                                                                       TIC15280
INITIATEERROR RES  0                                                    TIC15290
         LI,#ARG   X'1FF'              DCB-NOT-OPEN 'CODE'
         #T#PUT,#ARG #DEV#RECORD#STATUS INTO STATUS WORD.
*                                                                       TIC15330
         LI,#ERR   0                   SET THE WHOLE I/O AS COMPLETE    TIC15340
         #T#PUT,#ERR #DEV#EVENT#PTR    BY SETTING THE WAIT-ECB POINTER  TIC15350
*                                                                       TIC15360
         B         INITIATERETURN                                       TIC15370
         PAGE                                                           TIC15380
*        CODE HERE HANDLES THE 'WAIT' PROCS.  THEY ARE                  TIC15390
*        JUST LIKE THE 'GOTO' PROCS FOLLOWED BY AN 'EXIT'.              TIC15400
*                                                                       TIC15410
#WAIT#ON#CODE RES  0                                                    TIC15420
         #PUSH,#BAL,15                 SAVE REGS SAME AS GOTO'S DO.     TIC15430
         #PUSH,#ARG,#ARG               SPECIAL #ARG SAVE FOR GETMAINBLOCTIC15440
*                                                                       TIC15450
         LW,10     #BAL                 GET ULTIMATE RETURN POINTER.    TIC15460
         AI,10     1                   BUMP PAST BAL-TO-EXIT IN PROC.   TIC15470
         LW,11     #ARG                COPY THE EVENT POINTER.          TIC15480
*                                                                       TIC15490
         B         GOTOONCODEMAIN      AND JOIN NORMAL GOTO PROCESSING  TIC15500
*                                                                       TIC15510
*                                                                       TIC15520
*                                                                       TIC15530
#WAIT#ON#DEVICE#CODE RES 0                                              TIC15540
         #PUSH,#BAL,15                 SAVE REGS SAME AS GOTO'S DO.     TIC15550
         #PUSH,#ARG,#ARG               SPECIAL #ARG SAVE FOR GETMAINBLOCTIC15560
*                                                                       TIC15570
         LW,10     #BAL                GET ULTIMATE RETURN POINTER.     TIC15580
         AI,10     1                   BUMP PAST BAL-TO-EXIT IN PROC.   TIC15590
         #T#GET,11 #DEV#EVENT#PTR      OBTAIN EVENT POINTER.            TIC15600
*                                                                       TIC15610
         B         GOTOONCODEMAIN      AND JOIN NORMAL GOTO PROCESSING  TIC15620
         PAGE                                                           TIC15630
#GO#TO#ON#CODE RES 0                                                    TIC15640
         #PUSH,#BAL,15                 SAVE A LOT OF REGISTERS.         TIC15650
         #PUSH,#ARG,#ARG               SPECIAL #ARG SAVE FOR GETMAINBLOCTIC15660
*                                                                       TIC15670
         STD,4     10                  COPY ARGS FAR OUT OF THE WAY.    TIC15680
         B         GOTOONCODEMAIN                                       TIC15690
*                                                                       TIC15700
*                                                                       TIC15710
#GO#TO#ON#CODE#B RES 0                 HERE ON PROC WITH ARGUMENTS      TIC15720
         AI,#BAL   2                   ADJUST TO RETURN PAST ARGS.      TIC15730
         #PUSH,#BAL,15                 SAVE A LOT OF REGISTERS.         TIC15740
         #PUSH,#ARG,#ARG               SPECIAL #ARG SAVE FOR GETMAINBLOCTIC15750
         LW,10     -2,#BAL             GET FIRST ARGUMENT.              TIC15760
         LW,11     -1,#BAL             GET SECOND ARGUMENT.             TIC15770
*                                                                       TIC15780
*                                                                       TIC15790
GOTOONCODEMAIN RES 0                                                    TIC15800
         LI,5      (#TWCE#LENGTH+1)/2  DOUBLEWORDS IN TWCE.             TIC15810
*                                                                       TIC15820
         BAL,#BAL  #FIND#DWS           GET 'TWCE' WORTH OF WORDS.       TIC15830
*                                                                       TIC15840
         AI,4      0                   SEE IF WE GOT SPACE.             TIC15850
         BEZ       -1                  ABORT IF NOT.                 ***TIC15860
*                                                                       TIC15870
         LW,#ARG   4                   GET THE (DA) ADDRESS OF THE SPACETIC15880
         SLS,#ARG  1                   DA TO WA.                        TIC15890
         STW,10    #TWCE#LOCATION,#ARG SAVE LOCATION ARG.               TIC15900
         STW,11    #TWCE#ECW,#ARG      SAVE EVENT POINTER ARG.          TIC15910
*                                                                       TIC15920
         #PULL,6,6                     RELOAD SPECIAL SAVED #ARG.       TIC15930
         STW,6     #TWCE#REGISTERS+#ARG,#ARG AND REMEMBER IT.           TIC15940
         #PULL,#BAL,15                 RELOAD THE OTHER REGISTERS.      TIC15950
         LCI       #ARG-0              REMEMBER REGISTERS               TIC15960
         STM,0     #TWCE#REGISTERS+0,#ARG BELOW #ARG.                   TIC15970
         LCI       15-#ARG             REMEMBER REGISTERS               TIC15980
         STM,#ARG+1 #TWCE#REGISTERS+#ARG+1,#ARG ABOVE #ARG.             TIC15990
*                                                                       TIC16000
         LW,6      #TIC#WAIT#CHAIN     NOW CHAIN THIS ENTRY             TIC16010
         STW,6     #TWCE#FLINK,#ARG     ONTO THE CHAIN OF               TIC16020
         STW,#ARG  #TIC#WAIT#CHAIN       WAITING TIC-TASKS.             TIC16030
*                                                                       TIC16040
*        (NOTE THAT THE NEW ENTRY IS PLACED                             TIC16050
*        AT THE FRONT OF THE TWCE CHAIN)                                TIC16060
*                                                                       TIC16070
         LW,6      6+#TWCE#REGISTERS,#ARG RESTORE REGISTER SIX.         TIC16080
         B         0,#BAL              AND RETURN TO CALLER             TIC16090
         PAGE                                                           TIC16100
*        THE #EXIT PROCEDURE RETURNS CONTROL TO THE                     TIC16110
*        TIC 'DISPATCHER' ENDING THE CURRENT INVOKATION                 TIC16120
*        OF THE TIC-TASK.                                               TIC16130
#EXIT#CODE RES     0                                                    TIC16140
         LI,#DEV   0                   SET NO-ONE RUNNING               TIC16150
         STW,#DEV  #CURRENT#PROCESS#DEV AND SET INTO LOCAL STORAGE      TIC16160
DISPATCHER RES     0                                                    TIC16170
*                                                                       TIC16180
*        FOLLOW THE WAIT CHAIN TO FIND                                  TIC16190
*        SOMETHING FOR THE TIC TO DO:                                   TIC16200
*                                                                       TIC16210
*        (THE CODE IMMEDIATELY BELOW WILL FAIL                          TIC16220
*        IF THE FORWARD POINTER IN EACH TWCE ENTRY                      TIC16230
*        IS NOT THE FIRST WORD OF THE ENTRY.  SO:)                      TIC16240
         ERROR,1,#TWCE#FLINK>0 'BAD TWCE FLINK POINTER'                 TIC16250
*                                                                       TIC16260
*                                                                       TIC16270
*                                                                       TIC16280
*        WE SCAN DOWN THE ENTIRE CHAIN OF PROCESSES                     TIC16290
*        THAT ARE WAITING, AND FOR ALL THAT HAVE THEIR EVENT            TIC16300
*        POSTED, MARK WHEM BY ZEROING OUT THE ECB POINTER.              TIC16310
*        WE DO THIS SO THAT SEVERAL TASKS CAN WAIT ON                   TIC16320
*        ONE ECB.  WITHOUT THIS MARKING, IF TASKS A AND B               TIC16330
*        WERE BOTH WAITING ON THE SAVE ECB (OF OURS) WE                 TIC16340
*        WOULD GET INTO THE FOLLOWING PROBLEM:  TASK A                  TIC16350
*        AND TASK B ARE WAITING; THE EVENT OCCURS; TASK                 TIC16360
*        A IS ACTIVATED AND RUNS AND RESETS THE ECB; TASK               TIC16370
*        A RETURNS TO DISPATCHER; DISPATCHER LOOKS AND                  TIC16380
*        FINDS IT SHOULDN'T RUN TASK B.                                 TIC16390
*                                                                       TIC16400
         LI,9      0                   A ZERO FOR ZEROING BELOW         TIC16410
         LI,6      #TIC#WAIT#CHAIN     SET OT SCAN CHAIN                TIC16420
SCANCHAIN RES      0                                                    TIC16430
         LW,6      #TWCE#FLINK,6       GET A CHAIN ENTRY                TIC16440
         BEZ       SCANDONE            OVER IF AT END OF CHAIN          TIC16450
         LW,7      #TWCE#ECW,6         GET EVENT POINTER                TIC16460
         CI,7      X'1FFFF'            IS IT ALREADY ZERO               TIC16470
         BAZ       SCANCHAIN           YES, PROCESS NEXT                TIC16480
         LW,8      0,7                 NO, GET THE ECB                  TIC16490
         BGEZ      SCANCHAIN           BACK IF NOT POSTED.              TIC16500
         STW,9     #TWCE#ECW,6         YES, ZERO ECW POINTER            TIC16510
         B         SCANCHAIN           AND BACK                         TIC16520
SCANDONE RES       0                                                    TIC16530
*                                                                       TIC16540
*                                                                       TIC16550
*                                                                       TIC16560
         LI,6      #TIC#WAIT#CHAIN     SET TO START THE CHAIN           TIC16570
AGAINCHAIN RES     0                                                    TIC16580
         LW,5      6                   REMEMBER POINTER TO THIS ENTRY   TIC16590
         LW,6      #TWCE#FLINK,6       GET A CHAIN ENTRY                TIC16600
         BEZ       MUSTWAIT            OUT IF AT END                    TIC16610
*                                                                       TIC16620
         LW,7      #TWCE#ECW,6         GET EVENT POINTER OF ENTRY       TIC16630
         CI,7      X'1FFFF'            IS POINTER ZERO; IF SO THE       TIC16640
         BAZ       SOMETHINGTODO       EVENT HAS HAPPENED (BY DEFINE)   TIC16650
*                                                                       TIC16660
         LW,8      0,7                 OTHERWISE, GET THE ECB           TIC16670
         CW,8      =X'40000000'        SEE IF IT IS SET TO HAPPENED     TIC16680
         BANZ      SOMETHINGTODO       IF SO, GO DO IT                  TIC16690
*                                                                       TIC16700
         B         AGAINCHAIN                                           TIC16710
*                                                                       TIC16720
MUSTWAIT RES       0                                                    TIC16730
DISPCREATEMWAIT RES 0                                                   TIC16820
         LI,10     0                   TO COUNT ECBS IN                 TIC16830
         LI,11     0                   TO COUNT DEV-TASK ECBS IN.
         LI,6      #TIC#WAIT#CHAIN     SCAN DOWN THE CHAIN              TIC16840
DISPCOUNTNEXT LW,6 #TWCE#FLINK,6        AND JUST COUNT TO SEE           TIC16850
         BEZ       DISPCOUNTED           HOW MANY ECBS WE WILL          TIC16860
*
         AI,10     1                   YES: COUNT IT                    TIC16870
*
         MTW,0     #TWCE#REGISTERS+#DEV,6 SEE IF A DEV-TASK.
         BLEZ      DISPCOUNTNEXT       COUNTINUE ECB COUNT IF NOT.
         AI,11     1                   OR BUMP DEV-TASK COUNT
         B         DISPCOUNTNEXT        AND CONTINUE COUNTING           TIC16880
*                                                                       TIC16890
*                                      WHEN WE GET HERE WE HAVE         TIC16900
*                                      A COUNT OF HOW MANY ECBS         TIC16910
*                                      WE WILL BE WAITING ON IN R10.    TIC16920
DISPCOUNTED RES    0                                                    TIC16960
         AI,11     0                   SEE IF ANY DEV-TASKS.
         BGZ       DISPCOUNTEDSOME     OVER IF ARE SOME
         #SNAP,10  'ABOUT TO M:EXIT'   IF NOT, EVERYONE X'ED.
         M:EXIT                        SO TIC IS DONE.
*
DISPCOUNTEDSOME RES 0
         CW,10     ECBLISTMAXSIZE      SEE IF SOMEHOW TOO MANY
         BG        -1                  ABORT IF SO.
*
         LW,5      ECBLISTWA           GET WHERE TO PUT ECB POINTERS.
*                                                                       TIC16980
*                                      HAVING GOTTEN THE SPACE, WE      TIC16990
*                                      RE-SCAN THE CHAIN AND PUT        TIC17000
*                                      THE ECB POINTERS INTO            TIC17010
*                                      THE SPACE:                       TIC17020
*                                                                       TIC17030
         LW,4      5                   PTR TO WHERE ECB PTRS GO         TIC17040
         LI,6      #TIC#WAIT#CHAIN     START                            TIC17050
DISPCREATENEXT LW,6 #TWCE#FLINK,6       DOWN                            TIC17060
         BEZ       DISPCREATED           CHAIN                          TIC17070
         LW,7      #TWCE#ECW,6         GET ECB POINTER                  TIC17080
         STW,7     0,4                 STORE XOS ECB PTR INTO LIST      TIC17090
         AI,4      1                   BUMP THE LIST POINTER            TIC17100
         B         DISPCREATENEXT                                       TIC17110
*
*
*
DISPCREATED RES    0                                                    TIC17120
         M:CHECKECB (ECBL,*5,*10),(TIME,50)
         #POST#ECB #TIMESUP#ECB        (TO AWAKE INDEFINITE WAITERS)
         B         DISPATCHER                                           TIC17150
         PAGE                                                           TIC17180
*                                                                       TIC17190
*                                                                       TIC17200
*                                                                       TIC17210
SOMETHINGTODO RES  0                                                    TIC17220
         LW,9      #TWCE#FLINK,6        MOVE FORWARD POINTER TO         TIC17230
         STW,9     #TWCE#FLINK,5        POINT AROUND THIS ENTRY         TIC17240
*                                                                       TIC17250
         #PUSH,6,6                     SAVE ENTRY POINTER               TIC17260
         LCI       0                   RESTORE ALL THE                  TIC17270
         LM,0      #TWCE#REGISTERS,6    QUEUED REGISTERS                TIC17280
*
         #PULL,#BAL,#BAL               RETRIEVE ENTRY POINTER (INTO #BAL
         #PUSH,#ARG,#ARG               REMEMBER TASK'S #ARG.
         LW,#ARG   #BAL                COPY POINTER TO #ARG.
         LW,#BAL   #TWCE#LOCATION,#ARG RETRIEVE WHERE TO GO TO.
*
         #SNAP     'IN DISPATCHER AT SOMETHINGTODO'                     TIC17320
*                                                                       TIC17330
         #PUSH,0,15                    SAVE REGS (INCLUDING BAD #ARG)
         LW,4      #ERR                COPY ADDRESS OF SPACE.           TIC17350
         SLS,4     -1                  (WA TO DA)                       TIC17360
         LI,5      (#TWCE#LENGTH+1)/2  HOW MANY DW WE GOT.              TIC17370
         BAL,#BAL  #HIDE#DWS           RETURN THAT MANY.                TIC17380
*
         #PULL,0,15                    RESTORE REGS (INCLUDING BAD #ARG)
         #PULL,#ARG,#ARG               RESTORE TASK'S #ARG.
*                                                                       TIC17400
         STW,#DEV  #CURRENT#PROCESS#DEV REMEMBER WHO IS RUNNING         TIC17410
         B         0,#BAL              BRANCH TO WHERE WE SHOULD        TIC17420
         TITLE     'TIC - TABLES'
*
*        THE TIC-STACK IS DEFINED HERE.  IT IS USED                     TIC17520
*        BY MEANS OF THE #PUSH AND #PULL PROCEDURES.                    TIC17530
*        NOTE THAT A TIC-TASK CANNOT HAVE ENTRIES IN THE                TIC17540
*        STACK WHEN IT DOES AN #EXIT, EITHER EXPLICIT                   TIC17550
*        OR IMPLICIT (AS IN #CHECK).                                    TIC17560
*                                                                       TIC17570
         BOUND     8                                                    TIC17580
#TIC#STACK RES     0                                                    TIC17590
         GEN,32    #TIC#STACK#RES
         GEN,16,16 50,0
#TIC#STACK#RES RES 50
         PAGE                                                           TIC17630
*        THE TIC WAIT-CHAIN IS THE CHAIN THAT ALL TIC-TASKS THAT        TIC17640
*        ARE (OR WERE SHORTLY AGO) WAITING FOR SOMETHING                TIC17650
*        TO HAPPEN FIND THEMSELVES.  WHENEVER A TIC-TASK                TIC17660
*        GIVES UP THE CPU (BY DOING AN #EXIT), THIS                     TIC17670
*        CHAIN IS SEARCHED FOR SOMEONE WHO IS                           TIC17680
*        WAITING FOR AN EVENT THAT HAS OCCURRED.                        TIC17690
*                                                                       TIC17700
*        IF SUCH AN ENTRY IS FOUND, IT IS REMOVED FROM                  TIC17710
*        THE CHAIN AND CONTROL IS DISPATCHED TO WHERE                   TIC17720
*        THE ENTRY INDICATES.  OTHERWISE, THE TIC-EXECUTIVE             TIC17730
*        GOES INTO A WAIT (AN XOS WAIT) ON THE EVENTS IN THE            TIC17740
*        CHAIN THAT ARE XOS EVENTS PLUS ANY EXEC-LOCAL EVENTS           TIC17750
*        (E.G. WAITS ON MULTIDROP LINES).                               TIC17760
*                                                                       TIC17770
*        THE ENTRIES IN THIS CHAIN ARE TWENTY WORDS LONG -- WORDS       TIC17780
*        OBTAINED FROM DYNAMIC MEMORY.  THE FIRST WORD OF EACH          TIC17790
*        ENTRY POINTS TO THE NEXT.  THE END IS INDICATED                TIC17800
*        BY A ZERO POINTER VALUE.                                       TIC17810
*                                                                       TIC17820
*        THE CHAIN BEGINS AT THE FOLLOWING WORD:                        TIC17830
*                                                                       TIC17840
#TIC#WAIT#CHAIN DATA 0                                                  TIC17850
*                                                                       TIC17860
*                                                                       TIC17870
*                                                                       TIC17880
*        THE ENTRIES CHAINED ON THIS CHAIN ARE KNOWN AS                 TIC17890
*        TIC-WAIT-CHAIN-ENTRIES, OR TWCE'S.  THE CONTENT OF AN ENTRY    TIC17900
*        IS DEFICED SYMBOLICALLY BELOW:                                 TIC17910
*                                                                       TIC17920
#TWCE#FLINK EQU    0                    POINTER TO NEXT TWCE OR ZERO    TIC17930
#TWCE#LOCATION EQU 2                   LOCATION TO GO TO ON EVENT       TIC17940
#TWCE#ECW EQU      3                   EVENT POINTER                    TIC17950
#TWCE#REGISTERS EQU 4                  SIXTEEN SAVED REGISTERS          TIC17960
#TWCE#LENGTH EQU   20                   LENGTH OF A TWCE                TIC17970
         PAGE                                                           TIC17980
*                                                                       TIC17990
*        LOCAL STORAGE USED BY THE TIC NUCLEUS                          TIC18000
*                                                                       TIC18010
#CURRENT#PROCESS#DEV DATA              0                                TIC18020
*                                                                       TIC18030
*                                                                       TIC18040
*                                                                       TIC18050
         DO        DO#DEVELOPMENT
#FQM#CHAIN DATA    0                   CHAIN OF IN-CORE FQM'S           TIC18060
         FIN
*                                                                       TIC18070
*                                                                       TIC18080
*                                                                       TIC18090
@TFD@CHAIN DATA    0                    IN-CORE TFD CHAIN HEAD          TIC18100
*                                                                       TIC18110
*                                                                       TIC18120
*                                                                       TIC18130
#MESSAGE#CHAIN DATA 0                  CHAIN OF PENDING MESSAGES.       TIC18140
*                                                                       TIC18150
*                                                                       TIC18160
*                                                                       TIC18170
#BIGGEST#TIC#TASK DATA 5               CONTROLS DO-LOOPS THRU #DEV TABLETIC18180
#BIGGEST#MDL#TASK DATA 0               (WILL HOLD MDL-TASK #, IE NEGATIVTIC18190
*                                                                       TIC18200
*                                                                       TIC18210
*                                                                       TIC18220
*                                                                       TIC18230
#X#ED    DATA      0                   ON IF OPERATIR 'X'.              TIC18240
*
*
*                                                                       TIC18250
ECBLISTWA DATA     0                   LOCATION AND LENGTH OF
ECBLISTMAXSIZE DATA 0                   WHERE TO BUILD ECB LIST.
*                                                                       TIC18260
*
*
         BOUND     4                                                    TIC18270
#INFOBLOCK#TFDI RES 0                                                   TIC18280
#TFDI#GRANULE#KEY#CHAIN DATA 0                                          TIC18290
         DATA       17                                                  TIC18310
*                                                                       TIC18320
*                                                                       TIC18330
*                                                                       TIC18340
         BOUND     4                                                    TIC18350
#INFOBLOCK#STAI RES 0                                                   TIC18360
#STAI#GRANULE#KEY#CHAIN DATA 0                                          TIC18370
          DATA      8                                                   TIC18390
*                                                                       TIC18400
*                                                                       TIC18410
*                                                                       TIC18420
         BOUND      4                                                   TIC18430
#INFOBLOCK#DELI RES 0                                                   TIC18440
#DELI#GRANULE#KEY#CHAIN DATA 0         CHAIN-OF-KEYS HEAD.              TIC18450
         DATA      8                    CHAR COUNT OF 'KEYS' OF RECORD. TIC18470
*                                                                       TIC18480
*                                                                       TIC18490
*                                                                       TIC18500
*                                                                       TIC18510
*                                                                       TIC18520
*                                                                       TIC18530
         BOUND     8                                                    TIC18540
#NET#ECB GEN,32    X'30000000'
         GEN,32    0                                                    TIC18560
*
*
*
         BOUND     8
#TIMESUP#ECB GEN,32 X'30000000'
         GEN,32    0
*
*
*
         DO        DO#GATEOBTAININTERNAL
         BOUND     8
GATEOBTAININTERNALECB DATA X'80000000'
                      DATA 0
GATEOBTAININTERNALCOUNT DATA 0
         FIN
*                                                                       TIC18570
*                                                                       TIC18580
*                                                                       TIC18590
         DO        DO#CHECKOUT
#TS#TEST DATA      1                   ZERO IF SPECIAL ON-LINE CHECKOUT.TIC18600
         FIN
         PAGE                                                           TIC18610
*        TIC TABLES EXIST HERE FOR CHECKOUT.  EVENTUALLY THEY           TIC18620
*        WILL BE BUILT IN DYNAMIC MENORY BY TIC-INIT.                   TIC18630
*                                                                       TIC18640
         BOUND     4                                                    TIC18650
#DEV#RECORD#BA#IW  GEN,32 %+1
         DO        DO#DEVELOPMENT
         GEN,32    0                   ZERO'TH ENTRY                    TIC18690
         GEN,32    0                   STATION #1                       TIC18700
         FIN
*                                                                       TIC18780
         BOUND     4                                                    TIC18790
#DEV#RECORD#LENGTH#IW GEN,32 %+1
         DO        DO#DEVELOPMENT
        GEN,32    0                   ZERO'TH ENTRY                     TIC18830
         GEN,32    0                   STATION #1                       TIC18840
         FIN
*                                                                       TIC18890
         BOUND     4                                                    TIC18900
#DEV#RECORD#STATUS#IW GEN,32 %+1
         DO        DO#DEVELOPMENT
         GEN,32    0                   ZERO'TH ENTRY                    TIC18940
         GEN,32    0                   STATION #1                       TIC18950
         FIN
*                                                                       TIC18960
         BOUND     4                                                    TIC18970
#DEV#EVENT#PTR#IW  GEN,32 %+1
         DO        DO#DEVELOPMENT
         GEN,32    0                   ZERO'TH ENTRY                    TIC19010
         GEN,32    0                   STATION #1                       TIC19020
         FIN
*                                                                       TIC19080
         BOUND     4                                                    TIC19090
#DEV#COMMAND#LINE#RECORD#BA#IW GEN,32 %+1                               TIC19100
         DO        DO#DEVELOPMENT
         DATA      0                   ZERO'TH ENTRY.                   TIC19110
         DATA      0                   STATION #1                       TIC19120
         FIN
*                                                                       TIC19130
         BOUND     4                                                    TIC19140
#DEV#COMMAND#LINE#RECORD#LENGTH#IW GEN,32 %+1                           TIC19150
         DO        DO#DEVELOPMENT
         GEN,16    0                   ZERO'TH ENTRY                    TIC19160
         GEN,16    0                   STATION #1                       TIC19170
         FIN
*                                                                       TIC19230
         BOUND     4                                                    TIC19240
#DEV#DCB#POINTER#IW GEN,32 %+1                                          TIC19250
         DO        DO#DEVELOPMENT
         GEN,16    0                   THE XERO'TH ENTRY                TIC19260
         GEN,16    1                   110 BAUD LINE                    TIC19270
         FIN
*                                                                       TIC19280
         BOUND     4                                                    TIC19290
#DEV#CURRENT#IO#IW GEN,32 %+1                                           TIC19300
         DO        DO#DEVELOPMENT
         GEN,8     0                   ZERO'TH ENTRY                    TIC19310
         GEN,8     0                   STATION #1                       TIC19320
         FIN
*                                                                       TIC19330
*        BITS IN THE ABOVE TABLE ARE AS FOLLOWS:                        TIC19340
#CIO#REQD EQU      16                                                   TIC19350
#CIO#INIT EQU      32                                                   TIC19360
#CIO#COMP EQU      64                                                   TIC19370
#CIO#WRITE EQU     1                                                    TIC19380
#CIO#READ EQU      2                                                    TIC19390
#CIO#WANDR EQU     3                                                    TIC19400
#CIO#ATTN EQU      8                                                    TIC19410
*                                                                       TIC19420
         BOUND     4                                                    TIC19430
#MDL#WAKEUP#ECB#IW GEN,32 -100
*                                                                       TIC19480
         BOUND     4                                                    TIC19490
#MDL#FIXED#BUFFERS#IW GEN,32 -100
*                                                                       TIC19540
         BOUND     4                                                    TIC19550
#DEV#INPUT#TRL#IW  GEN,32 %+1
         DO        DO#DEVELOPMENT
         GEN,16    0                   ZERO'TH ENTRY                    TIC19590
         GEN,16    80                  STATION #1                       TIC19600
         FIN
*                                                                       TIC19610
         BOUND     4                                                    TIC19620
#DEV#OUTPUT#TRL#IW GEN,32 %+1
         DO        DO#DEVELOPMENT
         GEN,16    0                   ZERO'TH ENTRY                    TIC19660
         GEN,16    80                  STATION #1                       TIC19670
         FIN
*                                                                       TIC19680
         BOUND     4                                                    TIC19690
#DEV#LINE#IDENTIFIER#IW GEN,32 %+1                                      TIC19700
         DO        DO#DEVELOPMENT
         GEN,32    0                   ZERO'TH ENTRY                    TIC19710
         GEN,32    'C000'              STATION #1                       TIC19720
         FIN
*                                                                       TIC19730
         BOUND     4                                                    TIC19740
#DEV#MULTIPOINT#INDEX#IW GEN,32 -100                                    TIC19750
*                                      (NO TS TESTING OF MDL'S)         TIC19760
*                                                                       TIC19770
         BOUND     4                                                    TIC19780
#DEV#LOGON#BLOCK#IW GEN,32 %+1                                          TIC19790
         DO        DO#DEVELOPMENT
         GEN,32    0                   ZERO'TH STATION                  TIC19800
         GEN,32    0                   STATION #1                       TIC19810
         FIN
*                                                                       TIC19820
*        VALUES IN #DEV#DOING ENTRY:                                    TIC19822
*                                                                       TIC19823
#DOING#ACCEPT      EQU 3                                                TIC19824
#DOING#REPORT      EQU 4                                                TIC19825
*
*
*
          BOUND     4                                                   TIC19830
#DEV#STATION#TYPE#IW GEN,32 %+1                                         TIC19840
         DO        DO#DEVELOPMENT
         GEN,16     0                   ZERO'TH ENTRY                   TIC19850
         GEN,16    'XX'                                                 TIC19860
         FIN
*                                                                       TIC19870
         DO        HOWMANYXMITSBREAK>1
         BOUND     4
#DEV#XMIT#COUNT#IW GEN,32 %+1
         DO        DO#DEVELOPMENT
         GEN,8     0
         GEN,8     0
         FIN
         FIN
*
         BOUND     4
#DEV#ECB#IW GEN,32 %+1                                                  TIC19900
         DO        DO#DEVELOPMENT
         GEN,64     0                  ZERO'TH ENTRY                    TIC19910
         GEN,64     0                  STATION #1                       TIC19920
         FIN
*                                                                       TIC19930
        BOUND     4                                                     TIC19940
#DEV#LINE#STATUS#BITS#IW GEN,32 %+1                                     TIC19950
         DO        DO#DEVELOPMENT
         GEN,16    0
         GEN,16    0
         FIN
*                                                                       TIC19980
*        BITS IN ABOVE TABLE:                                           TIC19990
*                                                                       TIC20000
#LINE#UNACQUIRED EQU 1                                                  TIC20010
#LINE#MESSAGED EQU 2                                                    TIC20020
#LINE#REGULATED EQU 4                                                   TIC20030
#LINE#ATTENTION EQU 8                                                   TIC20040
#LINE#AWAITING#ATTENTION EQU 16                                         TIC20050
#LINE#AWAITING#REPORT EQU 32                                            TIC20060
#LINE#AWAITING#ACQUIRE EQU 64          ON IF I/O ERROR TABLED THE LINE.
#LINE#CANNOT#OUTPUT EQU 128            ON IF INPUT-ONLY.
#LINE#CANNOT#INPUT EQU 256             ON IF OUTPUT-ONLY.
*
*
*
         BOUND     4
#DEV#TYPE#INDEX#IW GEN,32 %+1
         DO        DO#DEVELOPMENT
         GEN,8     0
         GEN,8     0
         FIN
*
*        VALUES IN ABOVE TABLE:
*
#DEV#TYPE#INDEX#OWNCODE EQU 1
#DEV#TYPE#INDEX#UNIT#RECORD EQU 2
#DEV#TYPE#INDEX#TTY EQU 3
#DEV#TYPE#INDEX#3270 EQU 4
#DEV#TYPE#INDEX#BIGGEST EQU 4
*                                                                       TIC20070
*                                                                       TIC20080
*                                                                       TIC20090
         BOUND     4                                                    TIC20100
#DEV#REGULATION#IW GEN,32 %+1                                           TIC20110
         DO        DO#DEVELOPMENT
         GEN,8     0                   ZERO'TH ENTRY                    TIC20120
         GEN,8     0                   STATION #1                       TIC20130
         FIN
*                                                                       TIC20140
*        BITS IN ABOVE TABLE:                                           TIC20150
*                                                                       TIC20160
#REGULATE#QUESTION EQU 1                                                TIC20170
#REGULATE#AT       EQU 2                                                TIC20180
#REGULATE#CRUNCH   EQU 4                                                TIC20190
*                                                                       TIC20200
*                                                                       TIC20210
*                                                                       TIC20220
         BOUND     4                                                    TIC20230
#DCB#TABLE#IW GEN,32 %+3                                                TIC20240
         DO        DO#DEVELOPMENT
         GEN,32    0                   MDL LINE #2                      TIC20250
         GEN,32    0                   MDL LINE #1                      TIC20260
         GEN,32    0                   ZERO'TH ENTRY                    TIC20270
         GEN,32    M:UC                DCB #1                           TIC20280
         FIN
*                                                                       TIC20290
*                                                                       TIC20300
*                                                                       TIC20310
USECT    SET       %                                                    TIC20320
F:TFDX   DSECT     1                                                    TIC20330
F:TFDX   M:DCB     (FILE),(CONSEC),(SEQUEN),(IN)                        TIC20340
F:TICI   DSECT     1
         DO        DO#UTS
F:TICI   M:DCB     (FILE,'TICTICI'),(RANDOM),(OUTIN),(ECB)
         ELSE
F:TICI   M:DCB     (FILE,'TICTICI'),(RANDOM),(OUTIN)
         FIN
F:STAX   DSECT     1                                                    TIC20420
F:STAX   M:DCB     (FILE),(CONSEC),(SEQUEN),(IN)                        TIC20430
F:STAK   DSECT     1                                                    TIC20460
F:STAK   M:DCB     (FILE,'RMASTAK'),(KEYED),(DIRECT),(OUTIN)            TIC20470
F:DELX   DSECT     1                                                    TIC20480
F:DELX   M:DCB     (FILE),(CONSEC),(SEQUEN),(IN)                        TIC20490
F:MYSI   DSECT     1                                                    TIC20520
F:MYSI   M:DCB     (FILE,'RMAMYSI'),(CONSEC),(SEQUEN),(OUTIN)           TIC20530
F:JRNL   DSECT     1                                                    TIC20540
F:JRNL   M:DCB     (FILE),(CONSEC),(SEQUEN),(OUT),(SAVE)
         USECT     USECT                                                TIC20560
         PAGE                                                           TIC20570
*                                                                       TIC20580
*        TABLE USED IN CONNECTION WITH TIBS INSTRUCTION.                TIC20590
*                                                                       TIC20600
I        DO        255                                                  TIC20610
TTBSLIST(I) SET    0                                                    TIC20620
         FIN                                                            TIC20630
*                                                                       TIC20640
*        RIGHT-MOST BIT IS USED FOR FINDING UP-ARROWS:                  TIC20650
*                                                                       TIC20660
TTBSLIST(X'6A') SET TTBSLIST(X'6A')+1                                   TIC20670
*                                                                       TIC20680
*        WORD TO LOAD FOR UP-ARROW SEARCH:                              TIC20690
*                                                                       TIC20700
TTBSUPARROW GEN,8,24 1,BA(TTBSTABLE)                                    TIC20710
*                                                                       TIC20720
*                                                                       TIC20730
*                                                                       TIC20740
         BOUND     4                                                    TIC20750
TTBSTABLE GEN,8    0                                                    TIC20760
I        DO        255                                                  TIC20770
         GEN,8     TTBSLIST(I)                                          TIC20780
         FIN                                                            TIC20790
         TITLE     'TIC - LINE ERRORS'
*                                                                       TIC20810
*                                                                       TIC20820
TAMERR   RES       0                                                    TIC20830
TAMABN   RES       0                                                    TIC20840
COCLINEERR RES     0                                                    TIC20850
COCLINEABN RES     0                                                    TIC20860
MOCLINEERR RES     0                                                    TIC20870
MOCLINEABN RES     0                                                    TIC20880
*                                                                       TIC20890
         CW,#DEV   #CURRENT#PROCESS#DEV SEE IF #DEV IS VALID            TIC20900
         BNE       %                   ABORT TIC IF NOT.
*                                                                       TIC20930
         #T#GET,9  #DEV#RECORD#STATUS  SEE IF PREVIOUS ERROR.           TIC20940
         BNEZ      TAMABNRETURN         OVER IF SO                      TIC20950
*                                                                       TIC20960
         LW,9      10                  COPY SUB-CODE
         SLS,9     8                   ALIGN SUB-CODE
         SLS,9     -9                   INTO SECOND BYTE.
         SCS,10    8                   COPY CODE
         STB,10    9                    INTO FIRST BYTE.
         SCS,10    24                    (AND RESTORE R10)
         SLS,9     -16                 RIGHT JUSTIFY.
         #T#PUT,9  #DEV#RECORD#STATUS   AND STORE IT.
*                                                                       TIC20990
TAMABNRETURN RES   0                                                    TIC21000
         B         *8                  AND BACK.                        TIC21010
         TITLE     'TIC - MULTI-POINT LINE TASK'
*                                                                       TIC21050
#MDL#BEGIN 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
         #WAIT#ON#DEVICE                WAIT AND THEN                   TIC21150
         #CHECK#READ MDLTASKREADERROR  AND CHECK                        TIC21160
*                                                                       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,4      #BIGGEST#TIC#TASK   START DO-LOOP                    TIC21260
MDLTASKLOOKREAD RES 0                                                   TIC21270
         #T#GET,8,4 #DEV#DCB#POINTER   LOOP HERE TO FIND OUT            TIC21280
         CW,8      #DEV                 WHICH STATION STTISFIED         TIC21290
         BNE       MDLTASKBDR2002        THE READ.  IF IT IS THE        TIC21300
         #T#GET,9,4 #DEV#MULTIPOINT#INDEX RIGHT STATION, BOTH           TIC21310
         CW,9      10                       ITS DCB POINTER AND         TIC21320
         BE        MDLTASKFOUNDREAD          'IND' MATCH.               TIC21330
MDLTASKBDR2002 BDR,4 MDLTASKLOOKREAD                                    TIC21340
*                                                                       TIC21350
*        FALL THROUGH IF THE READ WE RECEIVED IS NOT FROM               TIC21360
*        A STATION THAT THE TABLES INDICATE.  THIS IS AN                TIC21370
*        IMPOSSIBILITY:                                                 TIC21380
         #ABORT                                                         TIC21390
*                                                                       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
         B         MDLTASKSEEIFWRITE   OVER 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
*                                                                       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
*                                                                       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
*                                                                       TIC23060
MDLTASKREADERROR RES 0                                                  TIC23070
MDLTASKWRITEERROR RES 0
         LW,9      #ARG                COPY ERR/ABN CODE/SUBCODE.
*
         #FREE#DEV#BUFFER              GIVE UP BUFFER SPACE.
*
         CI,9      X'5906'             IS IT HALTED POLLED READ.
         BE        MDLTASKENDOFLIST    IF SO, OUT NORMALLY              TIC23090
         CI,9      X'590C'             IS IT CLERK HIT XMIT DURING WRITE
         BE        MDLTASKPOLLEDREAD   IF SO, TRY TO READ.
         CI,9      X'01FF'             SEE IF FREED.
         BE        MDLTASK9185         NO MESSAGE IF SO.
*                                                                       TIC23100
         #SNAP,30  'MDL-TASK I/O ERROR'
         LI,8      0                   ABS VALUE OF
         SW,8      #DEV                 MDL-TASK NUMBER.
         #TYPE89   'MULTI-POINT I/O ERROR - LINE AND CODE:' TYPED.
MDLTASK9185 RES    0
         #T#GET,10 #DEV#LINE#STATUS#BITS
         OR,10     =#LINE#AWAITING#ACQUIRE
         #T#PUT,10 #DEV#LINE#STATUS#BITS
*
MDLTASK9200 RES    0
         #T#CLEAR,#ARG #DEV#ECB        WAIT FOR THE
         #T#GWA,#ARG #DEV#ECB           OPERATOR TO DO
         #WAIT#ON                         SOMETHING TO US.
*
         #T#GET,10 #DEV#LINE#STATUS#BITS
         CI,10     #LINE#AWAITING#ACQUIRE
         BANZ      MDLTASK9200
*
         B         MDLTASKPOLLEDREAD
         PAGE                                                           TIC23140
#TIC#BEGIN RES     0                                                    TIC23150
*
*
*
*        HERE WHEN COMPLETELY DONE WITH THE
*        'INITIALIZATION' SECTION OF CODE.  SO
*        WE GIVE IT TO THE MEMORY MANAGER.
*
         LI,4      DA(#INIT#SECTION#TWO#FWA+1)  GIVE REST OF
         LI,5      DA(#INIT#SECTION#TWO#LWA-1);  INITIALIZATION
                   -DA(#INIT#SECTION#TWO#FWA+1)-1 BACK FOR DYN STORAGE.
         BAL,#BAL  #HIDE#DWS           GIVE THE SPACE TO MEMORY MANAGER.
*
         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      #MDL#BEGIN          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 - OPCOM INTERFACE'
*                                                                       TIC23820
#TIC#INT RES       0                                                    TIC23830
         LW,7      1                   COPY POINTER TO THE PDD.         TIC23850
         LW,2      *0                  GET CURRENT STACK POINTER.       TIC23860
         LW,8      0,2                 AND GET -1 OR LINEID FROM END.   TIC23870
         CI,8      -1                  SEE IF -1 = OPERATOR INTERRUPT.  TIC23880
         BE        TICINTOPERATOR      OVER IF SO.                      TIC23890
*                                                                       TIC23900
*                                                                       TIC23910
*                                                                       TIC23920
*        HAVE LINEID IN R8.                                             TIC23930
*        SCAN TO SEE WHICH DEV-TASK TO GIVE ATTENTION TO.               TIC23940
*                                                                       TIC23950
         LW,#DEV   #BIGGEST#TIC#TASK   DO LOOP FOR ALL DEVS.            TIC23960
TICINT205 #T#GET,9 #DEV#LINE#IDENTIFIER GET LINEID.                     TIC23970
         CW,9      8                   IS IT THE SAME?                  TIC23980
         BE        TICINT220           OUT IF SO.                       TIC23990
         BDR,#DEV  TICINT205           LOOP IF NOT.                     TIC24000
*                                                                       TIC24010
*        FALL THROUGH IF BREAK NOT FROM ONE                             TIC24020
*        OF OUR POINT-TO-POINT LINES.                                   TIC24030
*                                                                       TIC24040
*        THIS IS IMPOSSIBLE.                                            TIC24050
*                                                                       TIC24060
         #SNAP,25  'IMPOSSIBLE BREAK IGNORED'                           TIC24070
         M:TRTN                                                         TIC24080
*                                                                       TIC24090
TICINT220 RES      0                   HERE TO SIGNAL BREAK - #DEV GOOD.TIC24100
*                                                                       TIC24110
         #T#GET,4  #DEV#DCB#POINTER    POINT TO COC LINE'S DCB.         TIC24120
         BLEZ      TICINTMTRTN         (WE MUST BE >0 HERE)             TIC24130
         LW,5      *#DCB#TABLE#IW,4    GET DCL LOCATION.                TIC24140
         M:PURGE   *5                  AND GET RID OF BUFFERS.          TIC24150
*                                                                       TIC24160
         SIGNALATTENTION                                                TIC24170
TICINTMTRTN RES    0                                                    TIC24180
         M:TRTN                                                         TIC24190
         PAGE                                                           TIC24200
*                                                                       TIC24210
*                                                                       TIC24220
*                                                                       TIC24230
TICINTOPERATOR RES 0                                                    TIC24240
         MTW,0     TICINTOPERATORLATER SEE IF TOO EARLY OR REENTRANCE.
         BEZ       OPERATORPROMPT      OVER IF NOT.
*
         M:TYPE    (MESS,LATERTEXTC)   TELL 'EM TO TRY LATER.
         M:TRTN                        AND GET OUT OF THIS TRAP-TIME.
LATERTEXTC TEXTC   'LATER'
*
TICINTOPERATORLATER DATA 1             1 = LATER   0 = ALLOWED.
*
OPERATORPROMPT MTW,1 TICINTOPERATORLATER BUMP TO PREVENT REENTRANCE.
         M:KEYIN   (MESS,TICINTMESS),(REPLY,TICINTREPLY),;              TIC24250
                   (SIZE,80),(ECB,TICINTECB)
         LI,6      BA(TICINTREPLY)+1   BA OF OPERATOR'S COMMAND.        TIC24270
         LB,7      TICINTREPLY         LENGTH PLUS START                TIC24280
         AI,7      BA(TICINTREPLY)+1-1  MINUS ONE FOR EOM IS END+1.     TIC24290
*
*
*
*        CORRECTION CODE HERE FOR M:KEYIN ERROR WHEN THE             ***
*        REPLY BUFFER CROSSES A APGE BOUNDARY.  AS OF 11 JAN 74,     ***
*        D00 UTS COMPUTES THE LENGTH INCORRECTLY.                    ***
*
         DO        DO#UTS
         LI,7      BA(TICINTREPLY)+1   SCAN FOR
         LB,8      0,7                  E-O-M
         CI,8      X'40'                 SINCE
         BL        %+5                    COUNT
         AI,7      1                       MAY BE
         CI,7      BA(TICINTREPLY)+81       WRONG.
         BL        %-5
         B         %
         FIN
*
*
*                                                                       TIC24300
OPERATORCOMMAND RES 0                                                   TIC24310
         LB,8      0,6                 GET FIRST LETTER OF COMMAND.     TIC24320
         LI,10     OPCOMMANDTABLESIZE  TABLE SIZE.                      TIC24330
         LI,9      OPCOMMANDLETTERTABLE SCAN                            TIC24340
         CB,8      *9                    TABLE                          TIC24350
         BE        OPCOMMANDBAL           FOR A                         TIC24360
         AI,9      1                       LETTER                       TIC24370
         BDR,10    %-3                      MATCH.                      TIC24380
*                                                                       TIC24390
*        HERE ON BAD COMMAND.                                           TIC24400
*                                                                       TIC24410
OPERATORCOMMANDNOT RES 0               HERE ON VARIOUS                  TIC24420
OPERATORCOMMANDBAD RES 0                SYNTAX PROBLEMS                 TIC24430
OPERATORBAD RES    0                     WITH COMMAND.                  TIC24440
OPERATORNOWHERE RES 0                                                   TIC24450
*                                                                       TIC24460
         M:TYPE    (MESS,OPERATORBADMESS)                               TIC24470
         MTW,-1    TICINTOPERATORLATER ALLOW ANOTHER ENTRANCE.
         B         TICINTMTRTN         AND EXIT.
OPERATORBADMESS TEXTC 'BAD TIC COMMAND SYNTAX'                          TIC24490
*                                                                       TIC24500
*                                                                       TIC24510
*                                                                       TIC24520
OPCOMMANDBAL RES   0                   HERE WITH COMMAND IDENTIFIED.    TIC24530
         LW,9      *9                  GET WHERE TO BAL TO.             TIC24540
         BAL,15    *9                  BAL THERE.                       TIC24550
*                                                                       TIC24560
*        (NOTE THAT OPCOMMAND PROCESSORS DON'T                          TIC24570
*        RETURN VIA R15, BUT RATHER USE THE                             TIC24580
*        FOLLOWING LABEL.)                                              TIC24590
*                                                                       TIC24600
OPERATORDIDCOMMAND RES 0                                                TIC24610
         MTW,-1    TICINTOPERATORLATER NOW ALLOW ANOTHER ENTRANCE.
         B         TICINTMTRTN         COMMAND DONE; SO OUT.            TIC24620
*                                                                       TIC24630
*                                                                       TIC24640
*                                                                       TIC24650
OPCOMMANDLETTERTABLE RES 0                                              TIC24660
         GEN,8,24  'M',OPERATORMESSAGE                                  TIC24670
         GEN,8,24  'D',OPERATORDISPLAY                                  TIC24680
         GEN,8,24  'N',OPERATORNET                                      TIC24690
         GEN,8,24  'R',OPERATORREGULATE                                 TIC24700
         GEN,8,24  'A',OPERATORACQUIRE                                  TIC24710
         GEN,8,24  'F',OPERATORFREE                                     TIC24720
         GEN,8,24  'X',OPERATORX                                        TIC24730
OPCOMMANDTABLESIZE EQU %-OPCOMMANDLETTERTABLE                           TIC24740
         B         TICINTMTRTN                                          TIC24750
TICINTMESS TEXTC   'TIC HERE: '                                         TIC24760
TICINTREPLY RES    20
TICINTECB RES      1                                                    TIC24780
         TITLE     'TIC - ABORT TASK'
*                                                                       TIC24800
*                                                                       TIC24810
*                                                                       TIC24820
ABORTCODE RES      0                                                    TIC24830
         LW,8      #DEV                COPY WHO AND WHERE TO R8
         LW,9      #BAL                 AND R9 AND TELL OPERATOR:
         #TYPE89   'ABORTING DEV-TASK - NUMBER AND LOCATION:'
*                                                                       TIC24850
         CW,#DEV   #CURRENT#PROCESS#DEV MAKE SURE CORRECT TIC-TASK.     TIC24860
         BNE       -1                  IF NOT, WE'RE REALLY LOST.
*                                                                       TIC24880
         MTW,-1    ABORTCOUNT          SEE IF TOO MANY TIMES HERE       TIC24890
         BLEZ      -1                  TRUE ABORT IF SO.
*                                                                       TIC24910
         #EXIT                                                          TIC24920
*                                                                       TIC24950
*                                                                       TIC24960
*                                                                       TIC24970
ABORTCOUNT GEN,32  TICABORTCOUNT                                        TIC24980
         TITLE     'TIC - DEV-TASK - COMMAND LEVEL'
COMMANDLEVELPROMPT DATA X'0D156F6F'
*                                                                       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
         DO        DO#DEVELOPMENT                                       TIC25330
         MTW,0     #TS#TEST            IF IN TIMESHARING TESTING,       TIC25340
         BEZ       COMMANDLEVELNETISON  DO NOT WAIT FOR NET.            TIC25350
         FIN                                                            TIC25360
*
         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,5      #MESSAGE#CHAIN                                       TIC25530
COMMANDLEVELMESS222 RES 0                                               TIC25540
         LW,14     5                   REMEMBER PREVIOUS CHAIN ENTRY.   TIC25550
         LW,5      *5                                                   TIC25560
         BEZ       COMMANDLEVELMESS900                                  TIC25570
*                                                                       TIC25580
*        WHEN HERE, HAVE POINTER TO POINTERS TO OUTSTANDING MESSAGE.    TIC25590
*                                                                       TIC25600
         LW,6      1,5                 GET DSP OF LIST OF STATIONS.     TIC25610
         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
         LW,9      2,5                 GET LAL (LOC & LENGTH) OF MESSAGETIC25760
         LB,10     9                   ISOLATE LENGTH.                  TIC25770
         AND,9     =X'7FFFF'           ISOLATE BA.                      TIC25780
*                                                                       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,5                 RE-LOAD DSP OF STATION LIST.     TIC25840
         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   1,5                 RE-LOAD DSP OF STATION LIST.     TIC25940
         #FREE#MAIN#BYTES              AND FREE IT.                     TIC25950
*                                                                       TIC25960
         OR,9      =X'80000000'        TURN MESSAGE BA INTO A DSP       TIC25970
*                                       SO THAT IT WILL BE FREED.       TIC25980
*                                                                       TIC25990
         LW,8      *5                  GET FLINK TO NEXT GUY.           TIC26000
         STW,8     *14                 POINT PREVIOUS GUY AROUND THIS GUTIC26010
*                                                                       TIC26020
         LW,#ARG   5                   NND THEN                         TIC26030
         SLS,#ARG  2                    FREE THIS                       TIC26040
         OR,#ARG   =X'80000000'          THREE WORD                     TIC26050
         #FREE#MAIN#BYTES                 BLOCK.                        TIC26060
*                                                                       TIC26070
COMMANDLEVELMESS550 RES 0                                               TIC26080
*                                                                       TIC26090
         #T#PUT,9  #DEV#RECORD#BA                                       TIC26100
         #T#PUT,10 #DEV#RECORD#LENGTH                                   TIC26110
         #INITIATE#WRITE                                                TIC26120
         #CHECK#WRITE COMMANDLEVELERROR                                 TIC26130
*                                                                       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
         DO        DO#DEVELOPMENT                                       TIC26730
         MTW,0     #TS#TEST            SEE IF SPECIAL TIMESHARING CHECKOTIC26740
         BNEZ      GETAREPORTFROMQUEUE OVER IF NOT.                     TIC26750
*                                                                       TIC26760
GETAREPORT RES     0                                                    TIC26770
         LI,7      #FQM#CHAIN          POINT TO CHAIN HEAD              TIC26780
NEXTFQMNAME RES    0                                                    TIC26790
         LW,6      7                   REMEMBER PREVIOUS GUY (WHO POINTSTIC26800
*                                       TO THIS GUY) FOR UNCHAINING     TIC26810
         LW,7      0,7                 CHAIN DOWN THE CHAIN             TIC26820
         BEZ       OVERREPORT          OVER IF NO MORE                  TIC26830
*                                                                       TIC26840
         LW,12     7                   GET THE WA OF THE BXR.           TIC26850
         SLS,12    2                    AND CONVERT TO BA               TIC26860
         #T#GET,13 #DEV#AT#NAME#LAL    GET LOC AND LENGTH OF STATION    TIC26870
         BEZ       OVERREPORT          (NO TESTS IF NO NAME)            TIC26880
         CBS,12    4+4+4+4+4+4         SEE IF WE HAVE MATCH.            TIC26890
*                                      (NAME IS 24 BYTES INTO BXR)      TIC26900
         BNEZ      NEXTFQMNAME         BACK FOR NEXT IF NO MATCH        TIC26910
*                                                                       TIC26920
*        FOUND A REPORT TO PRINT.  PRINT IT,                            TIC26930
*        DELETE IT FROM THE CHAIN, GO BACK                              TIC26940
*        FOR MORE:                                                      TIC26950
         LW,8      *7                  DE-CHAIN THE                     TIC26960
         STW,8     *6                   REPORT BEFORE DELIVERY          TIC26970
*                                        (TO KEEP ANOTHER TASK FROM IT) TIC26980
*                                                                       TIC26990
         LW,14     7                   COPY POINTER TO BXR.             TIC27000
         SLS,14    2                    AND MAKE IT INTO                TIC27010
         OR,14     =X'80000000'          A DSP TO THE BXR.              TIC27020
         B         GOTAREPORT                                           TIC27030
         FIN                                                            TIC27040
         PAGE                                                           TIC27050
*                                                                       TIC27060
*                                                                       TIC27070
*                                                                       TIC27080
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
         DO        DO#DEVELOPMENT                                       TIC28340
         MTW,0     #TS#TEST            NO QUEUE STUFF IF SPECIAL        TIC28350
         BEZ       REPORTOUTKEY479      TIMESHARING TESTING.            TIC28360
         FIN                                                            TIC28370
         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,#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
         DO        DO#DEVELOPMENT                                       TIC28790
         MTW,0     #TS#TEST            SEE IF SPECIAL T/S CHECKOUT      TIC28800
         BEZ       COMMANDLEVELWAITFORATTENTION SPECIAL BRANCH IF SO    TIC28810
         FIN                                                            TIC28820
*                                                                       TIC28830
         #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,#ARG #DEV#COMMAND#LINE#RECORD#BA                        TIC29330
         BNEZ      COMMANDLEVELGOTATRANORCOMMAND OVER IF PREVIOUS Y USE.TIC29340
*                                                                       TIC29350
COMMANDLEVELREAD RES 0
         LI,8      3                   WE
         #T#PUT,8  #DEV#RECORD#LENGTH   PROMPT                          TIC29370
         LI,8      BA(COMMANDLEVELPROMPT) FOR                           TIC29380
         #T#PUT,8  #DEV#RECORD#BA         AND                           TIC29390
         #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
*                                                                       TIC29470
         #T#XCA,8  #DEV#RECORD#LENGTH   THE LENGTH TOO.                 TIC29480
         #T#PUT,8  #DEV#COMMAND#LINE#RECORD#LENGTH                      TIC29490
*                                                                       TIC29500
*        TEST HERE FOR A LEADING QUESTION MARK.                         TIC29510
*        (IF FOUND, WE THROW AWAY ONE LEADING Q-MARK)                   TIC29520
*                                                                       TIC29530
         LB,9      0,6                 GET FIRST BYTE OF RECORD.        TIC29540
         CI,9      '?'                 IS IT A QUESTION MARK?           TIC29550
         BNE       COMMANDLEVELGOTATRANORCOMMAND OVER IF NOT.           TIC29560
*                                                                       TIC29570
*        HAD LEADING QUESTION MARK -- MOVE ONE BYTE DOWN TO OVER-WRITE. TIC29580
*                                                                       TIC29590
         LW,7      6                   DESTINATION IS THE RECORD BUFFER.TIC29600
         AI,6      1                   SOURCE IS ONE BYTE HIGHER.       TIC29610
         MBS678                        MOVE THE RECORD.                 TIC29620
*                                                                       TIC29630
         #T#GET,8  #DEV#COMMAND#LINE#RECORD#LENGTH THE COMMAND RECORD   TIC29640
         AI,8      -1                  IS NOW ONE BYTE SHORTER THAN IT WTIC29650
         #T#PUT,8  #DEV#COMMAND#LINE#RECORD#LENGTH                      TIC29660
*                                                                       TIC29670
COMMANDLEVELGOTATRANORCOMMAND RES 0                                     TIC29680
         #T#GET,6  #DEV#COMMAND#LINE#RECORD#BA GET BA OF THE COMMAND.   TIC29690
         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
         #T#GET,6  #DEV#COMMAND#LINE#RECORD#BA FIRST BYTE ADDRESS.      TIC29830
         AND,6     =X'7FFFF'           NEATEN IT.                       TIC29840
         #T#GET,7  #DEV#COMMAND#LINE#RECORD#LENGTH COUNT PLUS START     TIC29850
         AW,7      6                   IS END PLUS ONE.                 TIC29860
*                                                                       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
         LI,8      BA(COMMANDBADMESSAGE)                                TIC29990
         LI,9      19                                                   TIC30000
COMMANDNOT200 RES  0                                                    TIC30010
         #T#PUT,8  #DEV#RECORD#BA                                       TIC30030
         #T#PUT,9  #DEV#RECORD#LENGTH                                   TIC30040
         #INITIATE#WRITE                                                TIC30050
         #CHECK#WRITE COMMANDLEVELPOSTCOMMAND                           TIC30060
         B         COMMANDLEVELPOSTCOMMAND                              TIC30070
*                                                                       TIC30080
COMMANDBADMESSAGE DATA X'0DC2C1C4'
         TEXT      ' 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
         DO        DO#DEVELOPMENT                                       TIC30160
         GEN,8,24  'C',CHANGE                                           TIC30170
         GEN,8,24  'M',MCOLON                                           TIC30190
         FIN                                                            TIC30200
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.
         BAL,15    LOGOFF              LOG STATION OFF IF 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
         BEZ       COMMANDLEVEL        WAS; AND OUT IF NONE.            TIC30410
*                                      (NONE IF STORAGE FREED BY        TIC30420
*                                      THE COMMAND PROCESSOR ITSELF.)   TIC30430
*                                                                       TIC30440
         #FREE#MAIN#BYTES              OTHERWISE, FREE THE SPACE        TIC30450
         B         COMMANDLEVEL         CMD LINE OCCUPIED AND GO BACK.  TIC30460
         PAGE                                                           TIC30470
*        HERE ON A TRANSACTION NAME                                     TIC30480
*                                                                       TIC30490
TFDINKEYPROTO TEXT '?            XX01'                                  TIC30500
TFDINKEYPROTO3 TEXT '?000000000000XX01'                                 TIC30510
*                                                                       TIC30520
XACTION  RES       0                                                    TIC30530
         #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,7      4*9+1               POINT R7 TO BYTE AFTER THE ?.    TIC30660
*                                                                       TIC30670
         #T#GET,15 #DEV#COMMAND#LINE#RECORD#LENGTH GET TRANCODE LINE LENTIC30680
         #T#GET,5  #DEV#COMMAND#LINE#RECORD#BA GET POINTER TO TRANCODE. TIC30690
XACTION275 RES     0                                                    TIC30700
         LB,8      0,5                 SCAN INPUT RECORD                TIC30710
         CI,8      ' '                 FOR END OF TRANCODE              TIC30720
         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,7                 PUT CHARACTER INTO KEY.          TIC30790
         AI,7      1                   BUMP POINTER INTO ABUILDIN KEY.  TIC30800
         CI,7      4*9+1+12            SEE IF VERY LONG.                TIC30810
         BGE       XACTION300          OVER IF VERY LONG.               TIC30820
*                                                                       TIC30830
         AI,5      1                   BUMP SCAN IN CLERK'S TRANCODE.   TIC30840
         BDR,15    XACTION275          AND LOOP.                        TIC30850
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,14     7                   COPY HOW MANY.                   TIC30960
         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,14    XACTION312          AND DO NEXT %-TYPE.              TIC31290
*                                                                       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,14     7                   ISOLATE COUNT                    TIC31350
         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,14    XACTION352          AND DO NEXT ONE.                 TIC31690
*                                                                       TIC31700
*        FALL THROUGH ON NO QUESTION-TYPE MATCHED.                      TIC31710
*                                                                       TIC31720
XACTIONBAD RES     0                                                    TIC31730
         LI,8      BA(XACTIONBADMESSAGE)                                TIC31740
         LI,9      17                                                   TIC31750
         B         COMMANDNOT200                                        TIC31760
*                                                                       TIC31770
XACTIONBADMESSAGE DATA X'0DC9D3D3'
         TEXT      'EGAL 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
         LI,8      BA(XACTIONNOTMESSAGE)                                TIC32070
         LI,9      22
         B         COMMANDNOT200                                        TIC32090
*                                                                       TIC32100
XACTIONNOTMESSAGE DATA X'0DD5D6D5'
         TEXT      '-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
*                                                                       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
*                                                                       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
TSITFDSCAN #DSSWORD                    OUR CURRENT WORD POSITION IN TFD TIC32910
*                                                                       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                  SAVES REGS - GETS ABOVE DSS SPACETIC33060
*                                                                       TIC33070
         LI,8      0                   IMMEDIATELY IDENTIFY             TIC33080
         STW,8     TSIZEROORONE         OURSELVES AS INPUT.             TIC33090
*                                                                       TIC33100
         #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      0                   GET A ZERO                       TIC33180
         STW,9     TSIRECORDBA         AND                              TIC33190
         STW,9     TSIRECORDENDBA       CLEAR                           TIC33200
         STW,9     TSORECORDBA                                          TIC33210
         STW,9     TSORECORDENDBA                                       TIC33220
         STW,9     TSORECORDSIZE                                        TIC33230
         STW,9     TSIYSTRINGBA        NO Y-STRING.                     TIC33240
         STW,9     TSIFQMTEXTHIGHWATERMARKBA                            TIC33250
         STW,9     TSIRECORDCURRENTBA  NO CURRENT INPUT RECORD.         TIC33260
*                                                                       TIC33270
         LI,9      0                   INDICATE NO ID YET
         STW,9     TSITRANID           STORE OUR ID.                    TIC33290
*                                                                       TIC33300
         LI,9      10000               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
         STW,#ARG  7                        REMEMBER                    TIC33510
         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
*                                                                       TIC33680
*                                      THROUGHOUT THERREST OF THIS      TIC33690
*                                      ROUTINE, R7 IS A POINTER TO      TIC33700
*                                      THE 'NEXT' BYTE IN THE BUFFER    TIC33710
*                                      THAT HOLDS THE TEXT OF THE       TIC33720
*                                      FORMAL TRANSACTION.              TIC33730
*                                                                       TIC33740
         LW,6      TSIBXR              RETRIEVE BA OF BXR.              TIC33790
         AND,6     =X'7FFFF'           NEATEN IT.                       TIC33800
         SLS,6     -2                  MAKE INTO A WA.                  TIC33810
*                                                                       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  *6                  STORE IT INTO BXR.               TIC33850
*                                                                       TIC33860
         AI,6      1+1+1+1+1           BUMP TO TEXT LENGTH WORD.        TIC33870
         STH,10    *6                  AND STORE BYTE COUNT.
*                                                                       TIC33890
         AI,6      1                   BUMP TO WHERE NAME IS.           TIC33900
         SLS,6     2                   TO BA OF WHERE NAME IS.          TIC33910
*                                                                       TIC33920
         #T#GET,12 #DEV#COMMAND#LINE#RECORD#LENGTH C.C. OF TRAN LINE    TIC33930
         AI,12     1                   (UP ONE CAUS BDR BELOW PRECEEDS STORE)
         #T#GET,5  #DEV#COMMAND#LINE#RECORD#BA BA OF TRANCODE.          TIC33940
*                                                                       TIC33950
TSIGOTPROTO LI,8   '?'                 START WITH A QUESTION MARK.      TIC33960
*                                                                       TIC33970
TSIGOTTRAN250 RES  0                                                    TIC33980
         STB,8     0,6                 COPY                             TIC33990
         AI,6      1                    TRANCODE                        TIC34000
         LB,8      0,5                   TO                             TIC34010
         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,5      1                      NAME                          TIC34080
         BDR,12    TSIGOTTRAN250       AND LOOP.                        TIC34090
*                                                                       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,6                  PUT IT IN AS SEPARATOR.         TIC34160
         AI,6      1                   BUMP INDEX INTO NAME.            TIC34170
*                                                                       TIC34180
         #T#GET,5  #DEV#AT#NAME#LAL    GET ORIGINATING STATION NAME LOC.
         BEZ       TSIGOTATNAMEIN      OVER IF NONE.                    TIC34210
*                                                                       TIC34220
         LB,12     5                   ISOLATE BYTE COUNT.              TIC34230
*                                                                       TIC34240
         LB,8      0,5                 COPY                             TIC34250
         AI,5      1                    THE                             TIC34260
         STB,8     0,6                   NAME.                          TIC34270
         AI,6      1                                                    TIC34280
         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,6                  THE END OF THE NAME.            TIC34350
         AI,6      1                                                    TIC34360
*                                                                       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      6                   BA OF WHERE WE ARE.              TIC34440
         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,6                  REST OF THE NAME.               TIC34520
         AI,6      1                   BUMP POINTER THRU FIELD.         TIC34530
         CW,6      TSIFQMTEXTBA        AT END OF NAME FIEDL?            TIC34540
         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
         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
*                                                                       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
*                                                                       TIC34860
*        ABOVE WORDS MUST MATCH: TSI & TSO.                             TIC34870
*                                                                       TIC34880
TSOTFDSCAN #DSSWORD                    CURRENT WA POSITION IN TFD.      TIC34890
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                                                   TIC34970
*                                                                       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
*                                                                       TIC35170
         LI,9      0                   CLEAR STUFF:                     TIC35180
         STW,9     TSOYSTRINGBA        NO Y-STRING.                     TIC35190
*                                                                       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                                                           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
         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
ZEROANDNINE GEN,32 X'F0'                                                TIC36340
         GEN,32    X'F9'                                                TIC36350
         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
         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
*                                                                       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
         DO        DO#DEVELOPMENT                                       TIC43260
         MTW,0     #TS#TEST            IF NOT IN SPECIAL TIMESHARING
         BNEZ      TSINEXTPRIM          MODE, DON'T PUT INTO CORE CHAIN.
         LW,13     TSIBXR              GET BA OF BXR.                   TIC43270
         SLS,13    -2                  MAKE INTO A WA.                  TIC43280
         AND,13    =X'1FFFF'           INTO A CLEAN WA.                 TIC43290
*                                                                       TIC43300
         LW,12     #FQM#CHAIN          CHAIN INTO                       TIC43310
         STW,13    #FQM#CHAIN           THE IN-CORE                     TIC43320
         STW,12    *13                   FQMS                           TIC43330
         FIN                                                            TIC43340
*                                                                       TIC43350
         B         TSINEXTPRIM                                          TIC43360
*                                                                       TIC43370
*                                                                       TIC43380
*                                                                       TIC43390
HEXTABLE DATA      '0123'                                               TIC43470
         DATA      '4567'                                               TIC43480
         DATA      '89AB'                                               TIC43490
         DATA      'CDEF'                                               TIC43500
         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
         LW,12     TSICURRENTC         REMEMBER CURRENT COLUMN NUMBER.  TIC43610
*                                                                       TIC43620
         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      100000              BIG NUMBER                       TIC43840
         STW,8     TSICURRENTR          AS CURRENT ROW.                 TIC43850
*                                                                       TIC43860
         B         TSI@490             AND OVER TO COLUMN CODE.         TIC43870
*                                                                       TIC43880
TSI@160  RES       0                                                    TIC43890
         CI,13     X'80'               TEST R INFO                      TIC43900
         BE        TSI@500             OVER TO C CODE IF R+0            TIC43910
         BAZ       TSI@200             OVER IF NOT R+N                  TIC43920
*        FALL THROUGH ON PKUS-TYPE R                                    TIC43930
         AND,13    =X'7F'              CLEAN UP THE ADDEND              TIC43940
         AW,13     TSICURRENTR         ADD IN CURRENT ROW               TIC43950
*                                                                       TIC43960
TSI@200  RES       0                   WHEN HERE, NEW R IS              TIC43970
*                                      IN R13 AND OLD R IS              TIC43980
*                                      IN TSICURRENTR                   TIC43990
         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
         CI,14     X'80'               SEE IF TO-THE-RIGHT IN ROW.      TIC44040
         BANZ      TSI@500             IF SO, OVER TO C CODE.           TIC44050
         CW,14     TSICURRENTC         SEE IF LEFT OF WHERE WE ARE.     TIC44060
         BGE       TSI@500             IF NOT, OVER TO C CDDE.          TIC44070
*        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@250             3270 IS TTY FOR NOW.
*
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
*                                                                       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     1                   ELIMINATE
         BGE       TSI@200              ANY FAKE
         LI,14     1                     ZERO ROW.
         B         TSI@200             AND RE-DO THE ROW TESTS.         TIC44230
*                                                                       TIC44240
TSI@300  SW,13     TSICURRENTR         SEE HOW MANY ROWS DOWN           TIC44250
         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
*                                                                       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
         CI,14     X'80'               SEE ABOUT THE C INFO             TIC44390
         BAZ       TSI@700             OVER IF ABSOLUTE COLUMN          TIC44400
*        FALL THROUGH ON C+N                                            TIC44410
         AND,14    =X'7F'              CLEAN UP THE ADDEND              TIC44420
         AW,14     12                  ADD IN (FORMER) CURRENT COLUMN.  TIC44430
*                                      (IT WAS THE CURRENT COLUMN       TIC44440
*                                      WHEN WE BEGAN THIS PRIMITIVE.)   TIC44450
*                                                                       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
         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
TSOPRIMLOC(TFDP) SET %                                                  TIC44990
TSIPRIMLOC(TFDP) SET %                                                  TIC45000
*                                                                       TIC45010
         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
         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,15    TSOGETFQMCHAR       GET A CHAR FROM THE TEXT.        TIC45410
         BAL,15    TSOPUTCHAR          STUFF BYTE INTO THE OUTPUT BUFFERTIC45420
         BDR,13    TSOG200             AND PROCESS W BYTES.             TIC45430
*                                                                       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,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    TSOA200             AND PROCESS W CHARACTERS.        TIC45600
*                                                                       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
         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
         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.
         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
         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,#ARG   TSOBXR              RE-CHECKSUM
         SLS,#ARG  -2                   AFTER CHANGING
         BAL,#BAL  CHECKSUM              TYPE BYTE.
*
         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
*                                                                       TIC47680
         DO        DO#DEVELOPMENT                                       TIC47690
         MTW,0     #TS#TEST                                             TIC47700
         BEZ       TSOZ592                                              TIC47710
         FIN                                                            TIC47720
*                                                                       TIC47730
         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
         #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
*                                                                       TIC47960
         CW,11     =X'80000000'        SEE IF ERRORED DELIVERY.
         BAZ       TSOZ597             OVER IF NORMAL.
*
         #EXIT#SPACE                   ON ERRORED DELIVERY,
         B         COMMANDLEVELREAD     GO RIGHT TO COMMAND LEVEL.
*
TSOZ597  RES       0
         #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
         LI,13     BA(BADMESS#1)       START OF ERROR MESSAGE.          TIC48090
         LI,12     BADMESS#1LENGTH     AND ITS LENGTH.                  TIC48100
         BAL,14    BADMESSOUT          SEND 'EM.                        TIC48110
*                                                                       TIC48120
         LW,11     TSICURRENTR         ROW WE'RE AT.                    TIC48130
         BAL,14    BCDOFR11            AND SEND IT.                     TIC48140
*                                                                       TIC48150
         LI,13     BA(BADMESS#2)       MIDDLE OF MESSAGE.               TIC48160
         LI,12     BADMESS#2LENGTH     AND ITS LENGTH.                  TIC48170
         BAL,14    BADMESSOUT          SEND IT.                         TIC48180
*                                                                       TIC48190
         LW,11     TSICURRENTFIELDC    START OF BAD FIELD.              TIC48200
         BAL,14    BCDOFR11            AND SEND IT.                     TIC48210
*                                                                       TIC48220
         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 RES 0
         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
         LI,13     BA(BADMESS#6)                                        TIC48490
         LI,12     BADMESS#6LENGTH                                      TIC48500
         BAL,14    BADMESSOUT          SEND SESSAGE OF COMPLAINT        TIC48510
*                                      ATTACHED TO THE REPORT WHICH     TIC48520
*                                      WAS SENT TO THIS POINT.          TIC48530
         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
         LI,13     BA(BADMESS#7)                                        TIC48630
         LI,12     BADMESS#7LENGTH                                      TIC48640
         BAL,14    BADMESSOUT                                           TIC48650
*                                                                       TIC48660
         B         TSIZ500                                              TIC48670
*                                                                       TIC48680
*                                                                       TIC48690
*                                                                       TIC48700
BADMESS#1LENGTH EQU 18
BADMESS#1 DATA     X'0DC2C1C4'
         TEXT      ' FIELD AT ROW '
BADMESS#2LENGTH EQU 5
BADMESS#2 TEXT     ' COL '                                              TIC48730
BADMESS#6LENGTH EQU 33
BADMESS#6 DATA     X'0D5C5C40'
         TEXT      'BAD CHARACTER OR PRIMITIVE **'
BADMESS#7LENGTH EQU 32
BADMESS#7 DATA     X'0D5C5C40'
         TEXT      '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,15    TSOPUTCHAR                                           TIC48970
         AI,9      0                                                    TIC48980
         BNEZ      %-3                                                  TIC48990
*                                                                       TIC49000
         B         *14                                                  TIC49010
*                                                                       TIC49020
*                                                                       TIC49030
*                                                                       TIC49040
BADMESSOUT RES     0                   BAL'ED TO ON R14.                TIC49050
*                                      PRINTS STRING DEFINED BY         TIC49060
*                                      BA IN R13 AND LENGTH IN          TIC49070
*                                      R12.                             TIC49080
         LW,#ARG   13                  COPY BA.                         TIC49090
         LB,8      0,#ARG              GET A BYTE.                      TIC49100
         BAL,15    TSOPUTCHAR          AND SEND IT.                     TIC49110
         AI,13     1                   BUMP INTO MESSAGE.               TIC49120
         BDR,12    BADMESSOUT          AND LOOP.                        TIC49130
         B         *14                                                  TIC49140
         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                   WA OF CHAINED BLOCK.             TIC49720
         SLS,#ARG  2                   BA OF CHAINED BLOCK.             TIC49730
         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
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
         BANZ      T:MYPRIM             IF SO, GO DO IT.                TIC49990
*                                                                       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
*                                                                       TIC50080
*                                                                       TIC50090
*                                                                       TIC50100
TSINEXTPRIM RES    0                   HERE TO MOVE TO NEXT PRIMITIVE   TIC50110
         LW,8      TSITFDSCAN          RE-GET THE OLD PRIMITIVE         TIC50120
         INT,12    *8                  AND RE-INT IT                    TIC50130
*
         BCR,2     %+3                 OVER IF NO FLAG WORD.
         MTW,1     TSITFDSCAN          OR BUMP OVER FLAG WORD.
         INT,12    *8                  AND RE-ESTABLISH CC.
*                                                                       TIC50140
         BCR,1     TSINEXTPRIMZERO     OVER IF TYPE ZERO                TIC50150
*                                                                       TIC50160
         AI,13     3                   ROUND TYPE ONE BYTES             TIC50170
         SLS,13    -2                  INTO WORDS OF PRIMITIVE          TIC50180
         AWM,13    TSITFDSCAN          AND BUMP                         TIC50190
*                                                                       TIC50200
TSINEXTPRIMZERO MTW,1 TSITFDSCAN       BUMP FOR PRIMITIVE WORD          TIC50210
         B         TSIGETPRIM          AND CONTINUE PROCESSING          TIC50220
         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,#ARG   0
         #T#XCA,#ARG #DEV#RECORD#BA    OBTAIN AND CLEAR RECORD DSP.
         STW,#ARG  TSIRECORDBA         STORE AS START OF RECORD.        TIC50590
         AND,#ARG  =X'7FFFF'           NEATEN TO A BARE BA.             TIC50600
         STW,#ARG  TSIRECORDCURRENTBA  SAVE AS WHERE WE ARE.            TIC50610
*                                                                       TIC50620
         #T#GET,8  #DEV#RECORD#LENGTH  RECORD LENGTH                    TIC50630
         AW,8      #ARG                 PLUS RECORD START               TIC50640
         STW,8     TSIRECORDENDBA        IS RECORD END+1                TIC50650
*                                                                       TIC50660
         IFATTENTION TSIATTENTION      OUT ON AN ATTENTION.             TIC50670
*                                                                       TIC50680
TSIGETCHAROK RES   0                                                    TIC50690
         MTW,1     TSICURRENTC         BUMP CURRENT 'COLUMN' POSITION.  TIC50700
*                                                                       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
         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
         LI,#ARG   ' '                 RETURN A BLANK IN '#ARG' TOO.    TIC50880
         B         *15                                                  TIC50890
*                                                                       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.
*
         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
         SLS,8     7                     POSITION
         OR,9      8                      IN 3270.
         DW,8      =80                 CALCULATE R&C (ACTUALLY R-1 & C-1
*
*        R9 HAS ROW-1.  R8 HAS COLUMN-1.
*
         AI,9      1                   IF NOT (YET) AT
         CW,9      TSICURRENTR          THIS ROW,
         BNEZ      TSIGETBLANK           RETURN A BLANK.
*
         AI,8      1                   IF NOT (YET) AT
         CW,8      TSICURRENTC          THIS COLUMN,
         BNEZ      TSIGETBLANK           RETURN A BLANK.
*
*        THE INTERNAL R&C MATCH THE R&C (OF ATTRIBUTE PLUS ONE)
*        IN THE BUFFER.  SO WE ARE READY TO PROCESS THAT FIELD.
*
         MTW,4     TSIRECORDCURRENTBA  SKIP X'11', R, C, AND ATTRIBUTE.
         B         TSIGET2222          AND GO PROCESS.
         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.
*                                                                       TIC51290
TSIBUMPZERO RES    0
         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
*                                                                       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
TSXNEXTPRIM B      TSINEXTPRIM         (SEE R6 DISCUSSION ABOVE)        TIC52110
TSONEXTPRIM RES    0                                                    TIC52120
         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
*        AND FALL THROUGH TO CONTINUE PROCESSING.                       TIC52230
*                                                                       TIC52240
*                                                                       TIC52250
*                                                                       TIC52260
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
          BANZ      T:MYPRIM            IF SO, GO DO IT.                TIC52340
*                                                                       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
         LW,#ARG   TSORECORDSIZE       RETRIEVE SIZE TO GET.            TIC52650
         #GET#MAIN#BYTES                 AND GET IT.                    TIC52660
        STW,#ARG  TSORECORDBA         STORE FULL RETURNED ADDRESS.      TIC52670
         LI,5      X'7FFFF'            CREATE CLEAN BA                  TIC52680
        AND,5     #ARG                 IN REGISTER FIVE.                TIC52690
        LW,#ARG   TSORECORDSIZE       ADD SIZE TO GET                   TIC52700
        AW,#ARG   5                    THE BA OF (LAST BYTE + 1).       TIC52710
        STW,#ARG  TSORECORDENDBA      AND STORE.                        TIC52720
*                                                                       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
*                                                                       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                                                           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
*
*
*
         #SNAP,30  'GOT A ZERO FROM GETID'
         #ABORT
         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)
         #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.
*
*
*
FOURWORDSFORMTIME RES 4
         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
*                                                                       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
         BEZ       POINTTOTFDNOTINCORE OVER IF EXAUSTED IN-CORE ONES.   TIC54590
*                                                                       TIC54600
         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
*                                                                       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
         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
*                                                                       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
DONEWITHTFDCODEERROR RES 0                                              TIC55270
         #SNAP,30  'TFD NOT IN TFD CHAIN'                               TIC55280
         #ABORT                                                         TIC55290
*                                                                       TIC55300
*                                                                       TIC55310
*                                                                       TIC55320
POINTTOTFDNOTINCORE RES 0              HERE TO FETCH TFD FROM FILE.     TIC55330
*                                                                       TIC55340
         LI,5      #INFOBLOCK#TFDI     POINT TO (INTERNAL) TFDS FILE.   TIC55350
         BAL,15    OBTAININTERNALFILERECORD AND GET THE TFD.            TIC55360
         BEZ       POINTTONOT          OUT IF NONE.                     TIC55370
*                                                                       TIC55380
*        HERE WITH DSP OF TFD IN R8.                                    TIC55390
*                                                                       TIC55400
         SLS,8     -2                  MAKE DSP INTO                    TIC55410
         AND,8     =X'1FFFF'            A BARE WA.                      TIC55420
*                                                                       TIC55430
         LW,7      @TFD@CHAIN          PUT THE NEW TFD                  TIC55440
         STW,8    @TFD@CHAIN            ONTO THE CHAIN                  TIC55450
         STW,7     *8                    OF TFDS.                       TIC55460
*                                                                       TIC55470
         B         POINTFOUND          AND GO WITH R8 SET.              TIC55480
*                                                                       TIC55500
*                                                                       TIC55510
*                                                                       TIC55520
POINTTOTFDERR RES  0                                                    TIC55530
POINTTOTFDABN RES  0                                                    TIC55540
         #SNAP     'ERR/ABN IN TFDI READ'                               TIC55550
         B         POINTTONOT                                           TIC55560
         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                                                           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     4                   COMPARE. (4 INTO CHAIN ENTRY)    TIC56330
         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
         DO        DO#DEVELOPMENT                                       TIC56700
         MTW,0     #TS#TEST            SEE IF SPECIAL TS TESTING.       TIC56710
         BEZ       OBTAININTERNAL292   OVER IF SO                       TIC56720
         FIN                                                            TIC56730
*                                                                       TIC56740
         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     8                   COMPARE.  (KEY 2 WORDS INTO ENTRY)
         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
         #SNAP,22  'ERR/ABN READING INTERNAL FILE'
         #ABORT                                                         TIC57500
         PAGE
*
*        MOVES C(R8) CHARACTERS FROM C(R6) TO C(R7).
*        BAL'ED TO ON #BAL.
*
         AI,8      -255
         OR,7      =255*256*256*256
         MBS,6     0
MBS678CODE CI,8    255
         BG        %-4
         STB,8     7
         MBS,6     0
         B         *#BAL
         PAGE
*
*
*
FIELD6789LOADAAAACODE RES 0
*
         CW,6      7                   SCAN FOR
         BGE       0,#BAL               AND IGNORE
         LB,8      0,6                   LEADING
         CI,8      ' '                    BLANKS.
         BNE       %+3
         AI,6      1
         B         %-6
*
         LI,8      0                   CLEAR ANSWER REGISTER.
*
         OR,#BAL   =X'04000000'        LOOP COUNT INTO HOB OF #BAL.
*
FIELD6789LOADAAAALOOP RES 0
         CW,6      7                   GET
         BGE       0,#BAL               A
         LB,9      0,6                   CHAR.
         CI,9      ' '                 DONE IF
         BE        1,#BAL               A BLANK.
*
         CI,9      X'6A'               SEE IF UP ARROW.
         BNE       %+21                OVER IF NOT.
         AI,6      2                   SEE IF TWO CHARS PAST
         CW,6      7                    THE UP-ARROW AND
         BGE       0,#BAL                SAY NO FIELD IF NOT.
         AI,6      -1
         LB,9      0,6                 COMBINE
         EOR,9     =X'F0'               CHARS
         CI,9      X'F0'                 TO
         BAZ       %+2                    MAKE
         AI,9      9-48                    HEX
         SLS,8     4                        GUY.
         OR,8      9
         AI,6      1
         LB,9      0,6
         EOR,9     =X'F0'
         CI,9      X'F0'
         BAZ       %+2
         AI,9      9-48
         SLS,8     4
         OR,8      9
         B         %+3
*
         SLS,8     8                   OR IN NORMAL
         OR,8      9                    CHARACTER.
         AI,6      1
*
         SW,#BAL   =X'01000000'        END OF FOUR
         CW,#BAL   =X'0F000000'         CHARACTER
         BANZ      FIELD6789LOADAAAALOOP LOOP.
         CW,6      7                   AND SKIP
         BGE       1,#BAL               TRAILING
         LB,9      0,6                   BLANKS
         CI,9      ' '                    ON EXIT.
         BNE       %-5
*
         B         1,#BAL
         PAGE
*
*
*
FIELD6789LOADAAAAAAAACODE RES 0
*
         CW,6      7
         BGE       0,#BAL
*
         LB,#ARG   0,6
         CI,#ARG   ' '
         BNE       %+3
         AI,6      1
         B         %-6
*
         LI,8      0
         LI,9      0
         B         FIELD6789LOADAAAAAAAATERM
*
FIELD6789LOADAAAAAAAALOOP RES 0
         CW,8      =X'FF000000'
         BANZ      FIELD6789LOADAAAAAAAAORED
*
         CI,#ARG   X'6A'
         BNE       FIELD6789LOADAAAAAAAANORM
*
         AI,6      2
         CW,6      7
         BGE       0,#BAL
         AI,6      -1
         LB,#ARG   0,6
         EOR,#ARG  =X'F0'
         CI,#ARG   X'F0'
         BAZ       %+2
         AI,#ARG   9-48
         SLD,8     4
         OR,9      #ARG
         AI,6      1
         LB,#ARG   0,6
         EOR,#ARG  =X'F0'
         CI,#ARG   X'F0'
         BAZ       %+2
         AI,#ARG   9-48
         SLD,8     4
         OR,9      #ARG
         B         FIELD6789LOADAAAAAAAAORED
*
FIELD6789LOADAAAAAAAANORM RES 0
         SLD,8     8
         OR,9      #ARG
FIELD6789LOADAAAAAAAAORED RES 0
         AI,6      1
         CW,6      7
         BGE       FIELD6789LOADAAAAAAAADONE
*
         LB,#ARG   0,6
FIELD6789LOADAAAAAAAATERM RES 0
         CI,#ARG   ' '
         BE        FIELD6789LOADAAAAAAAADONE
         CI,#ARG   X'0D'
         BE        FIELD6789LOADAAAAAAAADONE
         CI,#ARG   X'15'
         BNE       FIELD6789LOADAAAAAAAALOOP
*
FIELD6789LOADAAAAAAAADONE RES 0
         AI,9      0                   IF R9 STILL ZERO, WE
         BEZ       0,#BAL               HIT IMMEDIATE TERMINATOR.
         CW,8      =X'FF000000'
         BANZ      1,#BAL
*
         SLD,8     8
         OR,9      =X'40'
         B         %-4
         PAGE
*
*
*
FIELD6789POINTTOSTRINGCODE RES 0
*
         CW,6      7
         BGE       0,#BAL
*
         LB,9      0,6
         CI,9      ' '
         BNE       %+3
         AI,6      1
         B         %-6
*
         LW,8      6
*
FIELD6789POINTTOSTRINGTEST RES 0
         CI,9      ''''
         BNE       FIELD6789POINTTOSTRINGNORM
*
         AI,6      1                   HERE WHEN QUOTE ENCOUNTERED.
         CW,6      7                   WE SCAN UP TO
         BGE       0,#BAL               THE NEXT QUOTE.
         LB,9      0,6                   (BAD STRING IF NO QUOTE)
         CI,9      ''''
         BNE       %-5
         B         FIELD6789POINTTOSTRINGBUMP
*
FIELD6789POINTTOSTRINGNORM RES 0
         CI,9      ' '
         BE        FIELD6789POINTTOSTRINGGOOD
         CI,9      X'15'
         BE        FIELD6789POINTTOSTRINGGOOD
         CI,9      X'0D'
         BE        FIELD6789POINTTOSTRINGGOOD
*
FIELD6789POINTTOSTRINGBUMP RES 0
         AI,6      1                   BUMP TO NEXT CHAR.
         CW,6      7                   SEE IF STILL IN THE STRING.
         BGE       FIELD6789POINTTOSTRINGGOOD OVER IF NOT.
*
         LB,9      0,6                 GET THE NEXT CHAR IN THE STRING.
         B         FIELD6789POINTTOSTRINGTEST AND GO SEE ABOUT IT.
*
FIELD6789POINTTOSTRINGGOOD RES 0       HERE WHEN DELIMITER FOUND.
         LW,9      6                   COMPUTE FIELD
         SW,9      8                    LENGTH IN R9.
         BEZ       0,#BAL              (BAD EXIT ON IMMEDIATE DELIMINATO
         B         1,#BAL                AND TAKE GOOD EXIT.
         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
         DO        DO#DEVELOPMENT                                       TIC57720
         MTW,0     #TS#TEST            SEE IF TESTING IN TIMESHARING.   TIC57730
         BEZ       *15                 AVOID ILLEGAL CAL IF SO.         TIC57740
         FIN                                                            TIC57750
*                                                                       TIC57760
         #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
         DO        DO#DEVELOPMENT                                       TIC58030
         MTW,0     #TS#TEST            SEE IF TESTING IN TIMESHARING.   TIC58040
         BEZ       *15                 AVOID ILLEGAL CAL IF SO.         TIC58050
         FIN                                                            TIC58060
*                                                                       TIC58070
         #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
*
*        CODE REACHED VIA THE SIGNALATTENTION PROC:
*
SIGNALATTENTIONCODE RES 0
         #PUSH,7,11                    SAVE SOME REGISTERS.
         LW,7      #DEV                COPY TASK-NUMBER OF TASK
*                                       TO SIGNAL ATTENTION TO.
         B         SIGNALATTENTIONMAINLINE
*
SIGNALATTENTIONCODECFTWO RES 0
         #PUSH,7,11                    SAVE SOME REGISTERS.
         LW,7      #ARG                COPY THE TASK-NUMBER OF THE TASK
*                                       THAT WE ARE SIGNALING ATTENTION.
*
SIGNALATTENTIONMAINLINE RES 0
         LW,11     #BAL                SAVE RETURN REGISTER.
*
         #T#GET,8,7 #DEV#LINE#STATUS#BITS GET STATUS INFO.
         OR,8      =#LINE#ATTENTION    INDICATE ATTENTION.
         #T#PUT,8,7 #DEV#LINE#STATUS#BITS AND RE-TABLE STATUS INFO.
*
         CI,8      #LINE#AWAITING#ATTENTION SEE IF TASK WAITING FOR ATTN
         BAZ       SIGNALATTENTION2235 OVER IF NOT.
         AND,8     =(-#LINE#AWAITING#ATTENTION-1) IF WAS WAITING FOR
         #T#PUT,8,7 #DEV#LINE#STATUS#BITS ATTN, CLEAR FLAG AND
         #T#POST,9,7 #DEV#ECB          POST HIS ECB TO AWAKE HIM.
*
SIGNALATTENTION2235 RES 0
         CI,8      #LINE#AWAITING#REPORT SEE IF TASK AWAITING REPORT.
         BAZ       SIGNALATTENTION4900 DONE IF NOT.
*
         #T#GET,9,7 #DEV#GET#LIST#ID   WAS AWAITING REPORT, SO PURGE
         M:QUEUE   *9,PURGE            HIS LIST TO END THAT WAIT.
         BCR,8     SIGNALATTENTION2445
         #SNAP,30  'Q/PURGE FAILURE'
         B         SIGNALATTENTION4900
SIGNALATTENTION2445 RES 0
         LI,8      0                   ON GOOD PURGE, INDICATE
         #T#PUT,8,7 #DEV#GET#LIST#ID   NO MORE LIST FOR THIS TASK.
*
SIGNALATTENTION4900 RES 0
         LW,#BAL   11                  RESTORE BAL REGISTER.
         #PULL,7,11                    RESTORE CLALER'S REGISTERS.
         B         *#BAL               AND RETURN.
         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                                                   TIC58840
*
*        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     0                   ZERO OUT                         TIC59290
         STW,11    LOGATSIGNCOUNT       THE                             TIC59300
         STW,11    LOGDOLLARCOUNT        VARIOUS                        TIC59310
         STW,11    LOGQUESTIONCOUNT       COUNTS.                       TIC59320
         STW,11    LOGCRITERIACOUNT                                     TIC59330
         STW,11    LOGCRITERIABYTES                                     TIC59340
         STW,11    LOGDELIVERIESCHAINHEAD                               TIC59350
*                                                                       TIC59360
         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.
*
         LW,12     6                   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
*
         LI,8      BA(LOGONPROMPT)     HERE TO PROMPT WITH DEFAULT
         LI,9      LOGONPROMPTSIZE     PROMPT FORS STATION NAME.
*
LOGON2159 RES      0
         #T#PUT,8  #DEV#RECORD#BA
         #T#PUT,9  #DEV#RECORD#LENGTH
         #INITIATE#WRITE#READ                                           TIC59660
         #CHECK#WRITE#READ LOGONIOERROR                                 TIC59670
*                                                                       TIC59680
         #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
         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
         LW,#ARG   8                                                    TIC60080
         LB,10     0,#ARG              GET 'NEXT' RECORD TEXT BYTE.     TIC60090
         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,#ARG   1                   BUMP TO CHAR AFTER THE 2ND AT.   TIC60170
         LB,10     0,#ARG              GET THAT CHARACEER.              TIC60180
         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
         LI,10     BA(PASSWORDPROMPT)  PROMPT                           TIC60420
         #T#PUT,10 #DEV#RECORD#BA       FOR AND                         TIC60430
         LI,10     PASSWORDPROMPTSIZE    READ IN                        TIC60440
         #T#PUT,10 #DEV#RECORD#LENGTH     CLERK'S                       TIC60450
         #INITIATE#WRITE#READ              PASSWORD                     TIC60460
         #CHECK#WRITE#READ LOGONIOERROR                                 TIC60470
*                                                                       TIC60480
*        HAVE JUST READ CLERK'S PASSWORD.                               TIC60490
*                                                                       TIC60500
*        WHEN HERE, R8 STILL HAS BA OF THE @ JUST PRECEEDING PASSWORD.  TIC60510
*                                                                       TIC60520
         #T#GET,5 #DEV#RECORD#BA       BA OF CLERK'S PASSWORD.          TIC60530
         LW,#ARG   8                   BA OF STAI PASSWORD - 1.         TIC60540
LOGON2176 RES      0                                                    TIC60550
         AI,#ARG   1                   BUMP IN STAI RECORD.             TIC60560
         LB,10     0,#ARG              GET STAI CHARACTER.              TIC60570
         CI,10     ' '                 IF BLANK, WE'RE AT END           TIC60580
         BE        LOGON2210            AND SO CLERK MATCHED.           TIC60590
         CB,10     0,5                 COMPARE PASSWORD CHARACTERS.     TIC60600
         BNE       LOGONDIDNOTMATCH    OVER IF BAD.                     TIC60610
         AI,5      1                   LOOP IF                          TIC60620
         B         LOGON2176            GOOD.                           TIC60630
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
*
         LI,8      BA(UNABLETO)                                         TIC60760
         LI,9      21
         #T#PUT,8  #DEV#RECORD#BA      WRITE COMPLAINING MESSAGE        TIC60780
         #T#PUT,9  #DEV#RECORD#LENGTH   AND GO DORMANT:                 TIC60790
         #INITIATE#WRITE                                                TIC60800
         #CHECK#WRITE
*
         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
         B         COMMANDLEVELWAITFORATTENTION                         TIC60820
*                                                                       TIC60830
UNABLETO DATA      X'0DE4D5C1'
         TEXT      'BLE 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
*                                                                       TIC60970
*        WHEN HERE, R6 POINTS TO FIRST CHAR (@) OF MATCHED              TIC60980
*        NAME IN THE STATION NAMES RECORD TEXT.                         TIC60990
*                                                                       TIC61000
         STW,6     LOGATNAMEBA         REMEMBER POINTER-TO-MATCHED-NAME.
*        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
         #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         *15                                                  TIC65280
*                                                                       TIC65290
*                                                                       TIC65300
*                                                                       TIC65310
LOGONPROMPT DATA   X'15D5C1D4'
         TEXT      'E = @'
LOGONPROMPTSIZE EQU 9
PASSWORDPROMPT DATA X'15D7C1E2'
         TEXT      'SWORD = '
PASSWORDPROMPTSIZE EQU 12
*                                                                       TIC65370
*                                                                       TIC65380
LOGONIOERROR RES   0                   HERE ON BAD STATOON I/O.         TIC65390
         BAL,14    LOGONFREESTAIBUFFER
*                                                                       TIC65420
         #EXIT#SPACE                                                    TIC65430
*                                                                       TIC65440
         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
         LW,#ARG   LOGSTAIRECORDDSP
         #FREE#MAIN#BYTES
         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,#ARG   X'0F'               FOR
         AND,#ARG  9                    MULTIPOINT
         LB,10     HEXTABLE,#ARG         THE KEY IS
         LW,#ARG   9                       THE
         SLS,#ARG  -4                     LINEID AND
         LB,9      HEXTABLE,#ARG           PHYSICAL
         SLS,9     8                        DEVICE
         OR,10     9                         ADDRESS
         OR,10     =X'F0F00000'               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.
*
         #SNAP,12  'NO STATION NAMES RECORD'
         #ABORT
*
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 - CHANGE'
*                                                                       TIC65470
*        HERE IN CHECKOUT TO CHANGE ? FQM NAME TO @ FQM NAME            TIC65480
*                                                                       TIC65490
         DO        DO#DEVELOPMENT                                       TIC65500
CHANGE   RES       0                                                    TIC65510
         AI,6      2                   GET THIRD CHAR                   TIC65511
         LB,8      0,6                  OF THE CONMAND.                 TIC65512
         CI,8      '@'                 IF @?#, THEN                     TIC65513
         BE        CHANGEPROTO          SPECIAL ACTION.                 TIC65514
         CI,8      '?'                                                  TIC65515
         BE        CHANGEPROTO                                          TIC65516
         CI,8      '#'                                                  TIC65517
         BE        CHANGEPROTO                                          TIC65518
*                                                                       TIC65519
         LI,6      #FQM#CHAIN          START DOWN THE CHAIN             TIC65520
*                                                                       TIC65530
         LI,9      '@'                 (LOAD THE @ WE'RE INSERTING)     TIC65540
         LI,7      24                  (LOAD BYTE OFFSET TO THE NAME)   TIC65550
*                                                                       TIC65560
CHANGENEXT LW,6    0,6                 DOWN THE CHAIN                   TIC65570
         BEZ       COMMANDLEVELPOSTCOMMAND OUT IF DONE.                 TIC65580
*                                                                       TIC65590
         LB,8      *6,7                GET FIRST BYTE OF NAME           TIC65600
         CI,8      '?'                 IS IT A QUESTION MARK            TIC65610
         BNE       CHANGENEXT          CONTINUE IF NOT                  TIC65620
         STB,9     *6,7                IF SO, MAKE IT A @               TIC65630
         B         CHANGENEXT          AND CONTINUE                     TIC65640
*                                                                       TIC65641
CHANGEPROTO LI,#ARG 3                  MODIFY THE LI INSTRUCTION        TIC65642
         STB,8     TSIGOTPROTO,#ARG     THAT LOADS FIRST CHAR OF FQM NAMTIC65643
         B         COMMANDLEVELPOSTCOMMAND                              TIC65644
         FIN                                                            TIC65650
         TITLE     'TIC - DEV-TASK - COMMAND PROCESSORS - DMODE'
*
DMODE    RES       0                   HERE ON DMODE COMMAND            TIC65670
         FIELD6789LOADAAAAAAAA,COMMANDBAD GET COMMAND NAME.
         CW,8      ='!D  '
         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
         LI,8      BA(DMODEMESSAGE)    COMPLAIN TO                      TIC65830
         LI,9      13                   THE CLERK THAT                  TIC65840
         #T#PUT,8  #DEV#RECORD#BA        HE ENTERED                     TIC65850
         #T#PUT,9  #DEV#RECORD#LENGTH     AN ILLEGAL OPTION.            TIC65860
         #INITIATE#WRITE                                                TIC65870
         #CHECK                                                         TIC65880
         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 DATA  X'0DD5D640'
         TEXT      'SUCH MODE'
*
         BOUND     8
DMODENAME TEXT     '!DMODE  '
         TITLE     'TIC - DEV-TASK - COMMAND PROCESSORS - STATUS'
*                                                                       TIC66140
*        HERE ON !STATUS COMMAND.                                       TIC66150
*                                                                       TIC66160
STATUS   RES       0                                                    TIC66170
*                                                                       TIC66180
         FIELD6789LOADAAAAAAAA,COMMANDBAD GET COMMAND NAME.             TIC66190
         CW,8      ='!S  '             MAKE                             TIC66200
         BE        STATUS120            SURE                            TIC66210
         CW,8      ='!STA'               IT IS                          TIC66220
         BNE       COMMANDNOT             CORRECT.                      TIC66230
         CW,9      ='TUS '                                              TIC66240
         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 14+1+31+1+11  GET BYTES TO BUILD TRANSACTION   TIC66350
*                                      NAME, SURROUNDED BY BYTES TO     TIC66360
*                                      CONTAIN REST OF OUTPUT MESSAGE.  TIC66370
*                                                                       TIC66380
         LW,14     #ARG                REMEMBER DSP OF THE WORKING SPACETIC66390
         LW,5      #ARG                BA OF SPACE TO INDEX REGISTER.   TIC66400
         AI,5      14+1                BUMP TO WHERE TRAN NAME IS TO BE.TIC66410
*                                                                       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      14                  SUBTRACTING -- SUBTRACT FROM     TIC67320
         AI,9      -14-1               START OF WORKING AND THEN ADD IN TIC67330
*                                      BECAUSE CRITERION DOESN'T START  TIC67340
*                                      AT THE BEGINNING.                TIC67350
*                                                                       TIC67360
         LW,10     14                  CREATE POINTER                   TIC67370
         AI,10     14+1                 TO CRITERION.                   TIC67380
*                                                                       TIC67390
         STB,9     10                  PUT SIZE IN.                     TIC67400
*                                                                       TIC67410
         #T#GWA,9  #DEV#ECB            MAKE AN ECB POINTER.             TIC67420
*                                                                       TIC67430
         M:QUEUE   10,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
*        WE NOW BUILD OUR REPLY AROUND THE TRAN NAME                    TIC67620
*        THAT IS IN THE MIDDLE OF THE WORKING STORAGE.                  TIC67630
*                                                                       TIC67640
*        FIRST COPY PREFIX TO FIRST 15 BYTES:
*
         LI,15     15                  CHARACTER COUNT OF
         LI,6      BA(STATUSPREFIX)    STRING TO GO INTO WORKING.       TIC67680
         LW,7      14                  INTO BEGINNING OF WORKING.       TIC67690
         LB,10     0,6                 COPY                             TIC67700
         STB,10    0,7                  STRING                          TIC67710
         AI,6      1                     INTO                           TIC67720
         AI,7      1                      WORKING.                      TIC67730
         BDR,15    %-4                                                  TIC67740
*                                                                       TIC67750
*        STATUS BITS ARE STILL IN R8.                                   TIC67760
*                                                                       TIC67770
         AI,8      STATUSANSWERSLIST   POINT R8 TO POINTER TO ANSWER.   TIC67780
         LW,6      *8                  LOAD LENGTH AND BA OF ANSWER.    TIC67790
*                                                                       TIC67800
*        WE STORE THE ANSWER IN WORKING STARTING AT THE NULL            TIC67810
*        (X'00') THAT WE PUT AT THE END OF THE TRAN NAME.               TIC67820
*                                                                       TIC67830
         LW,7      14                  BA OF WORKING.                   TIC67840
         AI,7      14+1+1+8            (WE KNOW END OF NAME IS AT       TIC67850
*                                      LEAST THIS FAR INTO WORKING)     TIC67860
         AI,7      1                   SCAN FOR                         TIC67870
         LB,10     0,7                  THE ZERO                        TIC67880
         BNEZ      %-2                   BYTE.                          TIC67890
*                                                                       TIC67900
*        HERE WITH LENGTH AND LOCATION OF ANSWER IN R6 AND              TIC67910
*        WHERE IN WORKING TO PUT IT  IN R7.                             TIC67920
*                                                                       TIC67930
         LB,15     6                   COPY THE COUNT.                  TIC67940
         LB,10     0,6                 COPY                             TIC67950
         STB,10    0,7                  ANSWER                          TIC67960
         AI,6      1                     INTO                           TIC67970
         AI,7      1                      WORKING.                      TIC67980
         BDR,15    %-4                                                  TIC67990
*                                                                       TIC68000
*        R7 HAS THE BA OF LAST-GOOD-BYTE-PLUS-ONE IN WORKING.           TIC68010
*                                                                       TIC68020
*        ALSO, ITS BITS IN 0-12 ARE THE SAME AS R14'S.                  TIC68030
*                                                                       TIC68040
         SW,7      14                  CALCULATE COUNT.                 TIC68050
*                                                                       TIC68060
         #T#PUT,14 #DEV#RECORD#BA      STORE DSP TO STRING.             TIC68070
         #T#PUT,7  #DEV#RECORD#LENGTH  STORE CHARACTER COUNT.           TIC68080
         #INITIATE#WRITE               TELL THE STATUS                  TIC68090
         #CHECK#WRITE STATUS800                                         TIC68100
*                                                                       TIC68110
STATUS800 B        COMMANDLEVELPOSTCOMMAND                              TIC68120
*                                                                       TIC68130
*                                                                       TIC68140
*                                                                       TIC68150
STATUSBAD RES      0                                                    TIC68160
         LW,#ARG   14                  GET DSP TO WORKING.              TIC68170
         #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 TEXT  ' TRANSACTION '                                      TIC68280
*                                                                       TIC68290
STATUSANSWERSLIST RES 0                                                 TIC68300
         GEN,8,24  8,BA(TEXTUNKNOWN)
         GEN,8,24  8,BA(TEXTUNKNOWN)
         GEN,8,24  8,BA(TEXTUNKNOWN)
         GEN,8,24  8,BA(TEXTUNKNOWN)
         GEN,8,24  8,BA(TEXTUNKNOWN)
         GEN,8,24  8,BA(TEXTUNKNOWN)
         GEN,8,24  8,BA(TEXTUNKNOWN)
         GEN,8,24  8,BA(TEXTUNKNOWN)
         GEN,8,24  07,BA(TEXTQUEUED)
         GEN,8,24  12,BA(TEXTINPROGRESS)
         GEN,8,24  07,BA(TEXTFAILED)
         GEN,8,24  10,BA(TEXTILLEGAL)
         GEN,8,24  07,BA(TEXTQUEUED)
         GEN,8,24  12,BA(TEXTINPROGRESS)
         GEN,8,24  07,BA(TEXTFAILED)
         GEN,8,24  10,BA(TEXTILLEGAL)
*                                                                       TIC68470
TEXTILLEGAL TEXT   ' ILLEGAL!!'                                         TIC68480
TEXTINPROGRESS TEXT ' IN PROGRESS'                                      TIC68490
TEXTFAILED TEXT    ' FAILED'                                            TIC68500
TEXTQUEUED TEXT    ' QUEUED'                                            TIC68510
TEXTUNKNOWN TEXT   ' 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
         #T#PUT,5  #DEV#RECORD#BA                                       TIC69370
         #T#PUT,6  #DEV#RECORD#LENGTH                                   TIC69380
         #INITIATE#WRITE                                                TIC69390
         #CHECK#WRITE COMMANDLEVELPOSTCOMMAND                           TIC69400
         B         COMMANDLEVELPOSTCOMMAND                              TIC69410
*                                                                       TIC69420
ECHONOQUOTE RES 0                                                       TIC69430
*
         LI,5      0                   INDICATE NO R5 BUFFER.
*
         LI,4      BA(ECHOMESSAGEONE)  SEND FIRST
         BAL,14    BUFFERTEXTC414       PART OF MESSAGE.
*
         #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,4      BA(ECHOMESSAGETWO)  SEND MORE
         BAL,14    BUFFERTEXTC414       OF MESSAGE.
*
         #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,4      BA(ECHOMESSAGETHREE) SEND MORE
         BAL,14    BUFFERTEXTC414       OF MESSAGE
*
         #T#GET,6  #DEV#COMMAND#LINE#RECORD#BA RE-OBTAIN
         AND,6     =X'7FFFF'           BA OF THE ECHO COMMAND.
*
ECHO6400 LI,12     20                  MAX CHARACTERS 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,12    ECHO6420            BACK TO PUT NEXT CHAR ON THIS LIN
         LI,4      BA(ECHOMESSAGEFOUR) OR TO THE
         BAL,14    BUFFERTEXTC414       NEXT LINE.
         B         ECHO6400            AND BACK.
*
ECHO6700 RES       0                   HERE TO FINISH.
         LI,4      BA(ECHOMESSAGEFIVE) SEND LAST PART
         BAL,14    BUFFERTEXTC414       OF MESSAGE.
         BAL,13    BUFFERFLUSH         DUMP BUFFER.
         B         COMMANDLEVELPOSTCOMMAND                              TIC69510
*
*
*
ECHOMESSAGEONE RES 0
         DATA      X'0C0D0CC6'
         TEXT      'R0M LINE '
*
ECHOMESSAGETWO RES 0
         TEXTC     '  '
*
ECHOMESSAGETHREE RES 0
         DATA      X'0D40C3C8'
         TEXT      'ARACTERS'
         DATA      X'15150000'
*
ECHOMESSAGEFOUR RES 0
         DATA      X'02151500'
*
ECHOMESSAGEFIVE RES 0
         DATA      X'02151500'
         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.
*
*
*
BUFFERTEXTC414 RES 0
         LB,8      0,4                 COPY CHAR COUNT.
         AI,4      1                   BUMP TO TEXT.
*
         STB,8     14                  COUNT --> INTERESTING PLACE.
*
         LB,8      0,4                 BUFFER OUT
         BAL,13    BUFFERR8             ONE BYTE.
*
         LB,8      14                  RETRIEVE COUNT.
         AI,8      -1                  DECREMENT COUNT.
         BGZ       %-6                 BACK IF NOT DONE.
*
         B         *14
*
*
*
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.
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.
*
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.
         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.
         TITLE     'TIC - DEV-TASK - COMMAND PROCESSORS'
*
         DO        DO#DEVELOPMENT                                       TIC69530
MCOLON   RES       0                                                    TIC69540
         AI,6      2                   HERE ON SPECIAL COMMAND          TIC69550
         LB,8      0,6                  WHICH ALLOWS THE TERMINATION    TIC69560
         CI,8      ':'                   OF TIC/DEMO FROM A STATION     TIC69570
         BNE       ECHO                   (INSTEAD OF NEEDING AN X)     TIC69580
*                                                                       TIC69590
*        WHEN HERE, WE KNOW WE WILL TERMINATE BELOW, SO:                TIC69600
*                                                                       TIC69610
         M:CLOSE   F:JRNL,(SAVE)                                        TIC69620
         M:CLOSE   F:TFDI                                               TIC69630
*                                                                       TIC69640
         AI,6      1                                                    TIC69650
         LB,8      0,6                 GET TYPE OF M: TO DO             TIC69660
         CI,8      'R'                 TEST FOR RETURN                  TIC69670
         BE        MCOLONR              OVER IF SO                      TIC69680
         CI,8      'A'                 TEST FOR ABORT                   TIC69690
         BE        MCOLONA              OVER IF SO                      TIC69700
MCOLONE  M:ERR     63                  NOT RETURN, MUST BE ERR          TIC69710
MCOLONR  M:EXIT                        WAS R = RETURN = EXIT            TIC69720
MCOLONA  DATA      0                   GIVE A TRUE ABORT                TIC69730
         FIN                                                            TIC69740
         TITLE     'TIC - OPCOM - UTILITIES'
*                                                                       TIC69760
*        BUILD LIST OF AFFECTED STATIONS BY #DEV NUMBER.                TIC69770
*                                                                       TIC69780
*        ENTER WITH C(R8) = FIRST FOUR CHAR OF STATION-SPECIFICATION.   TIC69790
*                   C(R9) = LAST FOUR CHAR OF STATION-SPECIFICATION.    TIC69800
*                                                                       TIC69810
*        RETURNS IN R8 DSP OF A LIST OF HW #DEV NUMBERS,                TIC69820
*        FOLLOWED BY A HW -1.                                           TIC69830
*                                                                       TIC69832
*        USES R5 AND R10.                                               TIC69833
*                                                                       TIC69840
MAKESTATIONLIST RES 0                                                   TIC69850
         AI,8      0                   SEE IF NO FIELD = ALL STATIONS.  TIC69860
         BEZ       MAKESTATIONLISTALL  OVER IF SO.                      TIC69870
*
*        FIRST CONVERT THE EBCDIC IN R9
*        TO HEX IN CASE WE GET TO THE CODE
*        DOWN AT MAKESTATIONLIST237-242:
*
         CW,9      ='    '             IS IT HEX IN EBCDIC.
         BE        MAKESTATIONLIST205  OVER IF NOT.
*
         LW,5      9
         LI,9      0
         LB,#ARG   5
         EOR,#ARG  =X'F0'
         CI,#ARG   X'F0'
         BAZ       %+2
         AI,#ARG   9-48
         SLS,9     4
         OR,9      #ARG
         SLS,5     8
         AI,5      0
         BNEZ      %-9
*                                                                       TIC69880
MAKESTATIONLIST205 RES 0
         LW,5      #BIGGEST#TIC#TASK   FOR ALL STATIONS, SEE IF SPECIFIETIC69890
MAKESTATIONLIST210 RES 0                                                TIC69900
         #T#GET,10,5 #DEV#LINE#IDENTIFIER STATION'S IDENTIFIER.         TIC69910
         CW,10     8                   IS IT THE SAME?                  TIC69920
         BEZ       MAKESTATIONLIST250  OUT IF THE SAME.                 TIC69930
         BDR,5     MAKESTATIONLIST210  LOOP TRYING FOR MATCH.           TIC69940
*                                                                       TIC69950
*        FALL THROUGH ON NO HIT WITH POINT-TO-POINT                     TIC69960
*        LINE-ID'S - SO TRY MULTI-POINT ID'S:                           TIC69970
*                                                                       TIC69980
         LW,5      #BIGGEST#MDL#TASK
MAKESTATIONLIST220 RES 0
         #T#GET,10,5 #DEV#LINE#IDENTIFIER
         CW,10     8
         BE        MAKESTATIONLIST230
         BIR,5     MAKESTATIONLIST220
*                                                                       TIC69990
*        FALL THROUGH ON NO MULTI-POINT MATCH EITHER.                   TIC70000
*                                                                       TIC70010
         LI,8      0                   RETURN NO LIST.                  TIC70020
         B         *15                                                  TIC70030
*
MAKESTATIONLIST230 RES 0
         CW,9      ='    '
         BE        MAKESTATIONLIST645
*
*        FALL THROUGH WHEN IT'S A PARTICULAR MULTIPOINT STATION.
*
         LW,10     5                   COPY MDC-TASK NUMBER.
*
         LW,5      #BIGGEST#TIC#TASK   FOR ALL DEV-TASKS,
MAKESTATIONLIST237 RES 0                SEE IF
         #T#GET,#ARG,5 #DEV#DCB#POINTER  MDL-TASK
         CW,#ARG   10                     NUMBER AND
         BNE       MAKESTATIONLIST242      PHYSICAL
         #T#GET,#ARG,5 #DEV#LINE#IDENTIFIER IDENTIFIER
         CW,#ARG   9                          AGREE.
         BE        MAKESTATIONLIST250  OUT TO MAKE LIST IF SO.
MAKESTATIONLIST242 RES 0
         BDR,5     MAKESTATIONLIST237  LOOP FOR ALL DEV-TASKS.
*
         LI,8      0                   IF NO MATCH,
         B         *15                  RETURN NO LIST.
*                                                                       TIC70040
MAKESTATIONLIST250 RES 0               HERE TO MAKE ONE-POINT-TO-POINT- TIC70050
*                                      STATION LIST.                    TIC70060
         #GET#MAIN#BYTES 4                                              TIC70070
         LW,8      #ARG                COPY DSP TO RETURN REGISTER.     TIC70080
         SLS,#ARG  -1                  HA OF LIST.                      TIC70090
         STH,5     0,#ARG              STATION'S #DEV --> LIST.         TIC70100
         AI,#ARG   1                   BUMP TO NEXT (= LAST) HW.        TIC70110
MAKESTATIONLIST290 RES 0                                                TIC70120
         LI,10     -1                  FENCE.                           TIC70130
         STH,10    0,#ARG              TO LIST.                         TIC70140
         AI,8      0                   SET RETURN CC.                   TIC70150
         B         *15                 AND RETURN.                      TIC70160
*                                                                       TIC70170
MAKESTATIONLISTALL RES 0               HERE TO MAKE LIST OF ALL STATIONSTIC70180
         LW,#ARG   #BIGGEST#TIC#TASK   NUMBER OF STATIONS.              TIC70190
         AI,#ARG   1                   PLUS ONE FOR FENCE.              TIC70200
         SLS,#ARG  1                   DOUBLED FOR HALFWORDS.           TIC70210
         #GET#MAIN#BYTES                GET THAT MANY BYTES.            TIC70220
*                                                                       TIC70230
         LW,8      #ARG                DSP OF LIST TO RETURN REGISTER.  TIC70240
*                                                                       TIC70250
         SLS,#ARG  -1                  HA OF LIXT.                      TIC70260
         LW,10     #BIGGEST#TIC#TASK   PUT ALL                          TIC70270
         STH,10    0,#ARG               STATIONS                        TIC70280
         AI,#ARG   1                     INTO LIST.                     TIC70290
         BDR,10    %-2                                                  TIC70300
*                                                                       TIC70310
         B         MAKESTATIONLIST290  BACK TO STORE FENCE AND EXIT.    TIC70320
*
*
*
MAKESTATIONLIST645 RES 0               HERE FOR ALL STATIONS ON
*                                       THE INDICATED MULTIPOINT LINE
         LW,10     5                   COPY MDL-TASK NUMBER.
         LW,5      #BIGGEST#TIC#TASK   FOR ALL DEV-TASKS.
         LI,9      2                   COUNT THE
MAKESTATIONLIST670 RES 0                ONES THAT ARE
         #T#GET,#ARG,5 #DEV#DCB#POINTER  ASSOCIATED
         CW,#ARG   10                     WITH THIS
         BNE       %+2                      MDL LINE.
         AI,9      2                   (COUNT IS 2*N+2 FOR EASE LATER)
         BDR,5     MAKESTATIONLIST670
*
         LW,#ARG   9                   GET 2*N+2 BYTES.
         #GET#MAIN#BYTES
         LW,8      #ARG                COPY STORAGE DSP TO RETURN REGIST
         SLS,#ARG  -1                  HA OF LIST.
         STW,#ARG  9                   TO R9.
*
         LW,5      #BIGGEST#TIC#TASK   FOR ALL DEV-TASKS.
MAKESTATIONLIST690 RES 0                SCAN
         #T#GET,#ARG,5 #DEV#DCB#POINTER  AGAIN
         CW,#ARG   10                     AND PUT
         BNE       %+4                     RIGHT ONES
         LW,#ARG   9                        INTO LIST.
         STH,5     0,#ARG
         AI,9      1
         BDR,5     MAKESTATIONLIST690
*
         LI,10     -1                  THEN PUT
         LW,#ARG   9                    FENCE AT
         STH,10    0,#ARG                THE END.
*
         AI,8      0                   SET RETURN CC.
         B         *15                 AND RETURN.
         PAGE                                                           TIC70330
*                                                                       TIC70340
*                                                                       TIC70350
*                                                                       TIC70360
OPERATORMESSAGE RES 0                  HERE ON "!MESSAGE"               TIC70370
         FIELD6789LOADAAAAAAAA,OPERATORCOMMANDNOT GET COMMAND NAME      TIC70380
         CW,8      ='M   '                                              TIC70390
         BE        %+3                                                  TIC70400
         CD,8      OPERATORMESSAGENAME                                  TIC70410
         BNE       OPERATORCOMMANDNOT                                   TIC70420
*                                                                       TIC70430
         LW,5      6                   COPY SCAN POINTER.               TIC70440
         FIELD6789LOADAAAAAAAA,OPERATORCOMMANDNOT GET NEXT FIELD.       TIC70450
         LB,10     8                   ISOLATE FIELD'S FIRST CHARACTER. TIC70460
*                                                                       TIC70470
         CI,10     ''''                SEE IF FIELD IS QUOTED.          TIC70480
         BNE       OPERATORMESSAGELIST IF NO QUOTES, MAKE STATION LIST. TIC70490
*                                                                       TIC70500
*        SECOND FIELD WAS QUOTED.  SO WE WANT TO SEND TO ALL STATIONS   TIC70510
*                                                                       TIC70520
         LW,6      5                   PUT SCAN POINTER BACK.           TIC70530
*                                                                       TIC70540
         LI,8      0                   AND SET FOR LIST OF ALL STATIONS.TIC70550
*                                                                       TIC70560
*                                                                       TIC70570
OPERATORMESSAGELIST RES 0                                               TIC70580
         BAL,15    MAKESTATIONLIST                                      TIC70590
         BEZ       OPERATORNOWHERE                                      TIC70600
         LW,12     8                                                    TIC70610
*                                                                       TIC70620
*        WHEN HERE, DSP OF STATION LIST IS IN R12.                      TIC70630
*                                                                       TIC70640
         FIELD6789POINTTOSTRING,OPERATORMESSAGEBAD                      TIC70650
*                                                                       TIC70660
         LW,#ARG   9                   CHARACTER COUNT.                 TIC70670
         #GET#MAIN#BYTES                GET SPACE FOR 'EM.              TIC70680
         LW,10     8                   BA OF QUOTED STRING.             TIC70690
         LW,11     #ARG                BA OF WHERE TO PUT STRING.       TIC70700
         STB,9     11                  PUT IN COUNT.                    TIC70710
         STW,11    13                  AND SAVE BA & COUNT WORD.        TIC70715
         MBS,10    0                   MOVE BYTES (<255 'CAUS OF OP'S LLTIC70720
*                                                                       TIC70730
*        WHEN HERE, DSP TO STATION LIST IN R12 AND                      TIC70740
*        DSP TO MESSAGE IN R8.                                          TIC70750
*                                                                       TIC70760
         #GET#MAIN#BYTES 12            GET THREE WORDS.                 TIC70770
         AND,#ARG  =X'7FFFF'           NEATEN BA.                       TIC70780
         SLS,#ARG  -2                  INTO A WA.                       TIC70790
*                                                                       TIC70800
         STW,12    1,#ARG              STATION LIST DSP TO WORD ONE.    TIC70810
         STW,13    2,#ARG              MESSAGE LAL TO WORD TWO.         TIC70820
*                                                                       TIC70830
         LW,9      #MESSAGE#CHAIN      CHAIN THE THREE WORD             TIC70840
         STW,#ARG  #MESSAGE#CHAIN       BLOCK INTO THE CHAIN            TIC70850
         STW,9     *#ARG                 OF PENDING MESSAGES.           TIC70860
*                                                                       TIC70870
         B         OPERATORDIDCOMMAND                                   TIC70880
*                                                                       TIC70890
*                                                                       TIC70900
*                                                                       TIC70910
OPERATORMESSAGEBAD RES 0                                                TIC70920
         LW,#ARG   12                  DSP OF STATION LIST.             TIC70930
         #FREE#MAIN#BYTES              RETURN SPACE.                    TIC70940
         B         OPERATORCOMMANDBAD  AND EXIT                         TIC70950
*                                                                       TIC70960
*                                                                       TIC70970
*                                                                       TIC70980
         BOUND     8                                                    TIC70990
OPERATORMESSAGENAME TEXT 'MESSAGE '                                     TIC71000
         PAGE                                                           TIC71010
*                                                                       TIC71020
*        HERE ON OPERATOR 'REGULATE' COMMAND.                           TIC71030
*                                                                       TIC71040
OPERATORREGULATE RES 0                                                  TIC71050
*                                                                       TIC71060
         FIELD6789LOADAAAAAAAA,OPERATORBAD GET COMMAND NAME.            TIC71070
         CW,8      ='R   '             CHECK IT.                        TIC71080
         BE        %+3                 SHOULD BE 'REGULATE'             TIC71090
         CW,9      ='LATE'             OR                               TIC71100
         BNE       OPERATORCOMMANDNOT  JUST FIRST LETTER.               TIC71110
*
         STW,6     13                  REMEMBER THE SCAN POINTER.
*                                                                       TIC71120
         FIELD6789LOADAAAAAAAA,OPERATORBAD                              TIC71130
         LB,10     8                                                    TIC71140
         CI,10     '?'                                                  TIC71150
         BE        OPERATORREGULATE200 ALL IF @?# HERE.                 TIC71160
         CI,10     '@'                                                  TIC71170
         BE        OPERATORREGULATE200 ALL IF @?# HERE.                 TIC71180
         CI,10     '#'                                                  TIC71190
         BE        OPERATORREGULATE200 ALL IF @?# HERE.                 TIC71200
         CI,10     'O'                 ALL IF ON/OFF HERE.
         BE        OPERATORREGULATE200
*                                                                       TIC71230
         BAL,15    MAKESTATIONLIST                                      TIC71240
         BEZ       OPERATORCOMMANDBAD                                   TIC71250
         B         OPERATORREGULATE210
*                                                                       TIC71300
OPERATORREGULATE200 RES 0                                               TIC71310
         LI,8      0                   SET TO CREATE LIST
         BAL,15    MAKESTATIONLIST      OF ALL STATIONS.
*
OPERATORREGULATE210 RES 0
         LW,14     8                   COPY DSP OF STATION LIST.
*
         LW,6      13                  RE-LOAD SCAN POINTER.
OPERATORREGULATE220 RES 0
         FIELD6789LOADAAAAAAAA,OPERATORREGULATEBAD
         LB,10     8                   GET FISST CHAR OF FIELD.
         CI,10     'O'                 ISS IF ON/OFF
         BNE       OPERATORREGULATE220 LOOP UNTIL WE FIND IT.
*
         SLS,8     8                   GET NEXT CHARACTER OF FIELD.
         LB,10     8                   ISOLATED.
         CI,10     'N'                 SEE IF 'ON'
         BE        OPERATORREGULATE500 OVER IF 'ON'
         CI,10     'F'                 SEE IF 'OFF'
         BE        OPERATORREGULATE400 OVER IF 'OFF'
*
*        FALL THROUGH IF NO ON/OFF FIELD.
*
OPERATORREGULATEBAD RES 0
         LW,#ARG   14                  RETRIEVE DSP OF STATION LIST.
         #FREE#MAIN#BYTES              AND FREE IT.
         B         OPERATORCOMMANDBAD  AND COMPLAIN ABOUT SYNTAX.
*
*
*
OPERATORREGULATE400 RES 0              HERE ON 'OFF'
         LW,6      13                  RE-LOAD SCAN POINTER.
         LI,12     0                   LOAD BITS TO OR IN.
*
OPERATORREGULATE405 RES 0
         FIELD6789LOADAAAAAAAA,OPERATORREGULATEBAD NO WAY TO TAKE CF(2).
         LB,10     8                   ISOLATE FIRST BYTE.
         CI,10     'O'                 ARE WE AT 'OFF' YET.
         BE        OPERATORREGULATE440 OVER IF SO.
*
         CI,10     '?'                 TEST FOR
         BNE       %+2                  EACH CHARACTER
         OR,12     =#REGULATE#QUESTION   AND ADJUST R12.
         CI,10     '@'
         BNE       %+2
         OR,12     =#REGULATE#AT
         CI,10     '#'
         BNE       OPERATORREGULATE405
         OR,12     =#REGULATE#CRUNCH
         B         OPERATORREGULATE405
*
OPERATORREGULATE440 RES 0
         AI,12     0                   SEE IF NO REGULATIONS.
         BNEZ      %+2                 OVER IF SOME REGULATION.
         LI,12     #REGULATE#QUESTION+#REGULATE#AT+#REGULATE#CRUNCH
*                                      (NO REGULATION = ALL REGULATION)
*
         LW,7      14                  COPY DSP OF STATION LIST.
         SLS,7     -1                  MAKE IT A HA.
OPERATORREGULATE450 RES 0
         LH,5      0,7                 GET A STATION BY #DEV.
         BLZ       OPERATORREGULATE700 OVER IF DONE EM ALL.
         #T#GET,10,5 #DEV#REGULATION   GET CURRENT REGULATION.
         OR,10     12                  AND CHANGE APPROPO.
         #T#PUT,10,5 #DEV#REGULATION   AND PUT THEM BACK.
         #T#GET,10,5 #DEV#LINE#STATUS#BITS ALSO SIGNAL
         OR,10     =#LINE#REGULATED     THAT WE REGULATED.
         #T#PUT,10,5 #DEV#LINE#STATUS#BITS
         AI,7      1                   BUMP TO NEXT STATION OR FENCE.
         B         OPERATORREGULATE450 AND PROCESS IT.
*
*
*
OPERATORREGULATE500 RES 0              HERE ON 'ON'.
         LW,6      13                  RE-LOAD SCAN POINTER.
         LI,12     -1                  SET TO LEAVE ALL BITS ON.
*
OPERATORREGULATE505 RES 0
         FIELD6789LOADAAAAAAAA,OPERATORREGULATEBAD
         LB,10     8                   ISOLATE FIRST BYTE OF FIELD.
         CI,10     'O'                 ARE WE AT 'ON' YET.
         BE        OPERATORREGULATE540 OVER IF SO.
*
         CI,10     '?'                 ADJUST R12
         BNE       %+2                  FOR THE PRESENT
         AND,12    =(-#REGULATE#QUESTION-1) FIELDS.
         CI,10     '@'
         BNE       %+2
         AND,12    =(-#REGULATE#AT-1)
         CI,10     '#'
         BNE       OPERATORREGULATE505
         AND,12    =(-#REGULATE#CRUNCH-1)
         B         OPERATORREGULATE505
*
OPERATORREGULATE540 RES 0
         LW,7      14                  COPY DSP OF STATION LIST.
         SLS,7     -1                  AND MAKE IT A HA.
*
         CI,12     -1                  SEE IF NO REGULATIONS PRESENT.
         BNE       %+2                 OVER IF SOME PRESENT.
         LI,12     0                   IF NONE PRESENT, 'ON' ALL.
OPERATORREGULATE550 RES 0
         LH,5      0,7                 GET THE #DEV OF A STATION.
         BLZ       OPERATORREGULATE700 DONE IF ITS THE FENCE.
*
         #T#GET,10,5 #DEV#REGULATION   GET CURRENT REGULATIONS.
         AND,10    12                  AND ADJUST THEM.
         #T#PUT,10,5 #DEV#REGULATION   AND PUT THEM BACK.
         #T#GET,10,5 #DEV#LINE#STATUS#BITS AND THEN
         OR,10     =#LINE#REGULATED     INDICATE WE
         #T#PUT,10,5 #DEV#LINE#STATUS#BITS REGULATED HIM.
*
         AI,7      1                   BUMP TO NEXT STATION OR FENCE.
         B         OPERATORREGULATE550 AND GO PROCESS.
*
*
*
OPERATORREGULATE700 RES 0              HERE WHEN DONE REGULATIOG.
         LW,#ARG   14                  DSP OF STATION LIST.
         #FREE#MAIN#BYTES              FREE THE STATION LIST.
         B         OPERATORDIDCOMMAND  AND WE ARE DONE.
         PAGE                                                           TIC71320
*                                                                       TIC71330
*        HERE ON OPERATOR 'NET' COMMAND.                                TIC71340
*                                                                       TIC71350
OPERATORNET RES    0                                                    TIC71360
*                                                                       TIC71370
         FIELD6789LOADAAAAAAAA                                          TIC71380
         CW,8      ='NET '                                              TIC71390
         BE        %+3                                                  TIC71400
         CW,8      ='N   '                                              TIC71410
         BNE       OPERATORBAD                                          TIC71420
*                                                                       TIC71430
         FIELD6789LOADAAAAAAAA                                          TIC71440
         CW,8      ='OFF '                                              TIC71450
         BE        OPERATORNETOFF                                       TIC71460
         CW,8      ='ON  '                                              TIC71470
         BNE       OPERATORBAD                                          TIC71480
*                                                                       TIC71490
OPERATORNETON RES  0                                                    TIC71500
         #POST#ECB #NET#ECB                                             TIC71510
         B         OPERATORDIDCOMMAND                                   TIC71520
*                                                                       TIC71530
OPERATORNETOFF RES 0                                                    TIC71540
         #CLEAR#ECB #NET#ECB                                            TIC71550
         B         OPERATORDIDCOMMAND                                   TIC71560
         PAGE                                                           TIC71570
*                                                                       TIC71580
*        HERE ON OPERATOR 'DISPLAY' COMMAND.                            TIC71590
*                                                                       TIC71600
OPERATORDISPLAY RES 0                                                   TIC71610
*                                                                       TIC71620
         FIELD6789LOADAAAAAAAA,OPERATORCOMMANDNOT                       TIC71630
         CW,8      ='D   '             MAKE                             TIC71640
         BE        %+3                  SURE                            TIC71650
         CW,9      ='LAY '               GOOD                           TIC71660
         BNE       OPERATORCOMMANDNOT     COMMAND.                      TIC71670
*                                                                       TIC71680
         FIELD6789LOADAAAAAAAA,OPERATORDISPLAYALL GET STATIONS.         TIC71690
         B         OPERATORDISPLAYLIST  AND OVER TO MAKE LIST.          TIC71700
*                                                                       TIC71710
OPERATORDISPLAYALL RES 0               HERE ON ALL STATIONS.            TIC71720
         LI,8      0                                                    TIC71730
*                                                                       TIC71740
OPERATORDISPLAYLIST RES 0                                               TIC71750
         BAL,15    MAKESTATIONLIST     MAKE LIST OF STATIONS TO DISPLAY.TIC71760
         BEZ       OPERATORCOMMANDBAD  OUT IF NO STATIONS.              TIC71770
*                                                                       TIC71780
*        HERE WITH DSP OF LIST OF HW STATION                            TIC71790
*        NUMBERS IN R8.  DISPLAY 'EM.                                   TIC71800
*                                                                       TIC71810
         LW,14     8                   REMEMBER DSP FOR LATER FREEING.  TIC71820
*                                                                       TIC71830
         SLS,8     -1                  R8 TO HW ADDRESS OF #DEV NUMBERS.TIC71840
*                                                                       TIC71850
         LW,7      8                                                    TIC71860
*                                                                       TIC71862
OPERATORDISPLAY222 RES 0                                                TIC71863
         LH,5      0,7                 GET A #DEV TO DISPLAY.
         BLZ       OPERATORDISPLAYDONE OVER WHEN WE HIT FENCE.          TIC71880
*                                                                       TIC71890
*        HAVE #DEV TO DISPLAY IN R5.
*                                                                       TIC71910
*        WE CAN USE STATIC STORAGE TO FORMAT OUR                        TIC71920
*        DISPLAY LINE BECAUSE THIS IS NOT RE-ENTRANT                    TIC71930
*        ROUTINE SINCE IT IS M:INT CONTROLLED.                          TIC71940
*                                                                       TIC71950
         #T#GET,10,5 #DEV#LINE#IDENTIFIER
         STW,10    OPERATORDISPLAYBUFFERID                              TIC71970
         LW,11     ='    '
         STW,11    OPERATORDISPLAYBUFFERID+1
*
         #T#GET,6,5 #DEV#DCB#POINTER   SEE IF MULTIPOINT
         BGZ       OPERATORDISPLAY340  OVER IF NOT.
*
*        FALL THROUGH IF MULTIPOINT.
*        R10 HAS PHYSICAL ADDRESS.
*
         SLD,10    -16                 CONVERT
         LI,12     4                    PHYSICAL
         LI,10     0                     ADDRESS
         SLD,10    4                      IN R10
         LW,#ARG   10                      TO EBCDIC
         LB,10     HEXTABLE,#ARG            PHYSICAL
         SLS,13    8                         ADDRESS
         OR,13     10                         IN R13.
         BDR,12    %-6
*
         #T#GET,12,6 #DEV#LINE#IDENTIFIER GET REAL ID OF MULTIPOINT LINE
         STW,12    OPERATORDISPLAYBUFFERID STORE UDENTIFIER.
         STW,13    OPERATORDISPLAYBUFFERID+1 AND PHYSICAL ADDRESS.
*
OPERATORDISPLAY340 RES 0
*                                                                       TIC71972
         LW,11     =' NOT'             SET NOT LOGGED ON - FOR BELOW.
         STW,11    OPERATORDISPLAYBUFFERNOT                             TIC71980
         LI,6      31                  LOAD SHORT COUNT IN CASE NOT LOGG
*                                                                       TIC71981
         #T#GET,10,5 #DEV#LOGON#BLOCK  SEE IF LOGGED ON.
         BEZ       OPERATORDISPLAY600  SEND SHORT MESSAGE IF NOT.
*                                                                       TIC72010
OPERATORDISPLAY400 RES 0                                                TIC72012
         LW,11     =' IS '             IF LOGGED ON, TURN               TIC72014
         STW,11    OPERATORDISPLAYBUFFERNOT 'NOT' INTO 'IS'.            TIC72015
*                                                                       TIC72016
         #T#GET,6,5 #DEV#DOING
         LD,10     OPERATORDISPLAYDOINGS,6                              TIC72030
         STW,10    OPERATORDISPLAYBUFFERDOING                           TIC72040
         STW,11    OPERATORDISPLAYBUFFERDOING+1                         TIC72050
*                                                                       TIC72060
         LW,11     ='    '             BLANK OUT NAME PLACE             TIC72061
         STW,11    OPERATORDISPLAYBUFFERNAME      IN THE                TIC72062
         STW,11    OPERATORDISPLAYBUFFERNAME+1     MESSAGE.             TIC72063
*                                                                       TIC72064
         #T#GET,6,5 #DEV#AT#NAME#LAL   GET POINTER TO HIS NAME.
         LB,11     6                   ISOLATE BYTE COUNT.              TIC72071
         AI,11     -1                  LESS TRAILING PERIOD.            TIC72072
         LI,#ARG   BA(OPERATORDISPLAYBUFFERNAME) WHERE TO PUT NAME.
         LB,12     0,6                 COPY                             TIC72074
         STB,12    0,#ARG               HIS
         AI,6      1                     NAME                           TIC72076
         AI,#ARG   1                      TO
         BDR,11    %-4                     MESSAGE.                     TIC72078
*
         LI,6      67                  LOAD MIDDLE LENGTH.
         #T#GET,9,5 #DEV#REGULATION    SEE IF REGULATED.
         BEZ       OPERATORDISPLAY600  SEND MIDDLE LENGTH IF NOT.
*
*        FALL THROUGH IF SOME REGULATION.
*
         LI,6      80                  MESSAGE LENGTH UP TO REGULATION.
         CI,9      #REGULATE#QUESTION  SEE IF ?-REG.
         BAZ       %+4                 OVER IF NOT.
         LI,8      '?'                 IF SO, PUT CHAR
         STB,8     OPERATORDISPLAYBUFFER,6 IN OUTPUT BUFFER
         AI,6      2                     AND BUMP POINTER.
         CI,9      #REGULATE#AT
         BAZ       %+4                 AND THE SAME FOR OTHER TWO ...
         LI,8      '@'
         STB,8     OPERATORDISPLAYBUFFER,6
         AI,6      2
         CI,9      #REGULATE#CRUNCH
         BAZ       %+4
         LI,8      '#'
         STB,8     OPERATORDISPLAYBUFFER,6
         AI,6      2
*
OPERATORDISPLAY600 RES 0
         STB,6     OPERATORDISPLAYBUFFER BYTE COUNT --> TEXTC COUNT.
*
         M:TYPE    (MESS,OPERATORDISPLAYBUFFER)
*
         AI,7      1                   BUMP TO NEXT HW STATION #DEV.
         B         OPERATORDISPLAY222  AND GO TO DISPLAY NEXT STATION.
*                                                                       TIC72080
*                                                                       TIC72090
*                                                                       TIC72100
*                                                                       TIC72110
*                                                                       TIC72120
OPERATORDISPLAYBUFFER        TEXT      'XDEVICE '
OPERATORDISPLAYBUFFERID      TEXT      'AAAABBBB'
OPERATORDISPLAYBUFFERNOT     TEXT      ' CCC LOG'
                             TEXT      'GED ON  '
                             TEXT      'NAME IS '
OPERATORDISPLAYBUFFERNAME    TEXT      'DDDDEEEE'
         DATA      X'15C1D5C4'
         TEXT      ' IS '
OPERATORDISPLAYBUFFERDOING   TEXT      'FFFFGGGG'
                             TEXT      'ING  REG'
                             TEXT      'ULATED: '
         TEXT      'H I J   '
*                                                                       TIC72180
         BOUND     8                                                    TIC72190
OPERATORDISPLAYDOINGS RES 0                                             TIC72200
         TEXT      '     IDL'
         TEXT      'DORMANT-'                                           TIC72211
         TEXT      '    WAIT'                                           TIC72212
         TEXT      '  ACCEPT'                                           TIC72213
         TEXT      '  REPORT'                                           TIC72214
         TEXT      ' COMMAND'                                           TIC72215
*                                                                       TIC72220
*                                                                       TIC72230
*                                                                       TIC72240
OPERATORDISPLAYDONE RES 0                                               TIC72250
         LW,#ARG   14                  GET DSP OF THE LIST OF STATIONS  TIC72260
         #FREE#MAIN#BYTES                AND FREE THE LIST.             TIC72270
*                                                                       TIC72280
         B         OPERATORDIDCOMMAND  AND WE ARE DONE WITH COMMAND.    TIC72290
         PAGE
*
*        HERE ON OPERATOR 'ACQUIRE' COMMAND.
*
         BOUND     8
OPERATORACQUIRETEXT TEXT 'ACQUIRE '
OPERATORACQUIRE RES 0
*
         FIELD6789LOADAAAAAAAA,OPERATORCOMMANDNOT
         CW,8      ='A   '             MAKE SURE
         BE        %+3                  IT'S REALLY
         CD,8      OPERATORACQUIRETEXT   THIS COMMAND.
         BNE       OPERATORCOMMANDNOT
*
         FIELD6789LOADAAAAAAAA,OPERATORACQUIREALL
         B         %+2                 OVER IF STATION(5) INDICATED.
OPERATORACQUIREALL LI,8 0              NO INDICATION = ALL STATIONS.
         BAL,15    MAKESTATIONLIST       CREATE LIST OF #DEV'S TO ACQUIR
         LW,14     8                      AND REMEMBER DSP OF LIST.
         BEZ       OPERATORCOMMANDBAD
*
         LW,7      8                   COPY BA OF LIST.
         SLS,7     -1                  TO HA OF LIST.
*
OPERATORACQUIRE222 RES 0
         LH,5      0,7                 GET A STATION'S #DEV
         BLZ       OPERATORACQUIRE700  OVER IF AT FENCE.
*
         #T#GET,8,5 #DEV#LINE#STATUS#BITS GET LINE STATUS.
         CI,8      #LINE#UNACQUIRED    SEE IF ALREADY ACQUIRED.
         BAZ       OPERATORACQUIRE650  OVER IF SO.
*
         #T#GET,8,5 #DEV#DCB#POINTER   SEE IF MULTIPOINT.
         BLZ       OPERATORACQUIRE400  OVER IF SO.
*
*        HERE TO ACQUIRE A CXXX LINE.
*
         #T#GWA,8,5 #DEV#LINE#IDENTIFIER
         M:GETLINE *8                  NO ERROR TEST IN CASE WE ALREADY
*                                      OWN IT BUT HAD FAILED ON OPEN.
*
         #T#GET,4,5 #DEV#DCB#POINTER
         LW,8      *#DCB#TABLE#IW,4
         #T#GWA,9,5 #DEV#LINE#IDENTIFIER
         M:OPEN    *8,(LINE,*9),(ERR,OPERATORACQUIRE620),;
                                (ABN,OPERATORACQUIRE620)
         M:SETDCB  *8,(ERR,COCLINEERR),(ABN,COCLINEABN)
         M:PURGE   *8
         #T#GET,9,5 #DEV#LINE#STATUS#BITS SET LINE/STATION
         AND,9     =(-#LINE#UNACQUIRED-1)  STATUS TO
         #T#PUT,9,5 #DEV#LINE#STATUS#BITS   ACQUIRED.
         B         OPERATORACQUIRE650
*
OPERATORACQUIRE400 RES 0
*
*        HERE TO ACQUIRE A MXXX STATION.
*
         #T#GET,4,5 #DEV#DCB#POINTER   PUT THE STATION
         LW,8      *#DCB#TABLE#IW,4     BACK INTO THE
         #T#GET,9,5 #DEV#MULTIPOINT#INDEX LIST.
         M:MDFLST  *8,(INCL,9),(PSL)
*
         #T#GET,9,4 #DEV#LINE#STATUS#BITS GET STATUS OF LINE
         CI,9      #LINE#UNACQUIRED    SEE IF NOT ACQUIRED.
         BAZ       OPERATORACQUIRE650  OVER IF ALREADY ACQUIRED.
         #T#GWA,9,4 #DEV#LINE#IDENTIFIER GET ID AND GET LINE.
         M:GETLINE *9                  NO ERROR TEST - SOMEHOW WE MAY
*                                      ALREADY OWN IT
*
         #T#GWA,9,4 #DEV#LINE#IDENTIFIER
         M:OPEN    *8,(LINE,*9),(ERR,OPERATORACQUIRE620),;
                                (ABN,OPERATORACQUIRE620)
         M:SETDCB  *8,(ERR,MOCLINEERR),(ABN,MOCLINEABN)
*
         #T#GET,9,4 #DEV#LINE#STATUS#BITS SET LINE
         AND,9     =(-#LINE#UNACQUIRED-1)  STATUS TO
         #T#PUT,9,4 #DEV#LINE#STATUS#BITS   ACQUIRED.
*
         CI,9      #LINE#AWAITING#ACQUIRE SEE IF LINE DORMANT,
         BAZ       OPERATORACQUIRE650   AWAITING A NEW ACQUIRE.
         #T#POST,#ARG,4 #DEV#ECB       IF SO, GET THE MDL-TASK
         AND,9     =(-#LINE#AWAITING#ACQUIRE-1) GOING AGAIN.
         #T#PUT,9,4 #DEV#LINE#STATUS#BITS
         B         OPERATORACQUIRE650
*
*
OPERATORACQUIRE620 RES 0
         M:TYPE    (MESS,OPERATORACQUIREMESS)
         B         OPERATORACQUIRE700
OPERATORACQUIREMESS TEXTC 'UNABLE TO GET OR OPEN LINE'
*
*
*
OPERATORACQUIRE650 RES 0
         AI,7      1                   BUMP TO NEXT STATION IN LIST.
         B         OPERATORACQUIRE222  AND GO TO PROCESS.
*
*
*
OPERATORACQUIRE700 RES 0
         LW,#ARG   14                  FREE SPACE OF
         #FREE#MAIN#BYTES               STATION LIST.
*
         B         OPERATORDIDCOMMAND  AND WE'RE DONE.
         PAGE
*
*        HERE ON OPERATOR 'FREE' COMMAND.
*
         BOUND     8
OPERATORFREETEXT TEXT 'FREE    '
OPERATORFREE RES   0
*
         FIELD6789LOADAAAAAAAA,OPERATORCOMMANDNOT
         CW,8      ='F   '             MAKE SURE
         BE        %+3                  IT'S REALLY
         CD,8      OPERATORFREETEXT      THIS COMMAND.
         BNE       OPERATORCOMMANDNOT
*
         FIELD6789LOADAAAAAAAA,OPERATORFREEALL
         B         %+2                 OVER IF STATION(5) INDICATED.
OPERATORFREEALL LI,8 0                 NO INDICATION = ALL STATIONS.
         BAL,15    MAKESTATIONLIST     CREATE LIST OF STATIONS TO FREE.
         LW,14     8                   REMEMBER DSP OF LIST.
         BEZ       OPERATORCOMMANDBAD
*
         LW,7      8                   COPY BA OF LIST.
         SLS,7     -1                  TO HA OF LIST.
*
OPERATORFREE222 RES 0
         LH,5      0,7                 GET A STATION'S #DEV.
         BLZ       OPERATORFREE700     OVER IF AT FENCE.
*
         #T#GET,8,5 #DEV#DCB#POINTER   SEE IF MULTIPOINT.
         BLZ       OPERATORFREE400     OVER IF SO.
*
*        HERE TO FREE A CXXX LINE.
*
         #T#GET,4,5 #DEV#DCB#POINTER
         LW,8      *#DCB#TABLE#IW,4
         M:SETDCB  *8,(ERR,OPERATORFREE370),(ABN,OPERATORFREE370)
         M:CLOSE   *8
OPERATORFREE370 RES 0
         #T#GWA,8,5 #DEV#LINE#IDENTIFIER
         M:RLSLINE *8
*
         #T#GET,9,5 #DEV#LINE#STATUS#BITS
         OR,9      =#LINE#UNACQUIRED
         #T#PUT,9,5 #DEV#LINE#STATUS#BITS
*
         B         OPERATORFREE650
*
*
*
OPERATORFREE400 RES 0
*
*        HERE TO FREE A MXXX STATION.
*
         #T#GET,4,5 #DEV#DCB#POINTER   REMOVE THE STATION
         LW,8      *#DCB#TABLE#IW,4     FROM ACTIVE PART
         #T#GET,9,5 #DEV#MULTIPOINT#INDEX OF IT'S MULTIPOINT LIST.
         M:MDFLST  *8,(EXCL,9),(PSL)
*
         #T#GET,9,5 #DEV#LINE#STATUS#BITS SET STATION'S
         OR,9      =#LINE#UNACQUIRED       STATUS TO
         #T#PUT,9,5 #DEV#LINE#STATUS#BITS   UNACQUIRED.
*
*        NOW TEST TO SEE IF WE CAN RELEASE
*        THE MULTIPOINT LINE.  WE CAN IF THE
*        UNACQUIRED BIT IS SET FOR EVERY
*        ONE OF ITS STATIONS.
*
         LW,5      #BIGGEST#TIC#TASK   SCAN ALL #DEV-TASKS.
OPERATORFREE435 RES 0
         #T#GET,8,5 #DEV#DCB#POINTER   SEE IF TASK USES THIS
         CW,8      4                    MULTIPOINT LINE.
         BNE       OPERATORFREE450     OVER IF NOT
*
         #T#GET,9,5 #DEV#LINE#STATUS#BITS SEE IF STATION ON THIS
         CI,9      #LINE#UNACQUIRED     MULTIPOINT LINE IS ACQUIRED.
         BAZ       OPERATORFREE650     OVER IF SO.
*
OPERATORFREE450 RES 0
         BDR,5     OPERATORFREE435     LOOP FOR ALL #DEV-TASKS.
*
*        FALL THROUGH IF ALL STATIONS ON
*        THIS MULTIPOINT LINE ARE UNACQUIRED.
*
         LW,8      *#DCB#TABLE#IW,4
         M:SETDCB  *8,(ERR,OPERATORFREE470),(ABN,OPERATORFREE470)
         M:CLOSE   *8                  CLOSE THE MULTIPOINT LINE.
OPERATORFREE470 RES 0
*
         #T#GWA,9,4 #DEV#LINE#IDENTIFIER GET ID AND
         M:RLSLINE *9                     FREE IT.
*
         #T#GET,9,4 #DEV#LINE#STATUS#BITS AND MARK
         OR,9      =#LINE#UNACQUIRED       LINE AS
         #T#PUT,9,4 #DEV#LINE#STATUS#BITS   UNACQUIRED.
*
*
*
OPERATORFREE650 RES 0
         AI,7      1                   BUMP TO NEXT STATION IN LIST.
         B         OPERATORFREE222     AND GO TO PROCESS.
*
*
*
OPERATORFREE700 RES 0
         LW,#ARG   14                  FREE SPACE OF
         #FREE#MAIN#BYTES               STATION LIST.
*
         B         OPERATORDIDCOMMAND  AND WE'RE DONE.
         PAGE                                                           TIC72300
*                                                                       TIC72310
*        HERE ON OPERATOR 'X' COMMAND.                                  TIC72320
*                                                                       TIC72330
OPERATORX RES      0                                                    TIC72360
         LI,8      1                   INDICATE THAT WE
         STW,8     #X#ED                HAVE BEEN XED.
*                                                                       TIC72380
         FIELD6789LOADAAAAAAAA         SKIP THE 'X'.
         FIELD6789LOADAAAAAAAA,OPERATORDIDCOMMAND LOOK FOR 'NOW'.
         CW,8      ='NOW '             IS IT A 'NOW'                    TIC72400
         BNE       OPERATORDIDCOMMAND  DONE IF NOT.                     TIC72410
*
         MTW,-2    #X#ED               INDICATE XED 'NOW'.
*                                                                       TIC72420
         LW,#DEV   #BIGGEST#TIC#TASK   FOR ALL TIC-TASKS,               TIC72430
OPERATORX200 RES   0                    WE MUST SIGNAL                  TIC72440
         SIGNALATTENTION                 AN ATTENTION.                  TIC72450
*
         #T#GET,4  #DEV#DCB#POINTER    GET INDEX TO DCB POINTER.
         BLEZ      OPERATORX215        (OVER IF MULTI-POINT)
         LW,5      *#DCB#TABLE#IW,4    KILL ANY PENDING READ OF DEVICE
         M:PURGE   *5                   SO DEV-TASK CAN LOOK AT XED FLAG
*
OPERATORX215 RES   0
         BDR,#DEV  OPERATORX200                                         TIC72460
*
         LW,#DEV   #BIGGEST#MDL#TASK   FOR ALL MDL-TASKS,
         BEZ       OPERATORDIDCOMMAND   IF THERE ARE ANY,
OPERATORX400 RES   0                     WAKE 'EM UP
         #T#GET,4  #DEV#DCB#POINTER       SO THEY GET
         LW,5      *#DCB#TABLE#IW,4        A CHANCE TO
         M:MDFLST  *5,(HALT)                LOOK AT THE
         BIR,#DEV  OPERATORX400              XED FLAG.
*                                                                       TIC72470
         B         OPERATORDIDCOMMAND                                   TIC72480
         TITLE     'TIC - INITIALIZATION'
*                                                                       TIC75240
*                                                                       TIC75250
*                                                                       TIC75260
         BOUND     8
#INIT#PRE#SECTION RES 100              DEFINE FINE/HIDE SPACE FOR INIT.
*
         BOUND     8
#INIT#SECTION#ONE#FWA RES 0            DEFINE PART FOR FREEING.
*
#TIC#INITIALIZE RES 0
         M:INT     #TIC#INT            HANDLE OPERATOR INTERRUPTS.
*
*
*
*        GET THE PAGES THAT WILL BE USED AS
*        BUFFERS BY THE INITIALIZATION SECTION:
*
         M:GVP     INITBUF2
         BCS,8     INITNOPAGES
         M:GVP     INITBUF3
         BCS,8     INITNOPAGES
         M:GVP     INITBUF4
         BCS,8     INITNOPAGES
         M:GVP     INITBUF5
         BCS,8     INITNOPAGES
*
         LI,4      DA(#INIT#PRE#SECTION) GIVE INITIALIZATION
         LI,5      100/2                  SOME SPACE TO WORK IN
         BAL,#BAL  #HIDE#DWS               (HOPEFULLY AVOIDS AN EARLY
*                                           PAGE-GRAB SOLELY FOR
*                                            INITIALIZE STUFF)
         PAGE                                                           TIC75280
*                                                                       TIC75290
*                                                                       TIC75300
*
*        WE PUT ALL OF OUR INTERNAL-FORMAT RECORDS INTO
*        ONE FILE.  IN ORDER TO FIND OUT HOW BIG THIS FILE
*        SHOULD BE, WE MUST SCAN THE SUPPLIED EXTERNAL-FORMAT
*        FILES IN ORDER TO SEE HOW MANY INTERNAL-FORMAT
*        GRANULES THE INFORMATION WILL FIT INTO.
*
*        CURRENTLY, WE ONLY SCAN THE TFDX FILE, ASSUMING THAT
*        THE STAX AND DELX INFO WILL FIT INTO 40 GRANULES.
*
*        THE DATA CELL 'INITCOUNTING' IS ASSEMBLED AS A ONE
*        TO INDICATE THAT WE ARE JUST COUNTING GRANULE USAGE.
*
INITTFD110 RES     0                   COUNT OR COPY TFD RECORDS.
         LI,11     INITBUF4            INDICATE THE OUTPUT
         STW,11    INITTFDNEXTBUF4WA    BUFFER IS EMPTY.
*                                                                       TIC75440
INITTFD200 RES     0                                                    TIC75450
*                                                                       TIC75460
*        GET A RECORD:                                                  TIC75470
         M:READ    F:TFDX,(BUF,INITBUF2),(SIZE,2047)                    TIC75480
         M:CHECK   F:TFDX,(ERR,INITTFDERR),(ABN,INITTFDABN)             TIC75490
*                                                                       TIC75500
         MTW,1     INITTFDNTH          BUMP OUR RECORD COUNT            TIC75510
*                                                                       TIC75520
         LW,7      F:TFDX+4            GET 'ACTUAL RECORD SIZE'         TIC75530
         SLS,7     -17                  AND ALIGN IT.                   TIC75540
*                                                                       TIC75550
         CI,7      17                  SEE IF RECORD UNREASONABLY SHORT.TIC75560
         BLE       INITTFDBAD          OUT IF SO.                       TIC75570
*                                                                       TIC75580
         LI,8      0                   STORE A ZERO AS A 'FENCE'        TIC75590
         STB,8     INITBUF2,7           IN THE INPUT BUFFER.            TIC75600
*                                                                       TIC75610
         LI,8      4*INITBUF2          POINT R8 AT KEY.
         LI,9      4*INITBUF3+4        POINT R9 TO WHERE KEY SHOULD
         OR,9      =X'11000000'         GO (WITH THE SEVENTEEN COUNT).  TIC75640
         MBS,8     0                   MOVE 'KEY' TO OUTPUT BUFFER.     TIC75650
*                                                                       TIC75660
         LI,10     INITBUF3
         STW,10    INITTFDTFDFWA       STORE WA OF TFD RECORD.          TIC75680
*                                                                       TIC75690
         LI,10     INITBUF3+6          POINT R10 TO WHERE PRIMS GO.
*                                                                       TIC75710
         LI,7      4*INITBUF2+16       POINT R7 TO JUST BEFORE THE
*                                      START OF PRIMIVIVES IN BUFFER.   TIC75730
*        THROUGHOUT THIS SECTION, R13 AND R14 ARE KEEPING TRACK         TIC75740
*        OF HOW LONG THE FORMAL TRANSACTION TEXT GETS -- THAT           TIC75750
*        IS WE ARE CALCULATING THE 'LIGH WATER' POINT OF #.             TIC75760
*                                                                       TIC75770
         LI,13     0                                                    TIC75780
         LI,14     0                                                    TIC75790
*                                                                       TIC75800
*                                                                       TIC75810
*                                                                       TIC75820
INITTFD295 RES     0                                                    TIC75830
         PICKUPCHARACTER78             PRIME R8 WITH A CHARACTER.       TIC75840
INITTFD300 RES     0                                                    TIC75850
         STW,10    INITTFDPRIMFWA      REMEMBER WA OF PRIM'S WORD ZERO.
*        (WE HAVE A BYTE OF TFD IN R8.)                                 TIC75870
         AI,8      0                   SEE IF IT IS OUR FENCE.          TIC75880
         BEZ       INITTFD800          OVER IF IT IS OUR FENCE.         TIC75890
*                                                                       TIC75900
         CI,8      ' '                 TEST FOR BLANK.                  TIC75910
         BE        INITTFD295          SKIP A BLANK.                    TIC75920
*                                                                       TIC75930
*        NOT A BLANK, SO IT SHOULD BE THE                               TIC75940
*        INITIAL CHARACTER OF A PRIMITIVE.  SCAN                        TIC75950
*        THE TALLE OF LEGAL PRIMITIVES LOOKING                          TIC75960
*        FOR A MATCH:                                                   TIC75970
*                                                                       TIC75980
         LI,6      INITTFDPRIMTABLESIZE                                 TIC75990
INITTFD312 LW,9    INITTFDPRIMTABLE-1,6                                 TIC76000
         CB,8      9                   COMPARE THE CHARACTER.           TIC76010
         BE        INITTFD330          OUT ON A MATCH.                  TIC76020
         BDR,6     INITTFD312          OTHERWISE LOOP.                  TIC76030
*                                                                       TIC76040
*        IF WE FELL THROUGH, NOT A LEGAL PRIMITIVE.                     TIC76050
*                                                                       TIC76060
         LI,9      X'400'               LOAD MYPRIM IDENTIFIER BIT.     TIC76070
         OR,9      8                    OR IN THE ACTUAL CHARACTER.     TIC76080
*        (REST OR R9 = 0, WHICH MAKES OK FLAGS FOR LATER)               TIC76090
*                                                                       TIC76100
         LI,14     X'10000'            MYPRIM MAKES THE LENGTH OF THE   TIC76110
*                                      FQM TEXT INDETERMINATE, SO WE    TIC76120
*                                      SET R14 TO THIS BIG NUMBER.      TIC76130
*                                      THE IDEA IS TO SET IS SO HIGH    TIC76140
*                                      THAT IT WON'T BE CHANGED BY      TIC76150
*                                      ANY SUBSEQUENT R13 CALCULATIONS, TIC76160
*                                      AND AT THE SAME TIME WILL RESULT TIC76170
*                                      IN A ZERO LENGTH WHEN WE STORE   TIC76180
*                                      JUST THE RIGHT HALF INTO THE TFD.TIC76190
*                                                                       TIC76200
INITTFD330 RES     0                   HERE ON FOUND PRIM IN TABLE.     TIC76210
         LW,11     9                   COPY TABLE ENTRY IN ORDER TO     TIC76220
*                                      BE ABLE TO CHECK FLAGS LATER.    TIC76230
*                                                                       TIC76240
         SLS,9     16                  ALIGN PRIMITIVE NUMBER.          TIC76250
         STW,9     *INITTFDPRIMFWA     STORE IT INTO TFD.
*                                                                       TIC76270
         CI,8      '@'                 TEST FOR THE                     TIC76280
         BE        INITTFD@             PRIMITIVES THAT                 TIC76290
         CI,8      '#'                   NEED SPECIAL                   TIC76300
         BE        INITTFD#               HANDLING.                     TIC76310
*                                                                       TIC76320
         PICKUPCHARACTER78             GET NEXT CHARACTER.              TIC76330
         CI,8      ''''                IS IT A QUOTE?                   TIC76340
         BE        INITTFD370          IF SO, PROCESS TYPE ONE PRIM.    TIC76350
*                                                                       TIC76360
         PICKUPINTEGER789              NOT A QUOTE - GET INTEGER.       TIC76370
         STS,9     *INITTFDPRIMFWA     STORE COUNT INTO PRIM IN TFD.
*                                                                       TIC76390
*        SEE IF THIS IS A PRIMITIVE THAT IS REFLECTED                   TIC76400
*        IN THE LENGTH OF THE FORMAL QUEUE MESSAGE TEXT:                TIC76410
*                                                                       TIC76420
         CI,11     X'30000'            SEE IF CONTRIBUTES FQM TEXT.     TIC76430
         BAZ       INITTFD550          OVER IF NOT.                     TIC76440
*                                                                       TIC76450
         CI,11     X'20000'            SEE IF 'COUNT' CHARS IN TEXT.    TIC76460
         BANZ      INITTFD350          OVER IF SO.                      TIC76470
*                                                                       TIC76480
         LI,9      1                   NOT 'COUNT' CHARS:  MUST BE      TIC76490
*                                      JUST ONE - SPECIAL FOR THE       TIC76500
*                                      'K' PRIMITIVE.                   TIC76510
*                                                                       TIC76520
INITTFD350 RES     0                                                    TIC76530
         AW,13     9                   BUMP CURRENT FQM TEXT POSITION.  TIC76540
*                                                                       TIC76550
         CW,13     14                  SEE IF NEW MAXIMUM.              TIC76560
         BLE       %+2                 OVER IF NOT.                     TIC76570
         STW,13    14                  STORE NEW MAXIMUM.               TIC76580
*                                                                       TIC76590
         B         INITTFD550                                           TIC76600
*                                                                       TIC76610
*                                                                       TIC76620
*                                                                       TIC76630
INITTFD370 RES     0                   HERE ON QUOTED = TYPE ONE PRIM.  TIC76640
*                                                                       TIC76650
         LW,9      =X'10000000'        GET 'TYPE ONE' BIT               TIC76660
         STS,9     *INITTFDPRIMFWA      AND ORS IT INTO PRIMITIVE.
*                                                                       TIC76680
         LW,6      10                  CREATE BYTE                      TIC76690
         AI,6      1                    POINTER INTO                    TIC76700
         SLS,6     2                     THE TFD.                       TIC76710
*                                                                       TIC76720
INITTFD376 RES     0                                                    TIC76730
         PICKUPCHARACTER78             GET A CHARACTER.                 TIC76740
         BEZ       INITTFDBAD          ERROR IF IT'S OUR FENCE.         TIC76750
*                                                                       TIC76760
         CI,8      ''''                IS IT (FINAL) QUOTE?             TIC76770
         BE        INITTFD390          OVER IF SO.                      TIC76780
*                                                                       TIC76790
         CI,8      X'6A'               IS IT A CIRCUMFLEX (UP-ARROW)?   TIC76800
         BNE       INITTFD382          OVER IF NOT.                     TIC76810
*                                                                       TIC76820
         PICKUPCHARACTER78             GET NEXT CHAR.                   TIC76830
         BEZ       INITTFDBAD          ERROR IF AT FENCE.               TIC76840
         EOR,8     =X'F0'               AND                             TIC76850
         CI,8      X'F0'                 WE                             TIC76860
         BAZ      %+4                     CONVERT                       TIC76870
         AI,8     X'9'-X'30'               TWO                          TIC76880
         CI,8     X'10'                     HEX                         TIC76890
         BGE       INITTFDBAD                EBCDIC                     TIC76900
         LW,9      8                          CHARACTERS                TIC76910
         PICKUPCHARACTER78                     TO                       TIC76920
         BEZ       INITTFDBAD                   A                       TIC76930
         EOR,8     =X'F0'                        HEX                    TIC76940
         CI,8      X'F0'                          INTEGER.              TIC76950
         BAZ       %+4                                                  TIC76960
         AI,8      X'9'-X'30'                                           TIC76970
         CI,8      X'10'                                                TIC76980
         BGE       INITTFDBAD                                           TIC76990
         SLS,9     4                                                    TIC77000
         OR,8      9                                                    TIC77010
*                                                                       TIC77020
INITTFD382 RES     0                                                    TIC77030
*                                                                       TIC77040
         STB,8     0,6                 STORE CHARACTER.                 TIC77050
         AI,6      1                   BUMP PRIM POINTER.               TIC77060
         MTW,1     *INITTFDPRIMFWA     BUMP C.C. IN PRIMITIVE.
         B         INITTFD376          AND LOOP.                        TIC77080
*                                                                       TIC77090
INITTFD390 RES     0                                                    TIC77100
         PICKUPCHARACTER78             STEP OVER THE QUOTE.             TIC77110
*                                                                       TIC77120
         AI,6      3-4                 ROUND R6 TO LAST WORD USED.      TIC77130
         SLS,6     -2                                                   TIC77140
         LW,10     6                   AND STORE AS PRIM POINTER.       TIC77150
*                                                                       TIC77160
INITTFD550 AI,10   1                   BUMP TO NEXT PRIM PLACE IN TFD.  TIC77170
*                                                                       TIC77180
         AND,11    =X'FFFF'            ISOLATE PRIM NUMBER.             TIC77190
         CI,11     TFDZ                SEE IF Z = END OF TFD.           TIC77200
         BNE       INITTFD300          IF NOT, BACK FOR MORE.           TIC77210
*                                                                       TIC77220
*        FALL THROUGH ON A Z.                                           TIC77230
*                                                                       TIC77240
         LW,8      *INITTFDPRIMFWA     RETRIEVE FIRST WORD OF Z PRIM.
         CI,8      X'FFFF'             SEE IF Z0.                       TIC77260
         BAZ       INITTFD820          OVER IF SO.                      TIC77270
*                                                                       TIC77280
         LI,14     X'10000'            SET BYTE COUNT TO BE ZERO.       TIC77290
         B         INITTFD820          OVER IF IT WAS A Z.              TIC77300
         PAGE                                                           TIC77310
*                                                                       TIC77320
*                                                                       TIC77330
*                                                                       TIC77340
INITTFD@ RES       0                                                    TIC77350
         PICKUPCHARACTER78             GET NEXT CHARACTER.              TIC77360
         LI,9      X'8000'             LOAD A +0 JUST IN CASE.          TIC77370
         CI,8      '+'                 IS IT A PLUS?                    TIC77380
         BE        INITTFD420          OVER IF SO.                      TIC77390
         CLM,8     ZEROANDNINE         SEE IF DIGIT.                    TIC77400
         BCS,9     INITTFD428          OVER IF NOT.                     TIC77410
         B         INITTFD425          JUST OVER + IF SO.               TIC77420
INITTFD420 RES     0                   HERE IF PLUS:  OR                TIC77430
         STS,9     *10                  IN THE PLUS BIT.                TIC77440
         PICKUPCHARACTER78             AND GET NEXT CHARACTER           TIC77450
*                                                                       TIC77460
INITTFD425 RES     0                                                    TIC77470
         PICKUPINTEGER789              GET THE 'R' VALUE.               TIC77480
         SLS,9     8                   SLIDE 'R' OVER.                  TIC77490
INITTFD428 RES     0                                                    TIC77500
         STS,9     *10                 AND OR IT IN.                    TIC77510
*                                                                       TIC77520
         LI,9      X'80'               LOAD A +0 C FOR TEST BELOW.      TIC77530
*                                                                       TIC77540
         CI,8      ','                 SEE IF COMMA.                    TIC77550
         BNE       INITTFD445          OVER IF NOT.                     TIC77560
*                                                                       TIC77570
         PICKUPCHARACTER78             COMMA:  GET CHAR PAST IT.        TIC77580
         CI,8      '+'                 IS IT A PLUS?                    TIC77590
         BNE       INITTFD435          OVER IF NOT.                     TIC77600
         LI,9      X'80'               WAS PLUS:  OR                    TIC77610
         STS,9     *10                  IN THE PLUS BIT.                TIC77620
         PICKUPCHARACTER78             AND GET ANOTHER CHARACTER.       TIC77630
*                                                                       TIC77640
INITTFD435 RES     0                                                    TIC77650
         PICKUPINTEGER789              GET THE 'C' VLAUE.               TIC77660
INITTFD445 RES     0                                                    TIC77670
         STS,9     *10                 AND OR IT IN.                    TIC77680
         AI,10     1                   BUMP TFD-BUILDIN POINTER.        TIC77690
         B         INITTFD300          AND WE'RE DONE.                  TIC77700
*                                                                       TIC77710
*                                                                       TIC77720
*                                                                       TIC77730
INITTFD# RES       0                                                    TIC77740
         LI,11     0                   CLEAN R11 FOR '+' TEST LATER.    TIC77750
*                                                                       TIC77760
         PICKUPCHARACTER78             GET NEXT CHARACTER.              TIC77770
         CI,8      '+'                 IS IT A PLUS?                    TIC77780
         BNE       INITTFD465          OVER IF NOT.                     TIC77790
         LI,11     X'8000'             WAS PLUS: OR IN                  TIC77800
         STS,11    *10                  THE PLUS BIT (? SET FLAG).      TIC77810
         PICKUPCHARACTER78             GET ANOTHER CHARACTER            TIC77820
*                                                                       TIC77830
INITTFD465 RES     0                                                    TIC77840
         PICKUPINTEGER789              GET THE COUNT                    TIC77850
         STS,9     *10                 OR THE COUNT IN.                 TIC77860
         AI,10     1                   BUMP TFD-BUILDIN POINTER.        TIC77870
*                                                                       TIC77880
         AW,13     9                   BUMP THE 'POSITION' IN THE       TIC77890
*                                      FQM TEXT.  (THIS IS THE CORRECT  TIC77900
*                                      THING TO DO FF THERE WAS         TIC77910
*                                      A PLUS.)                         TIC77920
*                                                                       TIC77930
         CI,11     X'8000'             SEE IF WAS A PLUS.               TIC77940
         BANZ      INITTFD300          DONE IF SO.                      TIC77950
*                                                                       TIC77960
         STW,9     13                  WAS ABSOLUTE:  SET COUNT.        TIC77970
         AI,13     -1                  (BUT START AT ZERO.)             TIC77980
         B         INITTFD300          AND WE'RE DONE.                  TIC77990
         PAGE                                                           TIC78000
*                                                                       TIC78010
*                                                                       TIC78020
*                                                                       TIC78030
INITTFD800 RES     0                   HERE WHEN WE HIT OUR FENCE.      TIC78040
         LI,9      TFDZ                STORE A FAKE Z                   TIC78050
         SLS,9     16                   INTO THE INTERNAL TFD           TIC78060
         STW,9     *10                   IF WE FALL OFF THE END.        TIC78070
         AI,10     1                                                    TIC78080
*                                                                       TIC78090
INITTFD820 RES     0                                                    TIC78100
*                                                                       TIC78110
         LI,3      11                  POINT TO CORRECT HW AND          TIC78120
         STH,14    INITBUF3,3           STORE MAX FQM TEXT LENGTH.      TIC78130
*                                                                       TIC78140
*        R10 HAS LWA+1 OF BUILT TFD.
*
         LW,9      INITTFDTFDFWA       GET FWA.
         LW,8      10                  LWA+1 MINUS FWA
         SW,8      9                    IS NUMBER OF WORDS.
         STH,8     *9                  STORE TFD LENGTH.
*
         LW,8      10                  COMPUTE THE
         AI,8      -INITBUF3            RECORD LENGTH.
*
*        TEST HERE TO SEE IF THE TFD THAT WE
*        JUST BUILT IS TOO LONG FOR THE EQU'ED
*        BUFFER LENGTH.  NOTE THAT THERE IS
*        SOME CHANCE THAT, IF THE TFD IS VERY LONG,
*        WE RAN OFF THE END OF INITBUF3 BEFORE WE
*        GOT HRE TO MAKE THIS TEST.
*
         CI,8      BYTESPERRANDOMBLOCK/4 SEE IF LONGER THAN THE
         BG        INITTFDLONG         EQUED BUFFER.  OUT IF SO.
*
         LW,11     INITTFDNEXTBUF4WA   SEE IF RECORD WILL
         AW,8      11                   FIT IN OUTPUT
         CI,8      INITBUF4+(BYTESPERRANDOMBLOCK/4) BUFFER.
         BLE       INITTFD870          OVER IF WILL FIT.
*
*        FALL THROUGH IF NEW TFD RECORD WILL NOT FIT INTO
*        REMAINDER OF THE INITBUF4 OUTPUT BUFFER.
*
*        SO WE MUST WRITE OUT CURRENT BUFFER CONTENT.
INITTFD830 RES     0
*                                      (R11 HAS LWA+1 OF BUFFER DATA)
         LI,8      0                   STORE A ZERO AT END
         STW,8     *11                  OF RECORDS IN BUFFER.
*
*        NOW THE BLOCK IS READY TO WRITE.
*                                                                       TIC78160
         MTW,1     INITGRANULE         BUMP TO NEXT GRANULE.
*                                                                       TIC78180
*        CHAIN THIS BLOCK ON TO THE IN-CORE BLOCK CHAIN.                TIC78190
*                                                                       TIC78200
         MTW,0     INITCOUNTING        SEE IF JUST COUNTING GRANULES.
         BGZ       INITTFD856          AVOID ACTUAL WRITE ETC IF SO.
*
         LI,5      3                   GET SIX WORDS
         BAL,#BAL  #FIND#DWS            FOR CHAIN ENTRY.
         BEZ       INITNOPAGES         ERROR IF AREN'T ANY.
         SLS,4     1                   WA OF ACQUIRED SPACE.
*                                                                       TIC78250
         LW,9      INITGRANULE         INTERNAL GRANULE NUMBER.
         STW,9     1,4                  INTO CHAIN ENTRY.
*
         LI,6      4*INITBUF5          'KEY'
         LW,7      4                    INTO
         SLS,7     2                     THE
         AW,7      =X'12000008'           CHAIN     (KEY 2 WORDS IN)
         MBS,6     0                       ENTRY.
*                                                                       TIC78380
         LI,9      #TFDI#GRANULE#KEY#CHAIN                              TIC78390
         B         %+2                 SCAN DOWN                        TIC78400
         LW,9      *9                    TO FIND                        TIC78410
         MTW,0     *9                    END OF                         TIC78420
         BNEZ      %-2                    THE CHAIN.                    TIC78430
*                                                                       TIC78440
         STW,4     *9
         LI,8      0                   AND SET LAST (NEW) GUY'S         TIC78460
         STW,8     *4
*                                                                       TIC78480
INITTFD845 RES     0
         M:WRITE   F:TICI,(BUF,INITBUF4),(SIZE,2048),;
                   (BTD,0),(BLOCK,*INITGRANULE)
         M:CHECK   F:TICI,(ERR,INITTICIERR),(ABN,INITTICIABN)
*
INITTFD856 RES     0
         MTW,0     INITBUF2            SEE IF DUMP-BUFFER-ON-EOF.
         BEZ       INITTFD900          PROBABLY DONE IF SO.
*
*
         LI,11     INITBUF4            INDICATE INITBUF4
         STW,11    INITTFDNEXTBUF4WA    IS NOW EMPTY.
*
INITTFD870 RES     0                   HERE TO COPY THE BUILT
*                                       TFD RECORD FROM INITBUF3
*                                        TO THE BUFFER IN INITBUF4.
*
*        R10 HAS THE LWA+1 OF THE RECORD IN INITBUF3.
*
*        R11 HAS THE WA OF THE FIRST FREE WORD IN INITBUF4.
*
*        AND WE PREVIOUSLY CHECKED SO WE KNOW THE RECORD WILL FIT.
*
         LI,12     INITBUF3
*
         LW,8      *12                 COPY
         STW,8     *11                  FROM
         AI,12     1                     INITBUF3
         AI,11     1                      TO
         CW,12     10                      INITBUF4.
         BL        %-5
*
         LI,8      4*(INITBUF3+1)           REMEMBER THIS KEY IN
         LW,9      =(4*INITBUF5+20*256*256*256) CASE IT TURNS OUT TO BE
         MBS,8     0                          LAST RECORD IN BLOCK.
*
         STW,11    INITTFDNEXTBUF4WA   REMEMBER WHERE WE ARE IN INITBUF4
*                                                                       TIC78640
         B         INITTFD200          AND DO NEXT TFD ...              TIC78650
         PAGE                                                           TIC78660
*                                                                       TIC78670
*                                                                       TIC78680
*                                                                       TIC78690
INITTFDPRIMTABLE RES 0                                                  TIC78700
         GEN,8,7,1,16 'Z',0,0,TFDZ                                      TIC78710
         GEN,8,7,1,16 'X',0,0,TFDX                                      TIC78720
         GEN,8,7,1,16 'A',1,0,TFDA                                      TIC78730
         GEN,8,7,1,16 'B',1,0,TFDB                                      TIC78740
         GEN,8,7,1,16 'C',1,0,TFDC                                      TIC78750
         GEN,8,7,1,16 'D',1,0,TFDD                                      TIC78760
         GEN,8,7,1,16 'E',1,0,TFDE                                      TIC78770
         GEN,8,7,1,16 'F',1,0,TFDF                                      TIC78780
         GEN,8,7,1,16 'I',1,0,TFDI                                      TIC78790
         GEN,8,7,1,16 'J',1,0,TFDJ                                      TIC78800
         GEN,8,7,1,16 'K',0,1,TFDK     (NOTE SPECIAL TREATMENT)         TIC78810
         GEN,8,7,1,16 'L',1,0,TFDL                                      TIC78820
         GEN,8,7,1,16 'M',1,0,TFDM                                      TIC78830
         GEN,8,7,1,16 'P',0,0,TFDP                                      TIC78840
         GEN,8,7,1,16 'G',1,0,TFDG                                      TIC78850
         GEN,8,7,1,16 '@',0,0,TFD@                                      TIC78860
         GEN,8,7,1,16 '#',0,0,TFD#                                      TIC78870
         GEN,8,7,1,16 'Y',0,0,TFDY                                      TIC78880
INITTFDPRIMTABLESIZE EQU %-INITTFDPRIMTABLE                             TIC78890
         PAGE                                                           TIC78900
*                                                                       TIC78910
*                                                                       TIC78920
*                                                                       TIC78930
INITTFDBAD RES     0                                                    TIC78940
         #OUT      'BAD TFD IGNORED'
         B         INITTFD200                                           TIC78960
*
*
*
INITTFDLONG RES    0
         #OUT      'TOO LONG TFD IGNORED'
         B         INITTFD200
         PAGE                                                           TIC78970
*                                                                       TIC78980
*                                                                       TIC78990
*                                                                       TIC79000
INITTFDERR RES     0                                                    TIC79010
INITTFDABN RES     0                                                    TIC79020
         LB,9      10                  GET CLEAN ERR/ABN CODE.
         CI,9      6                   SEE IF IT E-O-F.
         BNE       %+4                 OVER IF NOT E-O-F.
*
         LI,9      0                   STORE OUR
         STW,9     INITBUF2             EOF SIGNAL AND
         B         INITTFD830            WRITE LAST BUFFER.
*
         #OUT      'BAD TFDX FILE'
         M:XXX
         PAGE                                                           TIC79080
*                                                                       TIC79090
*                                                                       TIC79100
*                                                                       TIC79110
INITTFD900 RES      0                  HERE AFTER DOING TFDX-TFDI COPY. TIC79120
         M:SETDCB  F:TFDX,(ERR,INITTFD902),(ABN,INITTFD902)             TIC79130
         M:CLOSE   F:TFDX                                               TIC79140
INITTFD902 RES     0                                                    TIC79150
         MTW,0     INITCOUNTING        SEE IF JUST COUNTING.
         BEZ       INITTFD999          OVER IF NOT.
*
*
*
*        HERE WE CREATE OUR INTERNAL FILE,
*        NOW THAT WE (MORE-OR-LESS) KNOW HOW
*        BIG IT SHOULDD BE.
*
*        THE NUMBER OF GRANULES THAT THE TFDS REQUIRED
*        IS NOW IN CELL 'INITGRANULE'.
*
         LW,8      INITGRANULE         TFD GRANULES.
         AI,8      20+20+7             PLUS STAX PLUS DELX PLUS CMDS.
*
*        OWING TO AN ERROR IN UTS (AS OF 9 MAY 173), THE
*        (RANDOM) SPECIFICATION IS INEFFECTIVE WHEN USED IN
*        CONJUNCTION WITH (RSTORE).  SO WE INDICATED (RANDOM)
*        IN THE DCB AN HERE MENTION ONLY (RSTORE).
*
         M:OPEN    F:TICI,(RSTORE,*8),(ERR,OPENTICIERR),;
                                      (ABN,OPENTICIABN)
*
         LI,8      0-1                 START AT THE BEGINNING
         STW,8     INITGRANULE          OF THE INTERNAL FILE.
         MTW,-1    INITCOUNTING        INDICATE NOT COUNTING.
         B         INITTFD110          AND GO DO THE COPYING.
*
OPENTICIERR RES    0
OPENTICIABN RES    0
         #OUT      'ERROR OPENING THE INTERNAL FILE'
         M:XXX
*
         BOUND     8
INITTFD999 RES     0
*
#INIT#SECTION#ONE#LWA EQU %-1          DEFINE PART FOR FREEING.
         PAGE
*
*
*
#INIT#SECTION#TWO#FWA RES 0            DEFINE PART FOR FREEING
*
         LI,4      DA(#INIT#SECTION#ONE#FWA+1)  GIVE TFDS SECTION OF
         LI,5      DA(#INIT#SECTION#ONE#LWA-1);  INITIALIZATION BACK
                   -DA(#INIT#SECTION#ONE#FWA+1)+1 FOR DYN STORAGE USE.
         BAL,#BAL  #HIDE#DWS
         PAGE                                                           TIC79160
*                                                                       TIC79170
*        WE COPY THE F:STAX FILE TO A KEYED FILE - F:STAK.              TIC79180
*        WE WILL USE F:STAK TO OBTAIN NEEDED +-TYPE RECORDS.            TIC79190
*                                                                       TIC79200
INITSTA020 RES     0                                                    TIC79210
         M:READ    F:STAX,(BUF,INITBUF2),(BTD,1),(SIZE,2047),;          TIC79220
                   (ERR,INITSTACOPYINERR),(ABN,INITSTACOPYINABN)        TIC79230
         LW,7      F:STAX+4            GET ARS.                         TIC79240
         SLS,7     -17                  ALIGN ARS.                      TIC79250
*                                                                       TIC79260
         LI,8      8                   MAKE KEY INTO TEXTC.             TIC79270
         STB,8     INITBUF2            (THAT'S WHY WE READ WITH A BTD)  TIC79280
*                                                                       TIC79290
         M:WRITE   F:STAK,(BUF,INITBUF2),(BTD,1),(SIZE,*7),;            TIC79300
                   (KEY,INITBUF2),(NEWKEY),;
                   (ERR,INITSTACOPYOUTERR),(ABN,INITSTACOPYOUTABN)      TIC79320
         B         INITSTA020                                           TIC79330
*                                                                       TIC79340
INITSTA035 RES     0                   HERE WHEN F:STAX COPIED.         TIC79350
         M:PFIL    F:STAX,(BOF)        REWIND F:STAX SO WE CAN REALLY RETIC79360
*                                                                       TIC79370
*                                                                       TIC79380
*                                                                       TIC79390
*                                                                       TIC79400
*        HERE WE INITIALIZE THE STAI FILE.                              TIC79410
*                                                                       TIC79420
*                                                                       TIC79500
*                                                                       TIC79510
INITSTA110 RES     0
         LI,11     INITBUF3            POINT R11 TO OUTPUT BUFFER.      TIC79520
INITSTA200 RES     0                                                    TIC79530
*                                                                       TIC79540
*        GET A RECORD:                                                  TIC79550
*                                                                       TIC79560
         M:READ    F:STAX,(BUF,INITBUF2),(BTD,0),(SIZE,2047)            TIC79570
         M:CHECK   F:STAX,(ERR,INITSTAERR),(ABN,INITSTAABN)             TIC79580
*                                                                       TIC79590
         MTW,1     INITSTANTH          BUMP OUR RECORD COUNT.           TIC79600
*                                                                       TIC79610
         LW,10     F:STAX+4            GET 'ACTUAL RECORD SIZE'.        TIC79620
         SLS,10    -17                 AND ALIGN IT.                    TIC79630
*                                                                       TIC79640
         CI,10     9                   SEE IF RECORD UNREASONABLY SHORT.TIC79650
         BLE        INITSTABAD          OUT IF ERRONEOUS.               TIC79660
*                                                                       TIC79670
*        WE HAVE A RECORD.                                              TIC79680
*                                                                       TIC79690
*        ROUND RECORD LENGTH UP TO A MULTIPLE OF FOUR.                  TIC79700
*        BUT INSURE WE ADD AT LEAST ONE BLANK TO END.                   TIC79710
*                                                                       TIC79720
         LI,8      ' '                 A BLANK TO STORE.                TIC79730
         LW,#ARG   10                  COPY BYTE LENGTH TO INDEX.       TIC79740
         STB,8     INITBUF2,#ARG       STORE A BLANK.                   TIC79750
         AI,10     1                   AND BUMP.                        TIC79760
         CI,10     3                   AT WORD BOUNDARY?                TIC79770
         BANZ      %-4                 CONTINUE UNTIL WE ARE.           TIC79780
*
         LI,6      8                   BLANKS AT END IN
         AI,#ARG   1                    CASE PLUSES DO NOT
         STB,8     INITBUF2,#ARG         COME OUT EVEN.
         BDR,6     %-2
*                                                                       TIC79790
*        SCAN FOR +-TYPE NPS REPLACEMENT.                               TIC79800
*                                                                       TIC79810
INITSTA300 LI,6    4*INITBUF2+8        WHERE TO START SCANNING.
         LW,7      10                  SIZE PLUS                        TIC79830
         AI,7      4*INITBUF2           START IS END+1.
*                                                                       TIC79850
INITSTA305 LB,8    0,6                                                  TIC79860
         CI,8      ' '                                                  TIC79870
         BNE       INITSTA390                                           TIC79880
         AI,6      1                                                    TIC79890
         LB,8      0,6
         CI,8      '+'
         BNE       INITSTA391                                           TIC79910
*                                                                       TIC79920
*        FALL THROUGH ON HAVE A +-TYPE TO REPLACE.                      TIC79930
*                                                                       TIC79940
*        FIRST MUST MAKE A TEXTE KEY ON A WORD BOUNDARY.                TIC79950
*                                                                       TIC79960
         LW,14     ='    '             BLANK
         STW,14    INITBUF5+508         OUT
         STW,14    INITBUF5+509          KEY
         STW,14    INITBUF5+510           AREA.
         LW,14     6                   REMEMBER WHERE + IS.             TIC80010
         LI,5      4*(INITBUF5+508)+1  WHERE TO PUT KEY.
INITSTA320 LB,8    0,6                                                  TIC80030
         CI,8      ' '                                                  TIC80040
         BE        INITSTA355                                           TIC80050
         STB,8     0,5                                                  TIC80060
         AI,6      1                                                    TIC80070
         AI,5      1                                                    TIC80080
         CI,5      4*(INITBUF5+508)+8
         BLE       INITSTA320                                           TIC80100
*                                                                       TIC80110
*        FALL THROUGH ON A BAD +-TYPE NPS.                              TIC80120
*                                                                       TIC80130
INITSTA340 RES     0                                                    TIC80140
         #SNAP     'BAD +-TYPE NPS -- RECORD IGNORED'                   TIC80150
         B         INITSTA110                                           TIC80160
*                                                                       TIC80170
INITSTA355 RES     0                                                    TIC80180
         LI,8      8                   LENGTH TO MAKE                   TIC80190
         STB,8     INITBUF5+508         A TEXTC KEY.
*                                                                       TIC80210
         M:READ    F:STAK,(BUF,INITBUF5),;
                   (SIZE,2032),(KEY,INITBUF5+508),;
                   (BTD,0),;
                   (ERR,INITSTASTAKERR),(ABN,INITSTASTAKABN)            TIC80230
*                                                                       TIC80240
         LW,13     F:STAK+4            GET ARS.                         TIC80250
         SLS,13    -17                 ALIGN ARS.                       TIC80260
*                                                                       TIC80270
*        WHEN HERE, R14 HAS BA OF THE NPS WE ARE REPLACING (THE BA OF   TIC80280
*        THE PLUS) AND R6 HAS THE BA OF THE CHARACTER FOLLOWING THE NPS.TIC80290
*                                                                       TIC80300
*        ALSO, R7 HAS THE BA OF THE LAST-BYTE-PLUS-ONE IN THE RECORD.   TIC80310
*                                                                       TIC80320
*        R11 HAS THE NUMBER OF BYTES IN THE +-TYPE RECORD.  THE RECORD  TIC80330
*        BEGINS WITH ITS KEY AND IS IN INITBUF6.                        TIC80340
*                                                                       TIC80350
*        THE RECORD WE ARE INSERTING INTO IS IN INITBUF2.  R6 AND R7    TIC80360
*        AND R14 ALL POINT WITHIN INITBUF2.                             TIC80370
*                                                                       TIC80380
*                                                                       TIC80390
         LW,9      13                  (SIZE OF PLUS WITH KEY)
         AI,9      -8                  (SIZE OF PLUS TEXT)
         AW,9      14                  ...
         SW,9      6                   (SIZE OF PLUS) - (SIZE OF NPS)
*
         AW,10     9                   UPDATE R10 TO NEW RECORD ARS.
*                                                                       TIC80450
*        HAVE IN R9 THE SIZE HOLE WE NEED TO MAKE IN THE INITBUF2       TIC80460
*        RECORD SO THAT NPS-RECORD WILL FIT.                            TIC80470
*                                                                       TIC80480
         LW,#ARG   7                   MAKE SURE THAT                   TIC80490
         AW,#ARG   9                    RESULTANT RECORD                TIC80500
         CI,#ARG   4*INITBUF2+BYTESPERRANDOMBLOCK-8 WILL FIT IN FINAL GR
         BLE       INITSTA370          OVER IF SMALL ENOUGH.            TIC80520
*                                                                       TIC80530
*        FALL THROUGH ON RECORD TOO BIG UPON EXPANDING.                 TIC80540
*                                                                       TIC80550
         #OUT      'EXPANDED STAX RECORD TOO BIG -- IGNORED'            TIC80560
         B         INITSTA110                                           TIC80570
*                                                                       TIC80580
INITSTA370 RES                                                          TIC80590
*                                                                       TIC80600
*        WE MUST MOVE BYTES (FROM HIGH ENDS OF STRINGS) STARTING        TIC80610
*        WITH *R7  --> *#ARG AND MOVING 'TIL WE GET BACK TO *R6.        TIC80620
*                                                                       TIC80630
         LB,8      0,7                 DO A                             TIC80640
         STB,8     0,#ARG               POSSIBLY                        TIC80650
         AI,7      -1                    OVERLAPPING
         AI,#ARG   -1                     BYTE
         CW,7      6                       STRING                       TIC80680
         BGE       %-5                      MOVE.                       TIC80690
*                                                                       TIC80700
*        NOW WE HAVE MADE A SPACE FOR THE NPS-RECORD.                   TIC80710
*        MOVE IT, LESS ITS KEY.                                         TIC80720
*                                                                       TIC80730
*        R14 HAS BA OF THE SPACE.                                       TIC80740
*                                                                       TIC80750
*        R13 HAS TOTAL CHAR COUNT (ARS) OF THE NPS-RECORD.              TIC80760
*                                                                       TIC80770
         LI,6      4*INITBUF5+8        WHERE TO MOVE FROM.
         LW,7      14                  WHERE TO MOVE TO.                TIC80790
         LW,8      13                  HOW MANY CHARACTERS TO MOVE.     TIC80800
         AI,8      -8                                                   TIC80810
*                                                                       TIC80820
         MBS678                        DO THE MOVE.                     TIC80830
*                                                                       TIC80840
         B         INITSTA300          AND GO 'WAY BACK AND LOOK        TIC80850
*                                       FOR ANOTHER PLUS.               TIC80860
*                                                                       TIC80870
*                                                                       TIC80880
*        END OF THE LOOP THAT BEGINS AFTER INITSTA300 IS HERE.          TIC80890
*                                                                       TIC80900
INITSTA390 AI,6    1                                                    TIC80910
INITSTA391 CW,6    7                                                    TIC80920
         BL        INITSTA305                                           TIC80930
*                                                                       TIC80940
*        FALL THROUGH WHEN THERE ARE NO MORE +-TYPE NPS TO REPLACE.     TIC80950
*                                                                       TIC80960
*        R10 STILL HAS THE RECORD'S ARS.                                TIC80970
*                                                                       TIC80980
         AI,10     3                   ROUND RECORD SIZE                TIC80990
         SLS,10    -2                   INTO WORDS.                     TIC81000
         AI,10     1                     INCLUDING CONTROL WORD.        TIC81010
*                                                                       TIC81020
*        SEE IF ENOUGH SPACE IN OUTPUT BUFFER:                          TIC81030
*                                                                       TIC81040
         LW,8      10                  WORDS IN RECORD.                 TIC81050
         AW,8      11                  PLUS WHERE WE ARE IN BUFFER.     TIC81060
         CI,8      INITBUF3+(BYTESPERRANDOMBLOCK/4)-1 SEE IF ENUF ROOM.
         BLE       INITSTA600          OVER IF ROOM.                    TIC81080
*                                                                       TIC81090
*        READY TO WRITE THE STATION REOORD.                             TIC81100
*                                                                       TIC81110
INITSTA410 RES     0                                                    TIC81120
         MTW,1     INITGRANULE         BUMP TO NEXT INTERNAL GRANULE.
*                                                                       TIC81140
*        CHAIN THIS BLOCK ON THE THE IN-CORE BLOCK KEY CHAIN.           TIC81150
*                                                                       TIC81160
         LI,5      2                   GET FOUR WORDS
         BAL,#BAL  #FIND#DWS            TO HOLD KEY AND BLOCK
         BEZ       INITNOPAGES           NUMBER IN CHAIN.
         SLS,4     1                   (DA TO WA)
*
         LW,8      INITGRANULE         COPY GRANULE
         STW,8     1,4                  NUMBER INTO ENTRY.
*
         LD,8      INITBUF4            COPY
         STW,8     2,4                  THE
         STW,9     3,4                   KEY.
*                                                                       TIC81290
         LI,9      #STAI#GRANULE#KEY#CHAIN                              TIC81300
         B         %+2                 SCAN DOWN                        TIC81310
         LW,9      *9                   TO FIND                         TIC81320
         MTW,0     *9                    END OF                         TIC81330
         BNEZ      %-2                    THE CHAIN.                    TIC81340
*                                                                       TIC81350
         STW,4     *9                  PUT NEW GUY ON THE END.
         LI,8      0                   AND SET LAST (NEW) GUY'S         TIC81370
         STW,8     *4                   POINTER TO ZERO.
*                                                                       TIC81390
*        WHEN HERE, R11 POINTS TO THE FIRST                             TIC81400
*        UNUSED WORD IN THE BUFFER.                                     TIC81410
*                                                                       TIC81420
         LI,8      0                   PUT A FENCE                      TIC81430
         STW,8     *11                  IN THE BUFFER.                  TIC81440
*                                                                       TIC81450
         M:WRITE   F:TICI,(BUF,INITBUF3),(SIZE,2048),;
                   (BTD,0),(BLOCK,*INITGRANULE)
         M:CHECK   F:TICI,(ERR,INITTICIERR),(ABN,INITTICIABN)
*                                                                       TIC81490
         MTW,0     INITBUF2            SEE IF THERE WAS AN E-O-F.       TIC81500
         BEZ       INITSTA900          DONE IF SO.                      TIC81510
*                                                                       TIC81520
         LI,11     INITBUF3            RESET OUTPUT BUFFER POINTER.     TIC81530
*                                                                       TIC81540
INITSTA600 RES     0                                                    TIC81550
         LD,8      INITBUF2            REMEMBER                         TIC81560
         STD,8     INITBUF4             LATEST KEY.                     TIC81570
*                                                                       TIC81580
*        R10 STILL HAS SIZE OF OUTPUT RECORD IN WORDS.                  TIC81590
*                                                                       TIC81600
         STH,10    *11                 STORE COUNT CONTROL WORD.        TIC81610
         AI,11     1                   AND BUMP BUFFER POINTER.         TIC81620
         AI,10     -1                  COUNT OF WORDS TO MOVE.          TIC81630
*                                                                       TIC81640
         LI,12     INITBUF2            POINT TO INPUT BUFFER.           TIC81650
         LW,8      *12                 MOVE                             TIC81660
         STW,8     *11                  RECORD                          TIC81670
         AI,12     1                     TO                             TIC81680
         AI,11     1                      OUTPUT                        TIC81690
         BDR,10    %-4                     BUFFER.                      TIC81700
*                                                                       TIC81710
         B         INITSTA200                                           TIC81720
         PAGE                                                           TIC81730
*                                                                       TIC81740
*                                                                       TIC81750
*                                                                       TIC81760
INITSTAERR RES     0                                                    TIC81770
INITSTAABN RES     0                                                    TIC81780
         LB,8      10                  GET CLEAN ERR/ABN CODE.          TIC81790
         CI,8      6                   SEE IF IT IS E-O-F.              TIC81800
         BNE       %+4                 OVER IF NOT E-O-F.               TIC81810
*                                                                       TIC81820
         LI,8      0                   STORE A                          TIC81830
         STW,8     INITBUF2             EOF SIGNAL                      TIC81840
         B         INITSTA410            AND WRITE LAST BUFFER.         TIC81850
*                                                                       TIC81860
INITSTABADMESS RES 0
         #OUT      'BAD STAX/STAI/STAK FILE'
         M:XXX
*                                                                       TIC81890
*                                                                       TIC81900
*                                                                       TIC81910
INITSTACOPYINERR RES 0                                                  TIC81920
INITSTACOPYINABN RES 0                                                  TIC81930
         LB,8      10                  ISOLATE ERR/ABN CODE.            TIC81940
         CI,8      6                   SEE IF E-O-F.                    TIC81950
         BE        INITSTA035          BRANCH IF END-OF-FILE.           TIC81960
         B         INITSTABADMESS
*                                                                       TIC81990
*                                                                       TIC82000
*                                                                       TIC82010
INITSTACOPYOUTERR RES 0                                                 TIC82020
INITSTACOPYOUTABN RES 0                                                 TIC82030
         B         INITSTABADMESS
*                                                                       TIC82060
*                                                                       TIC82070
*                                                                       TIC82080
INITSTASTAKERR RES 0                                                    TIC82090
INITSTASTAKABN RES 0                                                    TIC82100
         B         INITSTABADMESS
         PAGE                                                           TIC82130
*                                                                       TIC82140
*                                                                       TIC82150
*                                                                       TIC82160
INITSTABAD RES     0                                                    TIC82170
         B         INITSTABADMESS
         PAGE                                                           TIC82200
*                                                                       TIC82210
*                                                                       TIC82220
*                                                                       TIC82230
INITSTA900 RES      0                                                   TIC82240
         M:SETDCB  F:STAX,(ERR,INITSTA902),(ABN,INITSTA902)             TIC82250
         M:CLOSE   F:STAX                                               TIC82260
INITSTA902 RES     0                                                    TIC82270
         M:SETDCB  F:STAK,(ERR,INITSTA904),(ABN,INITSTA904)             TIC82280
         M:CLOSE   F:STAK                                               TIC82290
INITSTA904 RES     0                                                    TIC82300
         PAGE                                                           TIC82310
*                                                                       TIC82320
*        COPY THE F:DELX FILE TO OUR INTERNAL FILE.
*                                                                       TIC82340
*        LIKE THE STAX COPY, BUT WITHOUT +-TYPE COMPLICATIONS.          TIC82350
*                                                                       TIC82360
*                                                                       TIC82440
         LI,11     INITBUF3            POINT R11 TO OUTPUT BUFFER.      TIC82450
*                                                                       TIC82460
INITDEL200 RES     0                                                    TIC82470
         M:READ    F:DELX,(BUF,INITBUF2),(BTD,0),(SIZE,2047)            TIC82480
         M:CHECK   F:DELX,(ERR,INITDELERR),(ABN,INITDELABN)             TIC82490
*                                                                       TIC82500
         MTW,1     INITDELNTH          BUMP OUR RECORD COUNT.           TIC82510
*                                                                       TIC82520
         LW,10     F:DELX+4            GET 'ACTUAL RECORD SIZE'.        TIC82530
         SLS,10    -17                 AND ALIGN IT.                    TIC82540
*                                                                       TIC82550
         CI,10     9                   SEE IF RECORD UNREASONABLY SHORT.TIC82560
         BLE       INITDELBAD          OUT IF ERRONEOUS.                TIC82570
*                                                                       TIC82580
*        WE HAVE A RECORD.                                              TIC82590
*                                                                       TIC82600
*        ROUND RECORD LENGTH UP TO A MULTIPLE OF FOUR.                  TIC82610
*        BUT INSURE WE ADD AT LEAST ONE BLANK TO END.                   TIC82620
*                                                                       TIC82630
         LI,8      ' '                 A BLANK TO STORE.                TIC82640
         LW,#ARG   10                  COPY BYTE LENGTH TO INDEX.       TIC82650
         STB,8     INITBUF2,#ARG       STORE A BLANK.                   TIC82660
         AI,10     1                   AND BUMP.                        TIC82670
         CI,10     3                   SEE IF AT WORD BOUNDARY.         TIC82680
         BANZ      %-4                 CONTINUE UNTIL WE ARE.           TIC82690
*                                                                       TIC82700
         SLS,10    -2                  RECORD SIZE IN WORDS.            TIC82710
         AI,10     1                   PLUS ONE CONTROL WORD.           TIC82720
*                                                                       TIC82730
*        SEE IF ENOUGH SPACE IN OUTPUT BUFFER:                          TIC82740
*                                                                       TIC82750
         LW,8      10                  WORDS IN NEW RECORD.             TIC82760
         AW,8      11                  PLUS WHERE WE ARE IN BUFFER.     TIC82770
         CI,8      INITBUF3+(BYTESPERRANDOMBLOCK/4)-1 SEE IF ENUF ROOM.
         BLE       INITDEL600          OVER IF ROOM.                    TIC82790
*                                                                       TIC82800
*        TIME TO WRITE A BUFFER-FULL TO DELI.                           TIC82810
INITDEL410 RES     0                                                    TIC82820
         MTW,1     INITGRANULE         BUMP TO NEXT INERNAL GRANULE.
*                                                                       TIC82840
*        CHAIN THIS BLOCK ON THE IN-CORE BLOCK KEY CHAIN.               TIC82850
*                                                                       TIC82860
         LI,5      2                   GET FOUR WORDS
         BAL,#BAL  #FIND#DWS            FOR THE CHAIN ENTRY.
         BEZ       INITNOPAGES
         SLS,4     1
*
         LW,8      INITGRANULE         THIS GRANULE'S NUMBER.
         STW,8     1,4                 STORED INTO ENTRY.
*
         LD,8      INITBUF4            COPY KEY
         STW,8     2,4                  INTO THE
         STW,9     3,4                   CHAIN ENTRY.
*                                                                       TIC82990
         LI,9      #DELI#GRANULE#KEY#CHAIN                              TIC83000
         B         %+2                 SCAN DOWN                        TIC83010
         LW,9      *9                   TO FIND                         TIC83020
         MTW,0     *9                    END OF                         TIC83030
         BNEZ      %-2                    THE CHAIN.                    TIC83040
*                                                                       TIC83050
         STW,4     *9                  PUT NEW GUY ON THE END.
         LI,8      0                   AND SET LAST (NEW) GUY'S         TIC83070
         STW,8     *4                   POINTER (FLINK) TO ZERO.
*                                                                       TIC83090
*        WHEN HERE, R11 POINTS TO THE                                   TIC83100
*        FIRST UNUSED WORD IN THE BUFFER.                               TIC83110
*                                                                       TIC83120
         LI,8      0                   PUT A FENCE                      TIC83130
         STW,8     *11                  IN THE BUFFER.                  TIC83140
*                                                                       TIC83150
         M:WRITE   F:TICI,(BUF,INITBUF3),(SIZE,2048),;
                   (BTD,0),(BLOCK,*INITGRANULE)
         M:CHECK   F:TICI,(ERR,INITTICIERR),(ABN,INITTICIABN)
*                                                                       TIC83190
         MTW,0     INITBUF2            SEE IF WE HAD A F:DELX E-O-F.    TIC83200
         BEZ       INITDEL900          DONE IF SO.                      TIC83210
*                                                                       TIC83220
         LI,11     INITBUF3            RESET OUTPUT BUFFER POINTER.     TIC83230
*                                                                       TIC83240
INITDEL600 RES     0                                                    TIC83250
         LD,8      INITBUF2            REMEMBER                         TIC83260
         STD,8     INITBUF4             LATEST KEY.                     TIC83270
*                                                                       TIC83280
*        R10 STILL HAS SIZE OF TO-OUTPUT RECORD IN WORDS.               TIC83290
*                                                                       TIC83300
         STH,10    *11                 STORE COUNT CONTROL WORD.        TIC83310
         AI,11     1                   AND BUMP BUFFER POINTER.         TIC83320
         AI,10     -1                  COUNT OF WORDS TO MOVE.          TIC83330
*                                                                       TIC83340
         LI,12     INITBUF2            LOAD WHERE TO MOVE FROM.         TIC83350
         LW,8      *12                 MOVE                             TIC83360
         STW,8     *11                  RECORD                          TIC83370
         AI,12     1                     TO                             TIC83380
         AI,11     1                      OUTPUT                        TIC83390
         BDR,10    %-4                     BUFFER.                      TIC83400
         B         INITDEL200                                           TIC83410
         PAGE                                                           TIC83420
*                                                                       TIC83430
*                                                                       TIC83440
*                                                                       TIC83450
INITDELERR RES     0                                                    TIC83460
INITDELABN RES     0                                                    TIC83470
         LB,8      10                  GET CLEAN ERR/ABN CODE.          TIC83480
         CI,8      6                   SEE IF IT IS E-O-F.              TIC83490
         BNE       %+4                 OVER IF NOT E-O-F.               TIC83500
*                                                                       TIC83510
         LI,8      0                   STORE OUR                        TIC83520
         STW,8     INITBUF2             EOF SIGNAL                      TIC83530
         B         INITDEL410            AND WRITE LAST BUFFER.         TIC83540
*                                                                       TIC83550
INITDELBADMESS RES 0
         #OUT      'BAD DELX/DELI FILE'
         M:XXX
         PAGE                                                           TIC83580
*                                                                       TIC83590
*                                                                       TIC83600
*                                                                       TIC83610
INITDELBAD RES     0                                                    TIC83620
         B         INITDELBADMESS
         PAGE                                                           TIC83650
*                                                                       TIC83660
*                                                                       TIC83670
*                                                                       TIC83680
INITDEL900 RES     0                                                    TIC83690
         M:SETDCB  F:DELX,(ERR,INITDEL902),(ABN,INITDEL902)             TIC83700
         M:CLOSE   F:DELX                                               TIC83710
INITDEL902 RES     0                                                    TIC83720
         PAGE                                                           TIC83730
*                                                                       TIC83740
*        FIRST PASS OVER M:SI DATA BUILDS TABLE SPACE.                  TIC83750
*                                                                       TIC83760
         LI,12     0                   COUNT OF DEV-TASKS.              TIC83770
         LI,13     0                   COUNT OF MDL-TASKS.              TIC83780
         LI,14     0                   NO MDL LINEIDS IN INITBUF3 YET.  TIC83790
*                                                                       TIC83800
INITMSI110 RES     0                                                    TIC83810
         M:READ    M:SI,(BUF,INITBUF2),(SIZE,80),;                      TIC83820
                   (ERR,INITMSIERR),(ABN,INITMSIABN)                    TIC83830
*                                                                       TIC83840
         LW,7      M:SI+4              GET ARS.                         TIC83850
         SLS,7     -17                 JUSTIFY ARS.                     TIC83860
*                                                                       TIC83870
         M:WRITE   F:MYSI,(BUF,INITBUF2),(SIZE,*7),;                    TIC83880
                   (ERR,INITFSIOUTERR),(ABN,INITFSIOUTERR)              TIC83890
*                                                                       TIC83900
*        R7 STILL HAS RECORD LENGTH.                                    TIC83910
*                                                                       TIC83920
         LI,6      4*INITBUF2          SET SCAN POINTER.
         AI,7      4*INITBUF2          SET END-OF-SCAN.
*                                                                       TIC83950
         FIELD6789POINTTOSTRING        SKIP ACQUIRE/TABLE FIELD.        TIC83960
         FIELD6789LOADAAAA             GET LINEID FIELD.                TIC83970
         LI,#ARG   1                   ISOLATE SECOND
         LB,9      8,#ARG               BYTE OF LINEID.
         CI,9      ':'                 IS IT A COLON.
         BE        INITMSI180          LOCAL (NOT MULTIPOINT) IF SO.
*
         LB,9      8                   ISOLATE FIRST BYTE.              TIC83980
         CI,9      'M'                 IS IT MULTIPOINT?                TIC83990
         BNE       INITMSI150          OVER IF NOT.                     TIC84000
*                                                                       TIC84010
*        FALL THROUGH IF MULTIPOINT.                                    TIC84020
*                                                                       TIC84030
*        MULTIPOINT LINE ID IS IN R8.                                   TIC84040
*                                                                       TIC84050
         LW,5      14                  COPY CURRENT # OF MULTIPOINTS.   TIC84060
         BEZ       INITMSI130          OVER IF NONE.                    TIC84070
*                                                                       TIC84080
         CW,8      INITBUF3,5          SEE IF LINEID                    TIC84090
         BE        INITMSI135           ON PREVIOUS                     TIC84100
         BDR,5     %-2                   M:SI CARD.                     TIC84110
*                                                                       TIC84120
*        FALL THROUGH ON NEW MULTIPOINT LINE.                           TIC84130
*                                                                       TIC84140
INITMSI130 AI,14   1                   BUMP INTO TABLE.                 TIC84150
         LW,5      14                  STORE NEW LINEID                 TIC84160
         STW,8     INITBUF3,5          INTO THE TABLE.                  TIC84170
*                                                                       TIC84180
         AI,13     1                   BUMP MDL-TASK COUNT              TIC84190
*                                                                       TIC84200
INITMSI135 RES     0                                                    TIC84210
*                                                                       TIC84220
INITMSI150 RES     0                                                    TIC84230
INITMSI180 RES     0
         AI,12     1                   BUMP DEV-TASK COUNT.             TIC84240
         B         INITMSI110          AND LOOP.                        TIC84250
*                                                                       TIC84260
*                                                                       TIC84270
*                                                                       TIC84280
INITMSI200 RES     0                   HERE AFTER READING ALL OF M:SI.  TIC84290
*                                                                       TIC84300
*        HERE AFTER COUNTING ALL STATIONS.
*
         LI,8      0                   CALCULATE TASK-NUMBER OF         TIC84310
         SW,8      13                   BIGGEST MDL-TASK WE HAVE.       TIC84320
         STW,8     #BIGGEST#MDL#TASK   AND REMEMBER IT.                 TIC84330
*                                                                       TIC84340
*        WHEN HERE, R12 HAS NUMBER OF DEV-TASKS TO BUILD TABLES FOR.    TIC84350
*        R13 HAS NUMBER OF MDL-TASKS TO BUILD TABLES FOR.               TIC84360
*                                                                       TIC84370
         DO        DO#DEVELOPMENT                                       TIC84380
         AI,12     0                   SEE IF NO DEV-TASKS.             TIC84390
         BEZ       INITMSI290          IF SO, USE CANNED IN DEVELOPMENT.TIC84400
         FIN                                                            TIC84410
*
         AI,12     0                   SEE IF ANY DEV-TASKS.
         BGZ       INITMSI265          OVER IF SO.
*
         #TYPE89   'NO STATIONS'
         M:XXX
*
INITMSI265 RES     0
*                                                                       TIC84420
MAKEATABLE CNAME                                                        TIC84430
         PROC                                                           TIC84440
AG       SET       AF                                                   TIC84450
         LI,10     AG(2)
         BAL,11    MAKEATABLECODE
         STW,4     AG(1)
         PEND                                                           TIC84700
*
*
*
         MAKEATABLE #DEV#RECORD#BA                                      TIC84710
         MAKEATABLE #DEV#RECORD#LENGTH                                  TIC84720
         MAKEATABLE #DEV#RECORD#STATUS                                  TIC84730
         MAKEATABLE #DEV#EVENT#PTR                                      TIC84740
         MAKEATABLE #DEV#DCB#POINTER                                    TIC84750
         MAKEATABLE #DEV#CURRENT#IO                                     TIC84760
         MAKEATABLE #DEV#INPUT#TRL                                      TIC84770
         MAKEATABLE #DEV#OUTPUT#TRL                                     TIC84780
         MAKEATABLE #MDL#WAKEUP#ECB                                     TIC84790
         DO        DO#FIXEDMDLBUFFERS
         MAKEATABLE #MDL#FIXED#BUFFERS
         FIN
         MAKEATABLE #DEV#COMMAND#LINE#RECORD#BA                         TIC84810
         MAKEATABLE #DEV#COMMAND#LINE#RECORD#LENGTH                     TIC84820
         MAKEATABLE #DEV#LINE#IDENTIFIER                                TIC84830
         MAKEATABLE #DEV#MULTIPOINT#INDEX                               TIC84840
         MAKEATABLE #DEV#LINE#STATUS#BITS                               TIC84850
         MAKEATABLE #DEV#TYPE#INDEX
         MAKEATABLE #DEV#REGULATION                                     TIC84855
         MAKEATABLE #DEV#STATION#TYPE                                   TIC84860
         DO        HOWMANYXMITSBREAK>1
         MAKEATABLE #DEV#XMIT#COUNT
         FIN
         MAKEATABLE #DEV#ECB                                            TIC84870
         MAKEATABLE #DEV#LOGON#BLOCK                                    TIC84880
         MAKEATABLE #DCB#TABLE                                          TIC84885
*
*        WHILE WE KNOW HOW MANY DEV-TASKS AND
*        HOW MANY MDL-TASKS WE HAVE, WE GET
*        SPACE TO HOLD THE LONGEST POSSIBLE
*        ECB LIST THAT WE MIGHT WAIT ON.
*
         LW,5      12                  ONE ECB PER DEV-TASK
         AW,5      13                  AND TWO ECBS
         AW,5      13                   PER MDL-TASK.
         STW,5     ECBLISTMAXSIZE      REMEMBER MAX NUMBER OF ECBS.
         AI,5      1                   ROUND UP TO
         SLS,5     -1                   DOUBLEWORDS
         BAL,#BAL  #FIND#DWS           GET THE DWS.
         BEZ       INITNOPAGES          OUT IF NONE.
         SLS,4     1                   (DA TO WA)
         STW,4     ECBLISTWA           REMEMBER WHERE TO BUILD ECB LIST.
*                                                                       TIC84890
*                                                                       TIC84900
*                                                                       TIC84910
INITMSI290 RES     0                                                    TIC84920
         M:PFIL    F:MYSI,(BOF)                                         TIC84930
*                                                                       TIC84940
*                                                                       TIC84950
*                                                                       TIC84960
*                                                                       TIC84970
*        SECOND PASS OFER THE M:SI DATA.                                TIC84980
*                                                                       TIC84990
INITMSI500 RES      0                                                   TIC85000
          LI,#DEV   0                   WE DO DEV-TASKS IN ORDER.       TIC85010
INITMSI510 RES      0                                                   TIC85020
         M:READ    F:MYSI,(BUF,INITBUF2),(SIZE,80),;
                   (ERR,INITMSIERR510),(ABN,INITMSIABN510)
*
*        IF THE READ FALLS THROUGH, THEN WE GOT THE NEXT DEV-TASKS RECOR
*
         AI,#DEV   1
*
*
*
         LI,8      0                   ZERO OUT SOME TABLES:
         #T#PUT,8  #DEV#RECORD#BA
         #T#PUT,8  #DEV#RECORD#LENGTH
         #T#PUT,8  #DEV#RECORD#STATUS
         #T#PUT,8  #DEV#EVENT#PTR
         #T#PUT,8  #DEV#CURRENT#IO
         #T#PUT,8  #DEV#COMMAND#LINE#RECORD#BA
         #T#PUT,8  #DEV#COMMAND#LINE#RECORD#LENGTH
         #T#PUT,8  #DEV#LINE#STATUS#BITS
         #T#PUT,8  #DEV#TYPE#INDEX
         #T#PUT,8  #DEV#REGULATION
         #T#PUT,8  #DEV#LOGON#BLOCK
         #T#PUT,8  #DEV#DCB#POINTER
         DO        HOWMANYXMITSBREAK>1
         #T#PUT,8  #DEV#XMIT#COUNT
         FIN
         #T#POST   #DEV#ECB
*
         LI,6      4*INITBUF2          SET SCAN OF CHARACTERS.
         LW,7      F:MYSI+4            GET AND                          TIC85080
          SLS,7     -17                  JUSTIFY ARS.                   TIC85090
          AW,7      6                   PLUS START IS END+1.            TIC85100
*                                                                       TIC85110
   FIELD6789BRANCHIF,INITMSIBAD INITMSI555,'A','C','Q','U','I','R','E'  TIC85150
   FIELD6789BRANCHIF,INITMSIBAD INITMSI550,'T','A','B','L','E'          TIC85160
INITMSIBAD RES     0                                                    TIC85170
         LW,8      INITBUF2
         LW,9      INITBUF2+1
         #TYPE89   'BAD M:SI RECORD: '
         M:XXX
*                                                                       TIC85200
INITMSI550 RES     0                    HERE ON TABLE.                  TIC85210
         #T#GET,12 #DEV#LINE#STATUS#BITS SET TO NOT                     TIC85220
          OR,12     =#LINE#UNACQUIRED    ACQUIRE                        TIC85230
         #T#PUT,12 #DEV#LINE#STATUS#BITS THE LINE.                      TIC85240
*                                                                       TIC85250
INITMSI555 RES      0                   HERE ON ACQUIRE.                TIC85260
          FIELD6789LOADAAAA,INITMSIBAD GET THE LINEID.                  TIC85270
          #T#PUT,8 #DEV#LINE#IDENTIFIER STORE IT.                       TIC85280
*
         LI,#ARG   1                   GET SECOND CHARACTER
         LB,9      8,#ARG               OF IDENTIFIER.
         CI,9      ':'                 COLON MEANS LOCAL.
         BNE       INITMSI590          OVER IF OT LOCAL.
*                                                                       TIC85290
*        FALL THRU ON LOCL DEVICE ON M:SI RECORD.
*
         CW,8      ='M:EO'             SEE IF KNOWN OUTPUT DEVICE.
         BNE       INITMSI582          OVER IF NOT.
*
         LI,9      #LINE#CANNOT#INPUT  LOAD APPROPRIATE LINE STATUS.
         LI,10     M:EO                LOAD DCB ADDRESS.
         BNEZ      INITMSI586          AND JOIN COMMON STORES.
         B         INITMSIBAD          (ERROR IF NO DCB)
*
INITMSI582 RES     0
         CW,8      ='M:EI'             SEE IF KNOWN INPUT DEVICE.
         BNE       INITMSIBAD          BAD RECORD IF UNKNOWN LOCAL NAME.
*
         LI,9      #LINE#CANNOT#OUTPUT LOAD APPROPRIATE LINE STATUS.
         LI,10     M:EI                LOAD DCB ADDRESS.
         BEZ       INITMSIBAD          (ERROR IF NO DCB)
*
INITMSI586 RES     0
         #T#PUT,9  #DEV#LINE#STATUS#BITS STORE TYPE OF UNIT RECORD
         LI,9      #DEV#TYPE#INDEX#UNIT#RECORD AND STORE UNIT
         #T#PUT,9  #DEV#TYPE#INDEX              RECORD INDEX.
         STW,10    *#DCB#TABLE#IW,#DEV AND STORE DCB ADDRESS IN
         #T#PUT,#DEV #DEV#DCB#POINTER   TABLE AND POINT TO IT.
         B         INITMSI660
*
INITMSI590 RES     0
          LB,9      8                   ISOLATE THE C OR M              TIC85300
          CI,9      'C'                 IS IT POINT-TO-POINT?           TIC85310
          BE        INITMSI660          OVER IF SO.                     TIC85320
         CI,9       'M'                 IS IT MULTI-POINT?              TIC85330
          BNE      INITMSIBAD           ERROR IF NEITHER.               TIC85340
*                                                                       TIC85350
*         FALL THROUGH ON 'M' TYPE LINE.                                TIC85360
*                                                                       TIC85370
*        LINE IDENTIFIER IS STILL IN R8.                                TIC85380
*                                                                       TIC85390
*        SCAN THROUGH THE LINEIDS IN INITBUF3                           TIC85400
*        TO FIND THIS GUYS MDL-TASK NUMBER.                             TIC85410
*                                                                       TIC85420
         LI,5      1                   START AT # ONE FOR TASK #S.      TIC85430
         CW,8      INITBUF3,5          SEE IF IDENTIFIER MATCHES.
         BE        INITMSI625                                           TIC85450
         AI,5      1                   OTHERWISE,                       TIC85460
         B         %-3                  LOOP LOOKING.                   TIC85470
*                                                                       TIC85480
INITMSI625 RES     0                                                    TIC85490
         LI,8      0                   MAKE R5 INTO CORRECT MDL-TASK    TIC85500
         SW,8      5                    NUMBER (THAT IS NEGATIVE).      TIC85510
         #T#PUT,8  #DEV#DCB#POINTER    AND STORE IT.                    TIC85520
*                                                                       TIC85530
*        NEED TO GET THE PHYSICAL ADDRESS AND                           TIC85540
*        PUT IT INTO THE #DEV TABLES.                                   TIC85550
*                                                                       TIC85560
         FIELD6789LOADAAAA,INITMSIDEFAULT3                              TIC85570
         B         INITMSISTORE3                                        TIC85580
INITMSIDEFAULT3 RES 0                                                   TIC85590
         LI,8      0                                                    TIC85600
INITMSISTORE3 RES  0                                                    TIC85610
         #T#PUT,8  #DEV#LINE#IDENTIFIER                                 TIC85620
         B         INITMSI670                                           TIC85630
INITMSI660 RES      0                                                   TIC85640
         FIELD6789LOADAAAA,INITMSIBAD  IGNORE THE MDL ADDRESS.          TIC85650
*                                                                       TIC85660
INITMSI670 RES      0                                                   TIC85670
          FIELD6789LOADAAAA,INITMSIDEFAULT4 GET STATION TYPE.           TIC85680
         B          INITMSISTORE4                                       TIC85690
INITMSIDEFAULT4 LI,8 0                  DEFAULT STATION TYPE IS X'0000'.TIC85700
INITMSISTORE4 #T#PUT,8 #DEV#STATION#TYPE                                TIC85710
*                                                                       TIC85720
          FIELD6789LOADINTEGER,INITMSIDEFAULT5,INITMSIBAD GET IN-TRL.   TIC85730
          B         INITMSISTORE5                                       TIC85740
INITMSIDEFAULT5 LI,8 80                 DEFAULT RECORD SIZE = 80.       TIC85750
INITMSISTORE5 #T#PUT,8 #DEV#INPUT#TRL                                   TIC85760
*                                                                       TIC85770
          FIELD6789LOADINTEGER,INITMSIDEFAULT6,INITMSIBAD GET OUT-TRL.  TIC85780
          B         INITMSISTORE6                                       TIC85790
INITMSIDEFAULT6 LI,8 80                 DEFAULT RECORD SIZE = 80.       TIC85800
INITMSISTORE6 #T#PUT,8 #DEV#OUTPUT#TRL                                  TIC85810
          B         INITMSI510                                          TIC86000
*                                                                       TIC86010
*                                                                       TIC86020
*                                                                       TIC86030
INITMSI800 RES     0                   HERE WHEN ALL DEV-TASKS INITIALIZ
INITMSI805 RES     0                                                    TIC86060
          STW,#DEV #BIGGEST#TIC#TASK    REMEMBER TOP TSSK NUMBER.       TIC86070
          B         INITMSI900                                          TIC86080
         PAGE                                                           TIC86090
*                                                                       TIC86100
*                                                                       TIC86110
*                                                                       TIC86120
INITMSIERR RES      0                                                   TIC86130
INITMSIABN RES      0                                                   TIC86140
         LB,8      10                   NEATEN THE ERR/ABN CODE.        TIC86150
          CI,8      6                   IS IT A E-O-F?                  TIC86160
         BE        INITMSI200          GO BUILD TABLES ON E-O-F.        TIC86170
*                                                                       TIC86180
         #OUT      'ERR/ABN ON M:SI'
         M:XXX
*                                                                       TIC86210
INITMSIERR510 RES  0                                                    TIC86220
INITMSIABN510 RES  0                                                    TIC86230
         LB,8      10                  ISOLATE THE ERR/ABN CODE.        TIC86240
         CI,8      6                   IS IT AN E-O-F?                  TIC86250
         BE        INITMSI800          DONE IF END-OF-FILE.             TIC86260
*
INITFSIOUTERR RES  0
INITFSIOUTABN RES  0
         #OUT      'ERR/ABN ON F:MYSI'
         M:XXX
         PAGE
*
*
*
*        BAL'ED TO FROM THE MAKEATABLE PROC.
*
*        ENTER WITH:  R12 HAS NUMBER OF DEV-TASKS.
*                     R13 HAS NUMBER OF MDL-TASKS.
*                     R10 HAS NUMBER OF BYTES PER TABLE ENTRY.
*                     R11 IS BAL REGISTER.
*
*        RETURN WA OF ZERO'TH TABLE ENTRY IN R4.
*
*        MAY USE R9, R5, AND #ARG AND #BAL.
*        MAY USE R4 AND R8.
*
MAKEATABLECODE RES 0
         LW,5      12                  CALCULATE BYTES
         MW,5      10                   OF DEV SPACE ...
*                                      (WATCH USE OF ODD REGISTERS HERE)
         LW,9      13                  CALCULATE BYTES
         MW,9      10                   OF MDL SPACE, ROUNDED
         AI,9      3                     UP TO NEXT WORD.
         AND,9     =X'FFFFC'              (THIS STAYS IN R9)
         AW,5      9
         AW,5      10                  SPACE FOR ZERO'TH ENTRY.
         AI,5      7                   ROUND UP TO
         SLS,5     -3                   DOUBLEWORDS.
         BAL,#BAL  #FIND#DWS
         BEZ       INITNOPAGES
         SLS,4     1                   (DA TO WA)
         SLS,9     -2                  (BYTES OF MDL IN R9 TO WORDS)
         AW,4      9                   PLUS MDL SPACE POINTS TO ZERO'TH.
         B         *11                 AND RETURN.
          PAGE                                                          TIC86360
*                                                                       TIC86370
*                                                                       TIC86380
*                                                                       TIC86390
INITMSI900 RES      0                                                   TIC86400
         M:SETDCB  M:SI,(ERR,INITMSI902),(ABN,INITMSI902)               TIC86410
         M:CLOSE   M:SI                                                 TIC86420
INITMSI902 RES     0                                                    TIC86430
         M:SETDCB  F:MYSI,(ERR,INITMSI904),(ABN,INITMSI904)             TIC86440
         M:CLOSE   F:MYSI                                               TIC86450
INITMSI904 RES     0                                                    TIC86460
         PAGE                                                           TIC86470
*                                                                       TIC86480
*        NOW WE ACQUIRE LINES AND OPEN THEM:                            TIC86490
*                                                                       TIC86500
INITACQ100 RES     0                                                    TIC86510
         LW,#DEV   #BIGGEST#TIC#TASK   DO FOR ALL DEV-TASKS.            TIC86520
         DO        DO#DEVELOPMENT                                       TIC86530
         STW,#DEV  #TS#TEST            SAVE TS TESTING INDICATOR.       TIC86540
         BGZ       %+3                 OVER IF NORMAL.                  TIC86550
         MTW,1     #BIGGEST#TIC#TASK   IF NOT, FORCE TO ONE.            TIC86560
         B         INITACQ900          AND SKIP ANY ACQUIRING.          TIC86570
         FIN                                                            TIC86580
         BEZ       INITACQ900          OVER IF NONE TO ACQUIRE.         TIC86590
INITACQ110 RES     0                                                    TIC86600
*                                                                       TIC86610
         #T#GET,6  #DEV#DCB#POINTER    GET CURRENT DCB POINTER VALUE.
         BEZ       INITACQ205          OVER IF POINT-TO-POINT.
         BGZ       INITACQ305          OVER IF LOCAL DEVICE.
*                                      FALL THRU IF MULTIPOINT.
*                                                                       TIC86640
         LI,9      INITBUF3            POINT R9 TO IDENTIFIER
         SW,9      6                    IN THE BUFFER/LIST.             TIC86660
*                                                                       TIC86670
         LB,10     *9                  SEE IF FIRST TIME ENCOUNTERED.   TIC86680
         BEZ       INITACQ140          OVER IF NOT.                     TIC86690
*                                                                       TIC86700
         LW,11     *9                  RETRIEVE IDENTIFIER.             TIC86710
         #T#PUT,11,6 #DEV#LINE#IDENTIFIER REAL IDENTIFIER TO MDL'S ENTRYTIC86730
*                                                                       TIC86760
         LI,7      0                   SCAN                             TIC86770
         LW,10     #DCB#SREFS#WLIST,7   YABLE
         BLZ       INITACQOUTOFDCBS      AND GET                        TIC86790
         BGZ       %+3                    A DCB                         TIC86800
         AI,7      1                       FOR THE                      TIC86810
         B         %-4                      MDL-LINE.                   TIC86820
         LI,8      0                                                    TIC86830
         STW,8     #DCB#SREFS#WLIST,7
*                                                                       TIC86850
         STW,10    *#DCB#TABLE#IW,6    MDL-DCBS ONE-FOR-ONE WITH MDL-TASTIC86860
*                                                                       TIC86870
         #T#PUT,6,6 #DEV#DCB#POINTER
         #T#PUT,8,6 #DEV#INPUT#TRL
         #T#PUT,8,6 #DEV#RECORD#BA
         #T#PUT,8,6 #DEV#RECORD#LENGTH
         #T#PUT,8,6 #DEV#RECORD#STATUS
         #T#PUT,8,6 #DEV#EVENT#PTR
         #T#PUT,8,6 #DEV#CURRENT#IO
         #T#PUT,8,6 #DEV#COMMAND#LINE#RECORD#BA
         #T#PUT,8,6 #DEV#COMMAND#LINE#RECORD#LENGTH
         #T#PUT,8,6 #DEV#REGULATION
         #T#PUT,8,6 #DEV#LOGON#BLOCK
         #T#POST,8,6 #DEV#ECB
*
         LI,8      #LINE#UNACQUIRED
         #T#PUT,8,6 #DEV#LINE#STATUS#BITS
*                                                                       TIC87050
         LI,10     0                   SET IN INDEX TO M:LIST,          TIC87060
         STW,10    *9                   REPLACING THE IDENTIFIER.       TIC87070
*                                        (STARTS AT ONE, SEE BELOW)     TIC87080
*                                                                       TIC87090
*                                                                       TIC87100
*                                                                       TIC87110
INITACQ140 LW,13   *9                  BUMP TO                          TIC87120
         AI,13     1                    NEXT INDEX                      TIC87130
         STW,13    *9                    VALUE IN INITBUF3              TIC87140
         #T#PUT,13 #DEV#MULTIPOINT#INDEX  AND STORE.                    TIC87150
*
         #T#GET,8  #DEV#INPUT#TRL      STATION'S INPUT MESSAGE LENGTH.
         #T#GET,9,6 #DEV#INPUT#TRL     LINE'S INPUT BUFFER SIZE.
         CW,8      9                   COMPARE.
         BLE       INITACQ146          OVER ON WILL FIT.
         #T#PUT,8,6 #DEV#INPUT#TRL     OR MAKE BUFFER BIGGER.
INITACQ146 RES     0
*
         #T#GET,8  #DEV#OUTPUT#TRL     STATION'S OUTPUT MESSAGE LENGTH.
         #T#GET,9,6 #DEV#OUTPUT#TRL    LINE'S OUTPUT BUFFER SIZE.
         CW,8      9                   COMPARE.
         BLE       INITACQ149          OVER ON WILL FIT.
         #T#PUT,8,6 #DEV#OUTPUT#TRL    OR MAKE BUFFER BIGGER.
INITACQ149 RES     0
*                                                                       TIC87160
*        NOW PUT THE STATION INTO THE MDL-LINE'S LIST.                  TIC87170
*                                                                       TIC87180
         LW,8      *#DCB#TABLE#IW,6    LINE'S DCB LOCATION.             TIC87190
         #T#GET,11 #DEV#LINE#IDENTIFIER PHYSICAL ADDRESS OF STATION.    TIC87200
*                                      R13 STILL HAS 'INDEX'.           TIC87210
         M:MDFLST  *8,(PSL),(REPL,11,13)
         BCS,8     INITACQMDFLSTERROR
*
         #T#GET,9  #DEV#LINE#STATUS#BITS GET STATION'S STATUS.
         CI,9      #LINE#UNACQUIRED    SEE IF STATION ACQUIRED.
         BAZ       INITACQ160          GO AND ACQUIRE.
*
         M:MDFLST  *8,(PSL),(EXCL,13)  NO ACQUIRE -- EXCLUDE HIM.
         B         INITACQ400
*
INITACQ160 RES     0
*
         #T#GET,9,6 #DEV#LINE#STATUS#BITS GET ACQUIRED STATUS OF MDL.
         CI,9      #LINE#UNACQUIRED    SEE IF LINE UNACQUIRED.
         BAZ       INITACQ400          OVER IF LINE ALREADY ACQUIRED.
*
         LW,8      *#DCB#TABLE#IW,6    GET DCB LOCATION.
         #T#GWA,9,6 #DEV#LINE#IDENTIFIER POINT TO LINEID.
*
         M:GETLINE *9                  GET THE MOC LINE
         BCS,8     INITACQERR          OVER IF COULDN'T.
         M:OPEN    *8,(LINE,*9),(ERR,INITACQERR),(ABN,INITACQABN)
         M:SETDCB  *8,(ERR,MOCLINEERR),(ABN,MOCLINEABN)
         #T#GET,9,6 #DEV#LINE#STATUS#BITS AFTER HAVING GOTTEN,
         AND,9     =(-#LINE#UNACQUIRED-1) SET THE LINE ACQUIRED.
         #T#PUT,9,6 #DEV#LINE#STATUS#BITS
*
         B         INITACQ400                                           TIC87240
*                                                                       TIC87250
*
*
*        HERE WHEN NOT MULTI-POINT.
*
INITACQ205 RES     0                                                    TIC87260
         LI,7      0                   SCAN HERE TO GAT A DCB           TIC87270
         LW,9      #DCB#SREFS,7         FOR THE DEV-TASK.               TIC87280
         BLZ       INITACQOUTOFDCBS    ERROR IF OUT OF DCBS.            TIC87290
         BGZ       INITACQ220           OUT IF FOUND ONE.               TIC87300
         AI,7      1                   OTHERWISE,                       TIC87310
         B         %-4                  WE LOOP.                        TIC87320
*                                                                       TIC87330
INITACQ220 RES     0                   HERE WITH DCB FROM THE LIST OF   TIC87340
*                                      DCBS IN R9 AND WITH R7 STILL     TIC87350
*                                      POINTING INTO THE LIST OF THEM.  TIC87360
         LI,8      0                   CLEAR THE DCB SO THE NEXT        TIC87370
         STW,8     #DCB#SREFS,7         GUY WON'T GET IT.               TIC87380
*                                                                       TIC87390
         STW,9     *#DCB#TABLE#IW,#DEV FOR NOW, DCB TABLE               TIC87400
         #T#PUT,#DEV #DEV#DCB#POINTER   IS ONE-FOR-ONE WITH TASK NUMBER.TIC87410
*                                                                       TIC87420
          #T#GET,8 #DEV#LINE#STATUS#BITS GET STATUS BITS.               TIC87430
         CI,8      #LINE#UNACQUIRED    SEE IF 'TABLE' RATHER THAN 'ACQUITIC87440
         BANZ      INITACQ400          OVER IF SO.                      TIC87450
*                                                                       TIC87460
         #T#GET,8  #DEV#LINE#IDENTIFIER GET LINEID OF TASK.             TIC87470
         BEZ       INITACQ400          SPECIAL OVER IF NONE.            TIC87480
*                                                                       TIC87490
         #T#GWA,8  #DEV#LINE#IDENTIFIER POINT TO LINEID.                TIC87500
         M:GETLINE *8                  ACQUIRE THE INDICATED LINE.      TIC87510
         BCR,8     INITACQ270          OVER IF GETLINE OK.
*
*        FALL THROUGH WHEN WE COULD NOT
*        ACQUIRE THE BI-POINT LIN.
*
         #T#GET,8  #DEV#LINE#IDENTIFIER
         #TYPE89   'UNABLE TO ACQUIRE LINE:'
*
         #T#GET,8  #DEV#LINE#STATUS#BITS SET UNACQUIRABLE LINE
         OR,8      =#LINE#UNACQUIRED      TO UNACQUIRED (TABLED)
         #T#PUT,8  #DEV#LINE#STATUS#BITS   IN OUR TABLE.
         B         INITACQ400
*
INITACQ270 RES     0
          #T#GET,4 #DEV#DCB#POINTER     RE-ACQUIRE STATION'S            TIC87540
         LW,8       *#DCB#TABLE#IW,4     DCB LOCATION.                  TIC87550
         #T#GWA,9  #DEV#LINE#IDENTIFIER POINT TO LINEID.                TIC87560
         M:OPEN    *8,(LINE,*9),(ERR,INITACQERR),(ABN,INITACQABN)       TIC87570
         M:SETDCB  *8,(ERR,COCLINEERR),(ABN,COCLINEABN)                 TIC87580
         M:PURGE   *8                  CLEAR OUT ANY TYPE-AHEAD.        TIC87590
         B         INITACQ400          AND GO TO BDR.
*
*
*
INITACQ305 RES     0                   HERE ON LOCAL DEVICE.
         #T#GET,4  #DEV#DCB#POINTER
         LW,8      *#DCB#TABLE#IW,4
*
         M:OPEN    *8,(ERR,INITACQERR),(ABN,INITACQABN)
         M:SETDCB  *8,(ERR,COCLINEERR),(ABN,COCLINEABN)
*
*
*                                                                       TIC87600
INITACQ400 RES     0                                                    TIC87610
         BDR,#DEV  INITACQ110          DO ALL THE DEV-TASKS.            TIC87620
         B         INITACQ900          THEN WE'RE DONE.                 TIC87630
         PAGE                                                           TIC87640
INITACQERR RES     0                                                    TIC87650
INITACQABN RES     0                                                    TIC87660
         #OUT      'BAD LINE OPENING'
         M:XXX
*                                                                       TIC87690
*                                                                       TIC87700
*                                                                       TIC87710
*                                                                       TIC87720
INITACQCOULDNOT RES 0                  HERE ON ERROR IN M:GETLINE.      TIC87730
         #SNAP     'ERROR RETURN FROM M:GETLINE'                        TIC87740
         B         INITACQ400                                           TIC87750
*                                                                       TIC87760
*                                                                       TIC87770
*                                                                       TIC87780
*                                                                       TIC87790
INITACQOUTOFDCBS RES 0                                                  TIC87800
         #OUT      'NEED MORE DCBS'
         M:EXIT
*                                                                       TIC87870
*                                                                       TIC87880
*                                                                       TIC87890
INITACQMDFLSTERROR RES 0                                                TIC87900
         #OUT      'BAD M:MDFLST'
         M:XXX
*                                                                       TIC87930
#DCB#SREFS RES     0                                                    TIC87940
         GEN,32    F:3000                                               TIC87950
         GEN,32    F:3001                                               TIC87960
         GEN,32    F:3002                                               TIC87970
         GEN,32    F:3003                                               TIC87980
         GEN,32    F:3004                                               TIC87990
         GEN,32    F:3005                                               TIC88000
         GEN,32    F:3006                                               TIC88010
         GEN,32    F:3007                                               TIC88020
         GEN,32    F:3008                                               TIC88030
         GEN,32    F:3009                                               TIC88040
         GEN,32    F:3010
         GEN,32    F:3011
         GEN,32    F:3012
         GEN,32    F:3013
         GEN,32    F:3014
         GEN,32    F:3015
         GEN,32    F:3016
         GEN,32    F:3017
         GEN,32    F:3018
         GEN,32    F:3019
         GEN,32    F:3020
         GEN,32    F:3021
         GEN,32    F:3022
         GEN,32    F:3023
         GEN,32    F:3024
         GEN,32    F:3025
         GEN,32    F:3026
         GEN,32    F:3027
         GEN,32    F:3028
         GEN,32    F:3029
         GEN,32    -1                  SIGNIFIES TABLE END.             TIC88050
*        DCBS WITH LISTS ATTAAHED:
#DCB#SREFS#WLIST RES 0
         GEN,32    F:4000
         GEN,32    F:4001
         GEN,32    F:4002
         GEN,32    F:4003
         GEN,32    F:4004
         GEN,32    F:4005
         GEN,32    F:4006
         GEN,32    F:4007
         GEN,32    F:4008
         GEN,32    F:4009
         GEN,32    -1                                                   TIC88180
         PAGE                                                           TIC88190
INITACQ900 RES     0                                                    TIC88200
         PAGE
INITLAST RES       0
         M:FVP     INITBUF2            FREE UP THE FOUR PAGES
         M:FVP     INITBUF3             IN THE BOONDOCKS
         M:FVP     INITBUF4              THAT INIT WAS USING
         M:FVP     INITBUF5               FOR VARIOUS BUFFERING.
*
         CAL1,8    =X'15000004'        AND THEN REMOVE THOSE
         BCS,8     -1                   FOUR PAGES FROM OUR LIMIT.
*
*
         DO        DO#DEVELOPMENT
         MTW,0     #TS#TEST
         BEZ       INITLAST233
         FIN
*
         M:GETID                       GET AN ID.
         AI,8      0                   SEE IF IT IS ZERO.
         BNEZ      INITLAST233         OVER IF OK.
*
         M:TYPE    (MESS,INITIDISZEROTEXTC)
*
INITLAST233 RES    0
         MTW,-1    TICINTOPERATORLATER ALLOW OPERATOR COMMANDS.
*
         M:TYPE    (MESS,INITRUNNINGTEXTC)
*
*
*
         DO        DO#DEVELOPMENT
         ELSE
         DO        DO#UTS
         CAL1,7    =X'0E000001'        GIVE BACK FILE BLOCKING BUFFERS.
         BCS,12    -1                  AND ABORT ON ANY PROBLEMS.
         FIN
         FIN
*
*
*
         B         #TIC#BEGIN
*
*
*
INITIDISZEROTEXTC TEXTC 'ID IS ZERO: FIX BEFORE DOING NET ON'
INITRUNNINGTEXTC TEXTC 'TIC IS INITIALIZED'
         PAGE
*
*
*
INITNOPAGES RES    0
         #OUT      'INIT COULD NOT GET PAGE - INCREASE LIMIT'
         M:EXIT
         PAGE
*        ERR/ABN ROUTINE FOR TICI FILE.
*        IT IS BACK HERE SO IT ISN'T FREED
*        EARLY IN INITIALIZATION.
*
INITTICIERR RES    0
INITTICIABN RES    0
         #OUT      'ERROR WRITING THE INTERNAL FILE'
         M:XXX
         PAGE                                                           TIC88220
*                                                                       TIC88230
*                                                                       TIC88240
*                                                                       TIC88250
INITCOUNTING DATA  1                   >0 IF COUNTING GRANULES.
INITGRANULE DATA   0                   CURRENT TICI GRANULE NUMBER.
INITTFDNTH DATA    0                                                    TIC88260
INITTFDTFDFWA DATA 0                                                    TIC88290
INITTFDPRIMFWA DATA 0                  WA OF FIRST WORD OF CURRENT PRIM.
INITTFDNEXTBUF4WA DATA -1              WILL POINT INTO INITBUF4.
*                                                                       TIC88300
INITSTANTH DATA    0                                                    TIC88310
*                                                                       TIC88330
INITDELNTH DATA    0                                                    TIC88340
*                                                                       TIC88370
*
*
#INIT#SECTION#TWO#LWA EQU %-1          DEFINE INIT END FOR FREEING.
         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
         PAGE                                                           TIC88800
*
*
*
LITPOOL  CSECT     1                   PUT LITERALS INTO 01 SPACE.
*
         END       #TIC#INITIALIZE                                      TIC88810

