*DECK TRAP
          IDENT  TRAP,65,TRAP 
**DOCK    TITLE  SPACE,4,10                                             01251844
**DOCK    EJECT  4,10                                                   01251845
          TITLE  TRAP - DEBUG AIDS CARD CRACKER 
          ABS 
          LIST   C,D,G
          SST    CM 
          SPACE  2
***       CONTROL DATA PROPRIETARY PRODUCT
*         COPYRIGHT CONTROL DATA CORP. - 1976, 1977, 1978, 1979, 1980,
*         1981, 1982. 
          SPACE  4
**        TRAP
* 
*         TRAP CRACKS THE TRAP DIRECTIVES AND SETS UP THE CRACKED 
*         DIRECTIVE TABLES THAT ARE USED BY TRAPPER.
*         TRAP SETS THE DEBUGGING AID FLAG BIT IN THE LOADER FLAG 
*         BYTE IN THE LOADER CONTROL WORD IN THE CONTROL POINT AREA 
*         SO THAT LOADER WILL KNOW THAT DEBUGGING IS TO BE DONE.
*         TRAP IS LOADED AS A RESULT OF A CONTROL CARD. 
* 
*         TRAP(I=LFN1,L=LFN2) 
* 
*         BOTH PARAMETERS ARE ORDER INDEPENDENT AND OPTIONAL. 
*         LFN1 - FILE FROM WHICH DIRECTIVES ARE TO READ 
*                (DEFAULT INPUT)
*         LFN2 - FILE ON WHICH DEBUG OUTPUT IS TO BE WRITTEN
*                (DEFAULT TRAPS)
          SPACE  2
          ORG    65 
*CALL TRAPCOM 
          TITLE  DEFINITIONS AND CONSTANTS
ABS       DATA   3LABS             KEYWORDS FOR COMPARING 
BLOCK     DATA   5LBLOCK
CM        DATA   2LCM 
ECS       DATA   3LECS
SCM       DATA   3LSCM
LCM       DATA   3LLCM
FRAME     DATA   5LFRAME
PROG      DATA   4LPROG 
PROGRAM   DATA   7LPROGRAM
TRACK     DATA   5LTRACK
CDT3      VFD    6/0,18/1,18/1,18/377777B 
S         IFSCOPE 
LDLPARM   VFD    26/0,1/1,6/S.CPLT,3/C.CPLT,12/W.CPLDR1,12/0
LDL       VFD    18/3LLDL,2/1,22/0,18/LDLPARM    PP ROUTINE CALLS 
S         ENDIF 
END       VFD    18/3LEND,42/0
 BLKMSK   DATA   40404040404040404040B
 BLKWD    DATA   7L 
READSKP   EQU    20B
          TITLE  RESERVED AREAS                                         000100
          SPACE  2                                                      000110
BLANKS    DATA   10R               AREA FOR CURRENT CARD READ           000120
CARD      BSSZ   9                                                      000130
LCARD     BSSZ   10 
          SPACE  2                                                      000150
CDT       BSSZ   20                CRACKED DIRECTIVES TABLE             000160
WHNLST    EQU    CDT+5                                                  000170
          SPACE  2                                                      000180
HEADER    DIS    1,1               OUTPUT HEADER LINE                   000190
          DIS    6,TRAP DIRECTIVES                                      000200
          DIS    2,DEBUG AIDS                                           000210
DAT       DIS    1, 
TIME      DIS    1,                                                     000230
          DIS    1,      PAGE                                           000240
PAGENO    BSSZ   2                                                      000250
SPACE     DATA   1L                FOR SKIPPING OUTPUT LINE             000260
ATFLAG    BSSZ   1
          TITLE  TEMPORARY CELLS                                        000270
          SPACE  2                                                      000280
COLUMN    BSSZ   1                 POSITION OF NEXT CHAR TO BE EXAMINED 000290
DEFAULT   BSSZ   1                 CURRENT DEFAULT PROGRAM NAME         000300
DIRCNT    BSSZ   1                 COUNT OF DIRECTIVES
ERROR     BSSZ   1                 COUNT OF ERRORS
EOD       BSSZ   1                 END OF DIRECTIVE INDICATOR           000310
EODF      BSSZ   1                 END OF DIRECTIVE FILE INDICATOR      000320
LINECNT   BSSZ   1                 CURRENT NO. LINES LEFT ON PAGE       000330
PAGECNT   BSSZ   1                 CURRENT PAGE NO. (IN OCTAL)          000340
TEMP      BSSZ   1                                                      000350
TERM      BSSZ   1                 LAST DELIMITER ENCOUNTERED           000360
TYPE      BSSZ   1                 TRACK/FRAME INDICATOR                000370
WHNCNT    BSSZ   1                 COUNT OF WHENS                       000380
WHNBIT    BSSZ   1                 LC, PC BITS FOR WHENS                000390
SLCOMF    BSSZ   1
K         IFNOS 
KNOSLCW   BSSZ   1                 TEMP CELL FOR LOADER CONTROL WORD
K         ENDIF 
          TITLE  JUMP TABLE                                             000400
          SPACE  2                                                      000410
JTAB      VFD    42/4LFROM,18/TRPFRM                                    000420
          VFD    42/3LFOR,18/TRPFOR                                     000430
          VFD    42/2LAT,18/TRPAT                                       000440
          VFD    42/5LSTART,18/TRPSTR                                   000450
          VFD    42/5LEVERY,18/TRPEVY 
          VFD    42/5LUNTIL,18/TRPUTL                                   000470
          VFD    42/3LREG,18/TRPREG                                     000480
          VFD    42/2LTO,18/TRPTO                                       000490
          VFD    42/4LWHEN,18/TRPWHN                                    000500
          TITLE  FILE FETS                                              000510
          SPACE  2                                                      000520
INPUT     VFD    42/5LINPUT,18/1
          VFD    42/3,18/BUFF1
          VFD    60/BUFF1                                               000550
          VFD    60/BUFF1                                               000560
          VFD    60/BUFF1+LBUF                                          000570
          BSSZ   3
          SPACE  2                                                      000580
OUTPUT    VFD    42/5LTRAPS,18/1
          VFD    60/BUFF2                                               000600
          VFD    60/BUFF2                                               000610
          VFD    60/BUFF2                                               000620
          VFD    60/BUFF2+LBUF                                          000630
          SPACE  2                                                      000640
ZZZZZ28   VFD    42/7LZZZZZ28,18/1                                      000650
          VFD    60/BUFF3                                               000660
          VFD    60/BUFF3                                               000670
          VFD    60/BUFF3                                               000680
          VFD    60/BUFF3+LBUF                                          000690
          TITLE  TRAP MACROS
          SPACE  2
          PURGMAC WRITEW
WRITEW    MACRO  A,B,C
          IFC    NE, X2 A ,1
          SX2    A
          IFC    NE, B6 B ,1
          SB6    B
          SB7    C
          RJ   WTW
          ENDM
          SPACE  4
RDCRD     MACRO 
          RJ   GETCRD 
          ENDM
  
ERM       MACRO  B,F
          IFC    NE,/F//,1
          RJ   PRAROW 
          SB6    B
          EQ   ERROUT 
          ENDM
          SPACE  4
          TITLE  INITIALIZATION                                         000700
          SPACE  2                                                      000710
**        THE TRAP CONTROL CARD PARAMETERS ARE CHECKED AND THE INPUT    000720
*         AND OUTPUT FILE NAMES ARE SET INTO THEIR FETS IF THEY WERE    000730
*         SPECIFIED.  THE TIME AND DATE ARE SET INTO THE HEADER LINE.   000740
*         THE LINE COUNT IS INITIALIZED SO THAT A NEW PAGE WILL BE
*         STARTED.  THE NAME OF THE OUTPUT FILE IS WRITTEN TO THE CDT 
*         FILE (ZZZZZ28).  DEFAULT VALUES ARE SET IN THE CDT IN CASE
*         OF AN EMPTY INPUT FILE.  THE FIRST INPUT CARD IS READ.
          SPACE  2
TRAP      SB1    1
          SA3    64B
          SX3    X3 
          ZR   X3,TRP1             JUMP IF NO PARAMS
          SA1    B1+B1             FETCH FIRST PARAMETER
          SA2    A1+B1             GET PARAM VALUE
          RJ   GETPAR              AND PROCESS IT 
          SX4    A6                SAVE RETURNED FET ADDR 
          SA1    A2+B1             FETCH NEXT PARAM 
          ZR   X1,TRP1             JUMP IF NO MORE PARAMS 
          SA2    A1+B1
          RJ   GETPAR              PROCESS NEXT PARAM 
          SX3    A6 
          IX3    X3-X4
          ZR   X3,ERR2             ERROR IF SAME PARAM
          SA1    A2+B1
          NZ   X1,ERR2             ERROR IF TOO MANY PARAMS 
