/COS BUILD			EDITED 10/8/73
/FDR - FIELD DESCRIPTOR ROUTINE
/COPYRIGHT 1972, 1973
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASS.  01754
	/SR
/
/THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE
/ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION
/OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT
/AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/

	FIXMRI CALL=4400
	FIXMRI EXIT=5400
	BASFLD=0	/AN RL-ISM
	DSCFLD=10	/FIELD OF DESCRIPTOR TABLE
	DATFLD=10	/FIELD OF DATA TABLE
	BUFFLD=10	/FIELD OF INPUT BUFFER
	INBUF=200	/START OF INPUT BUFFER
	INLEN=1		/LENGTH OF INPUT BUFFER (IN
			/400 WORD CHUNKS)
	DSCTAB=7550	/START OF DSCTAB
	DATTAB=6600	/START OF DATTAB
	FDRCRA=3000	/NON-USEFUL HALF OF FDR (3 PAGES)
	FDRUSE=200	/USEFUL HALF OF FDR (2 PAGES)
	FDRERR=3600	/FDR ERRORS (2 PAGES)
	KGETC=24
	KPUTC=25
	DSCLEN=230	/LENGTH OF DSCTAB (IN WORDS)
	DATLEN=1717	/LENGTH OF DATTAB (IN BYTES)
	KPTRST=43
	SBT=6370
	P7400=2
	W5=53
	W4=52
	W3=51
	RDOIO=26
	KCDOIO=27
	OTOPD=74
	LPOCHR=35
	TTOCHR=31
	W0=46
	W1=47
	W2=50
	BUFFER=2300	/START OF (100 WORD) LINE BUFFER
	M1=45
	P7600=70
	OPTCHR=7776
	LENGTH=44
	REALSYS=7774
	SYSHND=77
	DOSW=6260
	TOPFLD=7775
	LISTSW=7776
	SYSDAT=45
	X2=12
	OTOD=74
	KMOVE=23
	L70=65
	L17=64
	M4=66
	IZERO=63

