DO#UTS   SET       0                   ON TO RUN ON UTS.  OFF FOR CP-V.
*
DO#DEV#RECORD#BA#PUT#CHECK SET 0    ON TO CHECK #DEV#RECORD#BA PUTS
DO#CHECKOUT SET    1                   OFF FOR NO CHECKOUT, NO #SNAPS.
*
**************************************************************
#SNAP#ASM#FLAGS SET X'80000000'     SELECT #SNAPS TO ASSEMBLE
DO#OWNCODEHELP SET 0                   OFF FOR NO SPECIAL OWN CODE AIDS.
*
DO#3270  EQU       1                   ON TO HANDLE IBM3270 STATIONS.
*
*
*
DO#FIXEDMDLBUFFERS SET 1               ON FOR UN-DYNAMIC MDL BUFFERS.
*                                                                       TIC00060
DO#GATEOBTAININTERNAL SET 1            ON ALLOWS ONLY ONE TASK INTO THE
*                                      OBTAININTERNALFILERECORD ROUTINE
*                                      AT A TIME.
*
DO#STAIPROMPTS SET 1                   ON TO PROCESS PN'STRING'
*                                      LOGON PROMPTS SUPPLIED IN
*                                      STATION NAMES RECORD.
*
DO#ARESNAPS SET    DO#CHECKOUT         FOR SNAP-DEPENDENT CODE - DON'T
*                                       ASSEMBLE SET-UP CODE FOR #SNAP
*                                        IF #SNAP IS ITSELF NO-OPED.
*
DO#XMISSIONUPARROWS SET 1              ON IF UP-ARROW IS A MESSAGE ESC.
*
DO#HOLDSTAIDURINGLOGON SET 0           ON TO KEEP STATION'S STAI
*                                       RECORD IN CORE WHILE
*                                        CLERK ANSWERS PROMPT.
*
DO#CORETFDS SET    0                   ON TO KEEP CHAIN OF IN-CORE
*                                       TFDS SO THAT MORE THAN ONE
*                                        CLERK MAY BE USING THE SAME
*                                         CORE COPY OF A TFD.
*
*
*                                                                       TIC00080
TICABORTCOUNT      EQU 9999            NUMBER OF #ABORT'S TO ALLOW.     TIC00090
BYTESPERRANDOMBLOCK EQU 1000        MAX BYTES IN INTERNAL GRANULES
XACTIONTEXTINCREMENT EQU 76            NUMBER OF CHARS IN TSI FQM PIECESTIC00100
*
*
BYTESINSMALLBXR EQU 400                SMALL ENUF BXR TO REMOVE
*                                       IT FROM 2036 BYTE BUFFER
*                                        INTO ITS OWN FOR PROCESSING.
*
*
*
HOWMANYXMITSBREAK  EQU 1               ESTABLISHES HOW MANY TIMES
*                                       IN A ROW WE MUST GET AN
*                                        UNEXPECTED TRANSMISSION
*                                         FROM A MULTI-POINT STATION
*                                          IN ORDER TO CONSIDER IT
*                                           AS AN ATTENTION.
         PAGE
*        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
##TPUT   CNAME    0
#T#PUT   CNAME    1
         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
         DO       AG(2)=4
         DO SCOR(#DEV#RECORD#BA,AF)&NAME&DO#DEV#RECORD#BA#PUT#CHECK
         XW,CF(2) *AG(1),RX
         BEZ      %+2
         BAL,0    LOST#BUF
         LW,CF(2) *AG(1),RX
         ELSE
         STW,CF(2) *AG(1),RX                                            TIC02430
         FIN
         FIN
         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
*
*
*
*        SAME AS #ENTRY#SPACE BUT CLEARS TOO.
*
#ENTRY#SPACE#CLEAR CNAME
         PROC
         DO        NUM(AF)=1
         LI,#ARG   AF(1)
         ELSE
         LI,#ARG   JSECT
         FIN
         BAL,#BAL  #GET#MAIN#WORDS#SPECIAL#CODE#CLEAR
         PEND
         PAGE
*                                                                       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
         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
*
FIELD6789LOADAAAASKIP CNAME
         PROC
LF       BAL,#BAL  FIELD6789LOADAAAACODE
         PEND
*                                                                       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.
*
*
*
*        SAME AS ABOVE EXCEPT POINTS TO OUT-OF-LINE LIST.
*
#EXU#TABLE#ON#TYPE#INDEX CNAME
         PROC
         #T#GET,#BAL #DEV#TYPE#INDEX
         DO        DO#CHECKOUT
         CI,#BAL   #DEV#TYPE#INDEX#BIGGEST
         BG        -1
         FIN
         EXU       AF(1),#BAL
         PEND
         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:TYPE   (MESS,K)
         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&((1**CF(2)&#SNAP#ASM#FLAGS)>0)
         #PUSH,0,15                                                     TIC09260
         LI,#ARG   CF(2)+0                                              TIC09270
         BAL,#BAL  #SNAP#CODE                                           TIC09280
         DO       TCOR(AF(1),S:C)
         TEXTC    AF(1)
         ELSE
         DATA     AF(1)
         FIN
         #PULL,0,15                                                     TIC09300
         FIN                                                            TIC09310
         PEND                                                           TIC09320
         PAGE
#QCHK    CNAME
         PROC
         LOCAL    #RE#Q
#RE#Q    EQU      %-1
LF       BCR,12   AF(1)             B/GOOD STATUS
         BCS,4    AF(2)             B/WAIT
         SLS,10   -17               RJ/ERROR CODE
         CI,10    X'BC'**7+X'14'    C/CODE W/NO-ENTRY-YET
         BE       AF(2)             B/GET WITHOUT CRITERIA SATISFIED
         #SNAP,29 TCQCC1            'CC1 SET AFTER M:QUEUE CALL'
         CI,10    X'BC'**7+2        C/CODE W/BC-02 CODE
         BE       AF(3)             B/BC-02; INTERRUPTED
         CI,10    X'BC'**7+X'12'    C/CODE W/BC-12
         BNE      %+3               B/NOT BC-12
         CAL1,8   =X'0F000001'      M:WAIT 1
         B        #RE#Q             RE-ISSUE THE M:QUEUE CALL
         PEND
         END