TRP1      CLOCK  TIME              SET CURRENT TIME IN HEADER 
          DATE   DAT               SET CURRENT DATE IN HEADER 
          SX6    -B1
          SX7    B0 
          BX1    X7 
          SA6    LINECNT           INITIALIZE LINE AND PAGE COUNTS
          SA7    PAGECNT
          RJ   CDD                 CONVERT TO DISPLAY CODE
          SA6    PAGENO            SET IN HEADER
          SA1    OUTPUT 
          MX0    42 
          BX6    X0*X1
          SA6    TEMP              PUT OUTPUT FILE NAME ON CDT FILE 
          WRITEW ZZZZZ28,TEMP,B1
          RDCRD                    READ FIRST CARD
          ZR     X1,TRPCRK   IF EOR NOT FOUND 
          SX7    B1 
          SX2    MSG11
          SA7    EODF 
          EQ     ERRDF
          TITLE  DIRECTIVE CRACKER
          SPACE  2
**        FOR EACH NEW DIRECTIVE READ, CERTAIN CELLS ARE ZEROED.  THE 
*         FIRST CHARACTER IS CHECKED TO SEE IF THE DIRECTIVE IS A PAGE
*         EJECT OF A COMMENT CARD.  IF NEITHER OF THE ABOVE, IT IS
*         CHECKED FOR A LABEL.  IF A LABEL EXISTS, IT IS PROCESSED AND
*         THE VERB FIELD IS CHECKED.  THE TYPE FLAG IS SET DEPENDING
*         WHETHER IT IS A TRACK OR FRAME DIRECTIVE.  THE CORRECT
*         DEFAULTS ARE SET IN THE CDT.  THE NEXT KEYWORD IS PICKED
*         UP AND A JUMP IS MADE TO THE SECTION OF CODE WHICH HANDLES
*         IT.  A JUMP IS MADE TO THE END OF DIRECTIVE PROCESSING WHEN 
*         END OF DIRECTIVE IS ENCOUNTERED.
          SPACE  2
TRPCRK    SX6    B0 
          PX7    X6,B0
          SA6    WHNCNT      ZERO WHEN COUNT
          SA7    EOD         ZERO EOD CELL
          SA6    DEFAULT     ZERO DEFAULT 
          SA1    BLKWD
          SA6    ATFLAG 
          BX7    X1 
          SA6    WHNBIT      ZERO WHEN BITS 
          SA7    CDT         BLANK FIRST WORD OF CDT
          SB7    16 
          SA6    A7+1        ZERO SECOND WORD OF CDT
          SA0    CDT+3
 TRPCRK1  SA6    A0+B7
          SB7    B7-B1             ZERO LAST 16 WORDS OF CDT
          PL   B7,TRPCRK1 
          SA1    CARD 
          MX0    6
          BX3    X0*X1
          LX3    6
          SX4    X3-1R
          ZR   X4,TRPVRB           JUMP IF NO LABEL 
          SX4    X3-1R/ 
          ZR   X4,TRPSLH           JUMP IF PAGE EJECT 
          SX4    X3-1R* 
          ZR   X4,TRPCOM           JUMP IF COMMENT CARD 
          RJ   SCNCRD              GET FIRST FIELD
          NZ   X2,ERR3             ERROR IF BLANK CARD
          EQ   TRPLAB              GO PROCESS LABEL 
          SPACE  1
TRPVRB    WRITEC OUTPUT,SPACE 
          SA1    LINELIM
          SX6    X1-1              SKIP LINE BETWEEN DIRECTIVES 
          SA6    A1 
          RJ   PRINT               PRINT CARD 
          RJ   SCNCRD              FETCH VERB FIELD 
          NZ   X2,ERR3             ERROR IF NOT THERE 
          SA3    TRACK
          IX4    X3-X6
          ZR   X4,TRPVRB2          JUMP IF TRACK DIRECTIVE
          SA3    FRAME
          IX3    X3-X6
          SX7    B1                SET TYPE FLAG FOR FRAME
          NZ   X3,ERR4             ERROR IF VERB NOT TRACK OR FRAME 
          SA2    CDT3        SET FRAME DEFAULT VALUES IN CDT
          MX6    17          USE FL OR 377777B AS DEFAULT FOR FOR 
          LX6    17 
          SA6    CDT+1
          BX6    X2 
          SA6    A6+B1
          EQ   TRPVRB3
          SPACE  1
TRPVRB2   SA1    CDT3 
          MX7    0                 SET TYPE FLAG FOR TRACK
          BX6    X1                SET TRACK DEFAULT VALUES IN CDT
          SA6    CDT+2
TRPVRB3   RJ   CKTERM 
          NZ   X3,ERR5             ERROR IF ILLEGAL DELIMITER 
          SA1    CDT
          SA7    TYPE              SAVE TYPE
          IX7    X1+X7             SET TYPE BIT IN CDT
          SA7    A1 
TRPPAR    RJ   SCNCRD              GET NEXT FIELD 
          NZ   X2,TRPEOD           JUMP IF END OF DIRECTIVE 
          SB7    8
TRPPAR1   SA1    JTAB+B7
          BX4    X1-X6
          AX4    18                SEARCH KEYWORD TABLE FOR MATCH 
          ZR   X4,TRPPAR2 
          SB7    B7-B1
          PL   B7,TRPPAR1 
          EQ   ERR6                ERROR IF ILLEGAL KEYWORD 
          SPACE  1
TRPPAR2   SA3    TERM              MATCH FOUND
          SX4    X3-1R
          ZR   X4,TRPPAR3 
          SX4    X3-1R, 
          NZ   X4,ERR5             ERROR IF ILLEGAL DELIMITER 
TRPPAR3   SB5    X1 
          JP   B5                  JUMP TO KEYWORD PROCESSING SECTION 
          EJECT 
**        IF A SLASH (/) IS IN COLUMN 1 OF A DIRECTIVE, THE LINE COUNT
*         IS SET TO NEGATIVE SO A NEW PAGE WILL BE STARTED WITH THE 
*         NEXT LINE THAT IS PRINTED.  THE NEXT INPUT CARD IS READ.
          SPACE  1
TRPSLH    SA1    LINECNT
          SX6    X1-LINELIM        SET LINE COUNT TO NEGATIVE 
          SA6    A1 
          RDCRD                    READ NEXT CARD 
          SX6    B1 
          SA6    SLCOMF            SET FLAG TO INDICATE NO CDT BUILT
          NZ   X1,TRPEOD           JUMP IF EOR ENCOUNTERED
          SX6    B0 
          SA6    SLCOMF            CLEAR NO CDT FLAG
          EQ   TRPCRK              GO PROCESS NEW DIRECTIVE 
          SPACE  4
**        IF A COMMENT CARD IS ENCOUNTERED (* IN COLUMN 1), IT IS 
*         PRINTED AND THE NEXT CARD IS READ.  IF IT IS ANOTHER COMMENT
*         CARD OR A CONTINUATION CARD (, IN COLUMN 1) THIS PROCESS IS 
*         REPEATED.  OTHERWISE, IT IS PROCESSED AS A NEW DIRECTIVE. 
          SPACE  1
TRPCOM    WRITEC  OUTPUT,SPACE     PRINT BLANK LINE 
TRPCOM1   RJ   PRINT               PRINT COMMENT
          RDCRD                    READ NEXT CARD 
          SX6    B1 
          SA6    SLCOMF            SET FLAG TO INDICATE NO CDT BUILT
          NZ     X1,TRPEOD3  IF EOR 
          SX6    B0 
          SA6    SLCOMF            CLEAR NO CDT FLAG
          SA1    CARD 
          BX3    X0*X1
          LX3    6
          SX4    X3-1R* 
          ZR   X4,TRPCOM           REPEAT PROCESS IF COMMENT CARD 
          SX4    X3-1R, 
          ZR   X4,TRPCOM1          REPEAT PROCESS IF CONTINUATION CARD
          EQ   TRPCRK              ELSE, GO PROCESS NEW DIRECTIVE 
          SPACE  4
