Trailing-Edge
-
PDP-10 Archives
-
decuslib20-06
-
decus/20-153/rpgiib.mac
There is 1 other file named rpgiib.mac in the archive. Click here to see a list.
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 <?RPGNSC No source code found
>
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 <FCOMP!FEXEC!FRAF!FPRE!FDUMP>
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,<CD.FIL>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,<CD.FIL>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 <FPRE!FCOMP> ; 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,<CD.DAT>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,<CD.DAT>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