/THIS ROUTINE IS NOT REUSABLE
/CALLING SEQUENCE:
/	JMS I (FDR
/	<NORMAL RETURN>

	FIELD 0
	*17
X7,	TRIES-1
	*100
BLSTAR,	7665		/"B*"
TYPE,	1		/FIELD TYPE (A-0, D-1)
NUM,	0		/TEMPORARY USED BY GETNUM
TEMP,	0		/TEMPORARY
KNT,	-1		/TEMPORARY COUNTER
SIZE,	0		/CURRENT FIELD SIZE
INDEX,	0		/PREVIOUS FIELD NUMBER
FLIM,
TBRK,	0		/LAST F NUMBER ENCOUNTERED
CBRK,	0		/LAST F NUMBER + LAST T NUMBER
LIMIT,	0		/LAST F NUM + LAST T NUM + LAST C NUM
TLIM,	0		/LAST T NUMBER
CLIM,	0		/LAST C NUMBER
ZERROR,	ERROR		/POINTER TO ERROR SUBROUTINE
LSTSW,	1		/0 MEANS LIST
CHCT,	0		/CHAR COUNT
LINKNT,	-1		/LINE COUNT
DSCPTR,	DSCTAB-1	/POINTS INTO DSCTAB
ZGETCHR,GETCHR	/POINTER TO GET CHAR ROUTINE
	AAAAAA=.

	*FDRCRA
/***************************************/
/					/
/   <FIELD-SPECIFICATION-STMNT> ::=	/
/					/
/	<FIELD-NAME>			/
/					/
/	, <FIELD-TYPE>			/
/					/
/	[, <INITIAL-VALUE>]		/
/					/
/***************************************/
/					/
/ INITIAL VALUE MUST CORRESPOND TO 	/
/ FIELD TYPE IN BOTH TYPE AND SIZE.	/
/					/
/***************************************/
/				/
/   <FIELD-NAME> ::=		/
/				/
/	F			/
/	T <NUMBER>		/
/	C			/
/				/
/*******************************/
/				/
/   <INITIAL-VALUE> ::=		/
/				/
/	<INITIAL-DVALUE>	/
/	<INITIAL-AVALUE>	/
/				/
/*******************************/
/ ALL F FIELDS MUST PRECEDE	/
/ ALL T FIELDS WHICH MUST	/
/ PRECEDE ALL C FIELDS.		/
/				/
/ WITHIN EACH GROUP, FIELD	/
/ NUMBERS MUST BE IN ASCENDING	/
/ ORDER; HOWEVER NUMBERS MAY	/
/ BE SKIPPED.			/
/*******************************/

FDR,	0		/FIELD DESCRIPTOR ROUTINE ENTRY POINT
	CDF DATFLD+BASFLD
	STL CLA RAR	/4000
	DCA I (DATTAB-1	/BOO ON GETC
	CDF BASFLD
JFK,	CALL ZREADLN	/READ NEXT LINE
LBJ,	CALL ZGETCHR	/GET FIRST CHARACTER
	JMP JFK		/NULL LINES ARE IGNORED
	TAD I FTC	/SUBTRACT COMPARE CHARACTER
	SZA CLA		/IS IT F, T, OR C?
	JMP UPGRADE	/NOT CURRENT FIELD THRESHOLD CHARACTER
	ISZ LIMIT	/YES, UPDATE COUNT OF # OF FIELDS
	ISZ NOWLIM
	JMS GETNUM	/GET FIELD NUMBER
	CIA
	TAD INDEX	/SUBTRACT PREVIOUS NUMBER
	DCA KNT2		/KNT IS NEG OF DIF BETWEEN THEM
	TAD NUM
	DCA INDEX	/PRESERVE FIELD NUMBER
	TAD KNT2
	SMA CLA
	JMP ER7		/NUMBER REPEATED OR OUT OF ORDER

/*******************************/
/				/
/   <FIELD-TYPE> ::=		/
/				/
/	A <NUMBER>		/
/	D <NUMBER>		/
/				/
/*******************************/
DSCNTR,	CALL (COMA	/ENTER NEW DESCRIPTOR
	JMP ER5		/COMMA MUST FOLLOW
	CALL ZGETCHR	/GET A OR D CHARACTER (FIELD TYPE)
	JMP ER2	/***
	CALL (CHECK	/CHECK FOR A OR D
	JMS GETNUM	/GET FIELD SIZE
	DCA SIZE
	CDF DSCFLD+BASFLD
	TAD SAVE
	TAD TYPE
	JMS DSCPUT
	TAD SAVE
	CLL RAR		/GET ITS SIZE
	TAD SIZE	/ADD IN NEW SIZE
	CLL RAL
	DCA SAVE
FIXLUP,	ISZ KNT2		/ANY MORE SKIPPED FIELD NUMBERS?
	SKP		/YES
	JMP VINI	/NO MORE
	CDF DSCFLD+BASFLD
	TAD I DSCPTR	/GET CURRENT DESCRIPTOR
	ISZ LIMIT	/UPDATE NUMBER OF FIELDS
	ISZ NOWLIM
	JMS DSCPUT	/MAKE NEW DESCRIPTOR ENTRY
	JMP FIXLUP	/KEEP LOOKING
VINI,	TAD SIZE	/GET SIZE AGAIN
	CIA		/TAKE NEGATIVE
	DCA SIZE	/SAVE IT
	CALL (COMA
	STL CLA RTL	/ADD 2 IF NO INITIAL VALUE
	TAD TYPE
	TAD (INITVAL
	DCA TEMP
	TAD I TEMP
	DCA TEMP
	JMP I TEMP
UPGRADE,ISZ FTC
	TAD I FTC
	DCA TEMP
	TAD LIMIT	/GET LIM TO DATE
	DCA I TEMP	/STORE IT
	ISZ FTC
	TAD I FTC
	DCA TEMP
	TAD NOWLIM	/GET CURRENT LIM
	DCA I TEMP	/STORE IT
	ISZ FTC
	TAD I FTC	/GET NEXT ADDRESS TO GO TO
	DCA TEMP
	ISZ FTC
	DCA INDEX	/RESET FIELD # TO 0
	DCA NOWLIM	/RESET NOWLIM TO 0
	TAD (6
	DCA I (CHCT	/RESET SCAN
	JMP I TEMP
FTC,	FTCTAB
SAVE,	0		/HOLDS NEXT REL LOC FREE IN DATTAB
NOWLIM,	0		/HOLDS LIMIT ON CURRENT TYPE FLD #
DSCPUT,	0
	ISZ DSCPTR
	DCA I DSCPTR	/MAKE NEW ENTRY
	CDF BASFLD
	ISZ DSCKNT	/UPDATE # ITEMS
	EXIT DSCPUT	/RETURN
	CALL ZERROR
	ERR4-1
KNT2,	0		/TEMPORARY COUNTER

/*******************************/
/				/
/   <NUMBER> ::=		/
/				/
/	<DIGIT>...		/	VALUE MUST BE
/				/	IN RANGE 1-511
/*******************************/
GETNUM,	0		/GETS A THREE-DIGIT NUMBER
	DCA NUM		/RESET CURRENT NUMBER
NUMLUP,	CALL ZGETCHR	/LOOK FOR CHARACTER
	JMP NUMEND	/NO MORE IS AN ERROR
	CALL ZDIGIT	/IS IT A DIGIT?
	JMP NUMEND	/NO MORE DIGITS
	DCA TEMP	/SAVE DIGIT
	TAD NUM		/MULTIPLY PREVIOUS PART BY 10 (DECIMAL)
	CLL RTL		/X 4
	TAD NUM		/X 5
	RAL		/X 10
	TAD TEMP	/ADD IN NEW DIGIT
	SPA SZL		/LINK MUST BE 0 AND AC>0
	JMP ER3
	DCA NUM		/BECOMES NEW NUMBER
	JMP NUMLUP	/LOOK FOR MORE POSSIBLY
NUMEND,	TAD NUM		/HAVE GOT NUMBER
	SNA		/IS NUMBER 0?
	JMP ER3		/YES, ERROR
/	DCA TEMP
/	TAD TEMP
/	AND (7000
/	SZA CLA
/	JMP ER3		/NUMBER>511
/	TAD TEMP
	EXIT GETNUM	/RETURN WITH IT IN AC
ER3,	CALL ZERROR	/YES, ERROR
	ERR3-1
DSCKNT,	-DSCLEN		/COUNTS NUMBER OF ENTRIES LEFT IN DSCTAB

ER2,	CALL ZERROR
	ERR2-1
ER7,	CALL ZERROR
	ERR7-1
ER5,	CALL ZERROR
	ERR5-1
	PAGE

WAR,	TAD I (SAVE
	CDF DSCFLD+BASFLD
	CALL (DSCPUT
	CDF DSCFLD+BASFLD
	CALL (DSCPUT	/0 END OF DSCTAB
	CALL (DATPUT	/0 END OF DATTAB
	NOP
	TAD I (FDR	/GET RETURN ADDRESS
	DCA TEMP
	JMP I TEMP	/RETURN

/*******************************/
/				/
/   <INITIAL-DVALUE> ::=	/
/				/
/	[+] <DIGIT>...		/
/	 -  <DIGIT>...		/
/	<DIGIT>...  -		/
/				/
/*******************************/
/SIZE OF INITIAL DVALUE IS # OF DIGITS.
DINIT,	CALL (GETCHR	/LOOK FOR DECIMAL INIT
	JMP ER10	/NOTHING THERE IS ERROR
	TAD (-16
	SNA		/IS IT "-"?
	JMP NEG		/YES
	TAD (16-14	/NO
	SZA CLA		/IS IT "+"?
	CALL (BACKUP	/NO, BACK SCAN UP ONE
POS,	TAD (-40	/YES
NEG,	TAD (40
	DCA SIGN	/SET SIGN (0 FOR POSITIVE, 40 FOR NEGATIVE)
GETINT,	CALL (GETCHR	/GET DIGIT
	JMP ER13	/NO MORE, ERROR
	CALL (DIGIT	/IS IT DIGIT?
	JMP ER11	/NO, ERROR
	TAD (21		/CONVERT BACK TO -237
	JMS DATPUT	/YES, INSERT IN DATA TABLE
	JMP GETINT	/GO GET MORE DIGITS
	CALL (GETCHR	/AT END, BUT ANY MORE CHARACTERS?
	JMP ENDNUM	/NO, FINE
	CALL (DIGIT	/YES, DIGIT?
	JMP .+3		/NO, FINE AGAIN
	CALL ZERROR	/YES, ERROR
	ERR14-1		/TOO MANY DIGITS
	CALL (GETCHR	/RETRIEVE CHARACTER
DATKNT,	-DATLEN-1	/DNO
	TAD (-16
	SNA CLA		/IS IT "-"?
	JMP .+3		/YES
ER11,	CALL ZERROR	/NO, ERROR
	ERR11-1		/CRUD AT END OF DIGITS
	TAD (40		/MINUS AT END
	DCA SIGN
ENDNUM,	STA
	TAD DATPTR
	DCA DATP
	TAD DATP
	DCA DATP2
	CDF DATFLD+BASFLD
	TAD (DATTAB-1
	CALL KGETC
DATP,	0
	TAD SIGN	/ADD IN SIGN TO LAST DIGIT
	CDF DATFLD+BASFLD
	CALL KPUTC
	DATTAB-1
DATP2,	0
	JMP I PJFK

ZINIT,	TAD (21
	JMS DATPUT	/ENTER ZEROS IN DATA TABLE
	JMP ZINIT
	JMP I PJFK	/MUST BE 3 LOCATIONS AFTER ZINIT
BINIT,	IAC		/ENTER BLANKS IN DATA TABLE
	JMS DATPUT
	JMP BINIT
	JMP I PJFK
DATPUT,	0		/ENTER AC INTO DATA TABLE
	ISZ DATKNT	/ROOM LEFT IN TABLE?
	SKP		/YES, ALL X
	JMP ER12	/NO, ERROR (DATTAB OVERFLOW)
	CDF DATFLD+BASFLD
	CALL KPUTC
	DATTAB-1
DATPTR,	0		/POINTS INTO DATA TABLE
			/(NEXT FREE BYTE OFFSET)
	ISZ DATPTR	/INCREMENT POINTER
	ISZ I (SIZE	/WAS THIS LAST CHAR EXPECTED?
	EXIT DATPUT	/NO, RETURN 1
	ISZ DATPUT	/YES
	EXIT DATPUT	/RETURN 2
/DATTAB-1 WILL CONTAIN A 4000.
PJFK,	JFK		/CAN'T BE LITERAL

/*******************************/
/				/
/   <INITIAL-AVALUE> ::=	/
/				/
/	' <CHARACTER>... '	/
/				/
/*******************************/
/				/
/ THE CHARACTERS MAY NOT INCLUDE/
/ SINGLE QUOTES.		/
/				/
/*******************************/
/SIZE OF INITAL-AVALUE IS # OF CHARACTERS.
AINIT,	CALL (GETCHR	/LOOK FOR ALPHA INIT
	JMP ER10	/NOTHING THERE IS ERROR
	TAD (-10
	SZA CLA		/IS IT QUOTE?
	JMP ER16	/NO, ERROR
GETAIN,	CALL (GCH	/GET CHARACTER INCLUDING BLANKS AND QUOTES
	JMP ER13	/NO MORE IS ERROR (TOO FEW CHARS)
	JMS DATPUT	/INSERT IN DATA TABLE
	JMP GETAIN	/LOOK FOR MORE
	CALL (GCH	/LOOK FOR CLOSE QUOTE
	JMP ER17	/ERROR-UNMATCHED QUOTE
	TAD (-10
	SNA CLA		/IS IT QUOTE?
	JMP I PJFK	/YES, GOOD
	CALL ZERROR	/NO, ERROR
	ERR17-1
SIGN,	0		/SIGN OF NUMBER, 0-POSITIVE, 40-NEGATIVE

ER10,	CALL ZERROR
	ERR10-1
ER12,	CALL ZERROR
	ERR12-1
ER13,	CALL ZERROR
	ERR13-1
ER16,	CALL ZERROR
	ERR16-1
ER17,	CALL ZERROR
	ERR17-1
	PAGE

/LINE INPUT AND CHARACTER FETCH ROUTINES
READLN,	0		/READ A LINE
	CLA
	TAD M100
	DCA LENGTH
	ISZ	FSTSW
	JMP	NORFST
RINIT,	TAD (7
	JMS I	KPTRST	/INITIALIZE IFN 1
	TAD	(INLEN^200+BUFFLD
	DCA I	W0
	TAD XINBUF
	DCA I	W1
	TAD	(SBT-1
	DCA	NAM1
SYSILP,	ISZ	NAM1
	TAD I	NAM1
	SNA		/ANY ENTRIES?
	JMP	EOFERR	/NO - END OF INPUT
	CMA
	SNA		/HAVE W USED THIS ONE?
	JMP	SYSILP	/YES - GET NEXT ONE
	CLL CMA RAR
	RTR
	RTR		/TRANSFORM TO EDP-8 HUNK/SEGMENT FORMAT
	DCA	NAM2
	TAD	NAM2
	AND	P7400
	DCA I	W5
	TAD	NAM2
	RAL
	AND	(377
	DCA I	W4
	STA
	DCA I	NAM1	/MARK THIS ENTRY USED
	DCA I	W3	/INITIALIZE BUFFER WC
	DCA I (BUFFER	/DON'T PRINT INITIALLY

NORFST,	CALL (LPRINT	/PRINT PREVIOUS LINE
NORF,	TAD (7
	JMS I	RDOIO
	BUFFER+1
	JMP	RINIT	/SINCE THE BUFFER IS BIG, ERRORS MUST BE EOF'S
	CLL STA RAL
	TAD I	(BUFFER+2
	DCA I	(BUFFER
	DCA	CHCT
	TAD I	(BUFFER+3
	CLL
	TAD	(-144
	ISZ	CHCT
	SZL
	JMP	.-4	/SPLIT UP LINE NUMBER INTO TWO-DIGIT HUNKS
	TAD	(144
	JMS I	OTOPD	/CONVERT THEM SEPARATELY TO ASCII
	DCA I	(BUFFER+2	/AND PUT THEM BACK
	STA
	TAD	CHCT
	JMS I	OTOPD
	DCA I	(BUFFER+1
	TAD	(101
	DCA I	(BUFFER+3
	TAD	(6
	DCA	CHCT
	CALL ZGETCHR
	JMP NORF	/IGNORE NULL LINE
	SMA CLA
	TAD (6
	DCA CHCT
	JMP I	READLN
EOFERR,	DCA I	(BUFFER
	TAD (7601	/***
	DCA READLN	/THIS IS FATAL; RETURN TO EDP-8
	CALL ZERROR	/UNEXPECTED END OF FILE
	ERR1-1
FSTSW,	-1
XINBUF,	INBUF
CARCNT,
NAM1,	0
NAM2,	0
EOF2,	JMP I (EPILOG

CARET,	0
	TAD CHCT
	CIA
	TAD (4
	DCA CARCNT
	TAD (5
	DCA INK
BLINS,	TAD (BUFFER
	CALL KGETC	/GET CHAR
INK,	0
	TAD (-75
	SNA CLA
	TAD (74		/OUTPUT TABS AS TABS
	IAC		/BUT RANDOM STUFF AS SPACES
	CALL (LPTCHR
	ISZ INK		/GO TO NEXT CHAR
	ISZ CARCNT	/THROUGH?
	JMP BLINS	/NO
	TAD P77		/***YES, INSERT CARET
	CALL (LPTCHR
	EXIT CARET

ERRP1,	-10
		/NOT BUILD FILE!\
5760
6501
4366
5255
4501
4752
5546
200
	PAGE

	*FDRERR
/ERROR MESSAGES
ERR2,	ERR2-ERR3+1
		/NOTHING AFTER FIELD NAME\
5760
6551
5257
5001
4247
6546
6301
4752
4655
4501
5742
5646
ERR3,	ERR3-ERR4+1
		/FIELD NUMBER MISSING OR 0\
4752
4655
4501
5766
5643
4663
156
5264
6452
5750
160
6301
2100
ERR4,	ERR4-ERR5+1
		/DESCRIPTOR TABLE OVERFLOW\
4546
6444
6352
6165
6063
165
4243
5546
160
6746
6347
5560
7000
ERR5,	ERR5-ERR6+1
		/NO COMMA AFTER FIELD NAME\
5760
144
6056
5642
142
4765
4663
147
5246
5545
157
4256
4600
ERR6,	ERR6-ERR7+1
		/NOT A OR D\
5760
6501
4201
6063
145
ERR7,	ERR7-ERR10+1
		/NUMBER REPEATED OR OUT OF ORDER\
5766
5643
4663
163
4661
4642
6546
4501
6063
160
6665
160
4701
6063
4546
6300
ERR10,	ERR10-ERR11+1
		/MISSING INITIAL VALUE\
5652
6464
5257
5001
5257
5265
5242
5501
6742
5566
4600
ERR11,	ERR11-ERR12+1
		/BAD DIGIT IN DECIMAL INITIAL VALUE\
4342
4501
4552
5052
6501
5257
145
4644
5256
4255
152
5752
6552
4255
167
4255
6646
ERR12,	ERR12-ERR13+1
		/DATA TABLE OVERFLOW\
4542
6542
165
4243
5546
160
6746
6347
5560
7000
ERR13,	ERR13-ERR14+1
		/INITIAL VALUE TOO SMALL\
5257
5265
5242
5501
6742
5566
4601
6560
6001
6456
4255
5500
ERR14,ERR14-ERR16+1
		/INITIAL VALUE TOO BIG\
5257
5265
5242
5501
6742
5566
4601
6560
6001
4352
5000
ERR16,	ERR16-ERR17+1
		/INITIAL ALPHA VALUE DOESN'T BEGIN WITH QUOTE\
5257
5265
5242
5501
4255
6151
4201
6742
5566
4601
4560
4664
5710
6501
4346
5052
5701
7052
6551
162
6660
6546
ERR17,	ERR17-ERR20+1
		/MISSING CLOSE QUOTE ON ALPHA INITIAL VALUE\
5652
6464
5257
5001
4455
6064
4601
6266
6065
4601
6057
142
5561
5142
152
5752
6552
4255
167
4255
6646
ERR20,

CHECK,	0
	TAD (-42
	DCA TYPE
	TAD TYPE
	SNA
	EXIT CHECK
	TAD (-3
	SZA CLA
	JMP ER6
	IAC
	DCA TYPE
	EXIT CHECK
ER6,	CALL ZERROR
	ERR6-1

MOVPH2,	0
	TAD KCDOIO
	DCA KINPUT
	TAD (Q2-1
	DCA I (SUBHD	/SET SUBTITLE
/	SWAP TOP PART OF PHASE 2
/	DOWN (OVER USELESS FDR)
/	TO MAKE ROOM FOR INTAIL.
	CDF 10+BASFLD
	TAD P7400	/600 LOCS ***TOO MUCH
	CALL KMOVE
	CDF BASFLD
	3000-1
	3000-1
	CDF 10+BASFLD
	TAD P7600
	CALL KMOVE
	CDF BASFLD
	3600-1
	3600-1
	TAD (INDESC
	DCA I ZREADLN	/TRICK ERROR MESSAGE ROUTINE
	CALL ZRESET	/RESET SCAN
	EXIT MOVPH2

INITVAL,AINIT	/ALPHA INIT
	DINIT	/DECIMAL INIT
	BINIT	/BLANKS INIT
	ZINIT	/ZEROS INIT
/FIELD THRESHHOLD CHARACTER TABLE (FTCTAB)
FTCTAB,	-47;TBRK;FLIM;LBJ	/F
	-65;CBRK;TLIM;LBJ	/T
	-44;LIMIT;CLIM;WAR	/C
	PAGE

	*FDRUSE
	JMP I (START
/SHARABLE PART OF FDR
DIGIT,	0		/SKIP ON DIGIT, BACKUP SCAN IF NOT DIGIT
	TAD (-33
	CLL
	TAD (12
	SNL
	JMP NONO	/NOT DIGIT
	ISZ DIGIT
	EXIT DIGIT
NONO,	CLA		/NOT NECESSARY
	CALL ZBACKUP	/BACKUP SCAN
	EXIT DIGIT	/RETURN 1
ERROR,	0		/ERROR ROUTINE
	ISZ ERKNT	/BUMP ERROR COUNT
	CLA
	CDF BASFLD	/JUST IN CASE
	JMS CDOIOC
	BUFFER-1	/PRINT OFFENDING LINE ON LPT
	TAD I	ERROR
	DCA	PMESG	/GET MESSAGE
	TAD (252
	CALL LPOCHR
	TAD (252
	CALL LPOCHR
	TAD (252
	CALL LPOCHR
/	TAD (252
/	CALL LPOCHR
	TAD (-11
	DCA PTABCT
	CALL (CARET
	JMS LPCRLF
	JMS CDOIOC
PMESG,	0
	DCA I (BUFFER	/DON'T PRINT LINE AGAIN
/DO STUFF ABOUT LINKNT AND THINGS ***
	STA
	TAD I ZREADLN
	DCA PMESG
	JMP I PMESG	/RETURN VIA READLINE

CDOIOC,	0		/OUTPUT TO TTY OR LPT WITH TABS
	TAD	(-16
	DCA	PTABCT
	TAD	(-110
	DCA	PRWDTH
	DCA	WRELC
PRLOOP,	TAD I	CDOIOC	/GET ARG
	IAC		/KLUDGE
	JMS I	KGETC
WRELC,	0		/GET A CHARACTER FROM THE LINE
	SNA
	JMP	PRCRLF	/CR - END OF LINE
	JMS	LPTCHR	/PRINT THE CHAR
	ISZ	WRELC
	JMP	PRLOOP	/LOOP
LPTCHR,	0
	TAD	(-75
	SNA		/IS IT A TAB?
	JMP	PRTTAB	/YES
	TAD	(334	/NO - CONVERT TO ASCII
	JMS I	LPOCHR	/PRINT IT
	JMS	BUMPTC	/BUMP COUNTERS
	JMP I	LPTCHR	/RETURN
	JMP	PRCOMN	/TAB COUNTER OVERFLOWED - RESTORE IT
PRTTAB,	TAD	(240
	JMS I	LPOCHR	/PRINT A SPACE
	JMS	BUMPTC	/BUMP COUNTERS
	JMP	PRTTAB	/NO OVERFLOW YET
PRCOMN,	TAD	(-10
	DCA	PTABCT	/RESTORE TAB COUNT
	JMP I	LPTCHR
PRCRLF,	JMS	LPCRLF
	ISZ	CDOIOC
	JMP I	CDOIOC	/RETURN, SKIPPING OVER ARG
LPCRLF,	0
	TAD	(215
	JMS I	LPOCHR	/PRINT CR
	TAD	(212
	JMS I	LPOCHR	/PRINT LF
	JMP I	LPCRLF
BUMPTC,	0		/POINTER-BUMPING ROUTINE
	ISZ	PRWDTH	/LINE OVERFLOW?
	SKP		/NO
	JMS	LPCRLF	/YES - GO TO NEXT LINE
	ISZ	PTABCT	/TAB COUNTER OVERFLOW?
	SKP
	ISZ	BUMPTC	/YES - SKIP RETURN
	JMP I	BUMPTC

PTABCT,	0
PRWDTH,	0
GETCHR,
GNBC,	0		/GET NON-BLANK CHARACTER
	JMS I	(GCH
	EXIT GNBC
	TAD	M1
	SNA
	JMP	GNBC+1
	TAD (1-34
	SNA 		/IS IT ";"?
	JMP SEMIC
	ISZ GNBC	/";" INDICATES EOL
	TAD (34		/RESTORE CHAR
	JMP I	GNBC
ERKNT,	0		/# OF ERRORS
SEMIC,	CALL ZBACKUP
	EXIT GNBC
/THIS CODE CAN BE REMOVED FROM FDR
MOVE2,	TAD (-2200	/MOVE DOWN 2ND HALF
	CDF 10+BASFLD	/OF PHASE 2 BUILD
	CALL KMOVE	/
	CDF BASFLD	/
	600-1		/
	600-1		/
	JMP I (PHASE2	/GO TO PHASE 2
	PAGE

GCH,	0		/GET CHARACTER ROUTINE
	TAD CHCT
	DCA .+3
	TAD	(BUFFER
	JMS I	KGETC
	0
	SZA
	ISZ	CHCT
	TAD	(-75
	SZA		/CONVERT TABS
	TAD	(74	/TO SPACES
	IAC
	SZA
	ISZ GCH		/RETURN 1 IF EOL
	JMP I	GCH

/	LPRINT
/PRINTS CONTENTS OF LINE BUFFER ('BUFFER')
/IF C(LSTSW) .NE. 0  AND  WC .NE. 0
	DAY=HEADING+12
	MONTH1=DAY+1
	MONTH2=DAY+2
	YEAR=DAY+4
	PAGNUM=HEADING+24
LPRINT,	0
	TAD I (BUFFER	/NO
	SNA CLA		/IS WC=0?
	JMP LPND	/YES, RETURN
XTRTXT,	CALL ZGETCHR
	JMP .+3
	CALL ZERROR
	ERR15-1
	TAD LSTSW
	SZA CLA		/IS NOLIST SPECIFIED? (LSTSW .NE. 0)
	EXIT LPRINT	/YES, RETURN
	ISZ LINKNT	/NO, WANT TO PRINT
	SKP
	JMS EJEKT	/PAGE FULL
	CALL (CDOIOC	/PRINT LINE ON LPT
	BUFFER-1
LPND,	DCA I (BUFFER	/DON'T PRINT AGAIN
	EXIT LPRINT

EJEKT,	0
	TAD (-66
	DCA LINKNT	/RESET LINE COUNT
/PRINT HEADINGS, PAGE NUMBERS, TITLES, ETC.
	TAD L214
	CALL LPOCHR	/PRINT FORM FEED
	ISZ PGNM	/INCREMENT PAGE NUMBER
	TAD PGNM
	CALL OTOD	/CONVERT PAGE NUM TO -237
	DCA I (PAGNUM	/INSERT IT
	CALL (CDOIOC
HEAD,	HEADING-1
	CALL (CDOIOC
SUBHD,	HEADING-1
	CALL (LPCRLF	/CR
	EXIT EJEKT	/RETURN
COMA,	0		/SKIP ON COMMA
	CALL ZGETCHR	/GET NEXT CHARACTER
L214,	214
	TAD (-15
	SNA CLA		/IS IT ","?
	ISZ COMA	/YES, RETURN 2
	EXIT COMA	/NO, RETURN 1
BACKUP,	0		/BACKUP SCAN ONE CHARACTER
	STA
	TAD CHCT
	DCA CHCT
	EXIT BACKUP

/	CAN BE REMOVED FROM FDR ****
	0
UNITBL,	ZBLOCK 34
PGNM,	0		/PAGE NUMBER
HEADING,HEADING-TRIES+1
		/COS BUILD  V3.07  UNDATED        PAGE 00\
4460
6401
4366
5255
4501
6701	/V
2417	/3.
2130	/07
0101
6657
4542
6546
4501
101
101
101
161
4250
4601
2121
TRIES,	ZBLOCK 7
	PAGE

/	COS-8 BUILD
	FIELD 0
	FIXMRI INCR=2000
	X0=10
	*AAAAAA
	OUTBUF=400	/START OF OUTPUT LINE BUFFER
	OUTFLD=10	/FIELD OF OUTPUT LINE BUFFER
	OUTLEN=400	/LENGTH OF OUTPUT LINE BUFFER
	INPFLD=10	/FIELD OF INPTAB
	INPICT=4000	/START OF INPICT
	INPTAB=3000	/START OF INPTAB
	INPLEN=400	/NO. OF ENTRIES IN INPICT (IN WDS)
	INTLEN=2200	/NO. OF ENTRIES IN INTAIL "
	TABLEN=1200	/NO. OF ENTRIES IN INPTAB "
	INTAIL=4400	/START OF INTAIL
	INTFLD=10	/FIELD OF INTAIL
	PICFLD=0	/FIELD OF INPICT
	X4=14

ZKEYWRD,KEYWRD		/POINTS TO KEYWRD ROUTINE
ZREADLN,READLN		/POINTS TO READLN ROUTINE
ZRESET,	RESET		/POINTS TO RESET ROUTINE
ZFNAME,	FNAME		/POINTS TO FNAME ROUTINE
ZBACKUP,BACKUP		/POINTS TO BACKUP ROUTINE
TEM,	0		/TEMPORARY LOCATION
LIM,	0		/LIMIT WITH RESPECT TO TYPE OF FIELD
DEVYCE,	0		/INPUT DEVICE HANDLER CODE
PINPT,	INPTAB-1	/POINTER INTO INPTAB
ZDIGIT,	DIGIT		/POINTS TO DIGIT ROUTINE
DETAIL,	INTAIL-1	/POINTS TO 'INTAIL' TABLE
			/ALWAYS PTS TO ENTRY - 1
BRK,	0		/BREAK WITH RESPECT TO TYPE OF FIELD
DEPICT,	INPICT-1	/POINTS INTO 'INPICT' TABLE
			/ALWAYS POINTS TO ENTRY - 1
PROMPT,	0		/4 MEANS PROMPTING ELSE 0
EDIT,	0		/NON-ZERO MEANS ON LINE EDITING
DESPTR,	INPTAB		/PTS TO CURRENT DESCRIPTOR
			/ALWAYS PTS TO ENTRY EXACTLY
FORMAT,	0		/CURRENT FORMAT NO. (MUST BE ON PAGE 0)
MODE,	0		/1 MEANS COMMA MODE
CORAMT,	0		/=0 MEANS 8K
OUTNO,	0		/CURRENT OUTPUT FORMAT NO
SAVDSC,	0		/ALWAYS POINTS TO BEGIN OF DESCRIPTOR
			/FOR CURRENT OBJECT FIELD
M,	0		/USED BY DECADD
N,	0		/USED BY DECADD (LENGTH OF B)
A,	0		/USED BY DECADD
B,	0		/USED BY DECADD
SACT,
T1,	0		/TEMP USED BY DECADD
AFLAG,
T2,	0		/TEMP USED BY DECADD
KENT,
SA,	0		/SIGN OF A
LIKE,	0		/0 IF SAME SIGN
T,	0		/TEMP
OVFL,	0		/# OF OVERFLOWS
/ALL THE ABOVE USED BY DECADD
KINPUT,	0		/PTR TO PHASE 2 INPUT DEVICE
LSTSW2,	1		/0 MEANS LIST DATA
OBJSIZ,	0		/HOLDS SIZE OF OBJECT FIELD
OBJTYP,	0		/TYPE OF OBJECT FIELD
IFN,	0		/OUTPUT IFN #
OLFLG,	-1		/FIRST TIME THRU FLAG
BYTOFF,	0		/OFFSET OF OBJ FIELD IN DATTAB
SYS,	0		/101 IF SYS IS INPUT DEVICE
INNUM,	0		/# OF INPUT RECORDS READ
GHOST,	0		/START OF GHOST STUFF
BADNUM,	0		/# OF BAD INPUT RECORDS
PARITY,
MAXFMT,	0
QFLAG,	0		/1 MEANS QUOTED STRING
NXTSTR,	0		/ADDR OF NEXT *-DESCR, 0 MEANS NONE
M100,	7700

	*600
/INPUT SECTION DECODER
/***************************************/
/					/
/   <INPUT-SECTION> ::=			/
/					/
/	INPUT <DEVICE>			/
/					/
/	<INPUT-RECORD-DESCRIPTOR>...	/
/					/
/***************************************/
/				/
/   <DEVICE> ::=		/
/				/
/	KBD ! CDR ! RDR ! SYS	/
/				/
/*******************************/

INSEC,	CALL (MOVPH2
	CALL ZKEYWRD	/LOOK FOR
	KINPOT		/"INPUT"
	JMP ERC1	/NOT THERE IS ERROR
	CALL ZKEYWRD	/LOOK FOR DEVICE
	KKBD		/IS IT "KBD"?
	SKP		/NO
	JMP INSET	/YES (DEVICE CODE=0)
	CALL ZKEYWRD
	KCDR		/IS IT "CDR"?
	SKP		/NO
	JMP INCDR	/YES
	CALL ZKEYWRD
	KRDR		/IS IT "RDR"?
	SKP		/NO
	JMP INRDR	/YES
	CALL ZKEYWRD
	KSYS		/IS IT "SYS"?
	JMP ERC2	/NO, ERROR
INSYS,	TAD (READLN
	DCA KINPUT
	TAD (INTAIL+400
	DCA DETAIL
	TAD (53-INTLEN
	DCA I (INPKNT
	TAD (101
	DCA SYS		/SET BLANKING FIELD
	STL CLA RAR
	JMP INSET
/OPEN DEVICE WITH SYSINI
INRDR,	TAD (2		/RDR CODE IS 4
INCDR,	TAD (2		/CDR CODE IS 2
INSET,	DCA DEVYCE	/STORE HANDLER CODE

/	INPUT RECORD DESCRIPTOR
/***************************************/
/					/
/   <INPUT-RECORD-DESCRIPTOR> ::=	/
/					/
/	<KEYWORD> [,] [<OUTPUT-FORMAT#>]/  , MEANS SPECIAL MODE
/					/
/	<FIELD-DETAILER>...		/
/					/
/***************************************/
/				/
/   <OUTPUT-FORMAT#> ::=	/
/				/
/	<DIGIT>			/   (MUST BE IN RANGE 1-7)
/				/
/*******************************/

	CALL ZREADLN	/GET NEXT LINE
INDESC,	CALL ZRESET	/RESET SCAN
	DCA MODE
	CALL ZGETCHR	/GET FIRST CHARACTER
	JMP INDESC-1
	TAD (-13
	SZA CLA		/IS IT "*"?
	JMP KEY		/NO
	TAD (113	/YES
	CALL (PUTINP	/INSERT A B*BBBB IN INPTAB
	TAD (101
	CALL (PUTINP
	TAD (101
	CALL (PUTINP
	TAD (INPTAB
	DCA NXTSTR
	JMP OUTN
KEY,	CALL ZRESET
	CALL (KEYNAM	/LOOK FOR KEYWORD NAME
OUTN,	CALL ZGETCHR	/GET NEXT CHAR
	TAD (21		/NOTHING INDICATES FORMAT 0
	TAD (-15
	SZA		/COMMA?
	JMP ODI		/NO
	STL CLA RAR	/YES
	DCA MODE	/MODE BIT=4000
	CALL ZGETCHR
	TAD (21		/SEE NOTE ABOVE
	SKP
ODI,	TAD (15		/RESTORE
	CALL ZDIGIT	/IS IT A DIGIT?
	JMP ERC3	/NO, ERROR
	DCA TEM
	TAD TEM
	CIA
	TAD MAXFMT
	SMA CLA
	JMP .+3
	TAD TEM
	DCA MAXFMT
	TAD TEM
	TAD MODE	/INSERT MODE BIT
	CALL (PUTINP	/INSERT FORMAT NO IN INPTAB
	TAD DETAIL
	CALL (PUTINP	/INSERT DETAILER ADDRESS
	CALL ZGETCHR	/ANY MORE CHARS?
	JMP I (DETAI	/NO, GOOD PROCESS DETAILERS
	CLA		/TROUBLESOME CHAR
	CALL ZRESET	/YES, MIGHT BE BAD
	CALL ZKEYWRD
	KOUTPUT		/GOOD ONLY IF "OUTPUT"
	JMP ERD1	/BAD, EXTRANEOUS TEXT
	TAD (-5		/GOOD
	TAD PINPT
	DCA PINPT
	CALL (PUTINP	/END OF TABLE
	STA
	DCA LINKNT	/EJECT
	TAD (Q3-1
	DCA I (SUBHD	/SET SUBTITLE
	JMP I (OUTSEC	/PROCESS OUTPUT SECTION

ERC1,	CALL ZERROR	/INVALID INPUT STATEMENT
	ERRC1-1
ERC2,	CALL ZERROR	/BAD DEVICE
	ERRC2-1
ERC3,	CALL ZERROR	/BAD FORMAT NUMBER
	ERRC3-1
ERD1,	CALL ZERROR	/EXTRANEOUS TEXT
	ERRD1-1
UNDFMT,	TAD (VOILA2+1
	DCA I ZREADLN
	CALL ZERROR
	ERRC15-1
	PAGE

/GET DETAILERS
/***************************************/
/					/
/   <FIELD-DETAILER> ::=		/
/					/
/	<OBJECT-FIELD>			/
/					/
/	  ERROR				/
/	[ SKIP		    ]		/
/	  = <DEFAULT-FIELD>		/
/					/
/	[<FLAG-FIELD>]			/
/					/
/	[RANGE( [<LOW>] , [<HIGH>] )]	/
/					/
/	[HASH <HASH-FIELD>]		/
/					/
/	[CHECK]				/
/					/
/***************************************/
/				/
/ <DEFAULT-FIELD> MUST HAVE	/
/	SAME SIZE AND TYPE	/
/	AS <OBJECT-FIELD>.	/
/				/
/ <FLAG-FIELD>, <HASH-FIELD>,	/
/ <LOW> AND <HIGH> MUST ALL	/
/ BE DECIMAL.			/
/				/
/ SIZE OF <LOW> MUST BE <=	/
/	SIZE OF <OBJECT-FIELD>.	/
/				/
/ SIZE OF <HIGH> MUST BE >=	/
/	SIZE OF <OBJECT-FIELD>.	/
/				/
/*******************************/

DETAI,	CALL ZREADLN	/GET NEXT LINE
	CALL ZFNAME	/GET OBJECT FIELD
	JMS DPUT	/INSERT IN INTAIL
	CDF INTFLD+BASFLD
	TAD I DETAIL	/RETRIEVE OBJECT FIELD #
	CDF BASFLD
	SNA
	JMP I PINDESC	/NO MORE DETAILS
	CIA
	TAD CBRK
	SPA CLA
	JMP ERC4	/OBJECT FIELD CAN'T BE "C"
	TAD SIZE
	DCA OBJSIZ
	TAD TYPE
	DCA OBJTYP
	CALL ZGETCHR	/GET NEXT CHAR
	JMP NOTHIN
	TAD (-36
	SZA CLA		/IS IT "="?
	JMP NOEQ	/NO
	CALL ZFNAME	/YES, GET DEFAULT FIELD
	DCA TEM
	TAD SIZE
	CIA
	TAD OBJSIZ
	SZA CLA
	JMP ERC11	/WRONG SIZE
	TAD TYPE
	CIA
	TAD OBJTYP
	SZA CLA
	JMP ERC11
	TAD TEM
	JMP DP		/INSERT IN INTAIL
ERC11,	CALL ZERROR	/DEFAULT FIELD WRONG SIZE OR TYPE
	ERRC11-1

NOEQ,	CALL ZBACKUP	/PUT BACK ONE CHAR
NOTHIN,	CALL ZKEYWRD
	KERROR		/LOOK FOR "ERROR"
	SKP		/NOT FOUND
	JMP DP		/PUT 0 AS DEFAULT FIELD
	CALL ZKEYWRD
	KSKIP		/LOOK FOR "SKIP"
PINDESC,INDESC		/*****(NOP) NOT THERE IMPLIES THERE
	STA		/NEGATIVE DEFAULT FIELD # MEANS SKIP
DP,	JMS DPUT	/INSERT IN INTAIL
	INCR AFLAG	/FLAG DOESN'T REQUIRE DEC OBJ FIELD
	CALL ZFNAME	/GET FLAG FIELD
	SNA
	JMP NOFLAG
	CALL (D		/INSERT IN INTAIL
	CLA
FLAGG,	DCA AFLAG	/LIMS AND HASH REQ DEC OBJ FIELD
	CALL ZKEYWRD
	KRANGE		/LOOK FOR "RANGE"
	JMP HSH		/NOT THERE
	CALL ZGETCHR	/THERE
	JMP ERC6
	TAD (-11	/NEXT CHAR MUST BE "("
	SZA CLA
	JMP ERC6	/MISSING "("
	CALL ZFNAME	/GET LOW-LIMIT
	CALL (D		/INSERT IN INTAIL
	SPA CLA
	JMP ERC13	/SIZE TOO BIG
	CALL (COMA
	JMP ERC6
	CALL ZFNAME	/GET HIGH-LIMIT
	CALL (D		/INSERT IN INTAIL
	SMA SZA CLA
	JMP ERC13	/SIZE TOO SMALL
	CALL ZGETCHR	/NEXT CHAR MUST BE ")"
	JMP ERC6
	TAD (-12
	SNA CLA
	JMP HSH2
ERC6,	CALL ZERROR	/MISSING CLOSE PAREN
	ERRC6-1
NOFLAG,	JMS DPUT
	JMP FLAGG

HSH,	JMS DPUT	/INSERT 0'S FOR LOW AND HIGH LIMS
	JMS DPUT
HSH2,	CALL ZKEYWRD
	KHASH		/LOOK FOR "HASH"
	JMP NOHASH	/NOT FOUND
	CALL ZFNAME	/GET HASH-FIELD
	SNA
	JMP ERC5
	CALL (D		/INSERT IN INTAIL
	CLA SKP
NOHASH,	JMS DPUT
	CALL ZKEYWRD
	KCHECK		/LOOK FOR "CHECK"
	JMP DETAI	/NOT FOUND
	TAD OBJTYP
	SNA CLA
	JMP I (ERC14
	STL CLA RAR	/4000
	CDF INTFLD+BASFLD
	TAD I DETAIL
	DCA I DETAIL	/TURN ON HIGH ORDER BIT
	CDF BASFLD
	JMP DETAI

ERC4,	CALL ZERROR	/ILLEGAL C-FIELD
	ERRC4-1
ERC5,	CALL ZERROR	/MISSING HASH FIELD
	ERRC5-1
ERC12,	CALL ZERROR	/NOT DECIMAL
	ERRC12-1
ERC13,	CALL ZERROR	/LIMIT WRONG SIZE
	ERRC13-1

/	DPUT
/THIS ROUTINE INSERTS A NUMBER (FOUND IN THE AC)
/IN THE TABLE, 'INTAIL', AT ITS NEXT FREE SPOT.
/THE AC IS FREE UPON RETURNING, AND 'DETAIL'
/POINTS TO THE ENTRY JUST INSERTED.
/'INPKNT' IS MINUS THE NUMBER OF FREE ENTRIES LEFT.
DPUT,	0
	INCR DETAIL	/POINT TO NEXT ENTRY
	CDF INTFLD+BASFLD
	DCA I DETAIL	/INSERT VALUE
	CDF BASFLD
	ISZ INPKNT
	EXIT DPUT	/RETURN
	JMP I (FATAL
INPKNT,	-INTLEN		/MINUS NO. OF ENTRIES LEFT IN INTAIL
	PAGE

/	KEYWRD
/THIS ROUTINE LOOKS FOR THE OCCURRENCE OF A KEYWORD
/IN THE INPUT BUFFER.  THE KEYWORD IS A STRING OF
/CHARACTERS (NONE BLANK OR TAB) AND THE MATCH IS
/SUCCESSFUL EVEN IF THERE ARE LEADING, TRAILING, OR
/INTERMEDIATE SPACES OR TABS.
/IF NOT FOUND, AN ERROR RETURN IS MADE AND THE SCAN IS RESET.
/IF FOUND, THE SCAN ADVANCES PAST THE KEYWORD.
/
/CALLING SEQUENCE:
/
/	CALL (KEYWRD
/	ADDRESS OF KEYWORD-RECORD
/	<ERROR RETURN>
/	<NORMAL RETURN>
/
/THE KEYWORD-RECORD HAS THE FOLLOWING FORMAT:
/
/	FIRST WORD:	WORD COUNT	(MINUS THE NUMBER OF
/					CHARACTERS IN THE KEYWORD)
/
/	SUCCEEDING WORDS: TWOS COMPLEMENT OF THE -237 CODE FOR THE CHAR
KEYWRD,	0
	TAD CHCT
	DCA SAVECH	/SAVE SCAN POINTER POSITION
	STA
	TAD I KEYWRD	/GET ADDRESS OF KEYWORD-RECORD - 1
	DCA X0		/PUT IN AUTO-INDEX REGISTER
	INCR KEYWRD	/PASS UP ARGUMENT (PT TO ERROR RETURN)
	TAD I X0	/GET WORD COUNT
	DCA KOUNT	/USE IT TO SET 'KOUNT'
KEYLUP,	CALL ZGETCHR	/GET NEXT CHARACTER
	NOP
	TAD I X0	/COMPARE WITH DESIRED CHAR
	SZA CLA		/IS IT MATCH?
	JMP NOPE	/NO
	ISZ KOUNT	/YES, SO FAR
	JMP KEYLUP	/CONTINUE CHECKING
	INCR KEYWRD	/DONE, PERFECT MATCH
	EXIT KEYWRD	/MAKE NORMAL RETURN
NOPE,	TAD SAVECH
	DCA CHCT	/RESTORE SCAN PTR
	EXIT KEYWRD	/MAKE ERROR RETURN
SAVECH,	0		/HOLDS SCAN POINTER TEMPORARILY
KOUNT,	0		/TEMPORARY COUNTER

	SIX=OTBL2+1
	MSIX=OTBL+1
RESET,	0
	TAD SIX
	DCA CHCT	/SET CHCT BACK TO 6
	EXIT RESET
KEYSUB,	0
	TAD MSIX
	DCA KENT
	TAD (KEYLST-1
	DCA X0
	EXIT KEYSUB

/	KEYNAM
/THIS ROUTINE LOOKS FOR A KEYWORD NAME IN THE INPUT BUFFER.
/SUCH A NAME IS A SEQUENCE OF LETTERS ONLY.
/IF NOT FOUND, AN ERROR MESSAGE IS GENERATED.
/IF FOUND, THE SCAN ADVANCES PAST IT,
/AND THE FIRST 6 LETTERS ARE PLACED IN 3 SUCCESSIVE
/LOCATIONS POINTED TO BY 'PINPT'. (USUALLY IN FIELD INPFLD)
/IF FEWER THAN 6 LETTERS APPEAR, BLANKS ARE PADDED ON THE RIGHT.
KEYNAM,	0
	JMS KEYSUB	/SET UP
	IAC
	DCA I X0	/STORE BLANKS IN KEYLIST
	ISZ KENT
	JMP .-3
	JMS KEYSUB	/RESET UP
KEYLP,	CALL (GCH	/GET NEXT CHAR
	JMP NONLET+1	/NO MORE
	TAD M1
	SNA		/IS IT A SPACE?
	JMP NONLET	/YES
	TAD (1-15	/NO
	SNA		/IS IT A COMMA?
	JMP NONLET	/YES
	TAD (15-20
	SNA		/IS IT /?
	JMP NONLET+1
	TAD (20		/NO, RESTORE CHAR
	DCA I X0	/STORE IN KEYLIST
	ISZ KENT	/6 LETTERS YET?
	JMP KEYLP	/NO, KEEP GOING
	SKP		/YES
NONLET,	CALL ZBACKUP	/PUT BACK NON-LETTER
	TAD (3		/TRICK LEARNED FROM RL
	JMS KEYSUB	/RERESET UP
SETLUP,	TAD I X0	/GET LETTER
	CLL RTL
	RTL
	RTL
	TAD I X0	/ADD IN RIGHT HALF
	INCR PINPT
TRICK,	CDF INPFLD+BASFLD
	DCA I PINPT	/STORE
	CDF BASFLD
	ISZ KENT	/DONE? (6 CHARS?)
	JMP SETLUP	/NO
	CALL ZGETCHR
	ISZ CHCT
	TAD (-20
	SZA CLA
	CALL ZBACKUP
	EXIT KEYNAM	/YES, LEAVE

/LETTER,	0
/	TAD (-74
/	CLL
/	TAD (32
/	SNL
/	JMP NOLE
/	INCR LETTER
/	TAD (42		/RESTORE LETTER
/	EXIT LETTER
/NOLE,	CLA
/	EXIT LETTER

/	O-TABLE
/	(I)	LENGTH OF FIRST BUFFER
/	(II)	LENGTH OF ALL SUCCEEDING BUFFERS
/8K (USES ONLY 2000 WORDS)
OTBL2,	4^400;6		/1
	2^400;2^400	/2
	2^400;1^400	/3
	1^400;1^400	/4
/12K (USES ONLY 7000 WORDS)
OTBL,	7^1000;-6	/1
	4^1000;3^1000	/2
	3^1000;2^1000	/3
	4^1000;1^1000	/4
	3^1000;1^1000	/5
	2^1000;1^1000	/6
	1^1000;1^1000	/7

D,	0
	CALL (DPUT	/INSERT
	TAD TYPE
	SNA CLA
	JMP I (ERC12	/NOT DECIMAL
	TAD AFLAG
	TAD OBJTYP
	SNA CLA
	JMP ERC14
	TAD SIZE
	CIA
	SNA
	EXIT D
	TAD OBJSIZ
	EXIT D
ERC14,	CALL ZERROR	/OBJECT FIELD NOT DECIMAL
	ERRC14-1
/IF AFLAG IS 0, THEN OBJFLD=A (0) IS BAD.
	PAGE

/	FNAME
/THIS ROUTINE LOOKS FOR A FIELD NAME IN THE INPUT BUFFER.
/IF FOUND, THE SCAN ADVANCES PAST IT, AND THE NUMBER OF THE FIELD,
/MEASURED AS AN ENTRY OFFSET IN DSCTAB,
/IS LEFT IN THE AC.
/IF NOT FOUND, BUT STARTS WITH F, T, OR C, AN ERROR IS GENERATED.
/IF NOT FOUND, AND DOES NOT START WITH F, T, OR C, A NORMAL
/RETURN IS MADE, BUT THE AC IS ZERO.
/TYPE AND SIZE ARE SET.
/RECALL:
/*******************************/
/				/
/   <FIELD-NAME> ::=		/
/				/
/	F			/
/	T <NUMBER>		/	(NUMBER MUST BE
/	C			/	IN RANGE 1-511)
/				/
/*******************************/
/CALLING SEQUENCE:
/
/	CALL (FNAME
/	<NORMAL RETURN>		/FIELD NUMBER IN AC
/

FNAME,	0
	CLA IAC
	DCA TYPE
	DCA SIZE
	TAD CHCT
	DCA SACT	/SAVE SCAN PTR
	CALL ZGETCHR	/GET NEXT CHARACTER
	EXIT FNAME	/NOTHING IS ERROR, RETURN WITH AC=0
	TAD (-47
	SNA		/IS IT "F"?
	JMP FNAM	/YES
	TAD (47-65	/NO
	SNA		/IS IT "T"?
	JMP TNAM	/YES
	TAD (65-44	/NO
	SZA CLA		/IS IT "C"?
	JMP EXF		/NO, RETURN WITH AC=0
CNAM,	TAD CLIM
	DCA LIM		/LAST C NUMBER
	TAD CBRK
	JMP NOM
TNAM,	TAD TLIM
	DCA LIM		/LAST T NUMBER
	TAD TBRK
	JMP NOM
FNAM,	TAD FLIM
	DCA LIM		/LAST FNUMBER
NOM,	DCA BRK		/LAST F\T\C NUMBER
	JMS NUMY

	SNA		/IS IT 0?
	JMP EXF		/YES, NOT A FIELD NAME
	CIA		/NO
	TAD LIM		/COMPARE WITH LIMIT ON FIELDS SPECIFIED
	SPA CLA
	JMP ERB4	/OUT OF RANGE
	TAD FNUM	/ADD NUMBER
	TAD BRK		/TO BASE
	DCA TEM
	TAD TEM
	TAD (DSCTAB-1
	DCA SACT
	CDF DSCFLD+BASFLD
	CLA IAC
	AND I SACT
	DCA TYPE
	TAD I SACT
	CLL RAR
	CIA
	DCA FNUM
	INCR SACT
	TAD I SACT
	CLL RAR
	TAD FNUM
	SNA
	JMP ERB4
	DCA SIZE
	CDF BASFLD
	TAD TEM
	EXIT FNAME	/RETURN
EXF,	TAD SACT
	DCA CHCT	/RESTORE SCAN PTR
	EXIT FNAME
	OKNT=SACT

NUMY,	0
	DCA FNUM
FNDGLP,	CALL ZGETCHR	/GET NEXT CHAR
	JMP DGEND	/NONE MEANS END OF DIGITS
	CALL ZDIGIT	/IS IT A DIGIT?
	JMP DGEND	/NO, END OF DIGITS
	DCA TEM		/YES
	TAD FNUM	/GET PREVIOUS NUMBER
	CLL RTL		/X4
	TAD FNUM	/X5
	RAL		/X10 (DECIMAL)
	TAD TEM		/ADD IN NEW DIGIT
	SPA SZL		/LINK MUST BE ZERO AND AC > 0
	JMP ERB2	/ERROR - NUMBER TOO BIG
	DCA FNUM	/MAKE NEW NUMBER
	JMP FNDGLP	/REITERATE
DGEND,	TAD FNUM	/GET NUMBER
	EXIT NUMY

ERB2,	CALL ZERROR	/FIELD NUMBER TOO BIG
	ERRB2-1
ERB4,	CALL ZERROR	/FIELD DOESN'T APPEAR IN DEFINE SECTION
	ERRB4-1

/	OPEN
/THIS ROUTINE OPENS ALL THE OUTPUT FILES.
/IT ALLOCATES ALL THE BUFFERS (SIZES AND POSITIONS).
/THE NUMBER OF OUTPUT FILES IS GIVEN BY 'OUTNO'
/WHICH HOPEFULLY IS ALREADY SET.
	OFLD=10		/FIELD OF OUTPUT BUFFERS
	OBUF=1000	/START OF OUTPUT BUFFERS
/	(ASSUMED LENGTH OF 4^400)
OPEN,	0
/	TAD OUTNO
/	CIA
/	DCA OKNT	/SET COUNTER
/UNITBL MUST BE IN FIELD 0
	TAD (TRIES-1
	DCA X7
OLOOP,	CALL (GETOL	/GET OUTPUT BUFFER LENGTH (IN WDS)
	DCA TEMP	/SAVE IT
	TAD TEMP
	STL RAR		/*** GET LENGTH (IN INIT UNITS)
	TAD OTFLD	/ADD IN FIELD
	DCA RWLF
	INCR IFN	/INCREMENT IFN #
	TAD I X7
	DCA I GLOC
	TAD IFN		/GET IFN #
	CALL KINIT	/PERFORM INIT
FNUM,
RWLF,	0
	200		/FUDGE
OLBL,	UNITBL-1	/POINTS TO BEFORE UNIT ID
	TAD I W1	/UNFUDGE
	AND (177
	TAD OLOC
	DCA I W1
	STA
	TAD OLOC
	DCA I W2
	TAD OLOC
	TAD TEMP
	DCA OLOC	/INCREMENT BUFFER LOCATION
	TAD OLBL
	TAD (4
	DCA OLBL
	ISZ OKNT	/ANY MORE?
	JMP OLOOP	/YES
	EXIT OPEN	/NO, RETURN
OTFLD,	OFLD		/FIELD OF OUTPUT BUFFERS
OLOC,	OBUF
GLOC,	0

	PAGE

/***********************************************/
/						/
/   <OUTPUT-SECTION> ::=			/
/						/
/	OUTPUT <OUTPUT-FORMAT-NO> <UNIT-ID>	/
/						/
/	<FIELD-DEPICTOR>...			/
/						/
/	END					/
/						/
/***********************************************/
/						/
/   <FIELD-DEPICTOR> ::=			/
/						/
/	<FIELD-NAME> [ + [<INCREMENT>] ]	/
/		       C			/
/						/
/***********************************************/
/				/
/   <INCREMENT> ::=		/
/				/
/	<FIELD-NAME>		/
/				/
/*******************************/
/ <INCREMENT> MUST BE DECIMAL	/
/ AND HAVE SIZE NO GREATER	/
/ THAN SIZE OF <FIELD-NAME>.	/
/*******************************/

TRYOUT,	TAD (DEPIC+1
	DCA I ZREADLN	/TRICK ERROR ROUTINE***
	CALL ZKEYWRD
	KOUTPUT		/LOOK FOR "OUTPUT"
	JMP ERD4	/ERROR
OUTSEC,	CALL ZGETCHR	/GET EXPECTED OUTPUT FORMAT NO
M1000,	NOP		/DNO
	CALL ZDIGIT	/MAKE SURE IT'S A DIGIT
	JMP ERD2	/IT AIN'T -  ERROR
	CIA		/IT IS
	INCR OUTNO
	TAD OUTNO
	SZA CLA		/IS IT DIGIT EXPECTED?
	JMP ERD2	/NO, ERROR
	TAD OUTNO
	TAD CORAMT
	TAD (-5
	SMA CLA
	JMP ERD2	/8
	DCA LENTH
	JMS UNITID	/YES, PROCESS UNIT ID
	TAD DEPICT
	DCA I POUTPT	/INSERT ADDRESS OF START OF FIELD DEPICTOR

DEPIC,	CALL ZREADLN	/GET NEXT LINE
	CALL ZFNAME	/GET FIELD NAME
	SNA		/IS IT LEGAL FIELD NAME?
	JMP TRYEND	/NO, MAYBE IT'S "END"
	JMS DPOUT	/YES, INSERT IN INPICT
	TAD LENTH
	TAD SIZE
	DCA LENTH
	TAD SIZE
	DCA OBJSIZ
	TAD LENTH
	CLL
	TAD M1000
	SZL CLA
	JMP ERD7	/OUTPUT RECORD TOO BIG
	CALL ZGETCHR	/GET NEXT CHAR
	JMP PIC		/NO OPTIONS SPECIFIED
	TAD (-44
	SZA		/IS IT "C"?
	JMP PLUS	/NO
	STL CLA RAR	/YES (4000)
	JMP PIC
PLUS,	TAD (44-14
	SZA CLA		/IS IT ";"?
	JMP ERD3	/NO, ERROR
	CALL ZFNAME	/YES, GET INCREMENT FIELD NUMBER
	SNA
	STA		/IF NOT THERE, USE -1 TO INDICATE INCR BY 1
PIC,	JMS DPOUT	/INSERT IN INPICT
	TAD SIZE
	CIA
	TAD OBJSIZ
	SPA CLA
	JMP ERD10	/INCREMENT SIZE TOO BIG
	JMP DEPIC
TRYEND,	JMS DPOUT	/END OFF DEPICTOR
	CALL ZKEYWRD
	KEND		/IS IT "END"?
	JMP TRYOUT	/NO MAYBE IT'S OUTPUT
	CALL ZGETCHR	/YES, ANY MORE CHARS?
	JMP VOILA	/NO, GOOD
	CALL ZERROR	/YES, BAD
	ERRD5-1

DPOUT,	0
	ISZ OUPKNT	/ROOM LEFT IN INPICT?
	SKP		/YES
	JMP I (FATAL	/NO, TABLE OVERFLOW
	INCR DEPICT	/POINT TO NEXT ENTRY
/CHECK DETAIL OR DEPICT 
	CDF PICFLD+BASFLD
	DCA I DEPICT	/INSERT VALUE
	CDF BASFLD
	EXIT DPOUT	/LEAVE
OUPKNT,	-INPLEN		/-NUMBER ENTRIES LEFT IN INPICT

/ HAVE SEEN END
VOILA,	TAD MAXFMT
	CIA
	TAD OUTNO
	SPA CLA
	JMP I (UNDFMT
VOILA2,	CALL (ONCE	/PHASE 2 ONCE-ONLY CODE
	JMP I (MOVE2	/MOVE DOWN PHASE 2 PART 2

UNITID,	0
	CALL ZGETCHR
	INCR CHCT
	CLA
	CALL ZBACKUP
	TAD (CDF BASFLD
	DCA I (TRICK	/SIGNAL KEYNAM
	TAD POUTPT
	DCA PINPT	/USED BY KEYNAM
	CALL (KEYNAM	/INSERT UNIT ID INTO UNITBL
/	TAD (CDF INPFLD+BASFLD
/	DCA I (TRICK	/RESTORE KEYNAM TO FULL GLORY
	TAD POUTPT
	TAD (4
	DCA POUTPT
	CALL (NUMY
	AND L17
	DCA I X7	/SAVE TRY UNIT
	EXIT UNITID	/RETURN
POUTPT,	UNITBL-1	/POINTS INTO 'UNITBL'.
LENTH,	0		/LENGTH OF OUTPUT RECORD

ERD2,	CALL ZERROR	/OUT FORMAT NO OUT OF ORDER OR = 8
	ERRD2-1
ERD3,	CALL ZERROR	/BAD OPTION
	ERRD3-1
ERD4,	CALL ZERROR	/BAD DEPICTOR
	ERRD4-1
ERD5,	CALL ZERROR	/BAD END STATEMENT
	ERRD5-1
ERD7,	CALL ZERROR	/OUTPUT RECORD TOO BIG
	ERRD7-1
ERD10,	CALL ZERROR	/INCREMENT SIZE TOO BIG
	ERRD10-1
	PAGE

/	ONCE ONLY CODE
/	DEVICES CODES:
/	KBD	0
/	TTY	1
/	CDR	2
/	RDR	4
/	SYS	4000
ONCE,	0
	CALL (LPRINT	/PRINT END
	DCA I (XTRTXT
	TAD I (ERKNT
	SNA CLA
	JMP .+3
	DCA I (DOSW
	JMP I P7600
	TAD (Q5-1
	DCA I (SUBHD	/SET SUBTITLE
	STA
	DCA LINKNT
	TAD I (EOF2
	DCA I (EOFERR
	TAD (ERROR2
	DCA ZERROR	/SET NEW ERROR ROUTINE
	TAD LSTSW2
	DCA LSTSW	/SET NEW LIST SWITCH
	TAD CORAMT
	SZA CLA		/HOW MUCH CORE?
	JMS K		/>8K
	DCA EDIT
	DCA PROMPT
	TAD DEVYCE
	SMA CLA
	JMP NOTSIS
	TAD (INTAIL
	DCA I (XINBUF
	STA
	DCA I (FSTSW
NOTSIS,	TAD DEVYCE	/GET INPUT HANDLER
	SZA CLA		/IS IT KBD?
	JMP NOTKBD	/NO
	TAD (11		/YES
	CALL KCDOIO	/OUTPUT TO TTY
	MESG1-1		/"DO YOU PREFER PROMPTING?"
L20,	20
	JMS ANS		/GET ANSWER
	JMP YESED	/NO
	TAD L4
	DCA PROMPT	/YES, NOTE FACT
	JMP YESED	/PROMPTING IMPLIES ON-LINE EDITING
NOTKBD,	TAD (11
	CALL KCDOIO	/OUTPUT TO TTY
	MESG2-1		/"DO YOU WISH TO EDIT ON-LINE?"
L4,	4
	JMS ANS		/GET ANSWER
	SKP		/NO
YESED,	INCR EDIT	/YES, NOTE FACT
	TAD OUTNO
	CIA
	DCA OKNT
	CALL (OPEN	/ALLOCATE BUFFERS
	EXIT ONCE	/LEAVE

K,	0
	TAD (OTBL-2
	DCA I (POTBL
	DCA I POLOC	/12K BUFFERS START AT 0
	TAD L20
	DCA I (OTFLD	/IN FIELD 2
	EXIT K

Q2,	-10
		/   INPUT SECTION\
101
152
5761
6665
164
4644
6552
6057
Q3,	-11
		/   OUTPUT SECTION\
101
160
6665
6166
6501
6446
4465
5260
5700

/	ANS
/THIS ROUTINE GETS A YES OR NO REPLY FROM THE KBD.
/	JMS ANS
/	<"NO" RETURN>
/	<"YES" RETURN>
ANS,	0
	DCA I (BUFFER	/ZERO BUFFER
	TAD M100
	DCA LENGTH
	CALL KCDOIO	/READ FROM KBD
	BUFFER-1	/INTO LINE BUFFER
POLOC,	OLOC		/LINE TOO LONG TRATED AS "NO"
	TAD I (BUFFER+1	/GET FIRST 2 CHARS OF REPLY
	AND (7700
	TAD (-7200
	SNA CLA
	INCR ANS	/YES
	EXIT ANS	/NO

GETOL,	0		/GET NEXT OUTPUT BUFFER LENGTH
	ISZ OLFLG	/FIRST TIME THROUGH?
	JMP GETOL2	/NO
	TAD OUTNO	/YES
	CLL RAL
	TAD POTBL
	DCA POTBL
	TAD I POTBL
	INCR POTBL
	EXIT GETOL
GETOL2,	TAD I POTBL
	EXIT GETOL
POTBL,	OTBL2-2		/POINTS INTO O-TABLE
	PAGE

/KEYWORD RECORDS
KKBD,	-3
	-54;-43;-45
KCDR,	-3
	-44;-45;-63
KRDR,	-3
	-63;-45;-63
KSYS,	-3
	-64;-72;-64
KINPOT,	-5
	-52;-57;-61;-66;-65
KERROR,	-5
	-46;-63;-63;-60;-63
KSKIP,	-4
	-64;-54;-52;-61
KRANGE,	-5
	-63;-42;-57;-50;-46
KHASH,	-4
	-51;-42;-64;-51
KCHECK,	-5
	-44;-51;-46;-44;-54
KOUTPUT,-6
	-60;-66;-65;-61;-66;-65
KEND,	-3
	-46;-57;-45
/MUST END BEFORE 2300.
/2300: 100 WORD  LINE BUFFER.
	PAGE

	*2400
/	ERROR MESSAGES (BUILD)
ERRB1,	ERRB1-ERRB2+1
		/MISSING FIELD NAME\
5652
6464
5257
5001
4752
4655
4501
5742
5646
ERRB2,	ERRB2-ERRB4+1
		/BAD FIELD NUMBER\
4342
4501
4752
4655
4501
5766
5643
4663
ERRB4,	ERRB4-ERRB6+1
		/UNDEFINED FIELD\
6657
4546
4752
5746
4501
4752
4655
4500
ERRB6,

ERRC1,	ERRC1-ERRC2+1
		/BAD INPUT STATEMENT\
4342
4501
5257
6166
6501
6465
4265
4656
4657
6500
ERRC2,	ERRC2-ERRC4+1
		/BAD DEVICE\
4342
4501
4546
6752
4446
ERRC4,	ERRC4-ERRC5+1
		/C-FIELD NOT PERMITTED\
4416
4752
4655
4501
5760
6501
6146
6356
5265
6546
4500
ERRC5,	ERRC5-ERRC6+1
		/HASH FIELD MISSING\
5142
6451
147
5246
5545
156
5264
6452
5750
ERRC6,	ERRC6-ERRC10+1
		/BAD RANGE CONSTRUCTION\
4342
4501
6342
5750
4601
4460
5764
6563
6644
6552
6057
ERRC10,	ERRC10-ERRC11+1
		/OUT OF ROOM!\
6066
6501
6047
163
6060
5602	/TABLE OVERFLOW
ERRC11,	ERRC11-ERRC12+1
		/BAD DEFAULT FIELD\
4342
4501
4546
4742
6655
6501
4752
4655
4500
ERRC12,	ERRC12-ERRC13+1
		/FIELD NOT DECIMAL\
4752
4655
4501
5760
6501
4546
4452
5642
5500
ERRC13,	ERRC13-ERRC14+1
		/LIMIT BAD SIZE\
5552
5652
6501
4342
4501
6452
7346
ERRC14,	ERRC14-ERRC15+1
		/DESTINATION FIELD NOT DECIMAL\
4546
6465
5257
4265
5260
5701
4752
4655
4501
5760
6501
4546
4452
5642
5500
ERRC15,	ERRC15-ERRC16+1
		/UNDEFINED FORMAT\
6657
4546
4752
5746
4501
4760
6356
4265
ERRC16,
ERR1,	ERR1-ERRR2+1
		/UNEXPECTED END OF FILE\
6657
4671
6146
4465
4645
146
5745
160
4701
4752
5546
ERRR2,

ERR15,
ERRD1,	ERRD1-ERRD3+1
		/EXTRA CHARS AT STMNT END\
4671
6563
4201
4451
4263
6401
4265
164
6556
5765
146
5745
ERRD3,	ERRD3-ERRD4+1
		/BAD OPTION\
4342
4501
6061
6552
6057
ERRD4,	ERRD4-ERRD5+1
		/BAD DEPICTOR\
4342
4501
4546
6152
4465
6063
ERRD5,	ERRD5-ERRD6+1
		/BAD END STMNT\
4342
4501
4657
4501
6465
5657
6500
ERRC3,
ERRD2,
ERRD6,	ERRD6-ERRD7+1
		/BAD OUTPUT FORMAT #\
4342
4501
6066
6561
6665
147
6063
5642
6501
400
ERRD7,	ERRD7-ERRD10+1
		/OUTPUT RECORD TOO BIG\
6066
6561
6665
163
4644
6063
4501
6560
6001
4352
5000
ERRD10,	ERRD10-ERRD11+1
		/INCREMENT TOO BIG\
5257
4463
4656
4657
6501
6560
6001
4352
5000
ERRD11,

PUTINP,	0
	ISZ TABKNT	/ROOM LEFT?
	JMP ROOMLF	/YES
FATAL,	CLA		/NO
	TAD (7601
	DCA I ZREADLN
	CALL ZERROR
	ERRC10-1
ROOMLF,	INCR PINPT
	CDF INPFLD+BASFLD
	DCA I PINPT
	CDF BASFLD
	EXIT PUTINP
TABKNT,	-TABLEN		/-NO. OF ENTRIES LEFT IN INPTAB
KEYLST,	ZBLOCK 6	/TEMPORARILY HOLDS KEYWORD NAME FOUND
	PAGE

/	INPTAB
/TABLE FORMAT:
/
/	WORDS 1-3:	6 CHARACTER KEYWORD
/				WORD 1 POSITIVE MEANS "*" APPEARED
/				WORD 1 ZERO INDICATES TABLE END
/
/	WORD 4:		OUTPUT FORMAT NUMBER
/			(1-7)
/			0 MEANS NO OUTPUTTING
/			BIT 0 ON MEANS SPECIAL MODE
/
/	WORD 5:		ADDRESS - 1 OF START OF FIELD DETAILERS
/			PERTAINING TO THIS INPUT-RECORD-DESCRIPTOR
/			(KEYWORD)
/ALL * ENTRIES MUST PRECEDE ALL REGULAR ENTRIES.
/KEYWORD ENTRIES HAVE THE NAME ' *    '.

/	INTAIL
/TABLE FORMAT:
/
/	THIS TABLE CONSISTS OF GROUPS OF FIELD DETAILERS.
/
/	EACH GROUP HAS THE FOLLOWING FORMAT:
/
/	WORD 1:		OBJECT FIELD NUMBER
/				(0 DENOTES END OF GROUP)
/			[NEXT GROUP STARTS IMMEDIATELY AFTER]
/
/	WORD 2:		DEFAULT FIELD NUMBER
/				0 MEANS ERROR
/				-1 MEANS SKIP
/
/	WORD 3:		FLAG FIELD NUMBER
/				0 MEANS WASN'T PRESENT
/
/	WORD 4:		LOWER LIMIT FIELD NUMBER
/				0 MEANS NO LOWER LIMIT
/
/	WORD 5:		UPPER LIMIT FIELD NUMBER
/				0 MEANS NO UPPER LIMIT
/
/	WORD 6:		HASH TOTAL FIELD NUMBER
/				0 OR 4000 MEANS NO HASH TOTALING
/				NEGATIVE MEANS THERE IS A CHECK DIGIT
/			(FIELD NUMBER IS ONLY IN BITS 3-11)

/	UNITBL
/TABLE FORMAT:
/
/	WORDS 1-3:	6 CHARACTER UNIT ID
/
/	WORD 4:		ADDRESS-1 OF FIELD DEPICTOR FOR OUTPUT UNIT
/
/	THERE ARE 7 SUCH ENTRIES, CORRESPONDING TO OUTPUT
/	FORMAT NUMBERS 1-7.

/	INPICT
/TABLE FORMAT:
/
/	THIS TABLE CONSISTS OF GROUPS OF ENTRIES (ONE GROUP
/	FOR EACH OUTPUT DEPICTOR).  THE GROUP ENDS WITH A ZERO
/	ENTRY.
/
/	EACH GROUP HAS THE FOLLOWING FORMAT:
/
/	WORD 1:		OUTPUT FIELD NUMBER
/				0 DENOTES END OF GROUP
/
/	WORD 2:		INCREMENT FIELD NUMBER
/				ONLY BITS 3-11 ARE SIGNIFICANT
/				0 FIELD NUMBER MEANS NO INCREMENT
/				-1 MEANS INCREMENT BY 1
/				NEGATIVE (NOT -1) MEANS CLEAR AFTERWARDS
/

/	PROGRAM START
/PHASE 0  ONCE-ONLY CODE
	*2300
POOC,	0
	TAD I (LISTSW	/GET SWITCH OPTION
	AND (7700
	TAD (-1400	/IS IT "L"?
	SNA CLA
	DCA LSTSW	/YES, LIST
	TAD I (LISTSW	/GET SWITCH OPTION
	AND P77		/SECOND ONE
	TAD (-14
	SNA CLA		/IS IT "L"?
	DCA LSTSW2	/YES, LIST
	TAD (Q1-1
	DCA I (SUBHD
	TAD I SYSDAT	/GET DATE
	SNA
	EXIT POOC	/NO DATE
	DCA OTEM	/SAVE IT
	TAD OTEM
	CLL RTL
	RTL
	RAL
	AND (17
	CLL RAL
	TAD (MONLST-3
	DCA X2
	TAD I X2
	DCA I (MONTH1	/INSERT FIRST HALF OF MONTH NAME
	TAD I X2
	DCA I (MONTH2	/INSERT SECOND HALF
	TAD (1630
	DCA I (MONTH2+1	/INSERT "-7"
	STL CLA RTL
	TAD OTEM
	AND (7
	CLL RTL
	RTL
	RTL
	TAD (2101
	DCA I (YEAR	/INSERT YEAR
	TAD OTEM
	CLL RTR
	RAR
	AND (37
	CALL OTOD
	DCA I (DAY	/INSERT DAY
	EXIT POOC

OTEM,	0
	PAGE

	*4200
START,	TAD IZERO
	DCA I (GLOC
	CALL (POOC
	TAD I (REALSYS
	DCA SYSHND	/SET SYSTEM HANDLER
	TAD I (TOPFLD	/GET HIGHEST CORE FIELD
	TAD (-6211
	SZA CLA
	CLL STA RTL
	DCA CORAMT	/CORAMT=0 MEANS 8K
GOFDR,	CALL ZREADLN	/READ VERY FIRST LINE
	CALL ZKEYWRD
	KDEFINE		/IT HAD BETTER BE "DEFINE"
	JMP ERP1
	CALL (FDR
	STA
	DCA LINKNT
	TAD (7601
	DCA I ZREADLN
	JMS ALLOC
	JMP I (INSEC	/START
ERP1,	TAD (7601	/RETURN TO MONITOR
	DCA I ZREADLN
	CALL ZERROR	/NOT BUILD CONTROL FILE
	ERRP1-1

/	ALLOCATE ROOM FOR TALLIES
ALLOC,	0
	TAD I (DATPTR
	DCA GHOST
	TAD P7600
	DCA SIZE
	TAD (RETR
	DCA I (PJFK	/SET RETURN ADDR
	JMP I (ZINIT
RETR,	TAD GHOST
	TAD (160
	DCA INNUM
	TAD INNUM
	TAD (10
	DCA BADNUM
	EXIT ALLOC
/GHOST: FILE 1 GOOD REC 	GHOST+0
/	FILE 2 ABORTED RECS	GHOST+10
/	...
/	FILE 7 ABORTED 		GHOST+150
/INNUM				GHOST+160
/BADNUM				GHOST+170

		/-JAN-FEB-MAR-APR-MAY-JUN-JUL-AUG-SEP-OCT-NOV-DEC\
MONLST,	1653
	4257
	1647
	4643
	1656
	4263
	1642
	6163
	1656
	4272
	1653
6657
	1653
	6655
	1642
	6650
	1664
	4661
	1660
	4465
1657
	6067
	1645
	4644
	
Q1,	Q1-KDEFINE+1
		/    DEFINE SECTION\
101
101
4546
4752
5746
164
4644
6552
6057
	
KDEFINE,-6
	-45;-46;-47;-52;-57;-46
	PAGE

/	PHASE 2
	DERROR=ZERROR
	KINIT=72
	KFINI=75
	P77=20
	FIELD 1
	*600
PHASE2,	DCA FORMAT
	TAD PROMPT
	SZA CLA		/IS HE BEING PROMPTED?
	JMS PROMP	/YES
	JMS GETLINE	/NO, READ NEXT DATA LINE
GETK,	CALL (GETKEY	/FIND KEYWORD
PROCESS,CALL (PROCS	/PROCESS RECORD
OUT,	CALL (OUTPUT	/PERFORM ANY REQUIRED OUTPUT
	CALL (PROCED	/PROCEED TO NEXT KEYWORD OR *
	JMP PHASE2	/REITERATE

/	PROMP
/THIS ROUTINE TYPES OUT THE CURRENT PROMPT KEYWORD.
/ITS DESCRIPTOR IS POINTED TO BY 'DESPTR'.
/THEN A SPACE IS PRINTED OUT.
/DESPTR IS LEFT POINTING TO THE FORMAT NO.
PROMP,	0
	TAD (-6		/KEYWORD HAS 6 CHARS
	DCA KNT		/SET COUNTER
	DCA PRMPT	/ZERO POINTER
	TAD DESPTR
	DCA DBAS
PRMLUP,	CALL (GETM	/SUPERIOR TO GETC
	CDF INPFLD+BASFLD
DBAS,	0
PRMPT,	0		/OFFSET PTR INTO INPTAB
	INCR PRMPT	/INCREMENT POINTER
	TAD (237	/CONVERT TO ASCII
	CALL TTOCHR	/OUTPUT CHAR TO TTY
	ISZ KNT		/DONE?
	JMP PRMLUP	/NO
	TAD (240	/YES
	CALL TTOCHR	/OUTPUT SPACE
	TAD DESPTR
	TAD (3
	DCA DESPTR	/LEAVE DESPTR POINTING TO FORMAT NO.
			/FOR THE SAKE OF GETKEY.
	EXIT PROMP	/RETURN

/	GETLINE
/THIS ROUTINE GETS A LINE (RECORD) FROM
/THE DATA INPUT DEVICE. (DEVYCE)
/IT PUTS IT INTO 'BUFFER'.
/OR BUFFER+4 IF IN PROMPT MODE.
/IT RESETS CHCT
/FIRST, HOWEVER, IT PRINTS THE PREVIOUS CONTENTS
/OF BUFFER ON THE LPT (UNLESS OF COURSE WC=0).
/	CALL (GETLINE
/	<NORMAL RETURN>
GETLINE,0
	CALL (LPRINT	/PRINT PREVIOUS LINE
	TAD DEVYCE
	SZA CLA
	JMP .+3
	TAD (272
	CALL TTOCHR
	TAD PROMPT
	TAD BUFM1
	DCA GBUF	/SET BUFFER START
	TAD DEVYCE
L7700,	SMA CLA
	JMP .+3
	TAD SZACLA
	DCA GBUF	/DIF CALLING SEQ
	TAD DEVYCE	/GET DEVICE CODE
	CALL KINPUT	/INPUT RECORD FROM THIS DEVICE
GBUF,	BUFFER-1	/INTO LINE BUFFER
	JMP EOF		/END OF FILE
/	INCR INNUM	/*** TALLY # OF RECORS READ
	TAD DEVYCE
	SPA CLA
	TAD (6
	DCA CHCT
	TAD PROMPT	/NO
SZACLA,	SZA CLA		/IN PROMPT MODE?
	JMS FIX		/YES, INSERT KEYWORD
/	RISKY LAST MINUTE INSERTION
	TAD I (BUFFER+1
	SNA CLA
	JMP GETLINE+2
/	END RISK
	EXIT GETLINE
/	TAD SYS
/	SNA
/	EXIT GETLINE
/	DCA I (BUFFER+1
/	TAD SYS
/	DCA I (BUFFER+2
/	EXIT GETLINE	/NO, LEAVE

FIX,	0
	TAD I (BUFFER+4	/INSERT KEYWORD
	TAD M4
	DCA I PBUFFER	/GET CORRECT WORDCOUNT
	TAD (3300
	DCA I (BUFFER+1	/INSERT COLON AT BEGIN
	IAC
	DCA I (BUFFER+4	/INSERT BLANK AT END
	CLL STA RTL	/-3
	TAD DESPTR
	DCA DBS
/ BF +1 +2 +3 +4 +5
/ WC .. .. .. .. ...	BEFORE
/ WC :. .. .. .  ...	AFTER
	TAD (6
	DCA SIZE
	TAD (3
	DCA LTHREE
	CALL (BMOVE	/INSERT KEYWORD
	CDF INPFLD+BASFLD
DBS,	0
	0
	CDF BASFLD
PBUFFER,BUFFER
LTHREE,	3		/GETS INCR
	TAD (7
	DCA CHCT
	EXIT FIX

EOF,	TAD DEVYCE
	TAD M4
	SZA CLA
	JMP I (EPILOG	/LEAVE IF EOF ON KBD OR SYS OR CDR
	TAD (11
	CALL KCDOIO	/MORE?
	Q9-1
	CALL (EJEKT
	CALL KCDOIO	/READ ANSWER
BUFM1,	BUFFER-1
	NOP
	DCA I PBUFFER	/HIDE FROM LPT
	TAD I (BUFFER+1
	AND L7700
	TAD (-7200
	SZA CLA		/MORE?
	JMP I (EPILOG	/NO
	CLL STA RTL	/-3
	TAD DESPTR
	DCA DESPTR
	JMP OUT
	X3=13		/PTS TO FIELD DETAILER ENTRIES
	PAGE

/	GETKEY
/IF PROMPTED, THIS ROUTINE IS ENTERED ALREADY
/KNOWING THE CURRENT DESCRIPTOR. ('DESPTR' WILL
/BE POINTING TO FORMAT NO.)
/OTHERWISE, THIS ROUTINE GETS A KEYWORD FROM THE
/CURRENT RECORD (ERROR IF INVALID)
/SEARCHES 'INPTAB' 'TILL IT FINDS THIS KEYWORD,
/USES THAT AS DESCRIPTOR.
/IF NOT FOUND, USES NEXT "*" DESCRIPTOR AS DESPTR.
/IF NO SUCH ANIMAL, CALLS DATERR.
/ONCE IT HAS THE DESCRIPTOR, THIS ROUTINE GETS
/THE ENTRIES SPECIFIED BY THIS DESCRIPTOR AND SETS
/THREE WORDS BY THEM:
/FORMAT		IS SET TO CURRENT OUTPUT FORMAT NUMBER
/DETAIL		POINTS TO CURRENT FIELD DETAILER - 1
/MODE		1 IF SPECIAL COMMA MODE
/AT THE CONCLUSION, 'DESPTR' IS SET BACK TO
/POINT TO THE BEGINNING OF THE CURRENT DESCRIPTOR.

GETKEY,	0
	TAD PROMPT
	SZA CLA		/IS HE BEING PROMPTED?
	JMP GOTDES	/YES
	TAD (6		/NO
	DCA SIZE	/WANT 6-CHAR KEYWORD
	DCA BYTOFF	/?***
	DCA MODE	/KEYWORD IS MODELESS
	TAD (KYNM	/GET ALPHA ENTITY
	CALL (GETALPH	/STORE IN KYNM
	CDF BASFLD
	JMP NOTFN	/NOT THERE OR TOO BIG
	JMP NOTFN	/MISSING
/	SEARCH FOR IT IN 'INPTAB'
	TAD (INPTAB
	DCA DESPTR	/INITIALIZE DESCRIPTOR PTR
SRLUP,	CLL STA RTL	/-3
	DCA GETKNT	/WANT MATCH ON 3 WORDS
	TAD (KYNM-1
	DCA X0		/PT TO KEYWORD LOOKING FOR
	TAD DESPTR
	DCA TEM		/SAVE DESPTR
SR2LUP,	CDF INPFLD+BASFLD
	TAD I DESPTR	/GET WORD FROM INPTAB
	CDF BASFLD
	SNA
	JMP NOTFN	/0 DENOTES END OF TABLE
	CIA
	TAD I X0
	SZA CLA		/MATCH?
	JMP NOMAT	/NO
	INCR DESPTR	/YES
	ISZ GETKNT	/ANY MORE?
	JMP SR2LUP	/YES
GOTDES,	CDF INPFLD+BASFLD	/NO, PERFECT MATCH
	STL CLA RAR	/4000
	AND I DESPTR	/GET SPECIAL MODE BIT
	RTL		/GET 0 OR 1
	DCA MODE	/SET MODE
	TAD I DESPTR	/DESPTR POINTS TO OUTPUT FORMAT #
	AND L17
	DCA FORMAT	/GET AND SAVE IT
	INCR DESPTR	/BUMP DESCRIPTOR PTR
	TAD I DESPTR	/GET PTR TO FIELD DETAILER (-1)
	CDF BASFLD
	DCA DETAIL	/STORE IN 'DETAIL'
	TAD DESPTR
	TAD M4
	DCA DESPTR	/RESTORE (RESET) DESPTR
	EXIT GETKEY	/RETURN

NOMAT,	TAD TEM
	TAD K5
	DCA DESPTR	/BUMP DESPTR TO NEXT DESCRIPTOR
	JMP SRLUP	/KEEP A LOOKIN'
/KEYWORD NOT FOUND, THEREFORE MUST BE "*" TYPE RECORD
NOTFN,	TAD DEVYCE
	SPA CLA
	TAD (6
	DCA CHCT	/RESET SCAN
	TAD NXTSTR	/GET NEXT "*"-DESCRIPTOR
	SNA
	JMP DER2	/THERE HAD BETTER BE ONE.
	TAD (3
	DCA DESPTR	/SET DESPTR FROM NXTSTR
	JMP GOTDES	/NOW'VE GOT DESCR
DER2,	CALL DERROR	/BAD KEYWORD
	DERR2-1

LIMS,	0
	CALL (GETX3	/GET LOWER LIMIT FIELD #
	SNA
	JMP HLIM	/NO LOWER LIMIT
	CALL (FSETUP	/GET LOWER LIMIT FIELD
	DCA B
	TAD SIZE
	DCA M
	TAD BYTOFF
	DCA A
	TAD OBJSIZ
	DCA N
	CALL (CMPARE
HLIM,	CALL (GETX3	/GET UPPER LIMIT FIELD #
	SNA
	EXIT LIMS	/NO UPPER LIMIT
	CALL (FSETUP	/GET UPPER LIMIT FIELD
	DCA A
	TAD SIZE
	DCA N
	TAD BYTOFF
	DCA B
	TAD OBJSIZ
	DCA M
	CALL (CMPARE
	EXIT LIMS

/	CMPARE
/	A AND B ARE BYTE OFFSETS IN DATTAB
/	MAKES SURE B <= A.
/
/	FORM A-B AND BELCH IF NEGATIVE
/	THEN PERFORM (A-B)+B TO RESTORE A.
CMPARE,	0
	CALL (COMB
	CALL (DECADD	/FORM A_A-B
	TAD I (SA
	DCA SGN		/SAVE SIGN OF A-B
	CALL (COMB	/RESTORE SIGN OF B
	CALL (DECADD	/RESTORE A
	TAD SGN
	SNA CLA
	EXIT CMPARE
	CALL DERROR
	DERR7-1		/OUT OF RANGE
GETKNT,
SGN,	0
PUTERR,	0
	TAD L15
	CALL KCDOIO
	STARS-1
L15,	15
	TAD L15
	CALL KCDOIO
PM2,	0
K5,	5
	EXIT PUTERR
	PAGE

/	PROCED
/IF IN PROMPT MODE, THIS ROUTINE ADVANCE 'DESPTR'
/TO THE NEXT KEYWORD.
/OTHERWISE, IF DESPTR POINTS TO A "*", 
/IT SETS 'NXTSTR' POINTING TO THE NEXT "*"-DESCRIPTOR.
PROCED,	0
	CDF INPFLD+BASFLD
	TAD PROMPT
	SNA CLA		/IN PROMPT MODE?
	JMP UPSTAR	/NO
	TAD DESPTR	/YES
	TAD (5
	DCA DESPTR	/PT TO NEXT DESCRIPTOR
	TAD I DESPTR
	SZA CLA		/END OF TABLE?
	JMP PRCXIT	/NO, RETURN
	TAD (INPTAB	/YES
	DCA DESPTR	/RESET DESPTR TO START OF TABLE
PRCXIT,	CDF BASFLD
	EXIT PROCED	/RETURN
/UPDATE *-PTR
UPSTAR,	TAD I DESPTR	/WHAT IS DESPTR POINTING TO?
	TAD BLSTAR
	SZA CLA
	JMP PRCXIT	/NO, EXIT
	TAD NXTSTR
	TAD (5
	DCA NXTSTR
	TAD I NXTSTR	/LOOK AT NEXT ENTRY
	TAD BLSTAR
	SNA CLA
	JMP PRCXIT	/YES, NXTSTR CORRECTLY ADVANCED
	TAD (INPTAB	/NO
	DCA NXTSTR	/RESET TO TABLE BEGIN
	JMP PRCXIT	/NOW LEAVE

/	FSETUP
/THIS ROUTINE IS CALLED WITH A FIELD # IN THE AC
/(BITS 3-11).
/IT RETURNS THE BYTE OFFSET OF THE DATA ENTITY (IN DATTAB)
/FOR THAT FIELD. [IT RETURNS 0 IF GIVEN 0.]
/'DSCPTR' IS LEFT POINTING AT THE FIELD DESCRIPTOR.
/THE SIZE OF THE FIELD (IN BYTES) IS LEFT IN 'SIZE'.
/THE TYPE IS LEFT IN 'TYPE'.
FSETUP,	0
	AND (777	/ISOLATE FIELD NUMBER
	SNA		/ZERO?
	EXIT FSETUP	/YES, RETURN
	TAD (DSCTAB-1	/NO, ADD IN BASE OF FIELD DESCRIPTOR TBL
	DCA DSCPTR	/TO GET PTR TO FIELD DESCRIPTOR
	CDF DSCFLD+BASFLD
	TAD I DSCPTR	/GET FIELD DESCRIPTOR
	AND (3777
	CLL RAR
	DCA TEM
	RAL
	DCA TYPE
	CLA IAC
	TAD DSCPTR
	DCA SIZE
	TAD I SIZE	/GET NEXT WORD
	AND (3777
	CLL RAR
	CIA
	TAD TEM
	CIA
	DCA SIZE
	TAD TEM
	CDF BASFLD
	EXIT FSETUP	/LEAVE WITH IT IN AC
/LENGTH OF DATA TABLE IS 1717 BUT THIS OFFSET IS SHIFTED LEFT ONE
/IN DSCTAB SO IT CAN GET AS BIG AS 3636...SO, IT'S  AND (3777.

/	OUTPUT
/IF THERE WAS AN OUTPUT FORMAT ASSOCIATED
/WITH THE CURRENT RECORD,
/THIS ROUTINE BUILDS THE OUTPUT RECORD
/AND THEN (GLORY BE) OUTPUTS IT.
/...UNLESS OF COURSE SOME DATA ITEM WERE
/UNDEFINED (I.E. HAS BIT 0 ON IN DSCTAB ENTRY).
/EACH FIELD IS MODIFIED AFTERWARDS AS SPECIFIED
/BY THE FIELD DEPICTOR (INCLUDES ALL FIELDS GOTTEN TO
/BEFORE ANY ERRORS).
/THE FORMAT # IS IN 'FORMAT' UPON ENTRY.
/C(FORMAT)=0 MEANS DON'T OUTPUT ANYTHING.
/
/THE OUTPUT RECORD AREA IS OF LENGTH 'OUTLEN', (WORDS)
/AND THE OUTPUT LINE BUFFER IS 'OUTBUF' IN FIELD 'OUTFLD'.
/OUTLEN MUST BE .GE. 400
/OUTBUF SHARES SPACE WITH NUMBUF.
OUTPUT,	0
	TAD FORMAT
	SNA		/WANT TO OUTPUT?
	EXIT OUTPUT	/NO, RETURN
	CLL RTL		/YES
			/MULTIPLY FORMAT # BY 4
	TAD (UNITBL-1	/ADD TO BASE OF UNITBL - 1
	DCA TEM		/TO GET PTR TO WORD 4 OF UNITBL ENTRY
	DCA BADFLG
	TAD I TEM	/GET WORD 4
/*** ASSUMES UNITBL IS IN FIELD 0
	DCA DEPICT	/THIS IS PTR TO ADDR-1 OF FIELD DEPICTOR
	DCA OUTPTR	/ZERO TO-BASE
OTLOOP,	CDF BASFLD+PICFLD	/GO TO FIELD OF 'INPICT'
	INCR DEPICT
	TAD I DEPICT	/GET OUTPUT FIELD #
	SNA		/OVER?
	JMP OTDONE	/YES
	CDF BASFLD	/NO
	JMS FSETUP	/GET ITS ADDRESS
	DCA FL1		/SAVE ADDRESS
	CDF DSCFLD+BASFLD
	TAD I DSCPTR	/LOOK AT FIELD DESCRIPTOR
	CDF BASFLD
	SPA CLA		/IS FIELD UNDEFINED?
	INCR BADFLG
/	HOPEFULLY, 'SIZE' IS SET.
	CALL (BMOVE	/MOVE FIELD
	CDF DATFLD+BASFLD
	DATTAB		/FROM-BASE
FL1,	0		/INIT POS
	CDF OUTFLD+BASFLD /TO FIELD
	OUTBUF+1	/TO BASE (LEAVE ROOM FOR WC)
OUTPTR,	0		/TO-INIT POS (GETS BUMPED)
	CALL (INCRMN
	JMP OTLOOP

/PERFORM OUTPUT
OTDONE,	TAD BADFLG
	SZA CLA
	JMP OUTBAD
	TAD OUTPTR	/GET # OF CHARS TO OUTPUT
	IAC
	CLL RAR		/GET WORDCOUNT
	CIA
	CDF OUTFLD+BASFLD
	DCA I (OUTBUF	/SET WC
	CDF BASFLD
	TAD OUTPTR
	DCA FL3
	CALL (PUTM	/INSERT AN EXTRA 0
	CDF OUTFLD+BASFLD
	OUTBUF+1
FL3,	0
	STL CLA RAR
	DCA LENGTH
	TAD FORMAT
	TAD (OUTFLD
	CALL RDOIO	/DO OUTPUT
	OUTBUF-1	/*** CHECK
OUTBAD,	TAD (10		/NORMALLY SKIPPED BY RDOIO
	CALL (TALLY
	EXIT OUTPUT	/RETURN
BADFLG,	0		/NON-ZERO MEANS DON'T OUTPUT
	PAGE

/	BMOVE		(BYTE MOVE)
/	CALL (BMOVE
/	CDF FROM-FLD
/	FROM-BASE
/	FROM INIT-POS	/(0-ORIG) DOESN'T INCREMENT
/	CDF TO-FLD
/	TO-BASE
/	TO-INIT-POS	/GETS INCREMENTED
/	# OF BYTES TO MOVE SPECIFIED BY 'SIZE'.
BMOVE,	0
	TAD I BMOVE	/GET FROM-FIELD
	DCA FROFLD
	INCR BMOVE	/BUMP TO NEXT ARGUMENT
	TAD I BMOVE	/GET FROM-BASE
	DCA FROBAS
	INCR BMOVE	/BUMP TO NEXT ARGUMENT
	TAD I BMOVE	/GET FROM-INIT-POSITION
	DCA FROPOS	/INSERT IT
	INCR BMOVE	/BUMP TO NEXT ARGUMENT
	TAD I BMOVE	/GET TO-FIELD
	DCA TOFLD	/INSERT IN PROPER PLACE
	INCR BMOVE	/BUMP TO NEXT ARGUMENT
	TAD I BMOVE	/GET TO-BASE
	DCA TOBAS	/HO-HUM
	INCR BMOVE	/BUMP TO NEXT ARGUMENT
	TAD I BMOVE	/GET TO-INITIAL POSITION
	DCA TOPOS	/INSERT IN APPROPRIATE SPOT
	TAD SIZE	/DON'T GIVE ME AN ARGUMENT
	CIA
	DCA BKNT	/SET COUNT FROM 'SIZE'
FROGET,	JMS GETM	/GET A CHARACTER
FROFLD,	HLT
FROBAS,	0
FROPOS,	0
	INCR FROPOS	/INCREMENT FROM-PTR
	JMS PUTM	/PUT THE CHARACTER
TOFLD,	HLT
TOBAS,	0
TOPOS,	0
	INCR TOPOS	/INCREMENT TO-PTR
	ISZ BKNT	/ANY MORE?
	JMP FROGET	/YES
	TAD TOPOS	/NO
	CDF BASFLD	/GET FINAL INCREMENTED TO-POS
	DCA I BMOVE	/RETURN THIS NEW VALUE TO ARGUMENT
	INCR BMOVE	/AHA!, NOW BUMP PAST LAST ARG
	EXIT BMOVE	/AND RETURN
BKNT,	0		/TEMPORARY COUNTER

/	GETM
/GETS A BYTE FROM A STRING OF BYTES.
/NO WORRIES ABOUT WORDCOUNT NONSENSE.
/	CALL (GETM	/MUST BE CALLED FROM FIELD 0
/	CDF STRNG-FLD
/	STRNG BASE
/	BYTE #
/	<RETURN>
/THE STRING MAY NOT WRAP AROUND CORE.
/STRING BASE CONTAINS BYTES 0 AND 1.
GETM,	0
	TAD I GETM	/GET CDF STRING-FIELD
	DCA CD
	INCR GETM
	TAD I GETM	/GET STRING BASE
	DCA GETEM	/SAVE IT
	INCR GETM
	TAD I GETM	/GET BYTE NO.
	CLL RAR		/GET WORD OFFSET
			/PUT HALF IN LINK
			/LINK=0 MEANS LEFT HALF
			/LINK=1 MEANS RIGHT HALF
	TAD GETEM	/ADD TO BASE
	DCA GETEM	/TO GET WORD ADDRESS
CD,	HLT		/CHANGE TO CORRECT DF
	TAD I GETEM	/GET WORD
	CDF BASFLD
	SNL
	JMS RAR6	/ROTATE RIGHT 6 IF LEFT HALF
	AND P77
	INCR GETM	/BUMP PAST LAST ARG
	EXIT GETM	/RETURN WITH BYTE IN AC

RAR6,	0
	CLL RTR
	RTR
	RTR
	EXIT RAR6
RAL6,	0
	JMS RAR6
	RAR
	EXIT RAL6

/	PUTM
/THIS ROUTINE PUTS A BYTE INTO A STRING OF BYTES
/WITHOUT DESTROYING ANY NEARBY BYTES.
/THERE IS NO WORDCOUNT NONSENSE.
/	TAD (BYTE
/	CALL (PUTM
/	CDF STRNG-FLD
/	STRNG BASE
/	BYTE #
/	<RETURN>
PUTM,	0
	DCA PUTEM	/SAVE BYTE
	TAD I PUTM	/GET CDF STRING-FIELD
	DCA CD2
	INCR PUTM
	TAD I PUTM	/GET STRING BASE
	DCA GETEM	/SAVE IT
	INCR PUTM
	TAD I PUTM	/GET BYTE #
	CLL RAR		/GET WORD OFFSET, BUT HALF IN L
			/LINK=0 MEANS LEFT HALF
	TAD GETEM	/ADD TO BASE
	DCA GETEM	/TO GET WORD ADDRESS
CD2,	HLT		/CHANGE TO CORRECT DF
	TAD I GETEM	/GET WORD TO BE CHANGED
	SNL		/WHICH HALF SHOULD BE ZEROED?
	JMP ANDL	/LEFT HALF
	AND (7700	/RIGHT HALF
	SKP
ANDL,	AND P77
	DCA PUTEM2	/SAVE RESULT
	TAD PUTEM	/GET BYTE TO INSERT
	SNL
	JMS RAL6	/ROTATE LEFT 6 IF LEFT HALF
	TAD PUTEM2	/ADD IN OTHER PART
	DCA I GETEM	/RETURN TO STRING
	CDF BASFLD
	INCR PUTM	/BUMP PAST LAST ARGUMENT
	EXIT PUTM	/RETURN
PUTEM,	0		/TEMPORARY
GETEM,	0		/"
	PUTEM2=CD2	/"

/	DELIMM
/THIS ROUTINE FINDS AND PASSES BY A DELIMETR
/ON THE INPUT DATA RECORD.
/IF NOTHING LEFT, IT JUMPS TO MISSNG
/IF BAD DELIMETER, GENERATES AN ERROR.
DELIMM,	0
	CALL (GCH	/GET NEXT CHARACTER
	EXIT DELIMM
	TAD M1
	SNA		/IS IT A SPACE?
	JMP SOK		/YES
	TAD (-14		/NO
	SNA CLA		/IS IT A ","?
	JMP DOK		/YES
	TAD TYPE
	SZA CLA
	JMP I (DER3
	CALL DERROR	/NO, ERROR
	DERR6-1		/BAD DELIM (OR FIELD TOO BIG)
DOK,	CALL ZGETCHR	/GET NEXT NON-BLANK CHAR
	EXIT DELIMM
	CLA
	CALL ZBACKUP
	EXIT DELIMM
SOK,	CALL ZGETCHR	/PASS BY MORE SPACES
	EXIT DELIMM
	TAD (-15
	SNA CLA		/IS IT A ","?
	JMP DOK		/YES
			/NO
DBACK,	CALL ZBACKUP	/PUT EXTRA CHAR BACK
	EXIT DELIMM	/RETURN
	PAGE

/	DECADD
/DECIMAL ADD ROUTINES ADD TOGETHER TWO DECIMAL NUMBERS.
/THIS ROUTINE IS ENTERED WITH A BEING THE OFFSET OF
/THE FIRST NUMBER IN DATTAB AND B BEING THE OFFSET OF
/THE SECOND NUMBER IN DATTAB.
/LENGTH OF A = N.
/LENGTH OF B = M.
/N MUST BE .GE. M.
/THE RESULT IS LEFT IN A ON DATTAB.
/ARITHMETIC OVERFLOW RESULTS IN THE NUMBERS BEING ADDED
/MODULO 10^N AND 'OVFL' IS INCREMENTED.
DECADD,	0
	DCA CARRY	/SET CARRY TO 0 (OR 1)
	TAD N
	DCA T1		/PT TO END OF A
	TAD M
	DCA T2		/PT TO END OF B
	CALL (GETA	/GET LAST BYTE OF A
	AND (40		/GET SIGN
	DCA SA		/SAVE IT
	CALL (GETB
	AND (40
	CIA
	TAD SA
	DCA LIKE	/0 IF SAME SIGN

LP,	TAD CARRY
	DCA BD
	TAD T2
	SMA SZA CLA	/SKIP IF MINUS OR ZERO
	CALL (GETB	/CAN'T ADD IF AIN'T THERE
	AND L17
	TAD BD		/BD=B(T2)+BD
	DCA BD
	DCA CARRY
	TAD LIKE
	SNA CLA		/SAME SIGN?
	JMP ADD		/YES, ADD
SUBT,	CALL (GETA	/NO, SUBTRACT
	AND L17
	CIA
	TAD BD
	CIA		/FORM A(T1)-BD
	DCA T
	TAD T
	SMA SZA CLA
	JMP ELP
	INCR CARRY	/IF T<0, CARRY=1
	TAD (12		/T=T+10
	JMP ELP
ADD,	CALL (GETA
	AND L17
	TAD BD
	DCA T
	TAD T		/FORM A(T1)+BD
	TAD (-13
	SPA CLA
	JMP ELP
	INCR CARRY
	TAD (-12	/T=T-10
ELP,	TAD T
	TAD (20		/*
	CALL (PUTA

	STA
	TAD T2
	DCA T2		/DECREMENT T2
	STA
	TAD T1
	DCA T1		/DECREMENT T1
	TAD T1
	SZA CLA
	JMP LP		/REITERATE IF T1 .NE. 0
	TAD CARRY
	SNA CLA
	JMP SETSGN	/OK IF NO CARRY
	TAD LIKE	/WAS A CARRY
	SNA CLA
	JMP OVFLO	/LIKE SIGNS & CARRY MEAN OVERFLOW
	TAD SA
	CIA
	TAD (40
	DCA SA		/CHANGE SIGN OF A
	DCA CARRY
	TAD N
COMLP,	DCA T1
	CALL (GETA
	AND L17
	TAD CARRY
	TAD (-34	/R.L. SAID 34 BUT I SAY 33
	CIA		/A(T1)=54-A(T1)-CARRY
	CALL (PUTA
	DCA CARRY
	CALL (GETA	/UGGH
	TAD (-33
	SZA CLA
	JMP COML2
	TAD (21		/IF A(T1)=33,
	CALL (PUTA	/A(T1)=21
	SKP		/CARRY=0
COML2,	INCR CARRY	/OTHERWISE CARRY=1
	STA
	TAD T1
	SZA
	JMP COMLP	/LOOP UNTIL T1=0
SETSGN,	TAD N
	DCA T1
	CALL (GETA
	AND (37
	TAD SA
	CALL (PUTA	/INSERT SIGN OF A
	EXIT DECADD
OVFLO,	INCR OVFL	/NOTE OVERFLOW
	NOP
	JMP SETSGN

Q8,	-3
		/EPILOG\
4661
5255
6050
CARRY,	0
BD,	0		/TEMP
NOON,	-3
		/[NONE]\
7457
6057
4676
	PAGE

HASH,	0
	JMS GETX3	/GET HASH TOTAL FIELD 3
	AND (777
	SNA		/WANT HASH TOTALING?
	EXIT HASH	/NO, RETURN
	CALL (FSETUP	/YES, GET BYTE OFFSET FOR TOTAL
	DCA A
	TAD SIZE
	DCA N		/GET ITS SIZE
	TAD BYTOFF	/GET BYTE OFFSET OF ADDEND
	DCA B
	TAD OBJSIZ	/GET OBJECT SIZE
	DCA M
	CALL (DECADD	/ADD
	EXIT HASH	/RETURN
GETX3,	0
	CDF INTFLD+BASFLD
	TAD I X3
	CDF BASFLD
	EXIT GETX3

/	OBJ
/THIS ROUTINE GETS THE NEXT FIELD DETAILER
/OBJECT FIELD ENTRY NUMBER
/IF 0, THAT MEANS NO MORE FIELDS
/AND TRANSFER IS MADE TO 'PRCND'.
/IF FOUND, CORRESPONDING FIELD IS READ;
/IF FIELD MISSING, CONDITION GIVEN IN WORD 2 APPLIES
/IF FIELD IN ERROR, DATERR IS CALLED
/IF OK, NEW FIELD VALUE IS STORED
/FLAG FIELD IS THEN SET TO 0 OR 1.
OBJ,	0
	JMS GETX3	/GET OBJECT FIELD 3
	SNA		/ANY MORE DETAILERS?
	JMP I (PROCND	/NO
	CALL (FSETUP	/YES, GET FIELD TYPE, LENGTH AND LOCATION
	DCA BYTOFF	/SAVE BYTE OFFSET
	TAD DSCPTR
	DCA SAVDSC	/SAVE DSCPTR
	CALL (PTCH
	TAD SIZE
	DCA OBJSIZ
/	CALL ZGETCHR	/PASS BY INITIAL SPACES
/	INCR CHCT
/	CALL ZBACKUP
/	CALL (DELIMM	/DON'T NEED DELIM FIRST TIME
	TAD TYPE	/GET TYPE OF FIELD DESIRED
	SNA CLA		/WHICH IS IT?
	JMP LOOKA	/LOOK FOR ALPHA FIELD
LOOKD,	CALL (GETDEC	/LOOK FOR DECIMAL FIELD
	JMP MISSNG	/MISSING FIELD
	JMP FOK		/FIELD OKAY
LOOKA,	TAD (DATTAB	/LOOK FOR ALPHA FIELD
	CALL (GETALPH
	CDF DATFLD+BASFLD
	JMP DER4	/BAD ALPHA FIELD
	JMP MISSNG	/MISSING FIELD
FOK,	INCR X3		/FIELD OKAY, BYPASS DEFAULT FIELD
	IAC		/SET FLAG FIELD TO 1
	JMP FLAGF

/FIELD IS MISSING
MISSNG,	JMS GETX3	/GET DEFAULT FIELD 3
	SNA
	JMP DER5	/CONDITION IS 'ERROR'
	SPA
	JMP FLAGE	/CONDITION IS 'SKIP', SO RETURN
	CALL (FSETUP	/GET DEFAULT FIELD
	DCA FROBY	/STORE FROM BYTE LOCATION
/SIZE IS NOW SET
	CDF DSCFLD+BASFLD
	STL CLA RAR	/4000
	AND I DSCPTR	/GET DEFINED BIT
	DCA TEM
	CLL STA RAR
	AND I SAVDSC	/A GOOD DAY
	TAD TEM
	DCA I SAVDSC	/PASS ALONG TO OBJECT FIELD
	CDF BASFLD
	TAD BYTOFF
	DCA BYTOF
	CALL (BMOVE	/MOVE IN DEFAULT VALUE
	CDF DATFLD+BASFLD
	DATTAB
FROBY,	0
	CDF DATFLD+BASFLD
	DATTAB
BYTOF,	0		/USED TO MUST BE HERE

FLAGE,	CLA
FLAGF,	TAD (21
	DCA FTEM	/STORE NEW VALUE FOR FLAG FIELD
	JMS GETX3	/GET FLAG FIELD 3
	SNA
	EXIT OBJ	/NO FLAG FIELD GIVEN
	CALL (FSETUP	/GET FLAG FIELD
	DCA FLOBY	/STORE FROM BYTE LOC
/SIZE IS NOW SET
	TAD SIZE
	CIA
	DCA FKNT
FLOOP,	TAD (21		/INSERT 0'S INTO FLAG FIELD
	CALL (PUTM
	CDF DATFLD+BASFLD
	DATTAB
FLOBY,	0
	INCR FLOBY
	ISZ FKNT
	JMP FLOOP
	STA
	TAD FLOBY
	DCA FLOCY
	TAD FTEM
	CALL (PUTM	/INSERT 0 OR 1
	CDF DATFLD+BASFLD
	DATTAB
FLOCY,	0
	EXIT OBJ	/RETURN
DER4,	CALL DERROR	/BAD ALPHA FIELD
	DERR4-1
DER5,	CALL DERROR	/REQUIRED FIELD MISSING
	DERR5-1
FKNT,	0		/TEMPORARY COUNTER
FTEM,
COMB,	0		/COMPLEMENT B
	TAD M
	DCA T2
	CALL (GETB	/GET SIGN OF B
	TAD (41		/NOTE*** ADD 1 BACK
	AND P77
	CALL (PUTB	/STORE COMPLEMENT SIGN
	EXIT COMB
KYNM,	0;0;0		/HOLDS 6-CHAR KEYWRD NAME
	PAGE

/	NO LITERALS ALLOWED THIS PAGE!
/	IF LINK IS SET, GOT EXTRA DIGIT
DCHCK,	0
	CDF INTFLD+BASFLD	/PT TO HASH/CHECK FIELD
	TAD I TEM	/GET ENTRY
	CDF BASFLD
	SPA CLA		/WANT TO CHECK DIGIT?
	JMP CHCK	/YES
	SNL		/NO
	EXIT DCHCK	/RETURN
DE6,	CALL DERROR	/ERROR- GOT TOO MANY DIGITS
	DERR13-1		/FIELD TOO BIG
CHCK,	STA
	TAD I PNUMPTR
	DCA I PNUMPTR
	TAD I PNUMPTR
	CIA
	DCA DKNT
	DCA N2
	TAD PARITY
	RAR
	CML CLA RAR
	DCA DFLAG
	TAD I PNUMPTR
	DCA N1
	CALL PGETM
	CDF NUMFLD+BASFLD
	NUMBUF
SUM,
N1,	0
	TAD M21
CHOOP,	DCA SUM
	STL RAR
	TAD DFLAG
	DCA DFLAG
	CALL PGETM
	CDF NUMFLD+BASFLD
	NUMBUF
N2,	0
	TAD M21
	INCR N2
	TAD DFLAG
	SPA
	CLL RAL
	TAD M11
	SPA SNA
	TAD L11
	TAD SUM
	TAD M12
	SPA
	TAD L12		/MOD 10
	ISZ DKNT	/DONE?
	JMP CHOOP	/NO
	SNA CLA		/RESULT MUST BE 0
	EXIT DCHCK	/OK
	CALL DERROR	/BAD CHECKDIGIT
	DERR11-1
PGETM,	GETM
L11,	11
M11,	-11
L12,	12
M12,	-12
DFLAG,	0		/-1 MEANS TIMES 1
PNUMPTR,NUMPTR
	DKNT=KNT
M21,	-21

/2300 MUST BE FREE
/IT'S USED AS LINE BUFFER.
	*2300
	0;0		/DON'T PRINT CRAP
	PAGE

/	GETDEC
/THIS ROUTINE SEARCHES THE INPUT LINE
/FOR A DECIMAL CONSTANT, WHICH HAS
/ONE OF THE THREE FORMS:
/	[+] <DIGIT>...
/	 -  <DIGIT>...
/	<DIGIT>...  -
/MAXIMUM SIZE EXPECTED IS IN 'SIZE'.
/CONSTANT IS TO BE PUT RIGHT JUSTIFIED
/(PADDED WITH 0'S ON RIGHT) INTO 'DATTAB' AT
/THE OFFSET SPECIFIED BY 'BYTOFF'.
/IF COMMA FOUND IMMEDIATELY, OR IF WE ARE AT END OF LINE,
/THEN A SPECIAL MISSING-RETURN IS MADE
/AND SCAN ADVANCES PAST COMMA.
/IF THE FIELD IS FOUND, BUT IN ERROR,
/DATERR IS CALLED.
/	CALL (GETDEC
/	<MISSING-RETURN>
/	<NORMAL-RETURN>

	NUMBUF=OUTBUF
	NUMFLD=OUTFLD
GETDEC,	0
	DCA DSIGN
	DCA NUMPTR	/POINT TO FIRST (0TH) BYTE
	CALL (GCH	/LOOK FOR SIGN
	JMP DEND	/NOTHING WILL BE ERROR
	TAD (-14
	CLL RTR
	SNA
	JMP DMI
	RTL
	TAD (14
	JMP GETD2	/JUMP INTO LOOP
DMI,	SZL CLA
	TAD (40		/SET MINUS SIGN
DPL,	DCA DSIGN	/SET PLUS SIGN
GETD1,	CALL (GCH	/GET NEXT CHAR
	JMP DEND	/NO MORE MEANS END OF FIELD
GETD2,	CALL ZDIGIT	/IS IT A DIGIT?
	JMP DEND	/NO
	TAD (21		/YES, CONVERT TO -237
	CALL (PUTM	/STORE DIGIT
	CDF NUMFLD+BASFLD
	NUMBUF
NUMPTR,	0
	INCR NUMPTR	/POINT TO NEXT BYTE
	JMP GETD1	/NO
DEND,	CALL (GCH	/YES, LOOK FOR POSSIBLE TRAILING SIGN
	JMP GETD4
	TAD (-16
	SNA CLA		/IS IT "-"?
	JMP GETD3	/YES
	CALL ZBACKUP	/NO, RECTIFY ERROR
	JMP GETD4
GETD3,	TAD (40
	DCA DSIGN	/SET MINUS SIGN

GETD4,	CALL (DELIMM
	TAD NUMPTR
	SNA CLA		/WERE ANY DIGITS FOUND?
	EXIT GETDEC	/NO, ASSUME FIELD MISSING
			/EVEN IF FOUND SIGN
	TAD SIZE
	CIA
	TAD NUMPTR
	DCA PARITY
	TAD PARITY
	CLL
	SMA
	CLL RAR		/>1 IS BAD
	SZA CLA SMA	/SET LINK IF = 1
	JMP I (DE6
	TAD X3
	TAD (5
	DCA TEM
	CALL (DCHCK	/CHECK CHECKDIGIT
	STA
	TAD NUMPTR
	DCA NUMP1	/POINT TO LAST DIGIT
	TAD NUMP1
	DCA NUMP2
	CALL (GETM
	CDF NUMFLD+BASFLD
	NUMBUF
NUMP1,	0
	TAD DSIGN	/INSERT SIGN
	CALL (PUTM
	CDF NUMFLD+BASFLD
	NUMBUF
NUMP2,	0
	TAD NUMPTR
	CIA
	TAD SIZE
	DCA DIF		/GET SHIFT OFFSET
	TAD DIF
	TAD BYTOFF
	DCA OFSET
/	SET SIZE
	TAD NUMPTR
	DCA SIZE	/***DESTROY SIZE???
	CALL (BMOVE	/MOVE NUMBER TO RECEIVING FIELD
	CDF NUMFLD+BASFLD
	NUMBUF
	0
	CDF DATFLD+BASFLD
	DATTAB
OFSET,	0
	INCR GETDEC	/SKIP MISSING-RETURN

/INSERT ZEROES
	TAD BYTOFF
	DCA OFST
	TAD DIF
	SNA
	EXIT GETDEC
	CIA
	DCA DIF
ZRO,	TAD (21
	CALL (PUTM
	CDF DATFLD+BASFLD
	DATTAB
OFST,	0
	INCR OFST
	ISZ DIF
	JMP ZRO
	EXIT GETDEC
DSIGN,	0		/MINUS SIGN IS 40, + IS 0
NUMKNT,	0		/TEMPORARY COUNTER
DIF,	0

PTCH,	0
	CDF DSCFLD+BASFLD
	STA CLL RAR
	AND I DSCPTR
	DCA I DSCPTR	/DEFINE FIELD
	CDF BASFLD
	CALL ZGETCHR
	EXIT PTCH
	CALL ZBACKUP
	EXIT PTCH
DER3,	CALL DERROR
	DERR3-1
	PAGE

/	GETALPH
/THIS ROUTINE SEARCHES THE INPUT LINE
/FOR AN ALPHA CONSTANT (NOT NECESSARILY IN QUOTES).
/MAXIMUM SIZE EXPECTED IS IN 'SIZE'.
/AC CONTAINS ADDRESS OF PLACE WHERE CONSTANT
/IS TO BE PUT LEFT JUSTIFIED (PADDED WITH
/BLANKS ON THE RIGHT) IF FOUND.
/IF NOT FOUND, OR TOO LARGE, SCAN IS RESET
/AND RETURN 1 IS MADE.
/	TAD (LOCADDR
/	CALL (GETALPH
/	FIELD FOR RESULT
/	<ERROR-RETURN>
/	<MISSING-RETURN>
/	<NORMAL-RETURN>
/BYTE OFFSET MUST BE IN 'BYTOFF'.

GETALPH,0
	DCA RESADR	/SAVE RESULT ADDRESS
	TAD I GETALPH	/GET RESULT FIELD
	DCA RESFLD
	INCR GETALPH
	TAD P7400
	DCA NUMCNT
	TAD (NUMBUF-1
	DCA X2
/	FILL NUMBUF WITH SPACES
	CDF NUMFLD+BASFLD
SPLUP,	TAD (101
	DCA I X2
	ISZ NUMCNT
	JMP SPLUP
	CDF BASFLD
	DCA NUMPT	/POINT TO BYTE 0
	DCA QFLAG
	CALL (GCH	/LOOK FOR QUOTE
	JMP MS		/NOTHING IMPLIES MISSING ARG
	TAD (-10	/IS IT A QUOTE?
	SZA
	JMP GETA2
	INCR QFLAG
GETA1,	CALL (GCH	/GET NEXT CHAR
	JMP AEND2	/NO MORE MEANS END OF FIELD
	TAD (-10	/IS IT A QUOTE?
	SNA
	JMP AEND3	/YES
GETA2,	TAD (10-1	/NO
	SZA		/IS IT A SPACE
	JMP GETA3	/NO
	TAD MODE
	TAD QFLAG
	SNA CLA		/ALLOW BLANK?
	JMP AEND	/NO
GETA3,	TAD (1-15
	SNA		/IS IT A COMMA?
	JMP CEND	/YES
CPUT,	TAD (15		/NO, RESTORE CHAR
APUT,	CALL (PUTM	/STORE CHAR
	CDF NUMFLD+BASFLD
	NUMBUF
NUMPT,	0
	INCR NUMPT	/POINT TO NEXT BYTE
	JMP GETA1

AEND3,	TAD QFLAG
	SNA CLA		/QUOTES ALLOWD?
	JMP GETA2	/YES, TREAT AS ORD CHAR - R.L.
AEND,	CALL ZBACKUP	/PUT BACK CHAR
AEND2,	TAD QFLAG
	SNA CLA		/WANT CLOSE QUOTE?
	JMP GETA4	/NO
	CALL (GCH	/YES
	EXIT GETALPH	/MISSING CLOSE QUOTE
	TAD (-10
	SZA CLA		/CLOSE QUOTE?
	EXIT GETALPH	/NO, ERROR
GETA4,	CALL (DELIMM
GETA41,	TAD NUMPT	/YES, OK
	SNA		/WERE ANY CHARS FOUND?
	JMP MS		/NO, MISSING
	CIA
	TAD SIZE
	SPA CLA
/	JMP I (DE6
	EXIT GETALPH
	TAD BYTOFF
	DCA OFSET2
/	HOPEFULLY 'SIZE' IS ALREADY SET.
	CALL (BMOVE	/MOVE STRING TO RECEIVING FIELD
	CDF NUMFLD+BASFLD
	NUMBUF
	0
RESFLD,	0
RESADR,	0
OFSET2,	0
	INCR GETALPH	/SKIP ERROR RETURN
MS,	INCR GETALPH	/SKIP MISSING-RETURN
	EXIT GETALPH	/RETURN
NUMCNT,	0		/TEMPORARY COUNTER
CEND,	TAD QFLAG
	SZA CLA		/IS IT AN IMBEDDED ","?
	JMP CPUT	/YES
	JMP GETA41

/	DOTOD
/FULLWORD CONVERT TO DECIMAL ROUTINE
/
/DOTOD,	0
/	DCA TEM
/	TAD I DOTOD	/GET LOC TO INSERT RESULT
/	DCA X7
/	DCA QUOT
/	TAD TEM
/	INCR DOTOD
/DOTLUP,	CLL
/	TAD (-144
/	INCR QUOT
/	SZL		/DONE DIVIDING?
/	JMP DOTLUP	/NO
/	TAD (144	/YES
/	DCA TEM		/SAVE REMAINDER
/	STA
/	TAD QUOT
/	CALL OTOD	/CONVERT QUOTIENT TO DECIMAL
/	DCA I X7	/STORE
/	TAD TEM		/GET REMAINDER
/	CALL OTOD	/CONVERT
/	DCA I X7	/STORE
/	EXIT DOTOD
/
/QUOT,	0

/	ROUTINES USED BY DECADD
GETA,	0		/FETCHES A(T1)
	STA
	TAD A
	TAD T1
	DCA AT
	CALL (GETM
	CDF DATFLD+BASFLD
	DATTAB
AT,	0
	EXIT GETA
PUTA,	0		/INSERTS A(T1)
	DCA GETA	/SAVE VALUE
	STA
	TAD A
	TAD T1
	DCA AT2
	TAD GETA
	CALL (PUTM
	CDF DATFLD+BASFLD
	DATTAB
AT2,	0
	EXIT PUTA
PUTB,	0		/INSERTS B(T2)
	DCA GETA	/SAVE VALUE
	STA
	TAD B
	TAD T2
	DCA BT2
	TAD GETA
	CALL (PUTM
	CDF DATFLD+BASFLD
	DATTAB
BT2,	0
	EXIT PUTB
	PAGE

/	DERROR
ERROR2,	0
	STA		/AC MIGHT NOT BE CLEAR
	CDF BASFLD	/JUST IN CASE
	TAD L6		/SAVES A LITERAL (5
	CALL KCDOIO
	BUFFER-1	/PRINT OFFENDING LINE ON LPT
LL11,	11
	TAD I ERROR2
	DCA I (PM2
	CALL (PUTERR
	TAD EDIT
	SNA		/ON LINE EDIT?
	JMP UNDEF	/NO
	CALL KCDOIO	/AC HAS 1 IN IT
PBUF,	BUFFER-1	/PRINT OFFENDING LINE ON TTY
	NOP
	TAD I ERROR2
	DCA PM3
	TAD LL11
	CALL KCDOIO
PM3,	0		/PRINT ERROR MESSAGE ON TTY
L212,	212
	TAD LL11
	CALL KCDOIO
	MSGA-1		/"RETYPE:"?
L6,	6
	TAD PROMPT
	SZA CLA		/IS HE BEING PROMPTED?
	CALL (PROMP	/YES
	TAD PROMPT
	TAD PBUF
	DCA HBUF
	DCA CHCT
	CALL (FIXCHK
	TAD M100
	DCA LENGTH
	CALL KCDOIO
HBUF,	BUFFER-1	/READ LINE FROM KBD
	JMP I (EPILOG
	INCR HBUF
	INCR HBUF	/PT TO FIRST WORD INPUT
	TAD I HBUF
	SNA CLA
	JMP UNDEF	/HE HIT CR
	TAD PROMPT
	SZA CLA
	CALL (FIX	/INSERT KEYWORD IF PROMPTED
			/SET CHCT
	JMP I (GETK	/JOIN PROCESSING
FILL,	0

UNDEF,	CALL (FIXDES	/RESET DESPTR
	DCA I (BUFFER	/DON'T PRINT AGAIN
/	INCR DERKNT
	DCA I (DOSW
UNLOOP,	CDF INTFLD+BASFLD
	TAD I DETAIL	/GET OBJECT FIELD #
	CDF BASFLD
	SNA
	JMP I (OUT	/DONE
	TAD (DSCTAB-1
	DCA TEM		/GET PTR TO DESCRIPTOR
	CDF DSCFLD+BASFLD
	TAD I TEM
	RAL
	STL RAR
	DCA I TEM	/UNDEFINE IT
	TAD DETAIL
	TAD L6
	DCA DETAIL	/PT TO NEXT DETAILER
	JMP UNLOOP

INCRMN,	0
	TAD I (FL1	/GET OBJECT #
	DCA A
	TAD SIZE	/GET OBJECT SIZE
	DCA N
	TAD TYPE
	CLL RTL
	RTL
	IAC
	DCA FILL	/GET FILLER CHAR
	INCR DEPICT
	CDF PICFLD+BASFLD
	TAD I DEPICT	/GET INCREMENT FIELD #
	CDF BASFLD
	SPA		/SPECIAL TYPE?
	JMP SPECT	/YES
	SNA		/NO, WANT TO INCREMENT?
	EXIT INCRMN	/NO, SO RETURN
	CALL (FSETUP	/YES
	DCA B		/GET INCREMENT OFFSET
	TAD SIZE
	DCA M		/GET INCREMENT SIZE
DECA,	CALL (DECADD	/ADD
	EXIT INCRMN

SPECT,	IAC
	SNA CLA		/INCREMENT BY 1?
	JMP INC1	/YES
	CALL (PTCHB
	DCA KNT
	TAD A
	DCA BN
FILUP,	TAD FILL
	CALL (PUTM	/CLEAR
	CDF DATFLD+BASFLD
	DATTAB
BN,	0
	INCR BN
	ISZ KNT
	JMP FILUP
	EXIT INCRMN
INC1,	CALL (TRICK2
	JMP DECA
	PAGE

GETB,	0		/FETCHES B(T2)-1
	STA
	TAD B
	TAD T2
	DCA BT
	CALL (GETM
	CDF DATFLD+BASFLD
	DATTAB
BT,	0
	TAD M1		/SUBTRACT 1!
	EXIT GETB

/	TALLY
/THIS ROUTINE INCREMENTS COUNT OF # OF RECORDS WRITTEN
/IF AC=1, RECORD WASN'T WRITTEN
/'FORMAT' IS UNIT NO.
TALLY,	0
	TAD GHOST
	DCA TEM
	STA
	TAD FORMAT
	CLL RTL		/MULT FORMAT BY 20
	RTL
	TAD TEM
	DCA A
	TAD (10
	DCA N
	JMS TRICK2
	CALL (DECADD
	EXIT TALLY
TRICK2,	0
	TAD A
	TAD N
	NOP		/IAC?
	DCA B
	DCA M
	IAC
	EXIT TRICK2
MFILE,	-4
		/FILE  00\
4752
5546
101
2121
	FORNO=MFILE+4

DPRINT,	0
	DCA DOF
	TAD SIZE
	DCA DCNT
LPC,	CALL (LPCRLF
	CALL (CDOIOC
MPTR,	0
DPGET,	CALL (GETM
	CDF DATFLD+BASFLD
	DATTAB
DOF,	0
	CALL (LPTCHR
	INCR DOF
	ISZ DCNT
	JMP DPGET
	CALL (LPCRLF
	EXIT DPRINT
DCNT,	0
HSHTOT,	-6
		/HASH TOTALS:\
5142
6451
165
6065
4255
6433
JDPGET,	JMP DPGET

/SET DESPTR BACK 3 IF ONLINE EDIT AND PROMPTING
/ALSO, DON'T UNDEFINE IF BAD KEYWORD
FIXDES,	0
	INCR DETAIL	/GET ADDRESS OF FIELD DETAILER
	TAD I (PM2
	CIA
	TAD (DERR2-1
	SNA CLA
	JMP I (OUT
/NOTE:CAN'T GET BAD KEYWORD ON PROMPTING
	TAD PROMPT
	SNA CLA
	EXIT FIXDES	/DESPTR OK
	CLL STA RTL	/-3
	TAD DESPTR
	DCA DESPTR	/PT TO START OF THIS DESCRIPTOR
	EXIT FIXDES	/PROMPTING IMPLIES ON-LINE EDIT

EPILOG,	STA
	DCA LINKNT
	TAD (Q8-1
	DCA I (SUBHD
	CALL (EJEKT
	TAD OUTNO
	CIA
	DCA KNT
	TAD P7600
	CDF 10
	CALL KMOVE
	CDF 0
	CLOOPI-1	/MOVE DOWN PHASE 3
	CLOOPI-1
	JMP I (CLOOPI

/	PROCS	(PROCESS)
/UPON ENTERING, 'DETAIL' POINTS TO ADDR(FIELD-DETAILER)-1.
PROCS,	0
	TAD DETAIL	/GET ADDR (-1) OF FIELD DETAILER
	DCA X3		/PUT IN AN AUTO-INDEX REGISTER
PRCLUP,	CALL (OBJ	/READ IN NEXT FIELD
	CALL (LIMS	/CHECK LOWER AND UPPER LIMITS
	CALL (HASH	/PERFORM HASH TOTALLING
	JMP PRCLUP	/REITERATE
PROCND,	CALL ZGETCHR
	EXIT PROCS
	CALL ZERROR
	DERR12-1
	PAGE

	*3600
FIXCHK,	0
	TAD (272
	CALL TTOCHR	/PRINT :
	TAD I (PM2
	CIA
	TAD (DERR2-1	/BAD KEYWORD
	SNA CLA
	EXIT FIXCHK	/NO CHECKSUMS AFFECTED
	TAD PROMPT
	SNA CLA
	TAD (3
	TAD DESPTR
	DCA DESP	/PT TO FORMAT #
	INCR DESP	/PT TO START OF FIELD DETAILERS
	CDF INPFLD
	TAD I DESP	/GET PTR TO FIELD DETAILER-1
	DCA DETL	/PT TO OBJ FIELD NO. -1
FXLUP,	INCR DETL	/PT TO OBJECT FIELD NO.
	CDF INTFLD
	TAD I DETL	/GET OBJ FIELD NO.
	CDF BASFLD
	SNA
	NOP		/JUST IN CASE *** (USED TO BE HLT)
	JMS GETSIZ
	DCA M
	TAD DATLOC
	DCA B
	TAD DETL
	CIA
	TAD X3
	SPA
	CIA
	TAD (-6		/AM I WITHIN 6?
	SPA CLA
	EXIT FIXCHK	/YES
	TAD DETL
	TAD (5
	DCA DETL	/PT TO HASH TOTAL FIELD NO.
	CDF INTFLD
	TAD I DETL	/GET HASH TOTAL FIELD
	AND (777
	SNA
	JMP FXLUP	/NO HASH HERE
	CDF 0
	JMS GETSIZ
	DCA N		/STORE LENGTH IN N
	TAD DATLOC
	DCA A
	CALL (COMB	/COMPL SIGN OF B
	CALL (DECADD
	CALL (COMB
	JMP FXLUP
DETL,	0		/DETAILER
DESP,	0		/DESPTR
GETSIZ,	0
	TAD (DSCTAB-1
	DCA SACKT
	CDF DSCFLD
	TAD I SACKT
	CLL RAR
	DCA DATLOC
	TAD DATLOC
	CIA
	DCA KTEM
	INCR SACKT
	TAD I SACKT
	CLL RAR
	TAD KTEM
	CDF 0
	EXIT GETSIZ
KTEM,	0
SACKT,	0
DATLOC,	0
GOOD,	GOOD-BAD+1
		/# OF GOOD RECORDS:\
401
6047
150
6060
4501
6346
4460
6345
6433
BAD,	BAD-WORSE+1
		/# OF RECORDS ABORTED:\
401
6047
163
4644
6063
4564
142
4360
6365
4645
3300
WORSE,
Q5,	-6
		/  INPUT DATA\
101
5257
6166
6501
4542
6542
PTCHB,	0
	CDF DSCFLD
	TAD I DSCPTR
	RAL
	CLL RAR
	DCA I DSCPTR
	CDF 0
	TAD N
	CIA
	EXIT PTCHB
	PAGE

	*4200
CLOOPI,	IAC
	DCA I (TNO
	TAD (-10
	DCA SIZE
	TAD (UNITBL-1
	DCA X4
CLOOP,	TAD TNO
	CALL KFINI	/CLOSE OUTPUT FILES
	TAD TNO
	CALL OTOD
	DCA I (FORNO
	CALL (CDOIOC
	MFILE-1
	INCR TNO
	TAD (GOOD-1
	JMS COMSUB
	TAD (BAD-1
	JMS COMSUB
	CALL (LPCRLF
	CALL (LPCRLF
	ISZ KNT
	JMP CLOOP
	TAD I (JDPGET
	DCA I (LPC
	DCA TYPE
	CALL (CDOIOC
	HSHTOT-1
	TAD (INPTAB-1
	DCA X2
PLP,	CDF INPFLD
	TAD I X2	/GET INPTAB ENTRY
	SNA CLA
	JMP EPIEND
	INCR X2
	INCR X2
	INCR X2
	TAD I X2	/GET DETAILER ADDR-1
	DCA X4
ILP,	CDF INTFLD
	TAD I X4	/GET DETAILER
	SNA CLA
	JMP PLP
	INCR X4
	INCR X4
	INCR X4
	INCR X4
	TAD I X4	/GET HASH FIELD
	AND (777
	SNA
	JMP ILP
	DCA TEM
	CDF BASFLD
	TAD (147	/F
	DCA FORT
	TAD TEM
	CIA
	TAD FLIM
	SMA CLA
	JMP F
	TAD (165	/T
	DCA FORT
	TAD FLIM
	CIA
F,	TAD TEM
	CALL OTOD
	DCA FLNUM
	INCR TYPE
	CALL (CDOIOC
	FLN-1
	TAD TEM
	TAD (DSCTAB-1
	DCA TEM
	CDF DSCFLD
	TAD I TEM
	CLL RAR
	DCA TNO
	INCR TEM
	TAD I TEM
	CLL RAR
	CIA
	TAD TNO
	DCA SIZE
	CDF BASFLD
	TAD TNO
	CALL (DPRINT
	JMP ILP
COMSUB,	0
	DCA I (MPTR
	TAD GHOST
	CALL (DPRINT
	TAD GHOST
	TAD (10
	DCA GHOST
	EXIT COMSUB

TNO,	0
FLN,	-3		/WC
FORT,	147	/F
FLNUM,	0
	3601	/=

EPIEND,	CDF BASFLD
	TAD TYPE
	SZA CLA
	JMP .+3
	CALL (CDOIOC
	NOON-1
	TAD (214
	CALL LPOCHR
/	TAD I (DERKNT
/	SZA CLA		/ANY ERRORS?
/	DCA I (DOSW	/YES, ZERO DO SWITCH
	JMP I P7600	/RETURN TO EDP-8
	PAGE

	*1
/PHASE 2 BUILD ERROR MESSAGES
DERR2,	DERR2-DERR3+1
		/BAD KEYWORD\
4342
4501
5446
7270
6063
4500
DERR3,	DERR3-DERR4+1
		/BAD DECIMAL FIELD\
4342
4501
4546
4452
5642
5501
4752
4655
4500
DERR4,	DERR4-DERR5+1
		/BAD ALPHA FIELD\
4342
4501
4255
6151
4201
4752
4655
4500
DERR5,	DERR5-DERR6+1
		/NECESSARY FIELD MISSING\
5746
4446
6464
4263
7201
4752
4655
4501
5652
6464
5257
5000
DERR6,	DERR6-DERR7+1
		/BAD DELIM\
4342
4501
4546
5552
5600
DERR7,	DERR7-DERR10+1
		/FIELD OUT OF RANGE\
4752
4655
4501
6066
6501
6047
163
4257
5046
DERR10,
DERR11,	DERR11-DERR12+1
		/BAD CHECKDIGIT\
4342
4501
4451
4644
5445
5250
5265
DERR12,	DERR12-DERR13+1
		/EXTRA CHARS AT END OF DATA\
4671
6563
4201
4451
4263
6401
4265
146
5745
160
4701
4542
6542
DERR13,	DERR13-DERR14+1
		/TOO BIG\
6560
6001
4352
5000
DERR14,

MESG1,	-14
		/DO YOU PREFER PROMPTING?\
4560
172
6066
161
6346
4746
6301
6163
6056
6165
5257
5040
MESG2,	-16
		/DO YOU WISH TO EDIT ON-LINE?\
4560
172
6066
170
5264
5101
6560
146
4552
6501
6057
1655
5257
4640

MSGA,	-4
		/RETYPE:\
6346
6572
6146
3300
Q9,	Q9-Q10+1
		/MORE?\
5660
6346
4000
Q10,
/INERR,	INERR-CORR+1
		/INPUT ERROR\
/5257
/6166
/6501
/4663
/6360
/6300
/CORR,
STARS,	-2
		/****\
1313
1313
	$