**        IF THE DIRECTIVE HAS A LABEL, IT IS PLACED IN THE CDT AND 
*         THEN A JUMP IS MADE TO THE VERB PROCESSING SECTION. 
          SPACE  1
TRPLAB    RJ   CKTERM 
          NZ   X3,ERR5             ERROR IF ILLEGAL DELIMITER 
          SX4    1
          SA2    BLKMSK 
          IX4    X6-X4       FIND LOWEST BIT SET
          BX3    -X4+X6 
          SB4    60-5 
          BX4    X2*X3       BUILD MASK OF NON-ZERO CHARACTERS
          SA2    BLKWD
          LX3    X4,B4
          IX3    X4-X3
          IX4    X4+X3
          BX2    -X4*X2 
          IX6    X6+X2
          SA6    CDT               STORE LABEL IN CDT 
          EQ   TRPVRB              GO PROCESS VERB
          EJECT 
**        FOR THE START, EVERY AND UNTIL KEYWORDS, THE NUMBER IS PICKED 
*         UP, CONVERTED TO ITS OCTAL VALUE AND PLACED INTO THE
*         PROPER FIELD OF THE CDT.
          SPACE  1
TRPSTR    RJ   GETNUM              PICK UP OCTAL VALUE OF START NUMBER
          MX5    18 
          SA1    CDT+2
          LX5    54 
          BX1    -X5*X1            CLEAR START FIELD
          LX6    36                SHIFT VALUE TO PROPER POSITION 
          BX6    X1+X6             ADD IN START VALUE 
          SA6    A1                REPLACE IN CDT 
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          SPACE  4
TRPEVY    RJ   GETNUM              PICK UP OCTAL VALUE OF EVERY NUMBER
          MX5    18 
          SA1    CDT+2
          LX5    36 
          BX1    -X5*X1            CLEAR EVERY FIELD
          LX6    18                SHIFT VALUE TO PROPER POSITION 
          BX6    X1+X6             ADD IN EVERY VALUE 
          SA6    A1                REPLACE IN CDT 
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          SPACE  4
TRPUTL    RJ   GETNUM              PICK UP OCTAL VALUE OF UNTIL NUMBER
          MX5    18 
          SA1    CDT+2
          LX5    18 
          BX1    -X5*X1            CLEAR UNTIL FIELD
          BX6    X1+X6             ADD IN UNTIL VALUE 
          SA6    A1                REPLACE IN CDT 
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          EJECT 
**        WHEN A REG, FOR OR AT KEYWORD IS ENCOUNTERED, A CHECK IS
*         MADE TO INSURE IT IS A FRAME DIRECTIVE.  IF A REG IS
*         ENCOUNTERED, THE REG BIT  IS SET IN THE CDT.  IF A FOR IS 
*         ENCOUNTERED, THE OCTAL VALUE OF THE NUMBER IS PICKED UP AND 
*         STORED IN THE CDT.  IF AT IS ENCOUNTERED, THE BLOCK OR
*         PROGRAM NAME (IF ANY) IS PICKED UP AS WELL AS THE OCTAL VALUE 
*         OF THE ADDRESS AND THESE PARAMETERS ARE PLACED INTO THE 
*         CDT AT THE APPROPRIATE LOCATIONS. 
          SPACE  1
TRPREG    SA1    TYPE 
          ZR   X1,TRPPAR           MEANINGLESS ON TRACK DIRECTIVE 
          MX6    1
          SA1    CDT+2
          BX1    -X6*X1 
          BX6    X1+X6             SET REG BIT
          SA6    A1                REPLACE IN CDT 
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          SPACE  4
TRPFOR    SA1    TYPE 
          ZR   X1,ERR6             ERROR IF FOR ON TRACK DIRECTIVE
          RJ   GETNUM              GET OCTAL VALUE OF FOR NUMBER
          MX5    18 
          SA1    CDT+1
          LX5    18 
          BX1    -X5*X1            CLEAR FOR FIELD
          BX6    X6+X1             ADD IN FOR VALUE 
          SA6    A1                REPLACE IN CDT 
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          SPACE  4
TRPAT     SA1    TYPE 
          ZR   X1,ERR6             ERROR IF AT ON TRACK DIRECTIVE 
          RJ   GETADR              GET PROG (BLOCK) NAME AND ADDR 
          MX5    18 
          SA2    CDT+1
          LX6    39                SHIFT AT ADDR TO PROPER LOCATION 
          LX5    57 
          BX2    -X5*X2            CLEAR AT ADDR FIELD
          BX6    X6+X2             ADD IN AT ADDR 
          SA6    A2                REPLACE IN CDT 
          BX6    X1 
          SA6    CDT+3             STORE PROG (BLOCK) NAME
          SX6    B1 
          SA6    ATFLAG            SET AT SPECIFIED FLAG
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          EJECT 
**        WHEN A TO KEYWORD IN ENCOUNTERED, THE TYPE IS CHECKED TO
*         INSURE ITS ON A TRACK DIRECTIVE.  THE PROGRAM (BLOCK) NAME
*         AND ADDRESS ARE OBTAINED AND PLACED IN THE CDT. 
          SPACE  1
TRPTO     SA1    TYPE 
          NZ   X1,ERR6             ERROR IF TO ON FRAME DIRECTIVE 
          RJ   GETADR              GET PROG (BLOCK) NAME AND ADDR 
          MX4    2
          SX7    X1                SAVE LCT, PCT BITS 
          MX5    18 
          LX7    2
          SA2    CDT+1
          LX5   18
          BX1    -X5*X1            CLEAR ADDR FIELD FROM PROG NAME
          LX4    4
          BX2    -X4*X2            CLEAR LCT, PCT BITS
          BX6    X6+X1             ADD ADDR FIELD 
          BX7    X7+X2             ADD LCT, PCT BITS
          SA6    CDT+4
          SA7    A2                STORE IN CDT 
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          SPACE  4
**        WHEN A FROM KEYWORD IS ENCOUNTERED, THE PROGRAM (BLOCK) 
*         NAME AND ADDRESS ARE OBTAINED AND PLACED IN THE CDT,
*         ACCORDING TO WHETHER IT WAS A TRACK OR FRAME DIRECTIVE. 
          SPACE  1
TRPFRM    RJ   GETADR              GET PROG (BLOCK) NAME AND ADDR 
          SA2    TYPE 
          ZR   X2,TRPFRM1          JUMP IF TRACK
          SA2    CDT+1
          MX5    21 
          LX6    18 
          LX5    39 
          BX2    -X5*X2            CLEAR FROM ADDR FIELD
          BX6    X6+X2            ADD IN FROM ADDR
          SA6    A2 
          BX6    X1                STORE IN CDT 
          SA6    CDT+4
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          SPACE  1
TRPFRM1   SX7    X1                SAVE LCF, PCF BITS 
          MX5    18 
          SX4    3
          SA2    CDT+1
          LX5    18 
          BX2    -X4*X2            CLEAR LCF, PCF BITS
          BX7    X7+X2             ADD IN LCF, PCF BITS 
          BX1    -X5*X1            CLEAR ADDR FIELD 
          SA7    A2 
          BX6    X6+X1             ADD IN ADDR FIELD
          SA6    CDT+3             SAVE IN CDT
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          EJECT 
**        WHEN A WHEN KEYWORD IN ENCOUNTERED, A CHECK IS MADE TO INSURE 
*         IT IS ON A TRACK DIRECTIVE AND NO MORE THAN 14 WHENS HAVE 
*         ALREADY BEEN PROCESSED.  THE PROGRAM (BLOCK) NAME AND ADDRESS 
*         ARE OBTAINED AND PLACED IN THE CDT.  THE LC AND PC BITS ARE 
*         SAVED IN A SPECIAL WORD.
          SPACE  1
TRPWHN    SA1    TYPE 
          NZ   X1,ERR6             ERROR IF WHEN ON FRAME DIRECTIVE 
          SA2    WHNCNT 
          SX2    X2-15
          ZR   X2,ERR9             ERROR IF TOO MANY WHENS
          RJ   GETADR              GET PROG (BLOCK) NAME AND ADDR 
          SX7    X1                SAVE LC, PC BITS 
          MX5    18 
          SA2    WHNBIT 
          LX5    18 
          BX1    -X5*X1            CLEAR ADDR FIELD 
          LX2    58 
          BX6    X6+X1             ADD IN ADDR
          LX7    58 
          BX7    X7+X2             SAVE LC, PC BITS 
          SA3    WHNCNT 
          SA6    WHNLST+X3         STORE IN CDT 
          SA7    A2 
          SX6    X3+B1             INCREMENT WHEN COUNT 
          SA6    A3 
          EQ   TRPPAR              GO PROCESS NEXT PARAMETER
          EJECT 
