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,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,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,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,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,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,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,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,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,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,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,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,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,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,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,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, 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, 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,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,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