Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50517/rpgiic.mac
There is 1 other file named rpgiic.mac in the archive. Click here to see a list.
TITLE RPGIIC FOR RPGII %1A(70)
SUBTTL JULY 24, 1975 BOB CURRIER
TWOSEG
RELOC 400000
;INPUT SPECIFICATIONS SYNTAX SCAN
ENTRY RPGIIC
RPGIIC: PORTAL .+1 ; ENTER CONCEALED MODE
SETFAZ C; ; SET UP PHASE C JUNK
SWOFF FMDFIL; ; TURN OFF SOME FLAGS
JRST INPSPC ; GO PROCESS A CARD
;GET A CARD TO PROCESS
IN.00: SWOFF FARRY!FARRAY!FIMD ; TURN OFF SOME FLAGS
PUSHJ PP,GETSRC ; TRY TO GET A CHAR
TSWF FEOF; ; DID WE MAKE IT?
JRST IN.00A ; NO -
SWON FREGCH; ; GOT IT, NOW REGET IT
PUSHJ PP,GETCRD ; GET A WHOLE CARD
;STARTING ENTRY POINT
INPSPC: MOVE TB,COMMNT ; GET COMMANT COLUMN
CAIN TB,"*" ; IS IT A COMMENT?
JRST IN.00 ; YES - GO GET ANOTHER CARD
MOVE TB,FRMTYP ; GET FORM TYPE
CAIE TB,"I" ; INPUT CARD?
JRST NOTI ; NOT I SAID THE HARE
JRST IN.01 ; YES - GO PROCESS A CARD
IN.00A: JRST CA.00 ; WE RAN OUT OF SOURCE
NOTI: PUSHJ PP,IDNTYP## ; A NOTI PROBLEM INDEED!
JRST CALSPC ; ALL OK
WARN 22; ; NOT OK
JRST IN.00 ; TRY AGAIN
;FIND OUT EXACTLY WHAT KIND OF CARD WE'RE DEALING WITH
IN.01: MOVE TB,[BPNT 6,]
MOVEI TC,^D36
PUSHJ PP,BLNKCK ; CHECK FIRST HALF OF CARD
JRST IN.01A ; NOT BLANK
MOVE TB,[BPNT 42,] ; BLANK - IS 43-74 BLANK?
MOVEI TC,^D32
PUSHJ PP,BLNKCK
JRST .+2
JRST IN.00 ; BLANK CARD - IGNORE IT
TSWF FMDFIL; ; ARE WE IN MIDDLE OF FILE?
JRST IN.04 ; YES - GO PROCESS IT
WARN 94; ; NO - ERROR
JRST IN.00
IN.01A: MOVE TB,[BPNT 42,] ; WE KNOW COL 7-42 NOT BLANK, WHAT ABOUT 43-74?
MOVEI TC,^D32
PUSHJ PP,BLNKCK
JRST .+2
JRST IN.02 ; BLANK - MUST BE FILE LINE
TSWF FMDFIL; ; GARBAGE
JRST IN.01B ; ASSUME 7-42 BLANK
WARN 93; ; ASSUME 43-74 BLANK
JRST IN.02
IN.01B: WARN 84;
JRST IN.04
;HANDLE A CARD WITH DATA IN COLUMNS 7-42
IN.02: MOVE TA,[BPNT 6,]
MOVE TB,[POINT 6,NAMWRD]
MOVEI TC,^D8
PUSHJ PP,CRDSIX ; PICK UP FILE NAME
SKIPN NAMWRD ; ALL SPACES?
JRST IN.03 ; YES - CHECK FOR AND/OR
PUSHJ PP,TRYNAM ; NO - LOOK IN NAMTAB
JRST IN.02A ; NOT FOUND
MOVEM TA,CURNAM ; STORE POINTER
HRRZI TB,CD.FIL ; LOOKUP IN FILTAB
MOVSS TA ; ONLY THE BEST HALF GETS USED
PUSHJ PP,FNDLNK
JRST IN.02A ; NOT - FOUND
MOVEM TB,CURFIL ; STORE POINTER
SWON FMDFIL; ; WE'RE IN A FILE
SETZM OLDSEQ
SWOFF FSPRED!FLOKHD;
I.02D1: MOVE TA,[XWD CD.DAT,SZ.DAT] ; MAKE A PLACE IN THE WORLD
PUSHJ PP,GETENT
MOVEM TA,CURDAT
MOVEI TB,1 ; MARK AS FILE SECTION
DPB TB,DA.FLS##
DPB TB,DA.INF## ; WE'RE IN THE INPUT SECTION
MOVE TB,SAVELN## ; GET LINE NUMBER
DPB TB,DA.LIN## ; STASH IN DATAB ITEM
HRRZI TB,CD.DAT
DPB TB,[POINT 3,(TA),2] ; MAKE OUR MARK
MOVS TB,CURNAM
DPB TB,DA.NAM ; STORE NAMTAB POINTER
MOVE TA,CURFIL ; LINK INTO "MAJOR" CHAIN
LDB TB,FI.DAT
JUMPE TB,IN.02B ; THIS IS FIRST DATAB ITEM FOR FILE
IN.02D: MOVE TA,TB
PUSHJ PP,LNKSET ; LINK THRU ITEMS
LDB TB,DA.MAJ
JUMPE TB,IN.02C
JRST IN.02D
IN.02A: WARN 92;
JRST IN.00
IN.02B: MOVE TB,CURDAT ; MAKE A POINTER
SUB TB,DATLOC
IORI TB,<CD.DAT>B20
DPB TB,FI.DAT ; STORE IT
JRST IN.02E ; GO GET SEQUENCE ENTRIES
IN.02C: MOVE TB,CURDAT ; MAKE A POINTER, BUT STICK IN MAJOR CHAIN
SUB TB,DATLOC
IORI TB,<CD.DAT>B20
DPB TB,DA.MAJ
;GET SEQUENCE ENTRIES
IN.02E: MOVE TB,[BPNT 15,]
LDB CH,TB
CAIL CH,"0"
CAILE CH,"9"
JRST I.02E1 ; NOT A VALID DIGIT
MOVEI TC,-"0"(CH) ; CONVERT TO NUMBER
IMULI TD,^D10 ; SHIIIIIIIIFT
ILDB CH,TB ; GET ANOTHER CHAR
CAIL CH,"0"
CAILE CH,"9"
JRST I.02E2 ; NOT VALID - ERROR
ADDI TC,-"0"(CH)
JUMPE TC,I.02E2 ; ZERO IS INVALID TOO
CAMGE TC,OLDSEQ ; COMPARE TO LAST SEQ
JRST I.02E3 ; ERROR
SKIPN OLDSEQ ; IS THIS FIRST SEQ?
CAIN TC,1 ; YES - IS THIS ONE??
JRST I.02E4 ; YES - OK
WARN 101; ; NO - ERROR
MOVEI TC,1 ; DEFAULT TO 1
I.02E4: MOVEM TC,OLDSEQ ; UPDATE OLD SEQUENCE NUMBER
MOVE TA,CURDAT ; GET DATAB POINTER
MOVEI TB,1 ; SHOW THAT WE'RE NUMERIC
DPB TB,DA.NPS ; STORE FLAG
JRST IN.02F ; ONTO BIGGER AND BETTER THINGS
I.02E3: WARN 101;
JRST I.02E4+1
I.02E2: WARN 98;
JRST I.02E6
I.02E1: CAIL CH,"A" ; SEE IF VALID LETTER
CAILE CH,"Z"
JRST I.02E3 ; INVALID
ILDB CH,TB ; CHECK THE NEXT CHARACTER
CAIL CH,"A"
CAILE CH,"Z"
JRST I.02E3 ; INVALID
SETZ TB, ; [343] get a zero
DPB TB,DA.NPS ; [343] and clear this
I.02E6: JRST IN.02F
;GET "NUMBER" & "OPTION"
IN.02F: LDB TB,DA.NPS
LDB CH,[BPNT 17,]
JUMPE TB,I.02F1 ; COL 17-18 SHOULD BE BLANK
CAIN CH,"1"
JRST I.02F2 ; MUST BE ONE ENTRY PER
CAIE CH,"N"
WARN 102; ; INVALID ENTRY
MOVEI TB,2 ; N ENTRIES PER
DPB TB,DA.NPS
;GET OPTION
I.02F2: LDB CH,[BPNT 18,] ; GET COL 18
MOVEI TB,1
CAIN CH," " ; BLANK?
JRST I.02F3 ; YES - REQUIRED
CAIE CH,"O" ; OPTIONAL?
WARN 103; ; NO - ILLEGAL ENTRY
SETZ TB, ; YES - OR DEFAULT TO OPTIONAL
I.02F3: DPB TB,DA.RTR
JRST IN.02G
;CHECK COL 17-18 FOR BLANK
I.02F1: CAIE CH," "
JRST I.02F4
LDB CH,[BPNT 18,]
CAIE CH," "
I.02F4: WARN 104;
MOVEI TB,1
JRST I.02F3
;GET RECORD IDENTIFYING INDICATOR (01-99,L1-L9,LR,H1-H9,**,TR)
IN.02G: LDB CH,[BPNT 19,]
LDB TB,[BPNT 20,]
CAIL CH,"0"
CAILE CH,"9"
JRST I.02G1 ; NOT A VALID DIGIT
MOVEI TC,-"0"(CH) ; CONVERT TO REAL NUMBER
IMULI TC,12
I.02G7: MOVE CH,TB
CAIL CH,"0"
CAILE CH,"9"
JRST I.02G2
ADDI TC,-"0"(CH)
I.02G8: MOVE TA,CURDAT ; [024] ALMOST WORKS WITHOUT THIS!
DPB TC,DA.RII
JRST I.02G9
I.02G2: CAIN TB," " ; first char a space?
CAIE CH," " ; yes - how about second?
WARN 304; ; [272] no - error
TSWF FANDOR; ; [272] are we on and/or line?
POPJ PP, ; [272] yes - exit
MOVE TB,[BPNT (20)] ; [272] no - get column to check
MOVEI TC,^D21 ; [272] get number to check
PUSHJ PP,BLNKCK ; [272] are record identification codes blank?
WARN 304; ; [272] no - error
SETZ TC, ; [272] regardless, we want no links
MOVE TA,CURDAT ; [272] get link
DPB TC,DA.RII ; [272] no RII wanted
DPB TC,DA.IND ; [272] nor INDTAB chain
JRST IN.02I ; [272] on to next job
I.02G1: CAIN CH,"L" ; LEVEL INDICATOR?
JRST I.02G3 ; YES -
CAIN CH,"H"
JRST I.02G7 ; HALT INDICATOR
CAIN CH,"*"
JRST I.02G5 ; LOOK AHEAD RECORD
CAIE CH,"T"
JRST I.02G2 ; INVALID
CAIE TB,"R" ; TRAILER RECORD
JRST I.02G2 ; NO - INVALID
WARN 623; ; SHOULDN'T GET ONE HERE
JRST I.02G9
;CHECK FOR LAST RECORD
I.02G3: CAIN TB,"R"
JRST I.02G6 ; IS LAST RECORD
MOVEI TC,155 ; JUST PLAIN LEVEL, GET OFFSET
JRST I.02G7 ; GET DIGIT PORTION
I.02G6: MOVEI TC,166 ; LAST RECORD OFFSET
JRST I.02G8
;LOOK AHEAD RECORD
I.02G5: CAIE TB,"*"
JRST I.02G2 ; INVALID
SWON FLOKHD;
I.02G9: TSWF FANDOR; ; [105] IS FANDOR ON?
POPJ PP, ; YES - EXIT
; NO - FALL THRU TO IN.02H
;GET RECORD IDENTIFICATION CODES
IN.02H: MOVE TB,[BPNT 20,] ; GET START OF RECORD IDENTIFICATION CODES
MOVEI TC,^D21 ; GET LENGTH
PUSHJ PP,BLNKCK ; ARE THEY THERE?
CAIA ; IS NOT BLANK
JRST I.02H5 ; IS BLANK
SETZB TD,TE ; A BIT OF INITIALIZATION
I.02H1: MOVE TA,INDPTB(TD) ; GET A BYTE POINTER
MOVEI TB,4
PUSHJ PP,GETDCB ; GET POSITION
JUMPE TC,I.02H3 ; END OF THE LINE
PUSHJ PP,GETIND ; GET INDTAB ENTRY
JUMPN TD,I.02H4 ; SKIP OVER THIS IF NOT FIRST TIME THRU
I.02H6: EXCH TA,CURDAT ; GET DATAB POINTER
LDB TB,DA.RII ; GET RII
LDB CH,DA.SEQ ; GET SEQUENCE
EXCH TA,CURDAT ; GET INDTAB POINTER BACK
DPB TB,ID.RII## ; STASH RII
DPB CH,ID.SEQ## ; AS WELL AS SEQUENCE
TSWF FANDOR; ; ARE WE ON A AND/OR LINE?
JRST I.02H4 ; YES -
MOVE TB,TA ; SET UP AN INDTAB POINTER
PUSH PP,TA ; STORE TA FOR LATER
SUB TB,INDLOC
IORI TB,<CD.IND>B20
MOVE TA,CURDAT
DPB TB,DA.IND ; LINK IT IN
POP PP,TA ; RECOVER TA
JUMPL TD,IN.02I ; EXIT IF TD SET TO -1
I.02H4: DPB TC,ID.POS## ; STORE POSITION IN INDTAB
SETZ TB,
LDB CH,INDNTB(TD) ; GET NOT COLUMN
CAIN CH," "
JRST I.02H2
CAIE CH,"N"
WARN 107; ; INVALID ENTRY
MOVEI TB,1
I.02H2: DPB TB,ID.NOT##
LDB CH,INDCTB(TD) ; GET CHARACTER
DPB CH,ID.IND## ; STUFF INTO INDTAB
DPB TE,ID.OR## ; STORE AND/OR WORD
I.02H3: AOJ TD, ; INCREMANT POINTER
CAIE TD,3 ; REACHED THE END?
JRST I.02H1 ; NO -
JRST IN.02I ; YES -
;TABLE OF POINTERS TO CHARACTER POSITIONS
INDPTB: POINT 7,CRDBUF+4 ; COL 21 -
POINT 7,CRDBUF+5,13 ; COL 28 -
POINT 7,CRDBUF+6,27 ; COL 35 -
;TABLE OF POINTERS TO NOT POSITIONS
INDNTB: POINT 7,CRDBUF+4,34 ; COL 25
POINT 7,CRDBUF+6,13 ; COL 32
POINT 7,CRDBUF+7,27 ; COL 39
;TABLE OF POINTERS TO CHARACTERS
INDCTB: POINT 7,CRDBUF+5,13 ; COL 27
POINT 7,CRDBUF+6,27 ; COL 34
POINT 7,CRDBUF+^D8,6 ; COL 41
I.02H5: PUSHJ PP,GETIND ; GET DUMMY INDTAB ENTRY
SETO TD, ; PUT FLAG IN TD
JRST I.02H6 ; GO DO REST
;GET STACKER SELECT
IN.02I: MOVE TA,CURDAT
LDB TB,DA.IND ; SEE IF WE HAVE ANY RECORD IDENTIFICATION CODES
JUMPE TB,I.02I3 ; NOPE -
MOVE TA,CURIND ; YES - MARK END BIT
MOVEI TB,1
DPB TB,[POINT 1,(TA),22] ; MARK END OF INDTAB ENTRY
TSWFZ FANDOR; ; ARE WE ON A AND/OR LINE?
POPJ PP, ; YES -
I.02I3: LDB CH,[BPNT 42,] ; NO - GET STACKER COLUMN
CAIN CH," "
JRST IN.02J ; NOT SELECTED
CAIL CH,"1"
CAILE CH,"4"
JRST I.02I1 ; INVALID CHARACTER
MOVE TA,CURFIL
LDB TB,FI.DEV ; GET FILE DEVICE
CAIE TB,1 ; MFCU2?
JUMPN TB,I.02I2 ; MFCU1? NO - INVALID DEVICE
MOVEI TB,-"0"(CH)
MOVE TA,CURDAT
DPB TB,DA.STS
JRST IN.02J
I.02I1: WARN 109;
JRST IN.02J
I.02I2: WARN 164; ; INVALID DEVICE
IN.02J: SWON FDATLK; ; SHOW WE ALREADY HAVE A DATAB ITEM SET UP
JRST IN.00 ; GET ANOTHER CARD
;WE NOW KNOW WE HAVE A BLANK FILENAME
;
;FIRST THING WE MUST DO IS CHECK FOR AND/OR LINE
;
IN.03: MOVE TA,[BPNT (13)] ; [217] get pointer to column 13
MOVE TB,[POINT 6,TD]
MOVEI TC,3
SETZ TD, ; SET TD TO ALL SPACES
PUSHJ PP,CRDSIX
SETZB TB,TE
CAMN TD,[SIXBIT /AND/]
JRST IN.03A ; AND LINE
CAME TD,[SIXBIT /OR /]
JRST IN.03B ; ERROR
MOVEI TE,1 ; GET ID.OR FLAG
IN.03A: SWON FANDOR; ; SET SECRET FLAG
MOVE TA,CURIND ; GET POINTER TO INDTAB ENTRY
DPB TB,ID.END## ; ZAP OUT "END OF ENTRY" BIT
DPB TE,ID.OR## ; [105] STASH SECRET AND/OR FLAG
SKIPE TE ; [105] ARE WE ON "OR" LINE?
PUSHJ PP,IN.02G ; [105] YES - GET NEW RII
SETZB TD,TE ; [042] NECESSARY INITIALIZATION
PUSHJ PP,I.02H1 ; GO GET SOME RECORD IDENTIFIERS
JRST IN.00 ; GO GET ANOTHER CARD
; NOW CHECK FOR TRAILER RECORD OR LOOK AHEAD
IN.03B:
; MOVE TA,[BPNT (18)] ; get pointer
; MOVE TB,[POINT 6,TD] ; get place to put it
; MOVEI TC,3 ; get count
; SETZ TD, ; reset TD to spaces
; PUSHJ PP,CRDSIX ; get the data
REPEAT 0,<
CAMN TD,[SIXBIT / TR/]
JRST IN.03C ; IT'S A SPREAD CARD
>
; CAMN TD,[SIXBIT / **/]
; JRST .+4 ; look ahead record
TLNE TD,770000 ; IS FILENAME ALL BLANK?
JRST IN.02A ; NO - INVALID FILENAME
JRST I.02D1 ; YES - COULD BE A MAJOR ITEM
; SWON FLOKHD;
; MOVE TB,[POINT 7,CRDBUF+3,6]
; MOVEI TC,2
; PUSHJ PP,BLNKCK ; CHECK FOR APPROPRIATE BLANK COLUMNS
; JRST IN.03D ; ERROR - NOT BLANK
; MOVE TB,[POINT 7,CRDBUF+4]
; MOVEI TC,^D22
; PUSHJ PP,BLNKCK
;IN.03D: WARN 163; ; ERROR
; JRST IN.00 ; OK -
;IN.03C: SWON FSPRED ; SHOW WE HAVE SPREAD CARDS
; JRST IN.00
;FETCH DATA ITEM
IN.04: SETZM NAMWRD+1 ; [066] ZAP ANY LEFTOVER GARBAGE
MOVE TA,[BPNT 52,]
MOVE TB,[POINT 6,NAMWRD]
MOVEI TC,6
PUSHJ PP,CRDSIX ; PICK UP FIELD NAME
SKIPN NAMWRD ; ALL SPACES?
JRST IN.04A ; YES -
PUSHJ PP,NMVRFY## ; [244] verify validity
WARN 118; ; [244] not valid -
;CHECK TO SEE IF ARRAY ENTRY
MOVE TB,[POINT 6,NAMWRD]
SETZB TC,ARRENT
IN.04E: ILDB CH,TB ; GET A CHERACTER
CAIN CH,',' ; A COMMA?
JRST IN.04F ; YES -
TLNE TB,770000 ; END OF NAMWRD?
JRST IN.04E ; NO - LOOP
JRST IN.04G ; YES -
IN.04F: SETZ TD, ; [324] throw away comma and digits of
DPB TD,TB ; [324] subscript after use
MOVE TE,TB ; [324] save for later
ILDB CH,TB
CAIL CH,'0'
CAILE CH,'9'
JRST IN.04H ; INVALID DIGIT
IMULI TC,^D10
ADDI TC,-'0'(CH)
TLNE TB,770000 ; END OF NAMWRD
JRST IN.04F+1 ; [324] no - loop
IN.04I: SWON FARRAY!FIMD; ; FLAG AS ARRAY
MOVEM TC,ARRENT
JRST IN.04G
IN.04H: CAIN CH,' ' ; IS INVALID CHAR A SPACE?
JRST IN.04I ; YES - END OF INDEX
JRST IN.04M ; NO - ERROR
IN.04G: PUSHJ PP,TRYNAM ; LOOK IN NAMTAB
PUSHJ PP,BLDNAM ; IF IT'S NOT THERE, BUILD IT
MOVEM TA,CURNAM
MOVE TA,CURDAT
TSWF FDATLK; ; [061] DON'T TURN OFF FLAG WHEN WE DO THIS
JRST IN.04B ; DATAB ITEM ALREADY EXISTS
MOVE TA,[XWD CD.DAT,SZ.DAT]
PUSHJ PP,GETENT ; GET A DATAB ENTRY
IN.04B: MOVE TB,TA
SUB TB,DATLOC ; MAKE A POINTER
IORI TB,<CD.DAT>B20
HRLZ TD,CURDAT
HRR TD,TA
BLT TD,3(TA) ; TRANSFER SOME DATA
SETZ TD,
DPB TD,DA.NAM ; ZAP NAMTAB ENTRY
DPB TD,DA.BRO ; ZERO OUT BROTHER LINK
DPB TD,DA.VAL ; ZAP VALTAB LINK
MOVEI TD,1 ; FLAG THIS AS AN INPUT RECORD
DPB TD,DA.INF## ; FLAG IT HERE
DPB TD,DA.FLS## ; also flag as file section
MOVE TD,SAVELN ; GET LINE NUMBER
DPB TD,DA.LIN ; SAVE
EXCH TA,CURDAT
TSWTZ FDATLK; ; [061] DON'T DO ANYTHING IF ITEM ALREADY SET UP
DPB TB,DA.BRO ; STASH BROTHER LINK
HRRZI TB,CD.DAT
MOVS TA,CURNAM
PUSHJ PP,FNDLNK ; LOOK FOR NAMTAB LINK
JRST IN.04J ; NOT PREVIOUSLY USED
HLRZ TC,NAMWRD ; GET FIRST THREE CHARS OF FIELD NAME
CAIE TC,'TAB' ; IS IT A TABLE?
JRST IN.04K ; DOESN'T LOOK IT
MOVE TA,TB
LDB TC,DA.OCC ; GET NUMBER OF OCCURS
JUMPE TC,IN.04K ; NOPE -
WARN 158; ; YES - TABLE INVALID
JRST IN.00
IN.04K: TSWT FARRAY; ; IS THIS AN ARRAY ENTRY?
JRST IN.04L ; NO -
MOVE TA,TB ; YES -
MOVE TC,TA ; GET BASE ADDRESS
SUB TC,DATLOC ; MAKE A POINTER
IORI TC,<CD.DAT>B20 ; SAY WHO WE ARE
MOVEM TC,ARRPNT## ; STORE FOR FUTURE GENERATIONS
LDB TC,DA.OCC
JUMPE TC,IN.04A
TSWF FIMD;
CAML TC,ARRENT ; [324] is index valid?
JRST IN.04D ; YES -
WARN 180; ; NO -
JRST IN.00
IN.04L: MOVE TA,TB ; [145] GET LINK INTO PROPER AC
LDB TC,DA.OCC ; [145] GET NUMBER OF OCCURS FOR ITEM
JUMPE TC,IN.04D
SWON FARRY;
LDB TC,DA.SIZ
MOVEM TC,INSIZ ; STORE SIZE OF ARRAY
JRST IN.04D
MOVE TA,TB
PUSHJ PP,LNKSET
IN.04D: LDB TB,DA.SNM ; GET "SAME NAME" LINK
JUMPN TB,IN.04D-2 ; NOT ZERO - LOOP
MOVE TC,CURDAT ; MAKE A DATAB POINTER
SUB TC,DATLOC
IORI TC,<CD.DAT>B20
DPB TC,DA.SNM ; STORE LINK
IN.04C: MOVE TA,CURDAT
MOVS TB,CURNAM
DPB TB,DA.NAM ; STORE NAMTAB POINTER
TSWT FARRAY ; IS IT AN ARRAY?
JRST IN.05 ; NO -
MOVE TC,ARRENT
JUMPE TC,IN.04A
DPB TC,DA.INP## ; STORE INDEX
MOVE TC,ARRPNT ; GET POINTER TO ARRAY
DPB TC,DA.ARP## ; AND STORE
MOVEI TC,1
DPB TC,DA.ARE ; FLAG AS ARRAY ENTRY
TSWF FIMD; ; IMEDIATE(SIC)?
DPB TC,DA.IMD## ; YES - FLAG AS SUCH
JRST IN.05
IN.04J: TSWT FARRAY;
JRST IN.04C
IN.04A: WARN 118;
JRST IN.00
IN.04M: MOVE TB,[POINT 6,TD] ; PLACE TO PUT INDEX NAME
ILDB CH,TE ; GET C CHARACTER
CAIN CH,' ' ; SPACE?
JRST IN.04N ; YES - ALL DONE
IDPB CH,TB ; STASH CHAR
TLNE TE,770000 ; ALL DONE?
JRST IN.04M+1 ; NO - LOOP
IN.04N: PUSH PP,NAMWRD ; STASH TO KEEP SAFE
MOVEM TD,NAMWRD ; SET UP FOR SEARCH
PUSHJ PP,TRYNAM ; IS IT THERE?
PUSHJ PP,BLDNAM ; NO - PUT 'ER THERE PAL
MOVEM TA,CURNAM ; STORE POINTER
POP PP,NAMWRD ; RESTORE
HRRZI TB,CD.DAT ; SEARCH DATAB
MOVS TA,CURNAM ; SEARCH FOR THIS
PUSHJ PP,FNDLNK ; GO DO IT
JRST IN.04P ; NOT FOUND -
IN.04Q: SUB TA,DATLOC ; MAKE A POINTER
IORI TA,<CD.DAT>B20 ; FROM HERE
MOVEM TC,ARRENT ; AND STORE
SWOFF FIMD ; MAKE SURE
JRST IN.04G ; AND LOOP ON BACK
IN.04P: MOVE TA,[XWD CD.DAT,SZ.DAT] ; SET UP FOR CREATE
PUSHJ PP,GETENT ; MAKE HER BUDDY
MOVEI TB,1 ; TELL THE WORLD THAT WE DON'T
DPB TB,DA.NDF## ; HAVE ANY REAL DATA ON THIS ONE
MOVE TB,SAVELN
DPB TB,DA.LIN
JRST IN.04Q
;GET PACKED/BINARY
IN.05: LDB CH,[BPNT 43,]
MOVEI TC,PBTAB
PUSHJ PP,TABSCN
JRST IN.05A ; INVALID
DPB TB,DA.FLD ; STORE
JRST IN.06
IN.05A: WARN 111;
MOVEI CH," "
JRST IN.05+1
;TABLE OF VALID FIELD FORMATS
PBTAB: 777777
"P"
"B"
" "
Z
;GET "FROM" & "TO" ENTRIES
IN.06: MOVE TA,[BPNT 43,]
MOVEI TB,4
PUSHJ PP,GETDCB
JUMPE TC,IN.06A ; INVALID
MOVE TA,CURFIL
LDB TB,FI.RCL ; GET RECORD LENGTH
CAMLE TC,TB
JRST IN.06A ; INVALID (> REC LENGTH)
MOVE TA,CURDAT
DPB TC,DA.FRP ; STORE
MOVE TA,[BPNT 47,]
MOVEI TB,4
PUSHJ PP,GETDCB ; GET "TO" ENTRY
JUMPE TC,IN.06A ; INVALID
MOVE TA,CURFIL
LDB TB,FI.RCL
CAMLE TC,TB ; COMPARE TO REC LENGTH AGAIN
JRST IN.06A
MOVE TA,CURDAT
LDB TB,DA.FRP
CAMGE TC,TB ; COMPARE TO FROM POINTER
JRST IN.06B ; FROM > TO - INVALID
IN.06C: DPB TC,DA.TOP
SUB TC,TB
AOJ TC,
IN.06D: DPB TC,DA.SIZ ; STORE LENGTH OF FIELD
DPB TC,DA.ISZ## ; [317] store input size
TSWT FARRY ; IS THIS AN ARRAY?
JRST IN.07 ; NO -
MOVE TE,TC
MOVE TC,INSIZ
DPB TC,DA.SIZ ; [313] store the proper size
IDIV TE,TC
JUMPE TD,IN.07 ; NO REMAINDER - OK
WARN 180; ; REMAINDER - NOT MULTIPLE
JRST IN.07
IN.06A: WARN 112;
MOVE TA,CURDAT
MOVEI TC,1
DPB TC,DA.FRP
DPB TC,DA.TOP
JRST IN.06D ; DEFAULT TO 1 FOR FROM AND TO
IN.06B: WARN 113;
MOVE TC,TB ; DEFAULT TO FROM=TO
JRST IN.06C
;TEST FOR LOOK AHEAD FIELDS
IN.07: TSWT FLOKHD;
JRST IN.08
MOVE TA,CURDAT
MOVE TB,1
DPB TB,DA.LHI ; FLAG AS LOOK-AHEAD
MOVE TB,[POINT 7,CRDBUF+^D11,20]
MOVEI TC,^D16
PUSHJ PP,BLNKCK ; COLS 59-74 SHOULD BE BLANK
WARN 163; ; they're not -
JRST IN.08 ; [306] try decimal places
;GET DECIMAL POSITIONS
IN.08: LDB CH,[POINT 7,CRDBUF+^D10,13]
CAIN CH," "
JRST IN.08A ; BLANK - ALPHAMERIC
CAIL CH,"0"
CAILE CH,"9"
JRST IN.08B ; INVALID DIGIT
MOVEI TC,-"0"(CH)
MOVE TA,CURDAT
TSWF FARRY; ; AN ARRAY?
JRST IN.08E ; YES - SHOULDN'T BE NUMERIC
LDB TB,DA.SIZ ; GET FIELD SIZE
CAILE TC,TB
JRST IN.08C ; DEC POSISTIONS > SIZE
CAILE TC,^D15
JRST IN.08D ; DEC POS > 15
IN.08Y: LDB TB,DA.FLD ; GET FIELD TYPE
JUMPN TB,IN.08X ; PACKED OR BINARY
MOVEI TB,3 ; DEFAULT TO UNPACKED NUMERIC
DPB TB,DA.FLD
IN.08X: DPB TC,DA.DEC
JRST IN.09
IN.08B: WARN 116; ; INVALID ENTRY
SETZ TC, ; DEFAULT TO ALPHAMERIC
JRST IN.08Y
IN.08C: WARN 317; ; DEC EXCEEDS FIELD SIZE
JRST IN.08B+1
IN.08D: WARN 114;
MOVEI TB,^D15
DPB TB,DA.SIZ
LDB TB,DA.FRP
ADDI TB,^D15
DPB TB,DA.TOP ; STORE NEW "TO" POINTER
SETZ TC,
JRST IN.08Y
IN.08A: LDB TB,DA.FLD
SETZ TC,
CAIE TB,3
WARN 115;
DPB TC,DA.FLD
JRST IN.09
IN.08E: WARN 117;
JRST IN.08B+1
;GET CONTROL LEVEL INDICATOR
IN.09: TSWF FLOKHD; ; [306] look-ahead field?
JRST IN.00 ; [306] yes - no more work to do
MOVE TA,CURFIL
LDB TB,FI.DES
CAIE TB,2 ; CHAINED?
CAIN TB,5 ; DEMAND?
JRST IN.09A ; YES -
TSWF FARRY!FARRAY!FSPRED;
JRST IN.09D
MOVE TB,[BPNT 59,]
LDB CH,TB
CAIN CH," "
JRST IN.09B
CAIE CH,"L"
JRST IN.09C ; ERROR
ILDB CH,TB
CAIL CH,"1"
CAILE CH,"9"
JRST IN.09C ; INVALID DIGIT
MOVEI TB,155-"1"(CH)
MOVE TA,CURDAT
DPB TB,DA.CLI
JRST IN.10
IN.09B: ILDB CH,TB
CAIN CH," " ; THIS A SPACE TOO?
JRST IN.10 ; YES -
IN.09C: WARN 119;
JRST IN.10
IN.09A: MOVE TB,[BPNT 58,]
MOVEI TC,4
PUSHJ PP,BLNKCK
WARN 170;
JRST IN.11
IN.09D: MOVE TB,[BPNT 58,]
MOVEI TC,4
PUSHJ PP,BLNKCK
WARN 169;
JRST IN.11
;GET MATCHING INDICATOR
IN.10: MOVE TB,[BPNT 60,]
ILDB CH,TB
CAIN CH," "
JRST IN.10A ; BLANK
CAIE CH,"M"
JRST IN.10B ; INVALID INDICATOR
ILDB CH,TB
CAIL CH,"1"
CAILE CH,"9"
JRST IN.10B ; INVALID DIGIT
MOVEI TB,177-"1"(CH)
IN.10X: MOVE TA,CURDAT ; [245] get DATAB pointer
DPB TB,DA.MAT
JRST IN.11
IN.10A: ILDB CH,TB
CAIN CH," "
JRST IN.11 ; THIS ONE BLANK TOO -
IN.10B: WARN 120;
MOVEI TB,177 ; DEFAULT TO M1
JRST IN.10X
;GET FIELD RECORD RELATION INDICATOR
IN.11: MOVE TD,[BPNT (63)]
LDB CH,TD
CAIN CH," "
JRST IN.11A ; BLANK
CAIL CH,"0"
CAILE CH,"9"
JRST IN.11B ; NOT A DIGIT
MOVEI TC,-"0"(CH) ; A DIGIT -
IMULI TC,12
ILDB CH,TD ; GET NEXT DIGIT
CAIL CH,"0"
CAILE CH,"9"
JRST IN.11C ; ERROR - INVALID
ADDI TC,-"0"(CH)
JUMPE TC,IN.11C ; INVALID - ZERO
IN.11X: MOVE TA,CURDAT
DPB TC,DA.FRR
JRST IN.12
IN.11A: ILDB CH,TD
CAIN CH," "
JRST IN.12 ; FIELD NLANK
IN.11C: WARN 304; ; INVALID ENTRY
JRST IN.12 ; DEFAULT TO BLANK
IN.11B: MOVEI TC,FRRTB1
PUSHJ PP,TABSCN ; SCAN FOR INDICATOR TYPE
JRST IN.11C ; INVALID CHAR
JRST @FRRTB2(TB) ; DISPATCH
IN.11D: LDB CH,[BPNT (64)]
CAIL CH,"1"
CAILE CH,"9"
JRST IN.11C ; INVALID DIGIT
MOVEI TC,-"1"(CH)
ADD TC,FRRTB3(TB)
JRST IN.11X
IN.11E: LDB CH,[BPNT (64)]
CAIE CH,"R" ; MATCHING RECORD?
JRST IN.11C ; NO - ERROR
MOVE TC,FRRTB3(TB)
JRST IN.11X
IN.11F: LDB CH,[BPNT (64)]
CAIE CH,"9" ; IS IT A "9"?
JRST IN.11D ; NO - OK SO FAR
JRST IN.11C ; YES - INVALID
;TABLE OF VALID INDICATOR TYPES
FRRTB1: "L" ; CONTROL LEVEL INDICATORS
"M" ; MATCHING RECORD
"U" ; EXTERNAL INDICATOR
"H" ; HALT INDICATOR
Z
;DISPATCH TABLE
FRRTB2: IN.11D
IN.11E
IN.11F
IN.11D
;VALUES OF INDICATORS
FRRTB3: 155
210
213
144
;IN.12 Get field indicators
;
;
;
IN.12: MOVE TA,CURDAT ; make sure we have the DATAB pointer
MOVE TB,[BPNT 65,]
LDB TD,DA.FLD
PUSHJ PP,IN.16 ; GET AN INDICATOR
JUMPE TC,IN.12A ; SKIP OVER IF BLANK OR INVALID
JUMPE TD,IN.12B ; ERROR IF FIELD IS ALPHAMERIC
DPB TC,DA.FPL
IN.12A: MOVE TB,[BPNT 67,]
PUSHJ PP,IN.16
JUMPE TC,IN.12C ; SKIP IF BLANK
JUMPE TD,IN.12D ; INVALID IF ALPHAMERIC
DPB TC,DA.FMN
IN.12C: MOVE TB,[BPNT 69,]
PUSHJ PP,IN.16
JUMPE TC,IN.14
DPB TC,DA.FBZ
JRST IN.14
IN.12B: WARN 166;
JRST IN.12A
IN.12D: WARN 166;
JRST IN.12C
;IN.14 Get Sterling sign position
;
;
;
IFN STERLN,<
IN.14: MOVE TA,[POINT 7,CRDBUF+^D14]
MOVEI TB,4
PUSHJ PP,GETDCB ; GET POSITION
MOVE TA,CURDAT
LDB CH,[POINT 7,CRDBUF+^D14,27]; GET COL 74
CAIN CH,"S" ; STANDARD POSITION?
JRST IN.14A ; YES -
JUMPE TC,IN.15 ; NO - IF POSITION ZERO, IGNORE IT
;AT SOME LATER DATE, CHECK AGAINST HEADER CARD DATA
LDB TB,DA.CLI
LDB TD,DA.MAT
JUMPN TB,IN.14B ; CONTROL LEVEL INVALID
JUMPN TD,IN.14B ; MATCHING RECORD INVALID
MOVE TA,CURFIL
LDB TB,FI.RCL ; GET RECORD LENGTH
CAMLE TC,TB ; MAKE SURE STERLING POSITION FALLS WITHIN RECORD
JRST IN.14C ; IT DOESN'T
TSWF FARRY!FARRAY;
JRST IN.14D ; STERLING INVALID WITH ARRAY
MOVE TA,CURDAT
LDB TB,DA.FLD
CAIE TB,1
CAIN TB,2
JRST IN.14E ; STERLING INVALID WITH PACKED OR BINARY
TSWF FSPRED;
JRST IN.14F ; STERLING INVALID WITH SPREAD CARD
DPB TC,DA.STP
IN.14A: MOVEI TB,1
DPB TB,DA.STR
JRST IN.15
IN.14B: WARN 178;
JRST IN.15
IN.14C: WARN 176;
JRST IN.15
IN.14D: WARN 179;
JRST IN.15
IN.14E: WARN 328;
JRST IN.15
IN.14F: WARN 634;
JRST IN.15 > ;STERLN
IFE STERLN,<
IN.14: MOVE TB,[POINT 7,CRDBUF+^D14]
MOVEI TC,4
PUSHJ PP,BLNKCK ; IS ALL BLANK?
WARN 998; ; NO - ERROR
> ;IFE STERLN
;IN.15 Finish up here
;
;
;
IN.15: MOVE TA,CURDAT
TSWT FSPRED;
JRST IN.15A
MOVEI TB,1 ; MARK IT AS A TRAILER REC
DPB TB,DA.TRA
IN.15A: LDB TB,DA.FLD
CAIE TB,2 ; BINARY?
JRST IN.00 ; NO -
LDB TB,DA.CLI ; YES - GET CONTROL LEVEL INDICATOR
LDB TB,DA.MAT ; GET MATCHING INDICATOR
JUMPN TB,IN.15B ; ILLEGAL IF IT EXISTS
JUMPE TD,IN.00 ; SAME WITH THIS ONE
IN.15B: WARN 178;
JRST IN.00
;ROUTINE TO GET A FIELD INDICATOR
;
;THIS ROUTINE FETCHES AN INDICATOR OF THE FORM 01-99 OR H1-H9.
;
;ENTER WITH BYTE POINTER IN TB, EXIT WITH INDICATOR IN TC.
;IF INDICATOR WAS INVALID OR BLANK, ZERO IS RETURNED.
;
IN.16: LDB CH,TB
CAIN CH," " ; BLANK?
JRST IN.16A ; YES - FIRST CHAR AT LEAST
CAIN CH,"H" ; HALT INDICATOR?
JRST IN.16B ; LOOKS THAT WAY
CAIL CH,"0"
CAILE CH,"9"
JRST IN.16C ; INVALID DIGIT
MOVEI TC,-"0"(CH) ; CONVERT
IMULI TC,12 ; SHIIIIIIIIIIIIIIIIIFT
ILDB CH,TB ; GET NEXT DIGIT
IN.16E: CAIL CH,"0"
CAILE CH,"9"
JRST IN.16C ; INVALID DIGIT
ADDI TC,-"0"(CH)
JUMPE TC,IN.16C ; ALL ZEROES IS INVALID
POPJ PP, ; OK -
IN.16A: ILDB CH,TB
CAIE CH," " ; THIS ONE A SPACE TOO?
JRST IN.16C ; NO -
IN.16D: SETZ TC,
POPJ PP,
IN.16B: MOVEI TC,144 ; HALT INDICATOR OFFSET
ILDB CH,TB
CAIE CH,"0" ; NO "H0"
JRST IN.16E ; OK -
IN.16C: WARN 304;
JRST IN.16D
;TRANSFER CALCULATION STATMENTS INTO CALFIL FOR LATER PROCESSING
;
CA.00: PUSHJ PP,GETSRC ; SAME DAMN ROUTINE EVERY TIME
;ONE OF THESE DAYS MIGHT MAKE IT INTO A SUBROUTINE
TSWF FEOF;
JRST OUTSPC ; [274] no source left - no O specs given
SWON FREGCH;
PUSHJ PP,GETCRD
MOVE TB,FRMTYP
CALSP1: CAIE TB,"C"
JRST OUTSPC
MOVE TB,[POINT 7,CRDBUF] ; MOVE CARD IMAGE INTO CALFIL
MOVEI TC,^D80 ; MOVE 80 CHARS
CA.00B: ILDB CH,TB
PUSHJ PP,PUTCAL ; STUFF A CHARACTER
SOJN TC,CA.00B
MOVEI CH,12 ; GET A LINE FEED
PUSHJ PP,PUTCAL ; AND STUFF THAT TOO
JRST CA.00
NOTC: PUSHJ PP,IDNTYP
JRST OUTSPC
WARN 22;
JRST CA.00
;ENTRY POINT FROM INPUT SPECS
CALSPC: MOVE LN,SAVELN## ; GET LINE NUMBER
MOVEM LN,CALLIN## ; SAVE LINE NUMBER
JRST CALSP1
;ROUTINE TO PUT ONE CHARACTER INTO CALFIL
;
PUTCAL: SOSG CALBHO+2 ; ROOM IN CURRENT BUFFER?
JRST PUTCL2 ; NO - GO DUMP A BUFFER FULL
PUTCL1: IDPB CH,CALBHO+1 ; STUFF A CHAR
POPJ PP, ; AND RETURN
PUTCL2: OUT CAL, ; OUTPUT A BUFFER
JRST PUTCL1 ; ALLS WELL
MOVEI CH,CALDEV ; ERROR -
JRST DEVDED##
;HANDLE OUTPUT SPECIFICATIONS
OU.00: SWOFF FARRY!FARRAY!FLAG!FCON!FIMD; ; TURN OFF SOME FLAGS
PUSHJ PP,GETSRC
TSWF FEOF;
JRST FINC1
SWON FREGCH;
PUSHJ PP,GETCRD
OU.00A: MOVE TB,COMMNT
CAIN TB,"*"
JRST OU.00
MOVE TB,FRMTYP
CAIN TB,"O"
JRST OU.01
JRST NOTO
;MAINLINE ENTRY POINT
OUTSPC: MOVE TB,FRMTYP
CAIN TB,"O"
JRST OU.00A ; ALL OUT OF OUTPUT SPECS
NOTO: LDB TB,[POINT 14,CRDBUF,13] ; [314] get first two characters
CAIN TB,"//" ; [314] start of table stuff?
JRST FINC1 ; [314] yes -
PUSHJ PP,IDNTYP
JRST FINC1
WARN 22;
JRST OU.00
;FIND OUT WHETHER WE HAVE A RECORD OR FIELD DESCRIPTION
OU.01: MOVE TB,[BPNT 6,] ; [063]
MOVEI TC,^D16 ; [063] check filename thru skip entries for blanks
PUSHJ PP,BLNKCK
JRST OU.01A ; NOT BLANK
MOVEI TC,^D52
PUSHJ PP,BLNKCK ; PICK UP WHERE WE LEFT OFF
JRST OU.11 ; FIELD DESCRIPTION - GO PROCESS IT
JRST OU.00 ; IGNORE BLANK CARDS
OU.01A: MOVE TB,[BPNT 31,] ; [063]
MOVEI TC,^D38
PUSHJ PP,BLNKCK ; CHECK SOME MORE COLUMNS
JRST .+2 ; INVALID -
JRST OU.02 ; ALL OK- RECORD SPECIFICATION
WARN 142;
JRST OU.11 ; IGNORE GARBAGE
;HANDLE A CARD WITH DATA IN COLS. 7-31
OU.02: MOVE TA,[POINT 7,CRDBUF+1,6]
MOVE TB,[POINT 6,NAMWRD]
MOVEI TC,^D8
PUSHJ PP,CRDSIX ; PICK UP FILENAME
SKIPN NAMWRD ; ALL SPACES?
JRST OU.10 ; YES -
PUSHJ PP,TRYNAM ; LOOK UP IN NAMTAB
JRST OU.02A ; NOT THERE - ERROR
MOVEM TA,CURNAM
HRRZI TB,CD.FIL
MOVSS TA ; GET RELATIVE NAMTAB POINTER
PUSHJ PP,FNDLNK ; FIND FILTAB ENTRY
JRST OU.02A ; NONE - ERROR
MOVEM TB,CURFIL
SWON FMDFIL;
SETZM HIEND
OU.02B: MOVE TA,[XWD CD.DAT,SZ.DAT]
PUSHJ PP,GETENT ; GET A DATAB ENTRY
MOVEM TA,CURDAT
HRRZI TB,CD.DAT
DPB TB,[POINT 3,(TA),2] ; MAKE THE SECRET MARK UPON IT'S BODY
MOVEI TB,1 ; TELL WHO MADE IT
DPB TB,DA.FLS ; THE FILE SECTION!
;[342] MOVS TB,CURNAM
;[342] DPB TB,DA.NAM ; STORE NAMTAB LINK
MOVE TB,SAVELN ; GET LINE NUMBER
DPB TB,DA.LIN ; STASH
MOVE TA,CURFIL
LDB TB,FI.DAT ; GET FILES DATAB LINK
JUMPE TB,OU.02C ; JUMP IF NO PREVIOUS DATAB ITEM
OU.02D: MOVE TA,TB
PUSHJ PP,LNKSET ; CONVERT TO REAL CORE ADDRESS
LDB TB,DA.MAJ ; GET MAJOR LINK
JUMPE TB,OU.02E ; IF ZERO WE FOUND END OF CHAIN
JRST OU.02D ; LOOP -
OU.02A: WARN 92; ; INVALID FILENAME
JRST OU.00 ; GET ANOTHER CARD
;COME HERE IF NO PREVIOUS DATAB ITEM
OU.02C: MOVE TB,CURDAT ; CREATE POINTER TO DATAB ITEM
SUB TB,DATLOC
IORI TB,<CD.DAT>B20
DPB TB,FI.DAT ; STORE AS FIRST DATAB POINTER
JRST OU.03
;COME HERE IF NEW DATAB ITEM TO BE LINKED INTO "MAJOR" CHAIN
OU.02E: MOVE TB,CURDAT
SUB TB,DATLOC
IORI TB,<CD.DAT>B20
DPB TB,DA.MAJ ; STORE AS NEW MAJOR LINK
MOVEM TB,MAJLNK ; STORE FOR POSTERITY
;GET TYPE OF RECORD
OU.03: LDB CH,[BPNT 15,]
MOVEI TC,TYPTB1
PUSHJ PP,TABSCN ; LOOKUP IN TYPE TABLE
JRST OU.03A ; NOT FOUND
JRST @TYPTB2(TB) ; DISPATCH
OU.03A: WARN 143; ; INVALID TYPE ENTRY
SETZ TB, ; ASSUME HEADER
OU.03B: MOVE TA,CURDAT
DPB TB,DA.ORT ; STORE TYPE
JRST OU.04
OU.03C: MOVE TA,CURFIL ; SEE IF TYPE COMPATIBLE WITH FILE TYPE
LDB TC,FI.TYP
CAIE TC,3
JRST OU.03B ; ALL OK-
WARN 285;
JRST OU.03A+1
;TABLE OF VALID TYPES
TYPTB1: "H" ; HEADER
"D" ; DETAIL
"T" ; TOTAL
"E" ; EXCEPTION
Z
;DISPACTH TABLE FOR TYPTB1
TYPTB2: EXP OU.03B
EXP OU.03B
EXP OU.03C
EXP OU.03C
;CHECK FOR "ADD"
OU.04: LDB TB,[POINT 21,CRDBUF+3,20]
CAME TB,["ADD"] ; is it ADD ?
JRST OU.04A ; no -
MOVE TA,CURFIL
LDB TB,FI.ADD
JUMPE TB,OU.04B ; NOT AN ADD FILE
OU.04D: MOVE TA,CURDAT
MOVEI TB,1
DPB TB,DA.ARC
PUSHJ PP,OU.07 ; [371] GET SKIP ENTRIES
JRST OU.08 ; [371] AND CONTINUE
OU.04A:
; MOVE TA,CURFIL ; SEE IF WE SHOULD HAVE HAD A ADD
; LDB TB,FI.ADD
; JUMPE TB,OU.05 ; NO -
; WARN 397; ; YES - GIVE HIM AN ERROR
; JRST OU.04D ; ASSUME "ADD"
JRST OU.05 ; just ignore error check for now
OU.04B: WARN 555; ; add is not legal
PUSHJ PP,OU.07 ; [371] GET SKIP ENTRIES
JRST OU.08 ; [371] THEN CONTINUE WITH LIFE
;OU.05 Get Stacker Select if not an ADD record
;
;
;
OU.05: LDB CH,[BPNT 16,]
MOVEI TC,SSTAB1
PUSHJ PP,TABSCN ; LOOKUP ENTRY IN TABLE
JRST OU.05A ; INVALID ENTRY
JRST @SSTAB2(TB) ; DISPATCH TO APPROPRIATE ROUTINE
OU.05B: MOVE TA,CURFIL ; ENTRY FOR 1-4
LDB TC,FI.DEV ; SEE IF A CARD DEVICE
CAIE TC,1
JUMPN TC,OU.05C ; NO - ERROR
LDB TC,FI.TYP ; YES - NOW MAKE SURE IS CORRECT FILE TYPE
CAIE TC,1
CAIN TC,3
JRST OU.05D ; INVALID
OU.05C: WARN 256; ; (.25K ?)
JRST OU.06 ; IGNORE ENTRY
OU.05D: MOVE TA,CURDAT
DPB TB,DA.STS ; STORE STACKER SELECT
JRST OU.06
OU.05A: WARN 257; ; INVALID ENTRY
JRST OU.06
OU.05E: MOVE TA,CURFIL ; ENTRY FOR F
LDB TC,FI.DEV ; MAKE SURE VALID DEVICE
CAIE TC,3
CAIN TC,4
JRST OU.05F ; OK -
WARN 261 ; INVALID DEVICE
JRST OU.06 ; IGNORE ENTRY
OU.05F: MOVE TA,CURDAT
DPB TB,DA.FOV ; STORE "FORCE OVERFLOW"
JRST OU.06
;OU.05 (cont'd) Valid Stacker Select entries
;
;
;
SSTAB1: " "
"1"
"2"
"3"
"4"
"F"
Z
;Dispatch Table
;
;
;
SSTAB2: EXP OU.06 ; IGNORE SPACES
EXP OU.05B
EXP OU.05B
EXP OU.05B
EXP OU.05B
EXP OU.05E
;OU.06 Get Space and Skip, Before and After Entries
;
;
;
OU.06: PUSHJ PP,.GTSPC ; [357] get entries and setup DATAB entries
JRST OU.08 ; [357] continue elsewhere
;.GTSPC Get space before and after entries, if not ADD record
;
;
;
.GTSPC: LDB CH,[BPNT (17)] ; [357] get space before entry
MOVE TA,CURFIL
LDB TB,FI.DEV
MOVE TA,CURDAT
CAIN CH," " ; SPACE?
JRST OU.06A ; YES -
CAIL TB,.FILPT## ; [273] printer?
CAILE TB,.FITTY## ; [273] no - console?
JRST OU.06B ; INVALID DEVICE
CAIL CH,"0"
CAILE CH,"3"
JRST OU.06C ; INVALID CHARACTER
MOVEI TC,-"0"(CH)
DPB TC,DA.SPB ; STORE SPACE BEFORE
OU.06A: LDB CH,[BPNT 18,] ; GET SPACE AFTER
CAIL TB,.FILPT ; [273] printer?
CAILE TB,.FITTY ; [273] console?
CAIN CH," " ; [273] no - a space?
TRNA ; [273] either a space or printer/console
JRST OU.06B ; [273] error - no space on non-printer/console
MOVEI TC,1 ; [273] all kool so far - get default space
CAIN CH," " ; [273] is it space (ie use default)?
JRST OU.06D ; [273] yes - then do so
CAIL CH,"0"
CAILE CH,"3"
JRST OU.06C ; INVALID CHARACTER
MOVEI TC,-"0"(CH)
OU.06D: DPB TC,DA.SPA ; [273] store space after entry
JRST OU.07
OU.06B: WARN 258;
JRST OU.07
OU.06C: WARN 260;
CAIL TB,.FILPT ; [273] printer?
CAILE TB,.FITTY ; [273] no - console?
JRST OU.07 ; DON'T MAKE IT WORSE
MOVEI TC,1 ; DEFAULT TO 1
DPB TC,DA.SPA
;OU.07 Get Skip Entries
;
;
;
OU.07: MOVE TA,CURFIL
LDB TB,FI.DEV
MOVEI LN,SKTAB1
OU.07H: LDB CH,(LN) ; GET A CHARACTER
AOJ LN, ; INCREMENT INDEX
SETZ TC, ; ZAP OUR SUM
CAIN CH," "
JRST OU.07A ; JUST A LITTLE 'OL SPACE
CAIN CH,"A"
JRST OU.07B
CAIN CH,"B"
JRST OU.07C
CAIL CH,"0"
CAILE CH,"9" ; [066] IS IT TOO LARGE?
JRST OU.07D ; [044] INVALID DIGIT
MOVEI TC,-"0"(CH)
IMULI TC,12
OU.07E: LDB CH,(LN)
AOJ LN,
CAIL CH,"0"
CAILE CH,"9"
JRST OU.07D ; INVALID DIGIT
ADDI TC,-"0"(CH)
JUMPE TC,OU.07D ; ZERO IS INVALID
CAIL TB,3
CAILE TB,5
JRST OU.07F ; INVALID DEVICE
LDB TD,FI.LPP ; GET LINES PER PAGE
CAIGE TD,TC
JRST OU.07D ; CAN'T SKIP OFF PAGE!
MOVE TA,CURDAT
TSWFZ FLAG; ; SECOND PASS?
POPJ PP, ; YES - EXIT
DPB TC,DA.SKB ; NO - STORE SKIP BEFORE
JRST OU.07G ; GO GET SKIP AFTER
;OU.07 (cont'd)
;
;
;
OU.07A: LDB CH,(LN)
AOJ LN,
CAIE CH," " ; SECOND CHAR MUST BE SPACE ALSO
JRST OU.07E+2 ; IT'S NOT - MAYBE A DIGIT
JRST OU.07G ; IT WAS -
OU.07B: MOVEI TC,^D100
JRST OU.07E
OU.07C: MOVEI TC,^D110
JRST OU.07E
OU.07D: WARN 259; ; INVALID ENTRY
SETZ TC,
JRST OU.07G
OU.07F: WARN 258; ; INVALID DEVICE
SETZ TC,
OU.07G: TSWFZ FLAG; ; STILL ON SECOND PASS?
POPJ PP, ; NOT ANY MORE -
SWON FLAG; ; BUT WE ARE NOW!
MOVE TA,CURFIL
PUSHJ PP,OU.07H
MOVE TA,CURDAT ; THIS IS VERY VITAL, DON'T FORGET IT AGAIN
DPB TC,DA.SKA ; STORE SKIP AFTER
POPJ PP, ; [357] exit
;TABLE OF BYTE POINTERS TO SKIP ENTRIES
SKTAB1: BPNT 19;
BPNT 20;
BPNT 21;
BPNT 22;
;OU.08 Get Output Indicators
;
;
;
OU.08: PUSHJ PP,GETIND ; GET THOSE INDICATORS
SUB TA,INDLOC ; MAKE OURSELVES A POINTER
IORI TA,<CD.IND>B20
MOVE TB,TA
MOVE TA,CURDAT
DPB TB,DA.IND ; STORE INDTAB POINTER
LDB TB,DA.SPB ; [357] get space before
LDB TC,DA.SKB ; [357] get skip before
LDB TD,DA.SPA ; [357] get space after
LDB TE,DA.SKA ; [357] get skip after
MOVE TA,CURIND ; [357] get INDTAB link back
DPB TB,ID.SPB## ; [357] store space before
DPB TC,ID.SKB## ; [357] store skip before
DPB TD,ID.SPA## ; [357] store space after
DPB TE,ID.SKA## ; [357] store skip after
PUSHJ PP,GETIND ; [357] get another INDTAB entry
PUSHJ PP,OU.09 ; GET SOME INDICATORS
SKIPN @CURIND
JRST OU.08A ; INDICATORS MISSING
OU.08B: MOVE TA,CURIND
MOVEI TB,1
DPB TB,[POINT 1,(TA),22] ; MARK END
JRST OU.00 ; ALL DONE HERE
OU.08A: WARN 273; ; INDICATORS MISSING
JRST OU.08B ; STORE BLANK POINTER ANYWAY
;SUBROUTINE TO GET OUTPUT INDICATORS
;
OU.09: SETZB LN,TE
SWOFF FLAG; ; TURN ME OFF, DEAD MAN
OU.09F: LDB CH,INDTB1(LN)
MOVE TA,CURIND
CAIL CH,"0"
CAILE CH,"9"
JRST OU.09A ; NOT A DIGIT
MOVEI TC,-"0"(CH)
IMULI TC,12
LDB CH,INDTB2(LN) ; GET ANOTHER CHAR
CAIN CH,"P" ; 1P?
JRST OU.09G ; COULD BE
OU.09C: CAIL CH,"0"
CAILE CH,"9"
JRST OU.09B ; INVALID INDICATOR
ADDI TC,-"0"(CH)
JUMPE TC,OU.09B ; ZERO IS INVALID TOO
OU.09H: TSWFS FLAG; ; SKIP IF FIRST TIME
PUSHJ PP,GETIND ; GET ANOTHER INDATB ENTRY
DPB TC,[POINT 8,(TA),9] ; STORE IN INDTAB
LDB CH,INDTB3(LN) ; GET NOT COLUMN
CAIN CH," " ; BLANK?
JRST OU.09D ; YES -
CAIE CH,"N" ; NOT?
JRST OU.09E ; INVALID NOT ENTRY
MOVEI TC,1 ; [005] YES -
DPB TC,[POINT 1,(TA),1] ; STASH IN INDTAB
OU.09D: AOJ LN, ; BUMP INDEX
CAIN LN,3 ; ALL DONE?
POPJ PP, ; YEP-
JRST OU.09F ; AND LOOP ON BACK
OU.09B: CAIN CH," " ; SPACE ?
JRST OU.09N ; YES - SEE IF NEXT CHAR A SPACE TOO
WARN 304; ; INVALID INDICATOR
JRST OU.09D ; LOOP
OU.09E: WARN 147; ; INVALID NOT
JRST OU.09D-2 ; [005]
OU.09G: CAIE TC,12 ; CHECK OUT A POSSIBLE 1P
JRST OU.09B ; [005] NOPE
MOVEI TC,212 ; YES -
MOVE TA,CURDAT ; CHECK TO BE SURE IT'S COMPATIBLE WITH RECORD TYPE
LDB TB,DA.ORT
MOVE TA,CURIND
CAIG TB,1 ; IS OK?
JRST OU.09H ; IS OK!
WARN 265; ; NOT OK -
JRST OU.09D ; BUMP
;COME HERE ON NON-NUMERIC INDICATOR
OU.09A: MOVEI TC,INDTB4 ;SET UP FOR TABLE SEARCH
PUSHJ PP,TABSCN ; AND DO IT
JRST OU.09B ; INVALID
LDB CH,INDTB2(LN) ; GET NEXT CHARACTER
MOVE TA,CURIND
JRST @INDTB5(TB)
OU.09I: CAIN CH,"R" ; "L"
JRST O.09I1 ; IS LR
CAIE CH,"0" ; L0?
JRST OU.09P ; NO -
MOVEI TC,211 ; YES -
JRST OU.09H
O.09I1: MOVEI TC,166 ; IS LR
JRST OU.09H
OU.09J: CAIE CH,"0" ; "H"
JRST OU.09P ; ALL OK
JRST OU.09B ; IS NO H0
OU.09K: CAIL CH,"1" ; "U"
CAILE CH,"8" ; IS ON U1-U8
JRST OU.09B ; NOT VALID.
JRST OU.09P ; OK
OU.09L: MOVEI TC,INDTB6 ; "O"
PUSHJ PP,TABSCN ; SCAN FOR SECOND CHAR
JRST OU.09B ; INVALID ENTRY
MOVEI TC,167(TB) ; [034] ADD IN VALUE OF OA
JRST OU.09H
OU.09M: CAIE CH,"R" ; "M"
JRST OU.09B ; MR IS ONLY VALID ONE
MOVEI TC,210
JRST OU.09H
OU.09N: LDB CH,INDTB2(LN)
CAIN CH," " ; THIS ONE A SPACE TOO?
JRST OU.09D ; YES - IS BLANK INDICATOR
WARN 304; ; NO - INVALID
JRST OU.09D ; LOOP -
OU.09P: MOVE TC,INDTB7(TB) ; GET BASE
JRST OU.09C ; GO GET REMAINDER
;OUTPUT INDICATOR TABLES
;
;
;TABLE OF POINTERS TO FIRST CHAR OF OUTPUT INDICATOR
;
INDTB1: BPNT 24,
BPNT 27,
BPNT 30,
;
;TABLE OF POINTERS TO SECOND CHAR OF OUPUT INDICATOR
;
INDTB2: BPNT 25,
BPNT 28,
BPNT 31,
;
;TABLE OF POINTERS TO NOT ENTRIES
;
INDTB3: BPNT 23,
BPNT 26,
BPNT 29,
;
;TABLE OF VALID FIRST CHARACTERS FOR OUTPUT INDICATORS
;
INDTB4: "L"
"H"
"U"
"O"
"M"
Z
;
;TABLE OF DISPATCHES FOR INDTB4
;
INDTB5: EXP OU.09I
EXP OU.09J
EXP OU.09K
EXP OU.09L
EXP OU.09M
;
;TABLE OF VALID SECOND CHARACTERS FOR OVERFLOW INDICATORS
;
INDTB6: "A"
"B"
"C"
"D"
"E"
"F"
"G"
"V"
Z
;
;TABLE OF INDICATOR BASES (CORRESPONDS TO INDTB4)
;
INDTB7: OCT 154 ; L1 - 1
OCT 143 ; H1 - 1
OCT 212 ; U1 - 1
OCT 0 ;
OCT 176 ; M1 - 1
;
;THTHTHTHTHAAAAAAAT'S ALL FOLKS!!
;
;OU.10 Handle a card with columns 7-13 blank
;
;
OU.10: MOVE TA,[BPNT 13,] ; [062] GET POINTER
MOVE TB,[POINT 6,TD]
MOVEI TC,3
SETZ TD, ; SET TO SPACES
PUSHJ PP,CRDSIX
SETZ TC,
CAMN TD,[SIXBIT /OR /] ; [062]
JRST OU.10A
CAMN TD,[SIXBIT /AND/] ; [005]
JRST OU.10B ; [005]
TLNE TD,770000 ; [062] IS FILENAME ALL SPACES?
JRST OU.02A ; NO - ERROR
JRST OU.02B ; YES - MUST BE ANOTHER MAJOR ITEM
OU.10B: PUSH PP,TC ; [347] save AND/OR flag
MOVE TB,[BPNT (22)] ; [347] get start of indicators
MOVEI TC,^D9 ; [347] there are 9 columns of them
PUSHJ PP,BLNKCK ; [347] are they blank?
TRNA ; [347] no - ok
JRST OU.10C ; [347] yes - illegal with AND/OR
SETZ TB,
MOVE TA,CURIND
DPB TB,ID.END## ; zap end o'line flag
PUSHJ PP,GETIND ; GET AN INDTAB ENTRY
POP PP,TC ; [347] restore AND/OR flag
DPB TC,ID.OR## ; [347] and store it where it belongs
JUMPN TC,[ MOVE TB,[BPNT (16)] ; [357] get pointer to space/skip entries
MOVEI TC,^D6 ; [357] get column count
PUSHJ PP,BLNKCK ; [357] are columns blank?
PUSHJ PP,.GTSPC ; [357] no - set up DATAB entries
MOVE TA,CURDAT ; [357] get DATAB pointer
LDB TB,DA.SPB ; [357] get space before
LDB TC,DA.SKB ; [357] get skip before
LDB TD,DA.SPA ; [357] get space after
LDB TE,DA.SKA ; [357] get skip after
MOVE TA,CURIND ; [357] get INDTAB pointer back
DPB TB,ID.SPB ; [357] store space before
DPB TC,ID.SKB ; [357] store skip before
DPB TD,ID.SPA ; [357] store space after
DPB TE,ID.SKA ; [357] store skip after
PUSHJ PP,GETIND ; [357] get another INDTAB entry
JRST .+1 ] ; [357] return to mainline
PUSHJ PP,OU.09 ; GET SOME INDICATORS
MOVE TA,CURIND
MOVEI TB,1
DPB TB,ID.END ; flag end of entry
JRST OU.00
OU.10A: MOVEI TC,1 ; SET "OR" FLAG
JRST OU.10B
OU.10C: POP PP,(PP) ; [347] clean AND/OR flag off stack
WARN 274; ; [347] illegal format
JRST OU.00 ; [347] ignore the card
;HANDLE A DATA FIELD
OU.11: SETZM NAMWRD+1 ; [011]
MOVE TA,[POINT 7,CRDBUF+6,6]
MOVE TB,[POINT 6,NAMWRD]
MOVEI TC,6
PUSHJ PP,CRDSIX ; GET FIELD NAME
SKIPN NAMWRD ; ALL SPACES?
JRST OU.21 ; YES - SHOULD BE CONSTANT
MOVE TB,NAMWRD ; NO - CHECK FOR RESERVED WORDS
CAMN TB,[SIXBIT /*PLACE/] ; SUCH AS "*PLACE"
JRST OU.14 ; THATS IT ALL RIGHT
CAMN TB,[SIXBIT /*PRINT/] ; IS IT "*PRINT"
JRST OU.11A ; SHO'NUFF
PUSHJ PP,NMVRFY ; [244] verify name validity
WARN 148; ; [244] error - not valid
MOVE TB,[POINT 6,NAMWRD] ; CHECK FOR ARRAY ENTRY
SETZB TC,ARRENT
OU.11B: MOVE TE,TB
ILDB CH,TB ; GET A CHARACTER
CAIN CH,',' ; IS IT A COMMA?
JRST OU.11C ; YEP - GO GET ENTRY
TLNE TB,770000 ; NO - ARE WE AT END OF NAMWRD?
JRST OU.11B ; NO - LOOP
JRST OU.11D ; YES - STANDARD FIELD
OU.11C: ILDB CH,TB ; PICK UP AN INDEX DIGIT
CAIL CH,'0'
CAILE CH,'9'
JRST OU.11E ; INVALID OR SPACE
IMULI TC,12 ; SHIFT OUR SUM
ADDI TC,-'0'(CH) ; ADD IN NEW DIGIT
TLNE TB,770000 ; WE AT END?
JRST OU.11C ; NO - LOOP
OU.11F: SWON FARRAY!FIMD; ; YES - TELL THE WORLD WE ARE AN ARRAY
MOVEM TC,ARRENT
JRST OU.11D ; GO SET UP DATAB ENTRY
OU.11E: CAIE CH,' ' ; INVALID CHAR A SPACE?
JRST OU.11M ; NO - ERROR
JUMPE TC,OU.11A ; YES - BUT ZERO ENTRY INVALID
JRST OU.11F ; ALL'S COOL
;SET UP DATAB ITEM
OU.11D: TSWT FARRAY!FARRY; ; array of some sort?
JRST OU11D1 ; no -
MOVE TE,[POINT 6,NAMWRD] ; yes - we must zap index
SETZ TD, ; get a sixbit space ready
ILDB CH,TE ; get a character
CAIE CH,',' ; comma?
JRST .-2 ; No - loop
DPB TD,TE ; yes - zap the comma
IDPB TD,TE ; zap a character
TLNE TE,770000 ; all done?
JRST .-2 ; no - loop
OU11D1: PUSHJ PP,TRYNAM ; LOOKUP NAME
PUSHJ PP,BLDNAM ; NOT FOUND - PUT IT THERE
MOVEM TA,CURNAM ; STORE POINTER
;ENTRY POINT FOR CONSTANT LINE
OU.11L: MOVE TA,[XWD CD.DAT,SZ.DAT]
PUSHJ PP,GETENT ; GET A DATAB ENTRY
MOVE TB,TA ; PLAY WITH POINTERS
SUB TB,DATLOC ; MAKE A RELATIVE TABLE POINTER
IORI TB,<CD.DAT>B20
HRLZ TD,CURDAT ; SET UP TO TRANSFER THE VITALS
HRR TD,TA
BLT TD,3(TA) ; BLIIIIIIIIIIIITTTTT!
SETZ TD,
DPB TD,DA.NAM ; ZAP NAMTAB POINTER
DPB TD,DA.BRO ; ZAP BROTHER LINK
DPB TD,DA.VAL ; ZAP VALTAB LINK
DPB TD,DA.IND ; ZAP INDTAB LINK
DPB TD,DA.OCC ; [301] zap number of occurs
LDB TE,DA.SIZ ; [374] get the size
MOVEM TE,INSIZ ; [374] save for possible later use
DPB TD,DA.SIZ ; [301] zap size
DPB TD,DA.FLD ; [301] zap field type
MOVEI TD,1 ; get a flag
DPB TD,DA.FLS ; and flag as file section
MOVE TD,SAVELN ; GET LINE NUMBER
DPB TD,DA.LIN ; SAVE FOR PHASE E
EXCH TA,CURDAT ; OLD POINTER INTO TA, NEW POINTER INTO CURDAT
DPB TB,DA.BRO ; STORE AS BROTHER (MINOR) LINK
TSWF FCON; ; ARE WE ON A CONSTANT LINE?
POPJ PP, ; YES - GET THE HELL OUT OF HERE
HRRZI TB,CD.DAT ; NO - SET UP TO LOOKUP NAMTAB LINK
MOVS TA,CURNAM ; GET RELATIVE NAMTAB LINK
PUSHJ PP,FNDLNK ; SEE IF OTHERS HAVE SAME NAME
;(JOHN JACOB JINGLEHEIMER SMITH - THAT'S MY NAME TOO!)
JRST OU.11G ; NOT PREVIOUSLY USED
TSWT FARRAY; ; USED BEFORE - IS THIS AN ARRAY?
JRST OU.11H ; NO -
MOVE TA,TB ; YES -
OU11L1: MOVE TC,TA ; SET UP FOR POINTER MAKE
SUB TC,DATLOC ; SUBTRACT BASE
IORI TC,<CD.DAT>B20 ; SAY WHO IT IS
MOVEM TC,ARRPNT ; STASH
LDB TC,DA.SIZ ; GET SIZE OF FIELD
MOVEM TC,INSIZ ; STORE FOR LATER
LDB TC,DA.OCC ; GET NUMBER OF OCCURANCES
JUMPE TC,OU.11A ; ZERO - NOT A VERY LARGE ARRAY
MOVEM TC,INOCC ; STORE THIS FOR LATER TOO
TSWF FIMD;
CAML TC,ARRENT ; ARRAY LARGER THAN INDEX?
JRST OU.11I ; YEP -
WARN 300; ; NO -
JRST OU.00 ; IGNORE REST OF CARD
OU.11H: MOVE TA,TB
LDB TC,DA.OCC ; GET NUMBER OF OCCURANCES
JUMPE TC,OU.11I ; NOT A TABLE
SWON FARRY; ; EITHER A TABLE OR ENTIRE ARRAY
JRST OU11L1 ; CONTINUE ELSEWHERE
OU.11M: SKIPA TE,[POINT 6,TD] ; PLACE TO PUT IT
ILDB CH,TB ; GET A CHARACTER
CAIN CH,' ' ; IS IT A SPACE
JRST OU.11N ; YES -
IDPB CH,TE ; NO - DEPOSIT
TLNE TB,770000 ; DONE ?
JRST OU.11M+1 ; NO - LOOP
OU.11N: PUSH PP,NAMWRD ; STASH FOR SAFE KEEPING
MOVEM TD,NAMWRD ; GET NEW ONE
PUSHJ PP,TRYNAM ; IS IT IN NAMTAB?
PUSHJ PP,BLDNAM ; NO - PUT IT THERE
MOVEM TA,CURNAM ; STORE FOR LATER
POP PP,NAMWRD ; RECOVER THE ORIGINAL
HRRZI TB,CD.DAT ; SAY WHERE TO SEARCH
MOVS TA,CURNAM ; GET WHAT TO SEARCH FOR
PUSHJ PP,FNDLNK ; LOOK FOR LINK
JRST OU.11P ; NOT FOUND -
MOVE TA,TB ; GET INTO PROPER AC
OU.11Q: SUB TA,DATLOC ; SUBTRACT BASE
IORI TA,<CD.DAT>B20 ; SAY WHO WE ARE
MOVEM TA,ARRENT ; STASH
SWOFF FIMD; ; MAKE CERTAIN WE DON'T GET SCREWED
SWON FARRAY; ; SAY WHAT WE ARE
JRST OU.11D ; EXIT
OU.11P: MOVE TA,[XWD CD.DAT,SZ.DAT] ; SET UP FOR THE BIG MAKE
PUSHJ PP,GETENT ; GET ONE
MOVEI TB,1 ; SAY WE DON'T KNOW NOTHIN
DPB TB,DA.NDF ; RIGHT THERE
MOVE TB,SAVELN ; GET LINE NUMBER
DPB TB,DA.LIN ; SAVE IT
MOVS TB,CURNAM ; get current NAMTAB pointer
DPB TB,DA.NAM ; stash
JRST OU.11Q ; GO FINISH UP
;ENTER AT OU.11I
MOVE TA,TB
PUSHJ PP,LNKSET
OU.11I: LDB TB,DA.SNM
JUMPN TB,OU.11I-2
MOVE TC,CURDAT ; SET UP RELATIVE POINTER FOR SNM LINK
SUB TC,DATLOC
IORI TC,<CD.DAT>B20
DPB TC,DA.SNM ; STORE LINK
OU.11J: MOVE TA,CURDAT ; GET CURRENT POINTER
MOVS TB,CURNAM
DPB TB,DA.NAM ; STORE NAMTAB POINTER
MOVE TC,ARRENT
TSWT FARRAY; ; AN ARRAY ENTRY?
JRST OU.11K ; NO -
MOVEI TD,1
DPB TD,DA.ARE ; FLAG IT AS SUCH
OU.11K: DPB TC,DA.INP ; STORE ENTRY OR NUMBER OF OCCURANCES AS THE CASE MAY BE
MOVE TC,ARRPNT ; GET POINTER
DPB TC,DA.ARP ; STASH
TSWF FIMD; ; IMMEDIATE?
DPB TD,DA.IMD ; YES - FLAG IT
TSWT FARRY; ; whole array/table?
JRST OU.15 ; no -
MOVE TC,INOCC ; yes - get number of occurances
DPB TC,DA.OCC ; save it
MOVE TC,INSIZ ; get size of field
DPB TC,DA.SIZ ; save it
HLRZ TC,NAMWRD ; get the name of the monster
CAIE TC,'TAB' ; is it a table
JRST OU.15 ; no -
MOVEI TC,1 ; yes - get a flag
DPB TC,DA.TAB## ; and save the table flag
JRST OU.15
OU.11G: TSWT FARRAY;
JRST OU.11J
OU.11A: WARN 148;
JRST OU.00
REPEAT 0,<
;HANDLE *PRINT
OU.12: MOVE TA,CURFIL
LDB TB,FI.DEV
CAIL TB,3
JRST OU.12B ; *PRINT ONLY VALID ON CARDS
MOVE TA,MAJLNK ; GET MAJOR LINK
MOVEI TB,1
PUSHJ PP,LNKSET ; CONVERT TO REAL LINK
LDB TB,DA.BRO ; GET BROTHER LINK
JUMPE TB,OU.12C ; ERROR IF ZERO - MEANS NO FIELDS DEFINED SO FAR
OU.12A: LDB TA,DA.BRO ; GET BROTHER LINK
JUMPE TA,OU.00 ; ALL DONE IF ZERO
PUSHJ PP,LNKSET ; NOT ZERO, TURN LINK INTO POINTER
MOVEI TB,1
DPB TB,DA.PRI ; STORE "PUNCH AND PRINT"
JRST OU.12A ; LOOP -
OU.12B: WARN 280;
JRST OU.00
OU.12C: WARN 289;
JRST OU.00
>
;HANDLE *PLACE
OU.14: MOVE TA,[BPNT 39,]
MOVE TB,4
PUSHJ PP,GETDCB ; GET END COLUMN
JUMPE TC,OU.14A ; INVALID END COLUMN
SETZ TC,
LDB CH,[BPNT 40,]
CAIN CH,"*"
MOVEI TE,1 ; PRINT!
MOVE TA,CURFIL
LDB TB,FI.RCL ; GET RECORD LENGTH
CAMLE TC,TB
JRST OU.14H
MOVE TB,HIEND ; GET HIGHEST PREVIOUS END
LSH TB,1 ; TIMES 2
CAIG TC,^D256 ; END > 256?
CAMGE TC,TB ; END < HIEND*2?
JRST OU.14B ; YES - ERROR
SUB TC,HIEND ; SUBTRACT HIGHEST CURRENT LOC
MOVEM TC,PLCBAS ; STORE FOR LATER
MOVE TB,[BPNT 22,]
MOVEI TC,^D9
PUSHJ PP,BLNKCK ; MAKE SURE NO INDICATORS
JRST OU.14C ; ERROR IF THERE ARE
MOVE TA,MAJLNK
PUSHJ PP,LNKSET
LDB TB,DA.BRO
JUMPE TB,OU.14D ; NO PREVIOUS FIELDS
OU.14E: LDB TA,DA.BRO ; GET BROTHER LINK
JUMPE TA,OU.00 ; IF ZERO WE'RE ALL DONE
PUSHJ PP,LNKSET
LDB TB,DA.END
CAMLE TB,HIEND
JRST OU.14E ; IGNORE IF > HIEND
MOVEM TA,HLDLNK
OU.14G: LDB TB,DA.SNM
JUMPE TB,OU.14F ; AT END OF SNM CHAIN
MOVE TA,TB
PUSHJ PP,LNKSET
JRST OU.14G
OU.14F: PUSH PP,TA ; STORE TA SO WE CAN GET A DATAB ENTRY
MOVE TA,[XWD CD.DAT,SZ.DAT]
PUSHJ PP,GETENT
MOVEM TA,CURDAT
MOVE TB,SAVELN ; GET LINE NUMBER
DPB TB,DA.LIN ; SAVE
POP PP,TA ; RESTORE TA
MOVE TB,CURDAT
SUB TB,DATLOC ; MAKE A LINK
IORI TB,<CD.DAT>B20
DPB TB,DA.SNM
MOVE TA,CURDAT
HRLZ TB,HLDLNK
HRR TB,CURDAT
BLT TB,SZ.DAT(TA) ; BLIT.
LDB TB,DA.END
ADD TB,PLCBAS
DPB TB,DA.END ; UPDATE END POSITION
JUMPN TE,OU.14E ; LOOP IF PRIN
SETZ TB,
DPB TB,DA.PRI ; ZAP PRINT FLAGS
DPB TB,DA.PRO
JRST OU.14E ; LOOP -
OU.14A: WARN 151;
JRST OU.00
OU.14B: WARN 597;
JRST OU.00
OU.14C: WARN 596;
JRST OU.00
OU.14D: WARN 290;
JRST OU.00
OU.14H: WARN 271;
JRST OU.00
;OU.15 Get end position
;
;
;
OU.15: MOVE TA,[BPNT 39,]
MOVEI TB,4
PUSHJ PP,GETDCB ; GET END ENTRY
JUMPE TC,OU.15A ; ALL ZERO IS INVALID
MOVE TA,CURFIL
LDB TB,FI.RCL ; GET RECORD LENGTH
CAMLE TC,TB ; END POSITION WITHIN RECORD?
JRST OU.15B ; NO - ERROR
TSWT FARRY ; IS THIS AN ARRAY OR TABLE?
JRST OU.15E ; NO -
MOVE TA,CURDAT ; get DATAB pointer
LDB TB,DA.NAM ; get NAMTAB link
ADD TB,NAMLOC## ; set up
HLRZ TB,1(TB) ; get first three characters
CAIN TB,'TAB' ; is it a table?
JRST OU.15C ; yes - ok
MOVE TB,INOCC ; GET NUMBER OF OCCURANCES
IMUL TB,INSIZ ; TIMES SIZE OF EACH FIELD
CAMGE TC,TB ; AND SHOULD FIT WITHIN END POSITION
JRST OU.15D ; IT DOESN'T -
JRST OU.15C
OU.15E: CAMLE TC,INSIZ ; [374] do we have enough room?
SKIPA ; [374] yes -
JRST OU.15D ; [374] no - error
OU.15C: MOVE TA,CURDAT
DPB TC,DA.END ; STASH END POSITION
SETZ TB,
LDB CH,[BPNT 40,] ; GET PRINT COLUMN
CAIN CH,"*" ; A STAR?
MOVEI TB,1 ; YES - MARK AS A PRINTER
DPB TB,DA.PRO
CAMGE TC,HIEND ; NEW END > OLD ?
MOVEM TC,HIEND ; YES - UPDATE OLD
JRST OU.16 ; NO - EXIT
OU.15A: WARN 151;
MOVEI TC,1 ; DEFAULT TO COL 1
JRST OU.15C
OU.15B: WARN 270;
MOVE TC,TB
JRST OU.15C
OU.15D: WARN 272;
MOVE TC,TB
JRST OU.15C
;OU.16 Get packed/binary entry
;
;
;
OU.16: LDB CH,[BPNT 44,]
MOVEI TC,PBTAB ; USE A TABLE FROM WAY BACK
PUSHJ PP,TABSCN
JRST OU.16A ; INVALID
DPB TB,DA.FLD ; STORE
JRST OU.17
OU.16A: WARN 152;
MOVEI CH," " ; DEFAULT TO UNPACKED
JRST OU.16+1
;GET EDIT CODE
OU.17: LDB CH,[POINT 7,CRDBUF+7,20]
CAIN CH," " ; A SPACE?
JRST OU.18 ; YES - OK
LDB TB,DA.FLD ; GET FIELD TYPE
CAIE TB,3
JRST OU.17A ; INVALID FIELD TYPE
MOVEI TC,EDTAB
PUSHJ PP,TABSCN ; LOOKUP CODE
JRST OU.17B ; NOT FOUND - ERROR
TSWF FCON; ; ON CONSTANT LINE
JRST OU.17C ; YES - ERROR
DPB TB,DA.EDT ; NO - STORE CODE
JRST OU.18
OU.17A: WARN 278;
JRST OU.18
OU.17B: WARN 276;
JRST OU.18
OU.17C: WARN 282;
JRST OU.18
;
;TABLE OF VALID EDIT CODES
;
EDTAB: " "
"1"
"2"
"3"
"4"
"A"
"B"
"C"
"D"
"J"
"K"
"L"
"M"
"X"
"Y"
"Z"
Z
;GET "BLANK AFTER" ENTRY
OU.18: LDB CH,[POINT 7,CRDBUF+7,27]
CAIN CH," "
JRST OU.19 ; THE SIMPLE WAY OUT
CAIE CH,"B"
JRST OU.18A ; INVALID ENTRY
TSWF FCON; ; CONSTANT LINE?
JRST OU.18B ; YES - ERROR
MOVEI TB,1
DPB TB,DA.BLA
JRST OU.19
OU.18B: WARN 293;
JRST OU.19
OU.18A: WARN 150;
;GET STERLING ENTRY
IFE STERLN,<XLIST>
IFN STERLN,<
OU.19: MOVE TA,[POINT 7,CRDBUF+^D14]
MOVEI TB,4
PUSHJ PP,GETDCB ; GET STERLING POSITION ENTRY
MOVE TA,CURDAT
LDB CH,[POINT 7,CRDBUF+^D14,27]
CAIN CH,"S" ; STANDARD POSITION?
JRST OU.19A ; YES
JUMPE TC,OU.20 ; NO - IGNORE ZEROES
MOVE TA,CURFIL
LDB TB,FI.RCL ; GET RECORD LENGTH
CAMLE TC,TB ; POSITION WITHINF RECORD?
JRST OU.19C ; NO -
MOVE TA,CURDAT
LDB TB,DA.FLD ; GET FIELD TYPE
CAIE TB,1
CAIN TB,2
JRST OU.19E ; PACKED OR BINARY INVALID
LDB TB,DA.EDT ; GET EDIT CODE
JUMPE TB,.+3 ; BLANK OK
CAIE TB,^D15
JRST OU.19D ; ANYTHING BUT Z INVALID
DPB TC,DA.STP ; STORE POSITION
OU.19A: MOVEI TB,1 ; SHOW WE HAVE STERLING
DPB TB,DA.STR
JRST OU.20
OU.19C: WARN 298;
JRST OU.20
OU.19E: WARN 328;
JRST OU.20
OU.19D: WARN 295; > ;STERLN
LIST
IFN STERLN,<XLIST>
IFE STERLN,<
OU.19: MOVE TB,[POINT 7,CRDBUF+^D14]
MOVEI TC,4 ; GET POSITION
PUSHJ PP,BLNKCK ; SPACES?
WARN 998 ; NO - ERROR
> ;IFE STERLN
LIST
;GET EDIT WORD, CONSTANT
;
OU.20: MOVE TB,[BPNT 44,]
MOVEI TC,^D26
PUSHJ PP,BLNKCK ; ALL BLANKS?
JRST .+2 ; NO -
JRST OU.20G ; YES - IGNORE
MOVE TA,CURDAT ; GET DATAB LINK
LDB TB,DA.EDT ; GET EDIT CODE
CAIL TB,^D13 ; X,Y, OR Z?
JRST OU.20E ; YES - ERROR
LDB CH,[BPNT 45,] ; GET FIRST CHARACTER
CAIE CH,"'" ; QUOTE?
JRST OU.20A ; NO - ERROR
SETZ LN, ; INITIALIZE CHARACTER COUNTER
MOVE TB,[BPNT 45,]
PUSHJ PP,GETVAL ; GET A VALTAB ENTRY
MOVE TD,TA ; STORE POINTER
SUB TD,VALLOC ; MAKE A TABLE INDEX
IORI TD,<CD.VAL>B20
MOVE TA,CURDAT
DPB TD,DA.VAL
MOVE TA,CURVAL ; GET VALTAB POINTER
MOVE TC,[POINT 7,(TA),6] ; MAKE POINTER INTO VALTAB
OU.20B: ILDB CH,TB ; GET A CHARACTER
CAIN CH,"'" ; A QUOTE?
JRST OU.20C ; YES - ALL DONE
OU.20F: IDPB CH,TC ; STASH IN VALTAB
ADDI LN,1 ; INCREMENT CHARACTER COUNTER
CAIN LN,^D26 ; ALL THE WAY THRU YET?
JRST OU.20D ; YES
TLNE TC,760000 ; NO - RAN OUT OF ROOM IN VALTAB?
JRST OU.20B ; NO - LOOP
PUSHJ PP,GETVAL ; YES - GET ANOTHER WORD
MOVE TC,[POINT 7,(TA)]
JRST OU.20B
OU.20D: WARN 277;
;GET EDIT WORD (CONT'D)
;
;
OU.20C: ILDB CH,TB ; GET NEXT CHARACTER
CAIN CH,"'" ; ANOTHER QUOTE?
JRST OU.20F ; YES - QUOTED QUOTE
MOVEI CH,"_" ; NO - GET A BACK ARROW
IDPB CH,TC ; TO FLAG END OF ENTRY
ADDI LN,1 ; BUMP CHARACTER COUNT
MOVE TA,CURDAT ; GET DATAB POINTER
LDB TB,DA.END ; GET END POSITION
ADDI TB,1 ; ACCOUNT FOR BACKARROW DELIMITER
LDB TA,DA.VAL ; GET VALTAB LINK
PUSHJ PP,LNKSET ; SET UP LINK
DPB LN,[POINT 7,(TA),6] ; STORE CHAR COUNT
CAMGE TB,LN ; ARE WE IN BOUNDS?
JRST OU.20I ; NO - ERROR
JRST OU.20G ; CONTINUE
OU.20A: MOVE TA,CURDAT ; [302] get DATAB pointer
LDB TB,DA.EDT ; [302] get edit code flag
SKIPN TB ; [302] if edit code found, no error
WARN 277; ; [302] else bad edit word size
JRST OU.20G
OU.20I: WARN 272; ; END POSITION TO LOW
JRST OU.20G
OU.20E: WARN 279;
JRST OU.20G
OU.20G: PUSHJ PP,GETIND
SUB TA,INDLOC
IORI TA,<CD.IND>B20
MOVE TB,TA
MOVE TA,CURDAT
DPB TB,DA.IND
PUSHJ PP,OU.09
SKIPN @CURIND
JRST OU.20H
MOVE TA,CURIND
MOVEI TB,1
DPB TB,ID.END##
JRST OU.00
OU.20H: MOVE TA,CURDAT
SETZ TB,
DPB TB,DA.IND ; ZAP LINK
JRST OU.00 ; AND LOOP
;HANDLE CONSTANT (BLANK NAME FIELD)
OU.21: MOVE TB,[BPNT 44,]
MOVEI TC,^D26
PUSHJ PP,BLNKCK
JRST .+2
JRST OU.11A ; INVALID FIELD NAME
SETZM CURNAM ; ZAP NAMTAB POINTER
SETZM ARRENT ; ZAP NUMBER OF ARRAY ENTRIES
SWON FCON; ; TELL WORLD WE ARE PROCESSING CONSTANT
PUSHJ PP,OU.11L ; GO SET UP LINKING
JRST OU.15 ; GO DO REST, THEN EXIT
;FINC1 End of Phase C
;
;
;
FINC1: MOVE LN,SAVELN ; get current line number
MOVEM LN,ARRLIN## ; save for Phase E
TSWF FEOF; ; source file at E-O-F ?
JRST FINC4 ; yes - just exit
JRST FINC5 ; output current buffer
FINC2: PUSHJ PP,GETSRC ; no - try for another character
TSWF FEOF; ; are we at E-O-F now?
JRST FINC4 ; yes - exit
SWON FREGCH; ; no - set up to reget that character
PUSHJ PP,GETCRD ; get a buffer full
FINC5: MOVE TB,[POINT 7,CRDBUF] ; get a pointer
MOVEI TC,^D80 ; 80 column cards
FINC3: ILDB CH,TB ; get a character
PUSHJ PP,PUTCAL ; stash in CALfil
SOJG TC,FINC3 ; loop until we've output 80 chars
MOVEI CH,.CHLFD ; get a line feed
PUSHJ PP,PUTCAL ; output that too
JRST FINC2 ; and loop
FINC4: ENDFAZ C; ; end of the line
SUBTTL DEFINE EXTERNALS AND SUCH ROT
EXTERNAL GETCRD,FRMTYP,COMMNT,CRDBUF,GETDCB,GETIND
EXTERNAL ALLSPC,GETSRC,BLNKCK,LNKSET,OLDSEQ,ARRENT,INSIZ
EXTERNAL CALBHO,CALDEV,CURVAL,VALLOC,GETVAL
EXTERNAL MAJLNK,INOCC,HIEND,HLDLNK,PLCBAS
EXTERNAL INDLOC,CURIND,GETIND
EXTERNAL NAMWRD,CRDSIX,TRYNAM,BLDNAM,CURNAM,GETENT,CURFIL
EXTERNAL TABSCN,PRICNT,PUTEOL,SAVELN,FILNXT
EXTERNAL FI.TYP,FI.DES,FI.ORG,FI.PRO,FI.KYP,FI.KYL,FI.RAF
EXTERNAL FI.RCL,FI.EOF,FI.SEQ,FI.AST,FI.BUF,FI.REW,FI.EXT
EXTERNAL FI.ADD,FI.COR,FI.OVI,FI.EXI,FI.ADL,FI.DAT,FI.NAM
EXTERNAL FI.LPP,FI.OVL,FI.DEV,FI.BKL,FI.ADF,FI.LIN
EXTERNAL DA.NAM,DA.MAJ,DA.BRO,DA.IND,DA.VAL,DA.COR,DA.SEQ
EXTERNAL DA.RTR,DA.TRA,DA.LHI,DA.STS,DA.FLD,DA.SIZ,DA.DEC
EXTERNAL DA.ARE,DA.STR,DA.FRR,DA.RII,DA.CLI,DA.STP,DA.PRI
EXTERNAL DA.ORT,DA.ARC,DA.FOV,DA.SPB,DA.SKB,DA.EDT,DA.BLA
EXTERNAL DA.SPA,DA.SKA,DA.END,DA.LDC,DA.LDR,DA.LDE,DA.DMP
EXTERNAL DA.OCC,DA.ALT,DA.ALL,DA.EPR,DA.SEQ,DA.LDP,DA.DPP
EXTERNAL DA.MAT,DA.FPL,DA.FMN,DA.FBZ,DA.ARE,DA.SNM,DA.FRP
EXTERNAL DA.TOP,DA.NPS,DA.PRO
EXTERNAL FNDLNK,CURDAT,DATLOC,FILLOC
END RPGIIC