**        WHEN THE END OF DIRECTIVE IS ENCOUNTERED, THE CDT IS WRITTEN
*         ON THE ZZZZZ28 FILE.  IF IT WAS A TRACK DIRECTIVE, THE WHEN 
*         COUNT AND WHEN LC, PC BITS ARE PUT INTO THE CDT.  IF IT WAS 
*         A FRAME DIRECTIVE, A CHECK IS MADE TO INSURE THE PRESENCE OF
*         THE AT KEYWORD.  IF AN EOR HAS BEEN ENCOUNTERED, THE PAGE 
*         COUNT IS ADDED TO THE ZZZZZ28 FILE AND THE OUTPUT FILE AND
*         ZZZZZ28 ARE WRITTEN TO DISK.  A REQUEST TO LDL IS MADE TO 
*         SET A BIT IN THE CONTROL POINT AREA.  IF AN EOR HAS NOT BEEN
*         ENCOUNTERED, THE NEXT DIRECTIVE IS PROCESSED. 
          SPACE  1
TRPEOD    BX6    X1 
          SA6    EODF              SAVE EOR INDICATOR 
          SA1    CDT+2                                                  0193   7
          SX2    X1                UNTIL                                0193   8
          AX1    36                                                     0193   9
          SX3    X1                START                                0193  10
          IX3    X2-X3             UNTIL - START                        0193  11
          MI   X3,ERR10            ERROR IF(START .GT. UNTIL)           0193  12
          SA1    TYPE 
          NZ   X1,TRPEOD1          JUMP IF FRAME DIRECTIVE
          SA1    WHNCNT 
          SA2    WHNBIT 
          SB7    X1 
          LX1    54                SHIFT WHEN COUNT TO PROPER POSITION
TRPEODA   ZR   B7,TRPEODB 
          LX2    2
          SB7    B7-B1             SHIFT WHEN LC, PC BITS TO CORRECT
          EQ   TRPEODA             POSITION 
          SPACE  1
TRPEODB   LX2    4
          SA3    CDT+B1 
          BX6    X3+X2             ADD IN WHEN BITS 
          BX6    X1+X6             ADD IN WHEN COUNT
          SA6    A3                STORE IN CDT 
          LX1    6
          SX1    X1+5              LENGTH OF CDT
          EQ   TRPEOD2
          SPACE  1
TRPEOD1   BSS    0
          SA1    ATFLAG 
          ZR   X1,ERR7
          SA4    SLCOMF 
          SX6    B0 
          SA6    A4 
          NZ   X4,TRPNMJ
          SX1    5
TRPEOD2   WRITEW ZZZZZ28,CDT,X1    WRITE ON ZZZZZ28 FILE
TRPNMJ    BSS    0
          SA1    EODF 
          SA2    DIRCNT 
          SX6    X2+B1             INCREMENT DIRECTIVES COUNT 
          SA6    A2 
          ZR   X1,TRPCRK           GO PROCESS NEXT DIRECTIVE
TRPEOD3   SA1    ERROR
          ZR   X1,TRPEOD4          JUMP IF NO ERRORS
          RJ   PRTERR              ISSUE ERROR COUNT MESSAGE
TRPEOD4   WRITEW ZZZZZ28,PAGECNT,B1 WRITE PAGE COUNT ON ZZZZZ28 
          WRITER ZZZZZ28,R         WRITE FILES TO DISK
          WRITER OUTPUT,R 
S         IFSCOPE 
          SA1    LDL               REQUEST FOR LDL
          RJ   CALLPP 
S         ENDIF 
K         IFNOS 
          GETLC  KNOSLCW
          SA1    KNOSLCW           (X1) = CURRENT LOADER CONTROL WORD 
          LX1    59-48+12*C.CPLT-S.CPLT   TRAP BIT TO SIGN POSITION 
          MX7    1
          BX7    X7+X1             SET TRAP BIT 
          LX7    -59+48-12*C.CPLT+S.CPLT  RESTORE FORMAT
          SA7    KNOSLCW           (KNOSLCW) = NEW LOADER CONTROL WORD
          SETLC  KNOSLCW
K         ENDIF 
          SA1    END
          RJ   CALLPP              END TRAP 
          PS
          TITLE  TRAP SUBROUTINES 
**        CALLPP - CALL PP ROUTINE
* 
*         ISSUES A RA+1 REQUEST FOR THE PP ROUTINE WHOSE INPUT REGISTER 
*         IS IN X1. 
*         ENTRY  X1 - FORMATTED PP CALL 
*         USES   A-5,6
*                X-5,6
          SPACE  1
CALLPP    PS
+         SA5    B1 
          NZ   X5,*                WAIT UNTIL RA+1 IS ZERO
          BX6    X1 
          SA6    B1                PUT CALL IN RA+1 
+         SA5    B1 
          NZ   X5,*                WAIT UNTIL REQUEST IS HONORED
          EQ   CALLPP              RETURN 
          SPACE  4
**        CDB - CONVERT FROM DISPLAY CODE DECIMAL TO BINARY 
* 
*         CONVERTS A STRING OF DISPLAY CODE DECIMAL DIGITS INTO THEIR 
*         BINARY VALUE. 
*         ENTRY  X1 - DISPLAY CODE DECIMAL NUMBER, LEFT JUSTIFIED 
*         EXIT   X6 - BINARY VALUE, RIGHT JUSTIFIED 
*         USES   X-1,3,4,5,6
          SPACE  1
CDB       PS
          SX6    B0 
          SX5    77B
CDB1      LX1    6
          BX4    X5*X1             GET DIGIT
          ZR   X4,CDB              RETURN IF CONVERSION COMPLETE
          SX4    X4-33B 
          NG   X4,ERR8             ERROR IF CHAR NOT NUMBER 
          SX3   X4-10 
          PL   X3,ERR8             ERROR IF NOT LT 10 
          BX3    X6 
          LX6    2                 MULTIPLY TALLY BY 10 
          IX6    X6+X3
          LX6    1
          IX6    X6+X4             ADD IN LAST CHAR 
          EQ   CDB1                GO GET NEXT CHAR 
          EJECT 
**        COB - CONVERT FROM DISPLAY CODE OCTAL TO BINARY 
* 
*         CONVERT A STRING OF DISPLAY CODE OCTAL DIGITS INTO THEIR
*         BINARY VALUE. 
*         ENTRY  X1 - DISPLAY CODE OCTAL NUMBER, LEFT JUSTIFIED 
*         EXIT   X6 - BINARY VALUE, RIGHT JUSTIFIED 
*         USES   X-1,3,4,5,6
          SPACE  1
COB       PS
          SX6    B0 
          SX5    77B
COB1      LX1    6
          BX4    X5*X1             GET DIGIT
          ZR   X4,COB              RETURN IF CONVERSION COMPLETE
          SX4    X4-33B 
          NG   X4,ERR8             ERROR IF CHAR NOT NUMBER 
          SX3    X4-8 
          PL   X3,ERR8             ERROR IF NOT LT 8
          LX6    3                 MULTIPLY BY 8
          IX6    X6+X4             ADD IN NEW CHAR
          EQ   COB1                GO GET NEXT CHAR 
          SPACE  4
**        CKTERM - CHECK DELIMITER
* 
*         INSURES THAT THE CHAR IN CELL TERM IS A LEGAL DELIMITER 
*         WHICH INCLUDES , - ( ) AND BLANKS.
*         EXIT   X3 - 0 IF DELIMITER OK 
*                    NZ IF ILLEGAL DELIMITER
*         USES   A-4
*                X-3,4
          SPACE  1
CKTERM    PS
          SA4    TERM              PICK UP TERM 
          SX3    X4-1R, 
          ZR   X3,CKTERM           OK IF ,
          SX3    X4-1R- 
          ZR   X3,CKTERM           OK IF -
          SX3    X4-1R( 
          ZR   X3,CKTERM           OK IF (
          SX3    X4-1R) 
          ZR   X3,CKTERM           OK IF )
          SX3    X4-1R
          ZR   X3,CKTERM           OK IF BLANK
          EQ   CKTERM              ILLEGAL DELIMITER, RETURN
          EJECT 
