TITLE RPGIIB for RPGII %2 SUBTTL Handle H, F, E and L cards ;Copyright (C) 1975, 1976, 1977 Cerritos College and Robert Currier ;All rights reserved TWOSEG RELOC 400000 ENTRY RPGIIB RPGIIB: SETFAZ B; ; SET UP PHASE B JUNK MOVEI TB,1 ; SET LINE COUNTER TO 1 MOVEM TB,SAVELN ; OH, FOR MEMORY TO MEMORY TRANSFERS! MOVEI CH,12 ; SET FIRST CARRIAGE CONTROL TO LF PUSHJ PP,PUTEOL ; STUFF A CHAR INTO CPYFIL MOVE TB,[SIXBIT /RPGOBJ/] ; [263] get default program name MOVEM TB,PRGID ; [263] and store in case no H card GETFST: PUSHJ PP,GETSRC ; GET A CHARACTER TSWF FEOF; ; DID WE RUN OUT OF SOURCE? JRST RANOUT ; YES - DIE SWON FREGCH; ; NO - SET UP TO REGET CHARACTER PUSHJ PP,GETCRD ; AND GET A CARD IMAGE MOVE CH,COMMNT ; GET COMMENT COLUMN CAIN CH,"*" ; A COMMENT? JRST GETFST ; YES - GO GET ANOTHER CARD MOVE TB,FRMTYP ; GET THE TYPE CAIN TB,"H" JRST CONTRL ; CONTROL CARD PUSHJ PP,IDNTYP## ; SE IF WE CAN IDENTIFY IT JRST FILDS2 ; WE COULD - ALL IS OK WARN 22; ; NOT OK - TELL THE TURKEY JRST GETFST RANOUT: MSG JRST RESTRT## SUBTTL Process Control Cards ;CONTRL Routine to process header cards ; ; ; CONTRL: MOVE TB,[BPNT (6)] ; columns 7-12 should be blank MOVEI TC,^D6 ; that's six columns PUSHJ PP,BLNKCK## ; make sure they're blank WARN 21; ; they're not MOVE TA,[BPNT (12)] ; get core size option MOVEI TB,^D2 ; 2 digits PUSHJ PP,GETDCB ; go get it ASH TC,^D10 ; multiply by 1024 MOVEM TC,OBJSIZ## ; and store the result LDB CH,[BPNT (15)] ; get DEBUG column CAIN CH," " ; is it blank? JRST H.01 ; yes - ok CAIN CH,"1" ; no - is it a one? SWONS FDBUG; ; yes - turn on flag WARN 5; ; no - assume blank H.01: MOVE TB,[BPNT (15)] ; columns 16-40 should be blank MOVEI TC,^D25 ; thats 25 columns PUSHJ PP,BLNKCK ; check it out WARN 21; ; not blank LDB CH,[BPNT (41)] ; get 1P column CAIN CH," " ; blank? JRST H.02 ; yes - CAIE CH,"1" ; no - one? WARN 216; ; no - assume 1 SWON F1P; ; yes - turn on flag H.02: MOVE TB,[BPNT (41)] ; columns 42-43 should be blank MOVEI TC,^D2 ; two columns PUSHJ PP,BLNKCK ; check 'em out WARN 21; ; error - not blank LDB CH,[BPNT (44)] ; get MFCU zero supress CAIN CH," " ; blank? JRST H.03 ; yes - ok CAIE CH,"1" ; no - is it 1? WARN 19; ; no - but assume it is HRLM CH,NOPRNT## ; flag it ;CONTRL (cont'd) ; ; ; H.03: MOVE TB,[BPNT (44)] ; columns 45-74 should be blank MOVEI TC,^D30 ; that's 30 columns PUSHJ PP,BLNKCK ; check 'em on out WARN 21; ; not blank - error MOVE TA,[BPNT (74)] ; get pointer to program id MOVEI TC,^D6 ; which is six characters long MOVE TB,[POINT 6,TE] ; TE is the place to be PUSHJ PP,CRDSIX## ; get the filename SKIPN TE ; all spaces? MOVE TE,[SIXBIT /RPGOBJ/] ; yes - default MOVEM TE,PRGID ; save the name TSWT FDSKC; ; commands from disk? JRST GETFST ; no - go get another card MOVE TA,TE ; yes - set up to output filename PUSHJ PP,SIXOUT## ; output it on TTY: MSG < > JRST GETFST ; and go get another card SUBTTL File Description Specifications ;HANDLE THE FILE DESCRIPTION CARDS FI.01: PUSHJ PP,FI.25 ; GET A CARD IMAGE ;GET THE FILE NAME FILDES: MOVE TA,[BPNT 6,] ; POINTER TO GET FILENAME MOVE TB,[POINT 6,NAMWRD] ; POINTER TO STASH IT MOVEI TC,^D8 ; NUMBER OF CHARS POSSIBLE PUSHJ PP,CRDSIX ; GET A SIXBIT STRING PUSHJ PP,TRYNAM ; SEE IF FILENAME IN NAMTAB JRST .+2 ; NO - ALL OK SO FAR JRST FI.02E ; YES - ERROR PUSHJ PP,BLDNAM MOVEM TA,CURNAM ; STORE POINTER TO NEW ENTRY MOVE TA,[XWD CD.FIL,SZ.FIL] ; SET UP TO GET FILTAB ENTRY PUSHJ PP,GETENT ; AND GET IT MOVEM TA,CURFIL ; SAVE POINTER HRRZI TB,CD.FIL ; GET TABLE NUMBER DPB TB,[POINT 3,(TA),2] ; STORE IN FIRST WORD JRST FI.03 ; ONWARDS! FILDS2: CAIN TB,"F" ; FILE DESCRIPTION REQUIRED JRST FILDES ; WE GOT IT - OK WARN 22; ; MUST BE OUT OF SEQUENCE????? JRST GETFST ; TRY AGAIN ;NOTE: IF TURKEY FORGETS TO PUT IN A FILE DESCRIPTION CARD, HE MAY ; GET STUCK WITH A LARGE NUMBER OF RG022'S. SEE SAFETY VALVE ; IN IDNTYP IN RPGCOM. I REALIZE THAT THIS IS NOT IDEAL BUT ; IF I HAVE A CHOICE OF PLEASING THE SMART OR THE DUMB PROGRAMMERS ; I CHOOSE THE SMART ONES. ;GET DEVICE FI.03: MOVE TA,[BPNT (39)] ; get pointer to filename MOVE TB,[POINT 6,TD] ; GET PLACE TO PUT IT MOVEI TC,6 ; WE ONLY LOOK AT FIRST SIX CHARACTERS PUSHJ PP,CRDSIX ; GET A DEVICE NAME MOVEI TC,DVTAB ; GET START OF TABLE MOVE CH,TD ; CRDSIX USES CH PUSHJ PP,TABSCN JRST FI.03A FI.03D: MOVE TA,CURFIL ; YES - RESTORE ENTRY POINTER DPB TB,FI.DEV ; STORE DEVICE JRST FI.27 FI.03C: WARN 25; ; INVALID DEVICE MOVEI TB,6 ; ASSUME DISK JRST FI.03D FI.03A: TRZ CH,7777 ; drop any unit numbers CAME CH,DVTAB+7 ; is it TAPE? JRST FI.03C ; no - error LDB CH,[BPNT (44)] ; get unit digit CAIL CH,"0" ; we support 0-9 CAILE CH,"9" ; so check for those JRST FI.03C ; error LDB TB,[BPNT (45)] ; get the second digit CAIE CH," " ; we don't want one JRST FI.03C ; but we got one - error MOVEI CH,-"0"(CH) ; make into number MOVE TA,CURFIL ; get current FILTAB pointer DPB CH,FI.UNT## ; stash unit number MOVEI CH,.FIMTA ; get mag-tape code DPB CH,FI.DEV ; store as device JRST FI.27 ; and on to bigger and better things ;TABLE OF ALL VALID RPGII DEVICES DVTAB: SIXBIT /MFCU1/ SIXBIT /MFCU2/ SIXBIT /READ01/ SIXBIT /PRINTE/ SIXBIT /PRINTR/ SIXBIT /CONSOL/ SIXBIT /DISK/ SIXBIT /TAPE/ Z ;GET PHYSICAL NAME OF FILE FI.27: MOVE TA,[BPNT 46,] MOVE TB,[POINT 6,TD] MOVEI TC,6 PUSHJ PP,CRDSIX ; GET FILENAME MOVE TA,CURFIL ; GET BACK POINTER DPB TD,FI.PHY## ; PUT IT IN IT'S PLACE JRST FI.04 ; AND BACK ;GET FILE TYPE FI.04: LDB CH,[BPNT 15,] ; GET TYPE MOVEI TC,FTYTAB PUSHJ PP,TABSCN JRST FI.04B ; NOT FOUND - USE DEFAULT LDB TC,FI.DEV JRST @FTY2TB(TB) FI.04B: WARN 26; LDB TC,FI.DEV ; GET DEVICE, AGAIN MOVE TB,DEVDEF(TC) ; GET DEFAULT VALUE FOR DEVICE JRST @FTY2TB(TB) ; [013] ACT ON IT FI.04C: CAIE TC,.FILPT ; INPUT - MAKE SURE NOT PRINTER CAIN TC,.FILP2 JRST FI.04B ; ERROR - FI.04H: DPB TB,FI.TYP ; STORE FILE TYPE JRST FI.05 ; ON TO BIGGER AND BETTER THINGS FI.04D: CAIE TC,.FICDR ; OUTPUT - MAKE SURE NOT CARDS JRST FI.04H ; OK JRST FI.04B ; NOT OK FI.04E: CAIN TC,.FIDSK ; UPDATE - MUST BE DISK JRST FI.04H JRST FI.04B FI.04F: CAIE TC,.FIMF2 ; COMBINED - MUST BE MFCU JUMPN TC,FI.04B ; ERROR JRST FI.04H FI.04G: CAIE TC,.FITTY ; DISPLAY - MUST BE CONSOLE JRST FI.04B JRST FI.04H ;TABLE OF VALID FILE TYPES FTYTAB: "I" "O" "U" "C" "D" Z ;TABLE OF FILE TYPE HANDLERS, CORRESPONDS TO FTYTAB FTY2TB: FI.04C FI.04D FI.04E FI.04F FI.04G ;TABLE OF DEFAULT FILE TYPES, BY DEVICE DEVDEF: EXP 3 ; MFCU1 EXP 3 ; MFCU2 EXP 0 ; READ01 EXP 1 ; PRINTER EXP 1 ; PRINTR2 EXP 0 ; CONSOLE EXP 2 ; DISK EXP 0 ; TAPE ;GET FILE DESIGNATION FI.05: LDB CH,[BPNT 16,] ; GET DESIGNATION MOVEI TC,FDGTAB ; [013] PUSHJ PP,TABSCN JRST FI.05B LDB TC,FI.TYP JRST @FDG2TB(TB) FI.05B: WARN 28; MOVEI TB,1 LDB TC,FI.TYP JRST @FDG2TB(TB) FI.05C: MOVE TD,PRICNT ; PRIMARY - MAKE SURE THIS IS THE FIRST JUMPG TD,FI.05J CAIE TC,1 ; MAKE SURE NOT OUTPUT OR DISPLAY CAIN TC,4 JRST FI.05K ; IT WAS - OH HUM....BLOW UP AOS PRICNT FI.05X: DPB TB,FI.DES JRST FI.06 ; OFF WE GO (FOLLOW THE YELLOW BRICK ROAD) FI.05J: WARN 34; ; MULTIPLE PRIMARIES MOVEI TB,1 ; ASSUME SECONDARY JRST @FDG2TB(TB) FI.05K: WARN 30; ; ILLEGAL FOR OUTPUT & DISPLAY MOVEI TB,6 ; ASSUME BLANK JRST @FDG2TB(TB) FI.05D: CAIE TC,1 ; SECONDARY CAIN TC,4 JRST FI.05K JRST FI.05X FI.05E: LDB TD,FI.DEV ; CHAINED CAIN TD,.FIDSK ; IS IT DISK? JRST FI.05D ; YES - JRST FI.05B ; NO - FI.05F: JUMPE TC,FI.05X ; RECORD ADDRESS - INPUT? JRST FI.05B ; NO - ERROR FI.05G: JRST FI.05F ; TABLE OR ARRAY FI.05H: JRST FI.05D ; DEMAND FI.05I: CAIE TC,1 ; BLANK - MUST BE OUTPUT OR DISPLAY CAIN TC,4 JRST FI.05X JRST FI.05B ;TABLE OF FILE DESIGNATIONS FDGTAB: "P" "S" "C" "R" "T" "D" " " Z ;TABLE OF FILE DESIGNATION HANDLERS, CORRESPONDS TO FDGTAB FDG2TB: FI.05C FI.05D FI.05E FI.05F FI.05G FI.05H FI.05I ;END OF FILE HANDLEING FI.06: LDB CH,[BPNT 17,] SETZ TC, CAIE CH," " JRST FI.06B FI.06A: DPB TC,FI.EOF JRST FI.07 FI.06B: CAIE CH,"E" JRST FI.06C ; ERROR - LDB TB,FI.TYP ; GET FILE TYPE CAIE TB,1 CAIN TB,4 JRST FI.06C ; INVALID FOR OUTPUT OR DISPLAY LDB TB,FI.DES ; GET FILE DESCRIPTION JUMPE TB,.+3 CAIE TB,1 CAIN TB,3 ; MUST BE PRIMARY, SECONDARY OR RECORD ADDRESS JRST .+2 JRST FI.06C MOVEI TC,1 SETOM .EFLG ; say we've seen an E JRST FI.06A FI.06C: WARN 36; LDB TB,FI.TYP CAIN TB,0 ADDI TB,1 JRST FI.06A ;FILE ORGANIZATION FI.07: LDB CH,[BPNT 32,] CAIN CH,"I" JRST FI.07A CAIN CH,"T" JRST FI.07B ; ADDROUT CAIN CH," " JRST FI.07C CAIL CH,"1" CAILE CH,"9" JRST FI.07D ; ERROR FI.07E: MOVEI TB,1 ; MULTIPLE I/O AREAS FI.07X: DPB TB,FI.ORG ; STORE IT JRST FI.14 ; HAVE TO GET RECORD ADDRESS FORMAT BEFORE PROCESSING MODE FI.07A: MOVEI TB,2 ; SET UP FOR INDEXED LDB TC,FI.DEV ; FIRST CHECK IF IT'S LEGAL CAIN TC,.FIDSK ; DISK? JRST FI.07X ; YES - OK FI.07D: WARN 44; ; NO - ERROR JRST FI.07E FI.07B: MOVEI TB,3 ; ADDROUT JRST FI.07A+1 ; MAKE SURE IT'S ON DISK FI.07C: SETZ TB, JRST FI.07X ; ONLY ONE I/O AREA ;GET PROCESSING MODE FI.08: LDB CH,[BPNT 28,] CAIN CH,"L" ;[341] JRST FI.08A JRST F.08A2 ; [341] give an error message until implemented CAIN CH,"R" JRST FI.08B CAIN CH," " JRST FI.08C WARN 400; JRST FI.08B ; ASSUME RANDOM FI.08A: CAIN TB,2 ; CHAINED? JRST F.08A2 ; YES - ERROR LDB TB,FI.DES CAIN TB,5 ; DEMAND FILE? JRST F.08A1 ; YES - LDB TB,FI.DEV ; NO - DISK? CAIE TB,.FIDSK JRST F.08A2 ; NO - ERROR LDB TB,FI.ORG ; YES - INDEXED? CAIE TB,2 JRST F.08A2 ; NO - ERROR LDB TB,FI.DES ; YES - PRIMARY OR SECONDARY? CAIE TB,1 JUMPN TB,F.08A2 ; NO - ERROR F.08A1: MOVEI TB,3 FI.08X: DPB TB,FI.PRO JRST FI.09 F.08A2: WARN 560; JRST FI.08C ; ASSUME BLANK FI.08B: LDB TB,FI.DES CAIN TB,2 ; CHAINED? JRST F.08B1 ; YES - RANDOM OR DIRECT FILE LOAD CAIE TB,1 ; PRIMARY OR SECONDARY? JUMPN TB,F.08A2 ; NO - LDB TB,FI.ORG ; ADDROUT? CAIN TB,3 JRST F.08B2 ; YES - ERROR MOVEI TB,1 ; NO - ACCESS BY ADDROUT JRST FI.08X F.08B1: LDB TB,FI.ORG CAIN TB,3 ; ADDROUT? JRST F.08A2 ; YES - ERROR CAIN TB,2 ; INDEXED? JRST F.08B2 ; YES - MOVEI TB,4 JRST FI.08X F.08B2: MOVEI TB,5 JRST FI.08X ;WE NOW HANDLE A BLANK ENTRY. ;THIS CAN MEAN TWO THINGS: ; 1. IF NOT PRIMARY OR CONSECUTIVE, IT'S CONSECUTIVE ; 2. IF PRIMARY OR CONSECUTIVE, AND RECORD ADDRESS FORMAT ; IS BLANK, IS CONSECUTIVE, ELSE SEQUENTIAL BY KEY. ; FI.08C: LDB TB,FI.DES ; GET FILE DESCRIPTION CAIE TB,1 ; PRIMARY OR SECONDARY? JUMPN TB,F.08C2 ; NO - MUST BE CONSECUTIVE LDB TB,FI.RAF ; GET RECORD ADDRESS FORMAT CAIN TB,3 ; [276] record address format blank? JRST F.08C2 ; [276] yes - consecutive MOVEI TB,2 ; SEQ BY KEY JRST FI.08X F.08C2: SETZ TB, ; CONSECUTIVE JRST FI.08X ;CHECK FILE FORMAT FI.09: LDB CH,[BPNT 19,] CAIE CH," " ; [032] CAIN CH,"F" JRST FI.10 WARN 37; ;GET SEQUENCE ENTRY FI.10: LDB CH,[BPNT 18,] CAIN CH,"A" JRST FI.10A CAIN CH,"D" JRST FI.10B CAIN CH," " JRST FI.10C FI.10E: WARN 308; FI.10C: SETZ TB, FI.10X: DPB TB,FI.SEQ JRST FI.11 FI.10B: MOVEI TB,2 JRST .+2 FI.10A: MOVEI TB,1 LDB TC,FI.TYP ; MAKE SURE NOT OUTPUT OR DISPLAY CAIE TC,1 CAIN TC,4 JRST FI.10E ; IT WAS - ERROR LDB TC,FI.DES ; MAKE SURE NOT RECORD ADDRESS CAIN TC,3 JRST FI.10E ; IT WAS - JRST FI.10X ; ALL OK - GO DEPOSIT A BYTE ;GET RECORD LENGTH FI.11: MOVE TA,[BPNT 23,] MOVEI TB,4 ; RECORD LENGTH IS 4 DIGITS PUSHJ PP,GETDCB ; GET A NUMBER MOVE TA,CURFIL ; RESTORE OUR POINTER JUMPE TC,FI.11A ; ZERO REC LENGTH INVALID LDB TB,FI.DEV ; GET DEVICE CAIE TB,.FIMTA ; TAPE? JRST FI.11B ; N0- LDB TB,FI.ORG ; YES - CAIE TB,3 ; ADDROUT? JRST FI.11C ; NO - CAIN TC,^D18 ; YES - RECORD LENGTH MUST BE 18 JRST FI.11D ; OK - WARN 545; ; NOT OK - TELL HIM SO MOVEI TC,^D18 ; DEFAULT TO 18 JRST FI.11D FI.11C: CAIL TC,^D18 ; TAPE BUT NOT ADDROUT JRST FI.11D ; MUST BE > 18 WARN 41; MOVEI TC,^D4096 ; DEFAULT TO 4K JRST FI.11D FI.11B: CAMG TC,MAXTAB(TB) ; REC SIZE GREATER THAN MAXIMUM FOR DEVICE?? JRST FI.11D FI.11A: WARN 41; ; YEP - DEFAULT MOVE TC,DEFTAB(TB) FI.11D: DPB TC,FI.RCL ; STASH THAT RECORD LENGTH JRST FI.12 ;TABLE OF MAXIMUM RECORD SIZES, INDEXED BY DEVICE NUMBER MAXTAB: DEC 96 ; MFCU1 DEC 96 ; MFCU2 DEC 96 ; READ01 DEC 132 ; PRINTER DEC 132 ; PRINTR2 DEC 125 ; CONSOLE DEC 4096 ; DISK DEC 4096 ; TAPE ;TABLE OF DEFAULT RECORD SIZES, INDEX BY DEVICE DEFTAB: DEC 96 ; MFCU1 DEC 96 ; MFCU2 DEC 96 ; READ01 DEC 132 ; PRINTER DEC 132 ; PRINTR2 DEC 125 ; CONSOLE DEC 256 ; DISK DEC 4096 ; TAPE ;FI.12 Get Block Length ; ; ; FI.12: MOVE TA,[POINT 7,CRDBUF+3,27] MOVEI TB,4 PUSHJ PP,GETDCB ; GET A 4 DIGIT NUMBER MOVE TA,CURFIL ; get FILTAB pointer back JUMPE TC,FI.12A ; ZERO - ASSUME RECORD LENGTH MOVE TE,TC LDB TB,FI.RCL ; GET RECORD LENGTH IDIV TE,TB ; MAKE SURE BLOCK LENGTH MULTIPLE OF RECORD LENGTH JUMPN TD,FI.12B ; REMAINDER - ERROR FI.12X: DPB TC,FI.BKL ; ALL OK - JRST FI.15 ; HAD TO CHANGE ORDER FI.12B: WARN 42; ; ERROR - ASUME REC LENGTH FI.12A: LDB TC,FI.RCL ; ASSUME RECORD LENGTH JRST FI.12X ;GET RECORD ADDRESS TYPE FI.14: LDB CH,[BPNT 31,] ; GET COL 31 MOVEI TC,RAFTAB PUSHJ PP,TABSCN JRST FI.14A ; ENTRY NOT FOUND IN TABLE FI.14B: DPB TB,FI.RAF JRST FI.08 ; NOT EXACTLY THE NORMAL ORDER, BUT.... FI.14A: WARN 404; SETZB TB, JRST FI.14B ;TABLE OF RECORD ADDRESS FORMATS RAFTAB: "A" ; UNPACKED "I" ; ADDROUT (BINARY) "P" ; PACKED " " ; NOTHING MUCH Z ;GET KEY FIELD POSITION FI.15: MOVE TA,[BPNT 34,] MOVEI TB,4 PUSHJ PP,GETDCB MOVE TA,CURFIL LDB TB,FI.ORG LDB TD,FI.DEV CAIE TB,2 ; INDEXED? JRST FI.15A ; NO - JUMPE TC,FI.15B ; ZERO? IF SO - ERROR CAILE TC,^D4096 ; MUST BE LESS THAN 4K JRST FI.15B ; WASN'T - FI.15X: DPB TC,FI.KYP JRST FI.16 FI.15A: JUMPE TC,FI.15X ; ZERO ? IF YES STORE IT WARN 405; SETZ TC, JRST FI.15X FI.15B: WARN 405; MOVEI TC,1 JRST FI.15X ;GET LENGTH OF KEY FIELD FI.16: MOVE TA,[BPNT 28,] MOVEI TB,2 PUSHJ PP,GETDCB ; GET 2 DIGITS MOVE TA,CURFIL ; RESTORE OUR POINTER LDB TB,FI.RAF ; GET FORMAT JRST @KYLTAB(TB) FI.16A: CAILE TC,^D29 JRST FI.16E FI.16X: DPB TC,FI.KYL JRST FI.17 FI.16B: CAIN TC,3 JRST FI.16X JRST FI.16E FI.16C: CAIN TC,^D8 JRST FI.16X FI.16E: WARN 403; MOVEI TC,3 JRST FI.16X ;TABLE FOR DISPATCH KYLTAB: FI.16A ; UNPACKED FI.16B ; ADDROUT (BINARY) FI.16C ; PACKED FI.17 ; NO KEY FIELD ;GET CORE INDEX FI.17: MOVE TA,[BPNT 59,] MOVEI TB,4 PUSHJ PP,GETDCB ; GET A 4 DIGIT NUMBER MOVE TA,CURFIL JUMPE TC,FI.17X ; IF IT'S ZERO - STUFF IT CAIL TC,6 ; MUST BE > 6 CAILE TC,^D9999 ; AND < 9999 JRST FI.17A ; IT WASN'T - ERROR FI.17X: DPB TC,FI.COR JRST FI.18 FI.17A: WARN 406; SETZ TC, JRST FI.17X ;GET FILE ADDITION FI.18: LDB CH,[BPNT 66,] MOVEI TC,ADDTAB PUSHJ PP,TABSCN ; LOOKUP IN TABLE JRST FI.18E ; NOT FOUND FI.18X: DPB TB,FI.ADD ; DEPOSIT TABLE INDEX JRST FI.19 FI.18E: WARN 407; MOVEI TB,1 JRST FI.18X ADDTAB: " " "A" "U" Z ;GET NUMBER OF EXTENTS FI.19: MOVE TA,[BPNT 67,] MOVEI TB,2 PUSHJ PP,GETDCB MOVE TA,CURFIL JUMPE TC,FI.19X ; STORE ZERO LDB TB,FI.DEV ; GET DEVICEE CAIE TB,.FIDSK ; WE SUPPORT DISK & TAPE CAIN TB,.FIMTA JRST FI.19A ; OK - WARN 408; ; SOME OTHER DEVICE - ERROR FI.19E: SETZ TB, FI.19X: DPB TC,FI.EXT JRST FI.20 FI.19A: CAILE TC,^D50 ; MAKE SURE NOT GREATER THAN 50 JRST FI.19E JRST FI.19X ;GET TAPE REWIND OPTION FI.20: LDB CH,[BPNT (70)] LDB TB,FI.DEV CAIN CH," " JRST FI.20A CAIE TB,.FIMTA ; TAPE ? JRST FI.20E ; NO - ERROR MOVEI TC,REWTAB ; [013] PUSHJ PP,TABSCN JRST FI.20E ; NOT FOUND - FI.20X: DPB TB,FI.REW JRST FI.21 FI.20E: WARN 457; FI.20A: MOVEI TB,2 JRST FI.20X ;TABLE OF REWINF OPTIONS REWTAB: "R" "U" "N" Z ;CHECK FOR ILLEGAL CONTINUATION CHARACTER FI.21: LDB CH,[BPNT 53,] CAIE CH,"K" JRST FI.22 WARN 462; JRST FI.22 ;GET OVERFLOW INDICATORS FI.22: MOVE TB,[BPNT 33,] LDB CH,TB CAIN CH," " JRST FI.22A ; MAKE SURE SECOND CHARACTER IS ALSO A SPACE CAIN CH,"O" JRST FI.22B ; ALMOST LOOKS LIKE WE GOT ONE FI.22E: WARN 46; SETZ TB, JRST FI.22X FI.22B: ILDB CH,TB LDB TB,FI.DEV ; GET THE DEVICE CAIE TB,.FILPT ; IS IT EITHER ONE OF THE PRINTERS?? CAIN TB,.FILP2 JRST FI.22C ; YES - OK WARN 47; ; NO -ERRORR SETZ TB, JRST FI.22X FI.22C: MOVEI TC,OVTAB ; SET UP FOR TABLE SEARCH PUSHJ PP,TABSCN JRST FI.22E ; NOT FOUND ADDI TB,167 ; FOUND - CONVERT TO INDICATOR NUMBER FI.22X: DPB TB,FI.OVI JRST FI.23 FI.22A: ILDB CH,TB SETZ TB, CAIN CH," " JRST FI.22X JRST FI.22E ;TABLE OF VALID OVERFLOW INDICATORS OVTAB: "A" "B" "C" "D" "E" "F" "G" "V" Z ;FI.23 Get file conditioning indicators ; ; ; FI.23: MOVE TB,[BPNT 71,] LDB CH,TB CAIN CH," " JRST FI.23A ; HOPE WE FIND ANOTHER ONE CAIN CH,"U" JRST FI.23B FI.23D: WARN 57; ; UNIDENTIFIED INDICATOR FI.23E: SETZ TB, FI.23X: DPB TB,FI.EXI JRST FI.24 FI.23A: ILDB CH,TB CAIN CH," " JRST FI.23E JRST FI.23D FI.23B: ILDB CH,TB CAIL CH,"1" CAILE CH,"8" JRST FI.23D MOVEI TB,213-"1"(CH) JRST FI.23X ;STORE NAMTAB LINK AND LINE NUMBER FI.24: MOVS TB,CURNAM DPB TB,FI.NAM MOVE TB,SAVELN ; GET LINE NUMBER DPB TB,FI.LIN ; STASH IN FILTAB JRST FI.26 ;SUBROUTINE TO GET A CARD IMAGE ; ;THIS SUBROUTINE WILL GET A CARD IMAGE, CHECKING FOR END OF SOURCE, ;WILL IGNORE COMMENT LINES, AND WILL CHECK TO BE SURE THAT THIS IS ;A FILE DESCRIPTION CARD. IF IT IS NOT, IT WILL DISPATCH TO "EXTSPC". ;CALLED VIA A PUSHJ. ; FI.25: PUSHJ PP,GETSRC ; GET A CHARACTER TSWF FEOF; ; CHECK FOR END OF SOURCE JRST EXTSPC ; GO SCREAM IF IT IS SWON FREGCH; ; SET TO REGET SAME CHARACTER PUSHJ PP,GETCRD ; GET A CARD IMAGE MOVE TB,FRMTYP ; GET THE FORM TYPE CAIE TB,"F" ; IT BETTER BE AN "F" JRST NOTF ; IT'S NOT - SHOULD BE EXTENSION MOVE TB,COMMNT ; GET COMMENT COLUMN CAIN TB,"*" ; CHECK FOR ASTERISKS JRST FI.25 POPJ PP, NOTF: PUSHJ PP,IDNTYP## ; SEE IF WE CAN IDENTIFY IT JRST EXTSPC ; WE KNOW WHAT IT IS - WARN 22; ; BAD - TELL HIM JRST FI.25 ; AND GET ANOTHER ;FI.26 GET AND PROCESS CONTINUATION LINES ; ; ; FI.26: PUSHJ PP,FI.25 ; GET A CARD MOVE TA,[BPNT 6,] MOVE TB,[POINT 6,TD] MOVEI TC,6 PUSHJ PP,CRDSIX ; GET SIX CHARACTERS OF FILENAME MOVE TA,CURFIL JUMPN TD,FILDES ; IF NOT ALL SPACES - NO CONTINUATION LDB CH,[BPNT 53,] ; GET CONTINUATION COLUMN CAIN CH,"K" ; IS IT A K? JRST FI.26A ; YES - OK WARN 23; ; NO - JRST FI.26 FI.26A: LDB TB,FI.DEV ; GET THE DEVICE CAIE TB,.FIDSK ; both disk and tape can be ASCII CAIN TB,.FIMTA ; is it a tape JRST FI.26B ; YES - OK WARN 451; ; NO - JRST FI.26 FI.26B: MOVE TA,[BPNT 53,] MOVE TB,[POINT 6,TD] MOVEI TC,6 PUSHJ PP,CRDSIX MOVE TA,CURFIL CAMN TD,[SIXBIT /ASCII/] ; IS IT "ASCII"? JRST FI.26C ; YES - CAMN TD,[SIXBIT /BUFOFF/] ; IS IT "BUFOFF"? JRST FI.26D ; YES - WARN 452; ; NO - JRST FI.26 FI.26C: MOVEI TB,1 DPB TB,FI.AST JRST FI.26 FI.26D: LDB TB,FI.AST CAIN TB,1 ; IS THIS AN ASCII TAPE? JRST FI.26E ; YES - WARN 458; ; NO - MOVEI TB,1 ; ASSUME IT SHOULD BE DPB TB,FI.AST FI.26E: MOVE TA,[BPNT 59,] MOVEI TB,2 PUSHJ PP,GETDCB MOVE TA,CURFIL DPB TC,FI.BUF JRST FI.26 ;HANDLE ERROR FROM WAY BACK - DUPLICATE FILENAME FI.02E: WARN 24; ; TELL HIM ABOUT IT JRST FI.01 ; GO TRY AGAIN SUBTTL EXTENSION SPECIFICATIONS ;GET AND PROCESS A CARD EX.00: TSWFZ FALTAB; ; CHECK FOR BLOW-UP ON ALTERNATE TABLE/ARRAY POPJ PP, ; IF SO - BACK TO CALLER PUSHJ PP,GETSRC ; THIS IS THE SAME ROUTINE AS FI.25 TSWF FEOF; JRST LINSPC ; KEEP ON TRUCKING THRU SWON FREGCH; PUSHJ PP,GETCRD ;Entry from File Description Specs EXTSPC: MOVE TB,COMMNT ; [310] new entry point CAIN TB,"*" JRST EX.00 MOVE TB,FRMTYP CAIE TB,"E" JRST NOTE ; MAYBE A LINE COUNTER CARD? SWOFF FALTAB; ; JUST TO MAKE SURE MOVEI LN,PNTAB ; INITIALIZE BYTE POINTER POINTER JRST EX.01 ; LEAP OVER CODE IN A SINGLE BOUND NOTE: PUSHJ PP,IDNTYP## ; DO WE KNOW WHAT IT IS? JRST LINSPC ; YES -- WARN 22; ; NO - JRST EX.00 ; GET ANOTHER ;GET "FROM" FILENAME EX.01: SWOFF SETZM FILLNK SETZM DATLNK MOVE TA,[POINT 7,CRDBUF+2] ; SET UP TO GET FILENAME MOVE TB,[POINT 6,NAMWRD] MOVEI TC,^D8 ; EIGHT CHARS WORTH PUSHJ PP,CRDSIX MOVE TB,NAMWRD JUMPE TB,EX.01A ; JUMP IF ALL SPACES PUSHJ PP,TRYNAM ; LOOKUP IN NAMTAB JRST EX.01B ; DOESN'T EXIST MOVEM TA,CURNAM ; SAVE POINTER HRRZI TB,CD.FIL ; FIND FILTAB ENTRY MOVSS TA ; GET PROPER LINK TYPE PUSHJ PP,FNDLNK JRST EX.01B ; LINK NOT FOUND MOVEM TB,CURFIL ; SAVE POINTER MOVE TA,TB LDB TB,FI.ORG ; get file organization MOVEM TB,FRMPRO ; SAVE FOR LATER LDB TB,FI.RCL ; GET RECORD LENGTH MOVEM TB,FRMRCL ; AND DO LIKEWISE LDB TB,FI.DES ; FIND OUT WHAT KIND OF FILE WE GOT CAIN TB,3 JRST EX.01D ; RECORD ADDRESS CAIN TB,4 JRST EX.01E ; PRE-EXECUTION TABLE/ARRAY WARN 63; ; AN INVALID ONE JRST EX.00 ; IGNORE THIS CARD ;HANDLE FILENAME OF ALL SPACES EX.01A: MOVE TA,[POINT 7,CRDBUF+6,13] MOVEI TB,3 PUSHJ PP,GETDCB ; PICK UP ENTRIES/RECORD JUMPE TC,EX.01C ; EXECUTION TIME SWON FCOMP; ; COMPILE TIME JRST EX.02 EX.01C: SWON FEXEC; JRST EX.02 EX.01D: SWON FRAF; ; RECORD ADDRESS FILE JRST EX.01F EX.01E: SWON FPRE; ; PRE-EXECUTION TABLE/ARRAY EX.01F: MOVE TA,CURFIL ; CREATE TABLE POINTER INTO FILTAB SUB TA,FILLOC IORI TA,B20 MOVEM TA,FILLNK JRST EX.02 EX.01B: WARN 62; ; INVALID FILENAME JRST EX.00 ; IGNORE CARD ;GET "TO" FILENAME EX.02: MOVE TA,[POINT 7,CRDBUF+3,20] MOVE TB,[POINT 6,NAMWRD] MOVEI TC,^D8 PUSHJ PP,CRDSIX ; PICK UP 8 CHARS MOVE TB,NAMWRD ; CHECK FOR BLANK JUMPE TB,EX.02A ; jump if all spaces PUSHJ PP,TRYNAM ; LOOKUP IN NAMTAB JRST EX.02B ; UNDEFINED MOVEM TA,CURNAM HRRZI TB,CD.FIL ; LOOKUP IN FILTAB MOVSS TA PUSHJ PP,FNDLNK JRST EX.02B ; NOT FOUND MOVEM TB,CURFIL TSWF FEXEC; ; WAS "FROM" AN EXECUTION TIME ARRAY? JRST EX.02K ; YEP - MOVE TA,TB ; NO - SHUFFLE POINTERS LDB TB,FI.TYP ; GET FILE TYPE JUMPE TB,EX.02C ; INPUT CAIN TB,2 JRST EX.02C ; UPDATE CAIN TB,1 JRST EX.02D ; OUTPUT WARN 65; ; INVALID FILE TYPE JRST EX.00 EX.02B: WARN 64; ; INVALID FILE NAME JRST EX.00 EX.02C: TSWT FRAF; ; INPUT OR UPDATE JRST EX.02E ; "FROM" WASN'T A RAF LDB TB,FI.DES JUMPE TB,EX.02F ; MUST BE PRIMARY,SECONDARY OR DEMAND TO BE LEGAL CAIE TB,1 CAIN TB,5 JRST EX.02F ; ALL OK SO FAR EX.02L: WARN 503; JRST EX.00 EX.02E: WARN 504; JRST EX.00 EX.02F: MOVE TB,FRMPRO ; get from file organization CAIN TB,3 JRST EX.02G ; FROM IS AN ADDROUT LDB TB,FI.PRO ; FROM IS RECORD ADDRESS CAIE TB,3 ; WE SHOULD BE LIMITS JRST EX.02H ; WE AREN'T - EX.02I: LDB TB,FI.ADL JUMPN TB,EX.02J MOVE TB,FILLNK DPB TB,FI.ADL ; STORE LINK MOVEI TB,1 ; SET RA LINK FLAG DPB TB,FI.ADF JRST EX.00 ; IGNORE REMAINDER OF CARD EX.02G: LDB TB,FI.PRO ; SHOULD BE RANDOM CAIN TB,1 ; by addrout? JRST EX.02I ; IS - GO STORE LINK EX.02H: WARN 130; JRST EX.00 EX.02J: WARN 502; JRST EX.00 EX.02K: WARN 594; JRST EX.00 EX.02A: TSWT FRAF; JRST EX.03 JRST EX.02L EX.02D: SWON FDUMP; SUB TA,FILLOC IORI TA,B20 MOVEM TA,FILDLK ; STORE FOR DUMP LINK JRST EX.03 ;GET TABLE/ARRAY NAME EX.03: MOVE TA,(LN) AOJ LN, ; INCREMENT POINTER MOVE TB,[POINT 6,NAMWRD] MOVEI TC,6 PUSHJ PP,CRDSIX PUSHJ PP,TRYNAM JRST .+2 ; OK SO FAR JRST EX.03A ; ALREADY EXISTS PUSHJ PP,BLDNAM ; MAKE ME A NAME! MOVEM TA,CURNAM ; STASH THE POINTER MOVE TA,[XWD CD.DAT,SZ.DAT] PUSHJ PP,GETENT ; CREATE A DATAB ENTRY MOVEM TA,CURDAT ; STORE THIS POINTER TOO HRRZI TB,CD.DAT ; MARK ENTRY AS OUR VERY OWN DPB TB,[POINT 3,(TA),2] MOVS TB,CURNAM DPB TB,DA.NAM ; STORE NAMTAB LINK TSWF FALTAB ; SEE IF THIS IS ALTERNATE CHECK POPJ PP, ; IT WAS JRST EX.04 ; NO - EX.03A: WARN 67; ; INVALID NAME JRST EX.00 ; IGNORE EVERYTHING ;GET NUMBER OF ENTRIES/RECORD EX.04: MOVE TA,(LN) AOJ LN, MOVEI TB,3 PUSHJ PP,GETDCB MOVE TA,CURDAT JUMPE TC,EX.04A ; BLANK OR ZERO ENTRY TSWF FEXEC; JRST EX.04B ; EXECUTION TIME ARRAY EX.04X: DPB TC,DA.EPR JRST EX.05 EX.04A: TSWT ; SHOULDN'T BE PRE-EXECUTION OR COMPILE TIME JRST EX.04X ; OK - EX.04B: WARN 68; MOVEI TC,^D8 JRST EX.04X ; DEFAULT TO 8 ;GET NUMBER OF ENTRIES PER TABLE/ARRAY EX.05: MOVE TA,(LN) AOJ LN, MOVEI TB,4 PUSHJ PP,GETDCB MOVE TA,CURDAT CAILE TC,^D9999 JRST EX.05A ; TOO LARGE LDB TB,DA.EPR CAMGE TC,TB JRST EX.05B DPB TC,DA.OCC ; STORE AS NUMBER OF OCCURS JRST EX.06 EX.05A: WARN 70; JRST EX.06 EX.05B: WARN 71; JRST EX.06 ;EX.06 Get length of table/array entry ; ; ; EX.06: MOVE TA,(LN) AOJ LN, MOVEI TB,3 PUSHJ PP,GETDCB ; GET A 3 DIGIT NUMBER MOVE TA,CURDAT JUMPE TC,EX.06A ; ERROR IF ZERO TSWT FCOMP; ; dont check for compile time TSWF FEXEC; JRST EX.06X ; DON'T BOTHER WITH A CHECK IF EXECUTION TIME LDB TB,DA.EPR ; IS PRE-EXECUTION - GET NUMBER OF ENTRIES/RECORD IMUL TB,TC ; MULTIPLY BY SIZE OF EACH ENTRY CAMLE TB,FRMRCL ; IS IT LONGER THAN RECORD LENGTH? JRST EX.06B ; YES - ERROR EX.06X: DPB TC,DA.SIZ ; STORE SIZE OF FIELD DPB TC,DA.ISZ## ; [317] store input size JRST EX.07 EX.06A: WARN 72; MOVEI TC,5 ; DEFAULT TO FIVE JRST EX.06X EX.06B: WARN 73; JRST EX.00 ; IGNORE REMAINDER OF CARD ;GET PACKED OR BINARY FIELD EX.07: LDB CH,(LN) AOJ LN, EX.07B: MOVEI TC,PBTAB PUSHJ PP,TABSCN ; LOOKUP IN TABLE JRST EX.07A ; NOT FOUND JRST @PBTAB2(TB) ; DISPATCH TO APPROPRIATE ROUTINE EX.07X: DPB TB,DA.FLD ; STORE FIELD TYPE JRST EX.08 EX.07A: WARN 74; MOVEI CH," " ; DEFAULT TO SPACE JRST EX.07B EX.07C: TSWF FPRE; JRST EX.07X ; PACKED OR BINARY OK ONLY ON PRE-EXECUTION WARN 75; JRST EX.07A+1 ;TBALE OF VALID FIELD FORMAT CHARACTERS PBTAB: 777777 ; SHOULD NEVER FIND THIS "P" ; PACKED "B" ; BINARY PACKED " " ; UNPACKED EITHER NUMERIC OR ALPHA Z ;DISPATCH TABLE PBTAB2: EX.07A ; JUST IN CASE IT EVER IS FOUND EX.07C EX.07C EX.07X ;GET NUMBER OF DECIMAL POSITIONS EX.08: LDB CH,(LN) AOJ LN, CAIN CH," " JRST EX.08A ; IS ALPHAMERIC FIELD CAIL CH,"0" CAILE CH,"9" JRST EX.08B ; INVALID CHARACTER MOVEI TB,-"0"(CH) EX.08X: LDB TC,DA.SIZ CAIG TC,^D15 ; > 15 ? JRST EX.08Y ; NO - OK WARN 83; ; YES - ERROR MOVEI TC,^D15 ; DEFAULT TO 15 DPB TC,DA.SIZ DPB TC,DA.ISZ ; [317] store input size EX.08Y: DPB TB,DA.DEC JRST EX.09 EX.08A: SETZ TB, DPB TB,DA.FLD ; FLAG THAT WE ARE A ALPHAMERIC FIELD LDB TC,DA.SIZ ; CHECK FIELD SIZE CAIG TC,^D256 ; > 256 ? JRST EX.09 ; NO - OK WARN 82; ; YES - MOVEI TC,^D256 ; DEFAULT TO 256 DPB TC,DA.SIZ DPB TC,DA.ISZ ; [317] store input size JRST EX.09 EX.08B: WARN 76; SETZ TB, JRST EX.08X ; STORE A ZERO ;GET SEQUENCE ENTRY EX.09: LDB CH,(LN) AOJ LN, MOVEI TC,SEQTAB PUSHJ PP,TABSCN ; LOOKUP SEQUENCE ENTRY JRST EX.09A ; ENTRY NOT FOUND JUMPE TB,EX.09X ; BYPASS CHECK IF SPACE TSWF FEXEC; WARN 390; ; WARN HIM WE DON'T CHECK SEQUENCE EX.09X: DPB TB,DA.SEQ JRST EX.10 EX.09A: WARN 77; SETZ TB, ; DEFAULT TO SPACE JRST EX.09X ;TABLE OF VALID SEQUENCE COLUMN ENTRIES SEQTAB: " " ; NO SEQUENCE CHECK "A" ; ASCENDING ORDER "D" ; DESCENDING ORDER Z ;SET UP TO HANDLE ALTERNATING TABLE/ARRAY EX.10: MOVE TB,FILLNK ; get FILTAB link TRNN TB,777777 ; [250] [251] special case of zero? MOVEI TB,777777 ; [250] yes - set magic flag TSWF FPRE; ; pre-execution load? DPB TB,DA.LDP ; yes - store as load pointer MOVEI TB,1 ; get a flag TSWF FPRE; ; pre-execution? DPB TB,DA.LDR## ; yes - TSWF FCOMP; ; compile time? DPB TB,DA.LDC## ; yes - TSWF FEXEC; ; execution time? DPB TB,DA.LDE## ; yes - TSWFZ FALTAB; ; WERE WE PROCESSING AN ALTERNATING TABLE? POPJ PP, ; YES - RETURN TO WHENCE WE CAME MOVE TB,CURDAT SUB TB,DATLOC MOVEM TB,DATLNK ; MAKE OURSELVES A POINTER INTO DATAB LDB TB,DA.EPR ; GET ENTRIES/RECORD MOVEM TB,ALTEPR ; STORE FOR POSTERITY LDB TB,DA.OCC ; DO SAME WITH NUMBER OF OCCURANCES MOVEM TB,ALTOCC MOVE TB,FILDLK TSWF FDUMP; ; DO WE DUMP THIS FILE? PUSHJ PP,EX.10A ; YES STORE ALL THE JUNK MOVE TA,[POINT 7,CRDBUF+^D9] MOVE TB,[POINT 6,TD] MOVEI TC,6 PUSHJ PP,CRDSIX ; PICK UP ALTERNATE TABLE NAME JUMPE TD,EX.00 ; if all spaces - just get another card SWON FALTAB; ; NO - SET TO GET ALTERATE TABLE INFO PUSHJ PP,EX.03 ; GO GET IT AND A DATAB ENTRY MOVE TB,ALTEPR DPB TB,DA.EPR ; STORE ENTRIES/RECORD MOVE TB,ALTOCC DPB TB,DA.OCC ; STORE NUMBER OF OCCURS MOVE TB,FILDLK TSWF FDUMP; ; ARE WE DUMPING? PUSHJ PP,EX.10A ; YES - GO SET UP PUSHJ PP,EX.06 ; NO - GO SET UP ALT JUNK MOVE TB,DATLNK ; GET LINK TRNN TB,777777 ; [252] special case of zero? MOVEI TB,77777 ; [252] yes - set flag word IORI TB,B20 ; OR IN TABLE ID DPB TB,DA.ALL ; STORE AS LINK MOVE TC,TA MOVE TA,DATLNK ; GET LINK ADD TA,DATLOC ; ADD IN TABLE BASE ADDRESS SUB TC,DATLOC ; CREATE A NEW POINTER TRNN TC,777777 ; [252] special case of zero? MOVEI TC,77777 ; [252] yes - set flag IORI TC,B20 ; OR IN TABLE ID DPB TC,DA.ALL ; STORE IT MOVEI TB,1 ; STORE FLAG DPB TB,DA.ALT JRST EX.00 ; GET ANOTHER CARD EX.10A: TRNN TB,777777 ; [250] [251] special case of zero? MOVEI TB,777777 ; [250] yes - flag it DPB TB,DA.DPP ; STORE DUMP POINTER MOVEI TB,1 DPB TB,DA.DMP ; SET DUMP FLAG POPJ PP, ; EXIT - ;TABLE OF BYTE POINTERS USED BY EXTENSION SPECIFICATION ROUTINES ; PNTAB: POINT 7,CRDBUF+5,6 ; COL 27 - POINT 7,CRDBUF+6,13 ; COL 33 - POINT 7,CRDBUF+7 ; COL 36 - POINT 7,CRDBUF+7,27 ; COL 40 - POINT 7,CRDBUF+^D8,20 ; COL 43 POINT 7,CRDBUF+^D8,27 ; COL 44 POINT 7,CRDBUF+^D8,34 ; COL 45 ; POINT 7,CRDBUF+^D9 POINT 7,CRDBUF+^D10,6 POINT 7,CRDBUF+^D10,34 POINT 7,CRDBUF+^D11,6 POINT 7,CRDBUF+^D11,13 SUBTTL LINE COUNTER SPECIFICATIONS ;HANDLE LINE COUNTER CARDS, EASIEST TASK OF PHASE B ; LI.00: PUSHJ PP,GETSRC ; SAME DAMN ROUTINE WE GO THRU EVERYTIME TSWF FEOF; JRST FINB SWON FREGCH; PUSHJ PP,GETCRD MOVE TB,COMMNT CAIN TB,"*" JRST LI.00 MOVE TB,FRMTYP LINSPC: CAIN TB,"L" JRST LI.01 ; GO FINISH UP PHASE B PUSHJ PP,IDNTYP ; TRY TO IDENTIFY JRST FINB ; GOT IT WARN 22; ; WHAT THE HELL IS IT THEN? JRST LI.00 ; INGNORE IT ;LI.01 GET FILENAME ; ; ; LI.01: MOVE TA,[POINT 7,CRDBUF+1,6] ; SET UP FOR FILENAME FETCH MOVE TB,[POINT 6,NAMWRD] MOVEI TC,^D8 PUSHJ PP,CRDSIX MOVE TB,NAMWRD JUMPE TB,LI.01A ; JUMP IF FILENAME = SPACES PUSHJ PP,TRYNAM ; NO - SEE IF FILE IN NAMTAB JRST LI.01A ; NO - BAD MOVEM TA,CURNAM ; YES - STUFF POINTER MOVSS TA ; GET PROPER HALF OF POINTER HRRZI TB,CD.FIL ; GET "THE MARK OF FILTAB" PUSHJ PP,FNDLNK ; AND SCAN THRU IT JRST LI.01A ; NOT FOUND - GO CRY MOVEM TB,CURFIL ; STORE POINTER MOVE TA,TB ; STICK IN TA FOR BYTE JUNK LDB TB,FI.DEV ; GET DEVICE CAIE TB,3 CAIN TB,4 ; PRINTER? JRST LI.02 ; YES - ALL IS COOL THEN WARN 86; ; NO - IT DON'T MAKE MUCH SENSE JRST LI.00 ; FETCH ANOTHER CARD LI.01A: WARN 85; JRST LI.00 ;LI.02 GET LINES PER PAGE ; ; ; LI.02: MOVE TA,[POINT 7,CRDBUF+2,27] MOVEI TB,3 ; 3 DIGIT NUMBER PUSHJ PP,GETDCB JUMPE TC,LI.02A ; ZERO LENGTH IS INVALID CAILE TC,^D112 JRST LI.02A ; SO IS LENGTH > 112 MOVE TA,CURFIL DPB TC,FI.LPP ; ALL OK - STUFF IT JRST LI.03 LI.02A: WARN 87; ; "INVALID FORM LENGTH" JRST LI.00 ; IGNORE THIS CARD ;LI.03 GET "FORM LENGTH" LI.03: MOVE TB,[POINT 7,CRDBUF+3,20] LDB CH,TB CAIE CH,"F" ; IS IT AN "F"? JRST LI.03A ; NO - GO TELL HIM ILDB CH,TB CAIN CH,"L" ; IS IT AN "L"? JRST LI.04 ; YES - OK LI.03A: WARN 88; ; "FL MISSING, ASSUME FL" ;LI.04 GET OVERFLOW LINE ; ; ; LI.04: MOVE TA,[POINT 7,CRDBUF+3,27] MOVEI TB,3 PUSHJ PP,GETDCB JUMPE TC,LI.04A ; ZERO IS ILLEGAL CAILE TC,^D112 JRST LI.04A ; SO IS > 112 MOVE TA,CURFIL DPB TC,FI.OVL JRST LI.05 LI.04A: WARN 89; JRST LI.00 ;LI.05 GET "OVERFLOW LINE" LI.05: MOVE TB,[POINT 7,CRDBUF+4,20] LDB CH,TB CAIE CH,"O" ; IS IT AN "O" JRST LI.05A ; NO - DUMMY FORGOT TO MARK IT ILDB CH,TB CAIN CH,"L" ; SHOULD BE "L" JRST LI.00 ; IT WAS - OK LI.05A: WARN 90; ; "OL MISSING, ASSUME OL" JRST LI.00 SUBTTL FINISH UP PHASE B ;FIRST TASK IS TO SCAN THRU FILTAB, LOOKING FOR FILES THAT NEED EXTENSION ;SPECIFICATIONS BUT DIDN'T GET THEM. THIS IS TREATED AS AN ERROR CONDITION. ;NEXT, WE LOOKUP FOR ENTRIES THAT NEEDED LINE CONTER SPECS, BUT DIDN'T GET ;ANY. THIS IS NOT AN ERROR CONDITION, BUT WE MUST ASSIGN THE DEFAULT ;VALUES TO LINES/PAGE AND OVERFLOW LINE. AFTER ALL THIS IS DONE ;WE CAN CLEAN UP A BIT, DO STANDARD END OF PHASE STUFF, AND LEAP OFF TO ;THE WONDERFUL PHASE C. ; FINB: HRRZ TA,FILLOC ; GET START OF FILTAB HRRZ TC,FILNXT ; GET END OF FILTAB FINB0: LDB TB,FI.DEV ; GET FILE DEVICE CAIE TB,3 ; PRINTER? CAIN TB,4 ; PRINTR2? JRST FINB2 ; SOME SORT OF PRINTER FILE LDB TB,FI.PRO ; NO - GET PROCESSING MODE CAIE TB,1 ; BY ADDROUT? CAIN TB,3 ; BY LIMIT FILE? JRST FINB3 ; ONE OR THE OTHER SKIPE .EFLG## ; did we see any E's? JRST FINB1 ; yes - don't do anything then LDB TB,FI.TYP ; otherwise get type of file CAIE TB,1 ; output? CAIN TB,4 ; display? JRST FINB1 ; if so, leave them alone LDB TB,FI.DES ; get file descriptor CAILE TB,1 ; primary or secondary? CAIN TB,3 ; record address? TRNA ; yes - OK JRST FINB1 ; no - ignore MOVEI TB,1 ; yes - get EOF flag DPB TB,FI.EOF ; stash the flag FINB1: ADDI TA,SZ.FIL ; NO - INCREMENT BYTE POINTER CAME TA,TC ; HAVE WE HIT THE END? JRST FINB0 ; NO - LOOP ENDFAZ B; ; YES - FINISH UP PHASE B FINB2: LDB TB,FI.LPP ; GET LINES/PAGE JUMPN TB,FINB2A ; ALREADY SET MOVEI TB,^D65 ; DEFAULT TO 65 DPB TB,FI.LPP ; STORE FINB2A: LDB TD,FI.OVL ; GET OVERFLOW LINE JUMPN TD,FINB1 ; ALREADY SET? IF SO LOOP SUBI TB,6 ; ELSE DEFAULT TO 6 LESS THAN LPP DPB TB,FI.OVL ; STORE JRST FINB1 FINB3: LDB TB,FI.ADF ; HAVE WE SET UP RA LINKS? JUMPN TB,FINB1 ; YES - GET ANOTHER FILTAB ENTRY MOVE LN,SAVELN ; NO - SAVE CURRENT LINE LDB TB,FI.LIN ; GET FILTAB LINE NUMBER MOVEM TB,SAVELN ; STORE FOR ERROR WARN 578; ; GIVE HIM AN ERROR MOVEM LN,SAVELN ; RESTORE LINE COUNTER JRST FINB1 ; LOOP SUBTTL DEFINE EXTERNALS AND SUCH ROT EXTERNAL .FIMF1,.FIMF2,.FICDR,.FILPT,.FILP2,.FITTY,.FIDSK,.FIMTA EXTERNAL GETCRD,FRMTYP,COMMNT,CRDBUF,GETDCB,INVPRT EXTERNAL NOPRNT,ALLSPC,PRGID,SHR.IO,GETSRC EXTERNAL NAMWRD,CRDSIX,TRYNAM,BLDNAM,CURNAM,GETENT,CURFIL EXTERNAL TABSCN,PRICNT,PUTEOL,SAVELN,FILNXT EXTERNAL KASC,KBUF 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.FPL,DA.STP EXTERNAL DA.ORT,DA.ARC,DA.FOV,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 FRMPRO,FRMRCL,FILLNK,FILDLK,ALTEPR,ALTOCC,DATLNK EXTERNAL FNDLNK,CURDAT,DATLOC,FILLOC END