Google
 

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