**        GETADR - GET PROGRAM NAME AND ADDRESS 
* 
*         WHEN A FROM, AT, TO OR WHEN KEYWORD IS ENCOUNTERED, GETADR
*         IS CALLED TO PICK UP THE NEXT FIELD FROM THE DIRECTIVE.  IF 
*         THE NEXT FIELD IS ONE OF THE KEYWORDS, BLOCK, PROGRAM OR ABS, 
*         THE NEXT ONE OR TWO FIELDS ARE ALSO PICKED UP AND ARE THE 
*         PROGRAM (BLOCK) NAME (IF IT EXISTS) AND ADDRESS.  IF THE
*         FIELD WASNT A KEYWORD, IT IS ASSUMED TO BE AN ADDRESS OR
*         A REGISTER AND THAT INFORMATION IS RETURNED.  THE LC AND PC 
*         BITS ARE SET. 
*         EXIT   X1 - VFD 42/PROGRAM NAME, 18/LC AND PC BITS
*                X6 - ADDRESS, RIGHT JUSTIFIED
*         CALLS  SCNCRD, CKNUM
          SPACE  1
GETADR    PS
          SA3    TERM 
          SX4    X3-1R
          NZ   X4,ERR5             ERROR, ILLEGAL DELIMITER 
          RJ   SCNCRD              GET NEXT FIELD 
          NZ   X2,ERR3             ERROR IF END OF DIRECTIVE
          RJ   CKNUM
          ZR   X1,GANUM            JUMP IF NUMERIC FIELD
          SA3    ABS
          SA4    PROG 
          IX3    X3-X6
          IX4    X4-X6
          ZR   X3,GAABS            JUMP IF ABS ENCOUNTERED
          ZR   X4,GAPROG           JUMP IF PROG ENCOUNTERED 
          SA3    PROGRAM
          SA4    BLOCK
          IX3    X3-X6
          IX4    X4-X6
          ZR   X3,GAPROG           JUMP IF PROGRAM ENCOUNTERED
          ZR   X4,GABLK            JUMP IF BLOCK ENCOUNTERED
          BX3    X0*X6
          LX3    6
          SX4    X3-1RA 
          ZR   X4,GAREG            JUMP IF A REGISTER 
          SX4    X3-1RB 
          ZR   X4,GAREG            JUMP IF B REGISTER 
          SX4    X3-1RX 
          ZR   X4,GAREG            JUMP IF X REGISTER 
          SX4    X3-1RP 
          NZ   X4,ERR6             ERROR IF NOT P REGISTER
GAREG     LX6    6
          BX3    X0*X6             GET REG NUMBER 
          ZR   X3,GAREG1
          LX3    6
          SX4    X3-33B 
          NG   X4,ERR6             ERROR IF CHAR NOT NUMBER 
          SX4    X3-43B 
          PL   X4,ERR6             ERROR IF CHAR NOT LT 8 
          LX6    6
          SA1    TERM 
          SX4    X1-1R
          BX3    X0*X6
          NZ   X3,ERR6             ERROR IF TWO DIGITS FOR REGISTER 
          ZR   X4,GAREG1
          SX3    X1-1R, 
          NZ   X3,ERR5             ERROR, ILLEGAL DELIMITER 
GAREG1    MX1    42                SET REGISTER INDICATOR 
          EQ   GETADR              RETURN 
          SPACE  1
GANUM     SA1    TERM 
          SX3    X1-1R
          ZR   X3,GANUM1
          SX3    X1-1R, 
          NZ   X3,ERR5             ERROR, ILLEGAL DELIMITER 
GANUM1    SA1    DEFAULT           PICK UP NAME AND LC, PC BITS 
          EQ   GETADR              RETURN 
          SPACE  1
GAABS     SA1    TERM 
          SX3    X1-1R
          NZ   X3,ERR5             ERROR, ILLEGAL DELIMITER 
          MX7    0
          SA7    DEFAULT           SET PROGRAM NAME TO ZERO 
          RJ   SCNCRD              PICK UP NEXT FIELD 
          NZ   X2,ERR3             ERROR IF END OF DIRECTIVE
          RJ   CKNUM
          ZR   X1,GANUM            JUMP IF NUMBER 
          SA3    CM 
          SA4    ECS
          IX3    X6-X3
          IX4    X6-X4
          ZR   X3,GAABS1           JUMP IF CM 
          SA3    SCM
          IX3    X6-X3
          ZR   X3,GAABS1           JUMP IF SCM
          SA3    LCM
          IX3    X6-X3
          ZR   X3,GALCM            JUMP IF LCM
          NZ   X4,ERR6             ERROR IF NOT CM, ECS OR NUMBER 
GALCM     BSS    0
          SX7    B1 
          LX7    1
          SA1    DEFAULT
          IX7    X1+X7             SET LC BIT TO 1 (ECS)
          SA7    A1 
GAABS1    SA1    TERM 
          SX3    X1-1R
          NZ   X3,ERR5             ERROR, ILLEGAL DELIMITER 
          RJ   SCNCRD              GET NEXT FIELD 
          NZ   X2,ERR3             ERROR IF END OF DIRECTIVE
          RJ   CKNUM
          ZR   X1,GANUM            JUMP IF NUMBER 
          EQ   ERR6                ERROR IF NOT NUMBER
          SPACE  1
GAPROG    SA1    TERM 
          SX3    X1-1R
          NZ   X3,ERR5             ERROR, ILLEGAL DELIMITER 
          MX7    0
          SA7    DEFAULT           SET PC BIT TO ZERO (PROGRAM NAME)
          RJ   SCNCRD              PICK UP NEXT FIELD 
          NZ   X2,ERR3             ERROR IF END OF DIRECTIVE
          RJ   CKNUM
          ZR   X1,ERR6             ERROR IF NUMBER
GAPROG1   SA1    TERM 
          SX3    X1-1R
          NZ   X3,ERR5             ERROR, ILLEGAL DELIMITER 
          SA1    DEFAULT
          BX6    X6+X1
          SA6    A1                SAVE PROGRAM (BLOCK) NAME
          RJ   SCNCRD              PICK UP NEXT FIELD 
          NZ   X2,ERR3             ERROR IF END OF DIRECTIVE
          RJ   CKNUM
          ZR   X1,GANUM            JUMP IF NUMBER 
          EQ   ERR6                ERROR IF NOT NUMBER
          SPACE  1
GABLK     SA1    TERM 
          SX3    X1-1R
          NZ   X3,ERR5             ERROR, ILLEGAL DELIMITER 
          SX7    B1 
          SA7    DEFAULT           SET PC BIT TO 1 (BLOCK NAME) 
          RJ   SCNCRD              PICK UP NEXT FIELD 
          NZ   X2,ERR3             ERROR IF END OF DIRECTIVE
          EQ   GAPROG1
          SPACE  4
**        CKNUM - CHECK IF NUMBER 
* 
*         CHECKS IF VALUE IS LEGAL NUMBER.  IF IT IS, IT IS CONVERTED 
*         TO BINARY AND RETURNED. 
*         ENTRY  X6 - DISPLAY CODE CHAR STRING, LEFT JUSTIFIED
*         EXIT   X1 - NZ IF NOT NUMBER
*                X6 - BINARY VALUE IF NUMBER, RIGHT JUSTIFIED 
*         CALLS  COB
          SPACE  1
CKNUM     PS
          SB7    7
          BX1    X6 
CKNUM1    BX3    X0*X1             ISOLATE CHAR 
          ZR   X3,CKNUM2           JUMP IF DONE 
          LX3   6 
          SX4    X3-33B 
          NG   X4,CKNUM            NOT NUMBER IF LT 0 
          SX4    X3-45B 
          PL   X4,CKNUM            NOT NUMBER IF GT 9 
          LX1    6
          SB7    B7-B1
          PL   B7,CKNUM1           ALLOW ONLY 7 CHARS 
CKNUM2    BX1    X6 
          RJ   COB                 CONVERT NUMBER TO BINARY 
          MX1    0                 SET RETURN TO INDICATE NUMBER
          EQ   CKNUM
          EJECT 
**        GETNUM - GET NUMBER 
* 
*         FETCHES DISPLAY CODE DECIMAL NUMBER FROM DIRECTIVE AND
*         CONVERTS IT TO BINARY.
*         EXIT   X6 - BINARY VALUE, RIGHT JUSTIFIED 
*         CALLS  SCNCRD, CDB
          SPACE  1
GETNUM    PS
          SA3    TERM 
          SX4    X3-1R
          NZ   X4,ERR5             ERROR IF ILLEGAL DELIMITER 
          RJ   SCNCRD              GET NUMBER 
          NZ   X2,ERR3             ERROR IF END OF DIRECTIVE
          SA3    TERM 
          SX4    X3-1R, 
          ZR   X4,GETNUM1 
          SX4    X3-1R
          NZ   X4,ERR5             ERROR IF ILLEGAL DELIMITER 
GETNUM1   BX1    X6 
          RJ   CDB                 CONVERT NUMBER TO BINARY VALUE 
          EQ   GETNUM              AND RETURN 
          SPACE  4
**        GETPAR - GET PARAMETER
* 
*         INSURES ANY TRAP CONTROL CARD PARAMETERS ARE VALID AND PUTS 
*         THE FILE NAMES INTO THE PROPER FETS.
*         ENTRY  X1 - KEYWORD PARAMETER 
*                X2 - FILE NAME 
*         EXIT   A6 - ADDR OF FILES FET 
*         USES   A-6
*                X-1,2,3,5,6
          SPACE  1
GETPAR    PS
          ZR   X2,ERR2             ERROR IF NO FILE NAME
          MX0    42 
          SX5    B1 
S         IFSCOPE 
          SX3    X1-02B 
          NZ   X3,ERR2             ERROR IF = DOESNT FOLLOW KEYWORD 
          SX3    X2-01B 
          ZR   X3,GETPAR1 
          SX3    X2-17B            ERROR IF , OR TERMINATOR DOESNT
          NZ   X3,ERR2             FOLLOW FILE NAME 
S         ENDIF 
K         IFNOS 
          SX3    X1-02B            CHECK SCOPE CODE FOR = 
          ZR   X3,GETPARA          IF SCOPE CODE FOR =
          SX3    X1-1R=            CHECK KRONOS/NOS CODE FOR =
          NZ   X3,ERR2             IF = DOESNT FOLLOW KEYWORD 
GETPARA   SX3    X2-01B            CHECK SCOPE CODE FOR , 
          ZR   X3,GETPAR1          IF SCOPE CODE FOR ,
          SX3    X2-17B            CHECK SCOPE CODE FOR ).
          ZR   X3,GETPAR1          IF SCOPE CODE FOR ). 
          SX3    X2-00B            CHECK KRONOS/NOS CODE FOR ,).
          NZ   X3,ERR2             IF ,). DOESNT FOLLOW FILENAME
K         ENDIF 
GETPAR1   BX1    X1*X0
          LX1    6
          SX3    X1-1RI 
          ZR   X3,GETPAR2          JUMP IF I
          SX3    X1-1RL 
          NG   X3,ERR2             ERROR IF KEYWORD NOT I OR L
          BX2    X2*X0             ISOLATE FILE NAME
          IX6    X2+X5            ADD COMPLETE BIT
          SA6    OUTPUT            STORE OUTPUT FILE NAME 
          EQ   GETPAR              RETURN 
GETPAR2   BX2   X2*X0             ISOLATE FILE NAME 
          IX6    X2+X5             ADD IN COMPLETE BIT
          SA6    INPUT             STORE INPUT FILE NAME
 OPENNR   EQU    120B 
          BX3    X6 
          CIOCALL   INPUT,RCL,OPENNR
          BX6    X3 
          SA6    INPUT
          EQ   GETPAR              RETURN 
          EJECT 
**        PRINT - PRINT OUTPUT LINE 
* 
*         PRINTS CARD WHICH IS IN THE CARD SAVE AREA WITH A PRECEEDING
*         WORD OF BLANKS.  WHEN LINECNT IS NEGATIVE, A NEW PAGE IS
*         STARTED WITH THE HEADER LINE FOLLOWED BY A BLANK LINE.  EACH
*         TIME A LINE IS WRITTEN TO THE OUTPUT FILE, LINECNT IS 
*         DECREASED BY 1. 
*         CALLS  CDD, WRITE ROUTINE 
          SPACE  1
PRINT     PS
          SA2    LINECNT
          PL   X2,PRT1             JUMP IF MORE ROOM ON PAGE
          SX6    LINELIM-1
          SA1    PAGECNT
          SA6    A2                RESET LINE SOUNT 
          SX1    X1+B1
          BX6    X1                INCREMENT PAGE COUNT 
          SA6    PAGECNT
          RJ   CDD                 CONVERT TO DISPLAY CODE DECIMAL
          SA6    PAGENO            PUT PAGE NO. IN HEADER 
          WRITEC OUTPUT,HEADER     WRITE HEADER LINE
          SA1    LINECNT
          SX6    X1-2 
          SA6    A1 
          WRITEC OUTPUT,SPACE      LEAVE BLANK LINE 
          SA2    LINECNT
PRT1      SX6    X2-1 
          SA6    A2                DECREASE ?INE COUNT
          WRITEC OUTPUT,BLANKS     WRITE CARD TO OUTPUT 
          EQ   PRINT               RETURN 
          SPACE  4
**        PRTERR - ISSUE DAYFILE ERROR COUNT MESSAGE
* 
*         CONVERTS COUNT OF ERRORS TO DISPLAY DECIMAL, PUTS 
*         NUMBER IN ERROR COUNT MESSAGE AND ISSUES DAYFILE MESSAGE. 
*         CALLS  CDD, MESSAGE 
          SPACE  1
PRTERR    PS
          SA1    ERROR
          RJ   CDD                 CONVERT TO DISPLAY CODE
          SA6    ERRCNT 
          MESSAGE ERRCNT,R         ISSUE ERROR COUNT MESSAGE
          EQ   PRTERR              RETURN 
          EJECT 
**        SCNCRD - SCAN DEIRECTIVE
* 
*         IF END OF DIRECTIVE HAS ALREADY BEEN ENCOUNTERED, AN
*         IMMEDIATE RETURN IS MADE.  THE NEXT FIELD ON THE DIRECTIVE
*         IS PICKED UP A CHARACTER AT A TIME, SKIPPING BLANKS.
*         THE TRAILING DELIMITER IS SAVED FOR LATER CHECKING.  THE
*         COLUMN POINTERS ARE SAVED FOR THE NEXT SCAN.  IF END OF CARD
*         IS REACHED, THE NEXT CARD IS READ AND THE SCAN CONTINUES IF 
*         IT IS A CONTINUATION CARD,  IF END OF DIRECTIVE IS REACHED, 
*         THE PROPER RETURN INFORMATION IS RETURNED.
*         EXIT   X1 - NZ IF EOR ENCOUNTERED 
*                X2 - NZ IF END OF DIRECTIVE ENCOUNTERED
*                X6 - FIELD SCANNED 
*         CALLS  GETNC, SCNEOC, CKTERM
          SPACE  1
SCNCRD    PS
          SA2    EOD
          UX2    X2,B3
          SX1    B3 
          ZR   X2,SCN1             JUMP IF NOT AT END OF DIRECTIVE
          MX7    0
          PX7    X7,B0
          SA7    A2                RESET EOD
          EQ   SCNCRD              RETURN 
          SPACE  1
SCN1      SA1    COLUMN 
          UX1    X1,B7             GET WORD POINTER 
          SB6    X1                AND COLUMN POINTER 
          SB2    10 
          SB3    B6 
          MX6    0
          SA1    CARD+B7
SCN1A     ZR   B3,SCN2
          LX1    6                 SHIFT WORD TO CHAR TO BE CHECKED 
          SB3    B3-B1
          EQ   SCN1A
          SPACE  1
SCN2      RJ   GETNC               GET NEXT CHARACTER 
          NZ  X4,SCN2A
          RJ   SCNEOC              CHECK IF END OF CARD 
SCN2A     SX3    X4-1R
          ZR   X3,SCN2             SKIP LEADING BLANKS
SCN2B     BX7    X4 
          SA7    TERM 
          RJ   CKTERM 
          NZ   X3,SCN3
          ZR   X6,SCN4
          EQ   SCNTRM 
SCN3      BSS    0
          IX6    X6+X4             ADD CHAR TO RETURN FIELD 
          LX6    6
SCN4      BSS    0
          RJ   GETNC               GET NEXT CHAR
          NZ   X4,SCN2B 
          RJ   SCNEOC              CHECK IF END OF CARD 
          EQ   SCN2B               GO PROCESS CHAR
          SPACE  1
SCNTRM    BX5    X0*X6
          NZ   X5,SCNTRM1 
          LX6    6
          EQ   SCNTRM 
          SPACE  1
SCNTRM1   BX7    X4 
          SA7    TERM              SAVE DELIMITER 
          MX1    0
          SX2    B0                SET RETURN INDICATORS
          SX7    B6 
          PX7    X7,B7
          SA7    COLUMN            SAVE POINTERS
          ZR   X6,SCNCRD+1         TRY FOR ANOTHER PARAM IF NULL
          EQ   SCNCRD              RETURN 
          SPACE  4
**        GETNC - GET NEXT CHARACTER
* 
*         GETS NEXT CHAR CROM WORD BEING SCANNED AND INCREASES COLUMN 
*         POINTER.  IF END OF WORD IS REACHED, THE NEXT WORD IS PICKED
*         UP. 
*         ENTRY  B6 - COLUMN POINTER
*                B7 - WORD POINTER
*                X1 - WORD BEING SCANNED
*         EXIT   X4 - CHAR OBTAINED, RIGHT JUSTIFIED
*         USES   A-1
*                B-6,7
*                X-1,4
          SPACE  1
GETNC     PS
          BX4    X0*X1             PICK UP CHAR 
          SB6    B6+B1             INCREMENT POINTER
          LX1    6                 SHIFT TO NEXXT CHAR
          LX4    6
          LT   B6,B2,GETNC         RETURN IF MORE CHARS IN WORD 
          SB7    B7+B1
          SB6    B0                RESET POINTERS 
          SA1    CARD+B7           GET NEXT WORD
          EQ   GETNC               RETURN 
          SPACE  4
**        SCNEOC - END OF CARD PROCESSING 
* 
*         CALLED WHEN ZERO CHAR ENCOUNTERED.  IF IT ISNT END OF CARD
*         (SCANNING LAST WORD IN CARD), A IMMEDIATE RETURN IS MADE. 
*         ELSE, THE NEXT CARD IS READ.  IF IT IS A CONTINUATION CARD
*         POINTERS ARE RESET AND SCANNING CONTINUES.  IF IT IS END OF 
*         DIRECTIVE AND NO FIELD HAS BEEN SCANNED, RETURN IS SET UP 
*         AND AN EXIT IS MADE THROUGH SCNCRD.  IF A FIELD HAS BEEN
*         PICKED UP, THE CELL EOD IS SET UP TO REFLECT END OF DIRECTIVE 
*         AND EOR (IF ENCOUNTERED) AND A RETURN IS MADE TO SCNTRM.
*         ENTRY  B7 - WORD POINTER
*                X6 - FIELD SCANNED 
*         EXIT   B6 - COLUMN POINTER
*                B7 - WORD POINTER
*                X1 - NZ IF EOR ENCOUNTERED 
*                X2 - NZ IF END OF DIRECTIVE
*                X6 - FIELD SCANNED (IF PRESENT)
*         CALLS GETCRD, PRINT, GETNC
          SPACE  1
SCNEOC    PS
          SA3    LCARD
          SX4    B7+B1
          IX4    X4-X3
          NZ   X4,SCNEOC           RETURN IF NOT END OF CARD
          SA6    TEMP              SAVE SCANNED FIELD 
          RDCRD                    GET NEXT CARD
          NZ   X1,SCNEOC2          JUMP IF EOR ENCOUNTERED
          SA1    CARD 
          BX4    X0*X1
          LX4    6
          SX3    X4-1R, 
          ZR   X3,SCNEOC1          JUMP IF CONTINUATION CARD
          SX2    B1                SET END OF DIRECTIVE INDICATOR 
          SA1    TEMP 
          PX7    X2,B0
          ZR   X1,SCNCRD           RETURN IF NO FIELD 
          BX6    X1                                                     0076 414
SCNEOC0   SA7    EOD               SAVE EOD INDICATOR 
          SX4    1R                SET DELIMITER
          SB6    B0 
          SB7    B0                RESET COLUMN POINTER 
          EQ   SCNTRM 
          SPACE  1
SCNEOC1   RJ   PRINT               PRINT CONTINUATION CARD
          SB2    10                                                     0076 411
          SB7    B0                                                     0076 412
          SB6    B1 
          SA2    TEMP 
          SA1    CARD+B7           FETCH NEW CARD 
          BX6    X2                RESTORE FIELD SCANNED
          LX1    6
          RJ   GETNC               FETCH NEXT CHAR
          EQ   SCNEOC              AND RETURN 
          SPACE  1
SCNEOC2   SA1    TEMP 
          NZ   X1,SCNEOC3          JUMP IF HAVE FIELD 
          SX1    B1 
          SX2    B1                SET INDICATORS 
          EQ   SCNCRD              RETURN THRU SCNCRD 
          SPACE  1
SCNEOC3   PX7    X1,B1             SET UP EOD CELL AS NZ
          EQ   SCNEOC0             GO RESET POINTERS
          TITLE  READ, WRITE ROUTINES 
**        GETCRD - GET NEXT CARD
* 
*         THE NEXT CARD FROM THE INPUT BUFFER IS PUT INTO THE CURRENT 
*         CARD AREA.  IF THE BUFFER IS EMPTY AND AN EOR HAS NOT BEEN
*         ENCOUNTERED, THE NEXT BUFFERFUL IS READ FROM THE INPUT FILE 
*         IF AN EOR IS ENCOUNTERED, THE EOR RETURN IS SET.  THE CARD
*         IS SCANNED FOR THE END OF CARD ZERO BYTE AS IT IS MOVED FROM
*         THE BUFFER AND THE LENGTH OF THE CARD IS SAVED.  THE INPUT
*         FET OUT POINTER IS ADVANCED TO POINT TO THE NEXT CARD.
*         EXIT   X1 - NX IF EOR ENCOUNTERED 
*         CALLS  READ ROUTINE 
          SPACE  1
GETCRD    PS
          SB7    B0 
GETCRD0   MX5    12 
          LX5    12                MASK FOR END OF CARD BYTE
          SA1    INPUT+2           GET IN POINTER 
          SA2    A1+B1             GET OUT POINTER
GETCRD1   IX4    X1-X2
          ZR   X4,GETCRD2          JUMP IF BUFFER EMPTY 
          SA3    X2                FETCH WORD FROM BUFFER 
          BX6    X3 
          SA6    CARD+B7           STORE WORD IN CARD SAVE AREA 
          SX2    X2+B1             INCREMENT OUT POINTER
          BX4    X5*X6
          SB7    B7+B1             INCREMENT COUNTER
          ZR   X4,GETCRD4          JUMP IF END OF CARD
          EQ   GETCRD1             GO GET NEXT WORD 
          SPACE  1
GETCRD2   SA1    INPUT
          LX1    55 
          NG   X1,GETCRD3          JUMP IF EOR ENCOUNTERED
  
 GETCRD2A SX6    B7 
          SA6    LCARD             SAVE NO. OF WORDS READ 
          SA1    INPUT+B1 
          MX7    18 
          LX7    18 
          BX7    X7*X1             RESET IN AND OUT POINTERS TO FIRST 
          SA7    A1+B1
          SA7    A7+B1
          READ   INPUT,R           READ NEXT BUFFERFUL
          SA1    LCARD
          SB7    X1                GET NO. WORDS READ 
          EQ   GETCRD0             CONTINUE PROCESSING CARD 
          SPACE  1
 GETCRD3  SA3    INPUT+B1 
          AX3    48 
          SX3    X3-2RTT
          NZ     X3,GETCRD4A IF NOT NOS TERMINAL FILE 
          LX1    1
          MI     X1,GETCRD4A IF EOF 
          MX3    -4 
          LX1    60-14-59+3 
          BX1    -X3*X1 
          SX1    X1-1 
          ZR     X1,GETCRD2A   IF LEVEL 1 EOR 
  
 GETCRD4A NZ     B7,ERR6     ERROR IF NOT AT END OF CARD
          SX1    B1                SET EOR INDICATOR
          EQ   GETCRD              RETURN 
          SPACE  1
GETCRD4   SX6    B7 
          SX7    B7-8                                                   0076 464
          NG     X7,GETCRD5        JUMP IF CARD LESS THAN 8 WORDS       0076 465
          SA3    CARD+7                                                 0076 466
          MX7    12                                                     0076 467
          BX7    X7*X3             MASK OUT LOWER 48 BITS OF 8TH WORD   0076 468
          SA7    A3                                                     0076 469
          SX6    8                                                      0076 470
GETCRD5   SA6    LCARD                                                  0076 471
          BX7    X2 
          SA7    INPUT+3           SAVE OUT POINTER 
          MX1    0
          PX6    X1,B0             SET COLUMN POINTERS TO ZERO
          SA6    COLUMN 
          EQ   GETCRD              RETURN 
          EJECT 
**        WTW - TRANSFERS DATA FROM A WORKING BUFFER TO CIO BUFFER
*         ENTRY  X2 - ADDRESS OF FET FOR FILE 
*                B6 - FWA WORKING STORAGE 
*                B7 - WORD COUNT OF WORKING BUFFER
*         EXIT   X2 - ADDRESS OF FET
*         USES   X-1,2,3,4,6,7
*                B-2,3,4,5,6,7
*                A-1,2,384,6,7
*         CALLS  DCB, WTX 
          SPACE  1
WTW       PS
          SA4    WTW
          ZR   B7,WTW              IF WORKING BUFFER EMPTY
          SA1    X2+4 
          SA3    X2+B1             FIRST
          SB7    B6+B7             LWA+1 WORKING STORAGE
          SB5    X1                LIMIT
WTW1      SA1    A2+2              OUT
          SA2    A3+B1             IN 
          SB4    X1 
WTW2      SB3    X2+B1
          NE   B3,B5,WTW3 
          SB3    X3 
WTW3      SA1    B6                NEXT WORD
          EQ   B3,B4,DCB           DUMP CIRCULAR BUFFER 
          SB6    B6+B1             ADVANCE WORKING BUFFER 
          BX6    X1 
          SA6    X2                STORE WORD 
          SX2    B3 
          NE   B6,B7,WTW2          LOOP TO END OF WORKING BUFFER
          EQ   WTX                 EXIT 
          TITLE  ERROR PROCESSING 
**        ERROR PROCESSING
* 
*         IF THERE IS AN ERROR ON THE TRAP CARD A DAYFILE MESSAGE IS
*         ISSUED, THE DEBUG INPUT RECORD IS SKIPPED, AND TRAP ENDS. 
*         IF THERE ARE ANY ERRORS ON DEBUG DIRECTIVE, AN ERROR MESSAGE
*         IS ISSUED, AND THE NEXT DIRECTIVE IS SKIPPED TO AND ANY ERROR 
*         FREE DIRECTIVES ARE PROCESSED.  WHEN AN EOR ON THE INPUT
*         FILE IS ENCOUNTERED, A DAYFILE MESSAGE WITH THE ERROR COUNT 
*         IS ISSUED.  IF ANY GOOD DIRECTIVES WERE PROCESSED, LDL IS 
*         CALLED, OTHERWISE TRAP ENDS.
          SPACE  1
ERR2      SX2    MSG2 
          EQ   ERRDF
          SPACE  1
ERR3      ERM    MSG3,' 
ERR4      ERM    MSG4,' 
ERR5      ERM    MSG5,' 
ERR6      ERM    MSG6,' 
ERR7      ERM    MSG7                                                   0076 473
ERR8      ERM    MSG8,' 
ERR9      ERM    MSG9 
ERR10     ERM    MSG10                                                  0193  14
  
ERRDF     MESSAGE X2,R             ISSUE DAYFILE ERROR MESSAGE
          CIOCALL INPUT,R,READSKP  SKIP PAST DEBUG INPUT RECORD 
          SA1    END
          RJ   CALLPP              END
          PS
          SPACE  1
ERROUT    WRITEC OUTPUT,B6         WRITE ERROR MESSAGE TO OUTPUT
          WRITEC OUTPUT,SPACE      SKIP LINE
          SA1    LINECNT
          SX6    X1-2              DECREASE LINE COUNT
          SA6    A1 
          SA2    ERROR
          SA1    EODF 
          SX6    X2+B1             INCREMENT ERROR COUNT
          SA6    A2 
          NZ   X1,ERROUT2          JUMP IF AT EOR 
ERROUT1   RDCRD                    READ NEXT CARD 
          NZ   X1,ERROUT2          JUMP IF AT EOR 
          SA2    CARD 
          BX2    X0*X2
          LX2    6
          SX2    X2-1R, 
          NZ   X2,TRPCRK           JUMP IF NEW DIRECTIVE
          RJ   PRINT               PRINT CONTINUATION CARD
          EQ   ERROUT1             SKIP TO NEXT DIRECTIVE 
          SPACE  1
ERROUT2   SA1    DIRCNT 
          NZ   X1,TRPEOD3          JUMP IF HAVE GOOD DIRECTIVES 
          RJ   PRTERR              ISSUE DAYFILE ERROR COUNT MESSAGE
          WRITER OUTPUT,R          WRITE FILES TO DISK
          SA1    END
          RJ   CALLPP              END
          PS
          SPACE  4
**        ERROR POINTER 
* 
*         PRINT A ' APPROXIMATELY UNDER THE TERM IN THE INPUT DIRECTIVE 
*         WHICH IS RESPONSIBLE FOR THE ERROR MESSAGE TO FOLLOW. 
* 
  
PRAROW    PS                       ENTRY/EXIT 
          SA1    COLUMN 
          UX1    B7,X1             GET WORD AND COLUMN
          SX1    X1-2              BACK UP COLUMN POINTER               0076 458
          SB6    10 
          PL   X1,PR11             BRANCH IF COL. IS STILL IN THIS WORD 
          SB7    B7-B1             BACK UP CARD POINTER 
          SX1    X1+B6             RESET COLUMN POINTER 
PR11      BSS    0
          SB6    -60
          IX1    X1+X1             * (X1) = 6*(X1)                      0076 460
          IX2    X1+X1             *                                    0076 461
          IX1    X1+X2             *                                    0076 462
          SA2    ARROW             PICK UP LEFT JUST. BLANK FILL '
          SB6    X1+B6             LEFT SHIFT COUNT FOR ARROW 
          SB7    B7+B1             BIAS FOR 10 CHAR LEAD IN ON ERRORS 
          SB6    -B6
          LX6    B6,X2             POSITION THE ARROW 
          SA6    ARF+B7            STORE THE ARROW
          SA5    A6                SAVE A6
          WRITEC OUTPUT,ARF 
          SA1    BLANKS            CLEAR THE ARROW
          BX6    X1 
          SA6    A5 
          EQ   PRAROW              RETURN 
          SPACE  2
ARROW     DATA   1H'
ARF       DATA   1H 
          DUP    8D,1 
          DATA   1H 
          DATA   0
          SPACE  4
          TITLE  ERROR MESSAGES 
MSG2      DIS    ,*TRAP CARD PARAM ERROR, NO DEBUG DONE*
MSG3      DIS    ,+ *****  PARAM(S) MISSING ON ABOVE TRAP DIRECTIVE+
MSG4      DIS    ,+ *****  ILLEGAL VERB IN ABOVE TRAP DIRECTIVE+
MSG5      DIS    ,+ *****  ILLEGAL DELIMITER ON ABOVE TRAP DIRECTIVE+ 
MSG6      DIS    ,+ *****  ILLEGAL PARAM ON ABOVE TRAP DIRECTIVE+ 
MSG7      DIS    ,+ *****  AT PARAM REQUIRED ON ABOVE FRAME DIRECTIVE+
MSG8      DIS    ,+ *****  ILLEGAL NUMBER ON ABOVE TRAP DIRECTIVE+
MSG9      DIS    ,+ *****  TOO MANY WHENS ON TRACK DIRECTIVE+ 
MSG10     DIS    ,+ *****  UNTIL CANNOT BE LESS THAN START+             0193  16
 MSG11    DIS    ,*NO TRAP DIRECTIVES FOUND, NO DEBUG DONE.*
ERRCNT    BSSZ   1
          DIS    ,* TRAP DIRECTIVE ERROR(S)*
          TITLE  TRAP BUFFERS 
 LBUF     EQU    1000B
 BUFF1    BSS    LBUF 
 BUFF2    BSS    LBUF 
 BUFF3    BSS    LBUF 
          ORG    BUFF3
 COPYRGHT DATA   C/ CONTROL DATA PROPRIETARY PRODUCT /
          DATA   C/ COPYRIGHT CONTROL DATA CORP. 1976, 1977, 1978,/ 
          DATA   C/ 1979, 1980, 1981, 1982./
          ORG    BUFF3+LBUF 
          END    TRAP 
