/COS UPDATE			EDITED 10/8/73
/COPYRIGHT 1972, 1973
/DIGITAL EQUIPMENT CORPORATION
/MAYNARD, MASS.  01754
/
/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=3000	/START OF INPUT BUFFER
	INLEN=2		/LENGTH OF INPUT BUFFER (IN
			/400 WORD CHUNKS)
	DSCTAB=6000	/START OF DSCTAB
	DATTAB=6401	/START OF DATTAB
	KGETC=24
	KPUTC=25
	DSCLEN=400	/LENGTH OF DSCTAB (IN WORDS)
	DATLEN=777	/LENGTH OF DATTAB (IN WORDS)
	KPTRST=43
	SBT=6370
	P7400=2
	W5=53
	W4=52
	W3=51
	KGPBUF=41
	KCDOIO=27
	OTOPD=74
	LPOCHR=35
	TTOCHR=31
	W0=46
	W1=47
	BUFFER=1600	/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

	FIELD 0
	*101
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,	0		/0 MEANS LIST
CHCT,	0		/CHAR COUNT
LINKNT,	-1		/LINE COUNT
DSCPTR,	DSCTAB-1	/POINTS INTO DSCTAB
ZGETCHR,GETCHR		/POINTER TO GET CHAR ROUTINE
	X0=10
	P77=20
	GETXR=12
	PUTXR=13
	XR=16
	CMXR=17
	GTNUM=GETNUM
PASS,	0		/0 MEANS PASS1; 1 MEANS PASS2
SORT,	0		/NON-ZERO IF ALREADY SORTED (MISSING SORT STMNT)
FLAG,	0		/NON-ZERO IF FOUND TO BE NON-SORTED
	SCRATCH=10+2	/IFN FOR SCRATCH UNIT
	IN=10+3		/IFN FOR INPUT FILE
	OUT=10+4	/IFN FOR OUTPUT FILE
	SCRBUF=4000	/RDOIO BUFFER FOR SCRATCH FILE
	INBUFF=0000	/RDOIO BUFFER FOR INPUT FILE
	OUTBUF=1400	/RDOIO BUFFER FOR OUTPUT FILE
RECSIZ,	0		/- SIZE OF RECORD
CCHAR,	0		/CONTROL CHAR, I, C, OR D
KINPUT,	0		/PTS TO INPUT ROUTINE
DEVYCE,	0		/DEVICE CODE

	OLD=4400
	NEW=5000
	FILE=5400
	FIXMRI INCR=2000
	PMOUNT=60
	KRDOIO=26
	KINIT=72
	KFINI=75
	W2=50
	IFN=42
ZKEYWRD,KEYWRD
ZREADLN,READLN
ZBACKUP,BACKUP
TEM,	0
BYTOFF,	0
	NUMFLD=10
	NUMBUF=7400
ZDIGIT,	DIGIT
KNT2,	0
Z7700,	7700
LOPT,	0		/NE 0 IF LOPTION IN EFFECT
NOPT,	0		/NE 0 IF N OPTION IN EFFECT
MASK,	0
SAVEC,	0
NUMB,	0
SCRSIZ,	0		/SIZE OF SCRATCH RECORD
			/IN BYTES (1-ORIGINING)
			/INCLUDES RECORD + 1 (CCHAR)
CCLOC,	0		/ABSOLUTE LOCATION IN NEW RECORD OF
			/WORD USED FOR CCHAR
/CCHAR IS ALWAYS IN RIGHT BYTE
REALWC,	0		/FILE WORD COUNT
Z101,	101
INIFN,	IN
ZLPCRLF,LPCRLF
ZLPTCHR,LPTCHR
GLOC,	0		/HOLDS PTR TO IZERO
SCRTRY,	0
M20,	-20
LPTR,	0		/PTS TO LABEL
LKNT,	0		/TEMP COUNTER
DPTR,	0		/PTS TO TRY UNIT
MOUNT,	0
Q7700,	7700

	*200
/***************************************/
/					/
/   <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.			/
/*******************************/

	JMP I (START
FDR,	0		/FIELD DESCRIPTOR ROUTINE ENTRY POINT
	CALL ZREADLN
	CALL ZKEYWRD	/LOOK FOR "DEFINE"
	KDEFINE
	JMP ERX
	CDF DATFLD+BASFLD
	STL CLA RAR	/4000
	DCA I (DATTAB-1	/BOO ON GETC
	CDF BASFLD
/	6665	/*** TEMPORARY
JFK,	CALL (READLN	/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
	CALL (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>		/
/				/
/*******************************/
	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
	CALL (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
DSCKNT,	-DSCLEN		/COUNTS NO OF ENTRIES LEFT IN DSCTAB

ER2,	CALL ZERROR
	ERR2-1
ER7,	CALL ZERROR
	ERR7-1
ER5,	CALL ZERROR
	ERR5-1
ERX,	TAD (7601	/FAKE OUT ERROR
	DCA I ZREADLN	/THIS IS FATAL
	CALL ZERROR
	ERRX-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 ZGETCHR	/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 ZGETCHR	/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 ZGETCHR	/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 ZGETCHR	/RETRIEVE CHARACTER
DATKNT,	-DATLEN-1	/DNO
	TAD (-16
	SNA CLA		/IS IT "-"?
	JMP .+3		/YES
	CALL ZERROR	/NO, ERROR
ER11,	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 ZGETCHR	/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

/ERROR MESSAGES
ERR1,	ERR1-ERR2+1
		/UNEXPECTED END OF FILE\
6657
4671
6146
4465
4645
146
5745
160
4701
4752
5546
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-ERR15+1
		/INITIAL VALUE TOO BIG\
5257
5265
5242
5501
6742
5566
4601
6560
6001
4352
5000
ERR15,	ERR15-ERR16+1
		/EXTRA CHARS AT STMNT END\
4671
6563
4201
4451
4263
6401
4265
164
6556
5765
146
5745
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

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

RUP,	CALL ZREADLN
	SKP
SCAN,	0
	CALL (RESET	/RESET SCAN
	TAD (RUP+1
	DCA I ZREADLN
	CALL ZKEYWRD
	KUPDATE		/LOOK FOR "UPDATE"
	JMP ERU4	/MISSING
	TAD (UPLAB
	CALL (LABEL	/GET UPDATE LABEL
	CALL ZREADLN	/READ NEXT LINE
	CALL ZKEYWRD
	KINPOT		/LOOK FOR "INPUT"
	JMP ERU5	/MISSING
	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 ERU6	/NO, ERROR
INSYS,	TAD (SYSREAD
	DCA KINPUT	/INPUT UNIT IS "SYSREAD"
	JMP SORTSEC

INRDR,	TAD (2		/RDR CODE IS 4
INCDR,	TAD (2		/CDR CODE IS 2
INSET,	DCA DEVYCE	/STORE HANDLER CODE
	TAD (CREAD
	DCA KINPUT	/INPUT ROUTINE IS "CREAD"
SORTSEC,CALL ZGETCHR
	JMP SRTSEC
	TAD (-20
	SZA CLA
	JMP ERU5
	CALL (GETNUM
	AND L17
	DCA SCRTRY
SRTSEC,	CALL ZREADLN	/READ NEXT LINE
	CALL ZKEYWRD
	KSORT		/LOOK FOR "SORT"
	JMP COMBN	/NO SORT STATEMENT
	DCA SORT
PASSS,	CALL ZGETCHR	/GO TO END OF SORT STATEMENT
	JMP KEYSEC
	CLA
	JMP PASSS
KEYSEC,	CALL ZREADLN
KEYCES,	CALL ZKEYWRD
	KKEY		/LOOK FOR "KEY"
	JMP ERU7
	CALL (KEYGET
OUTSEC,	CALL ZREADLN	/READ NEXT LINE
	CALL ZKEYWRD
	KOUTPUT		/LOOK FOR "OUTPUT"
	JMP NOUT
	TAD (OUTLAB
	CALL (LABEL	/GET OUTPUT LABEL
	CALL ZREADLN	/READ NEXT LINE
ENDSEC,	CALL ZKEYWRD
	KEND		/LOOK FOR "END"
	JMP ERU11
	CALL (LPRINT
	STA
	DCA LINKNT
	TAD I (ERKNT
	SNA CLA
	EXIT SCAN	/RETURN
	DCA I (DOSW	/ABORT BATCH
	JMP I P7600	/RETURN TO MONITOR
COMBN,	CLA IAC
	DCA SORT
	JMP KEYCES

NOUT,	TAD I UPPTR	/MOVE UPDATE LABEL
	DCA I OUTPTR	/TO OUTPUT LABEL
	INCR UPPTR
	INCR OUTPTR
	ISZ KONT
	JMP NOUT
	JMP ENDSEC
UPPTR,	UPLAB
OUTPTR,	OUTLAB
KONT,	-3		/3 WORD LABEL

ERU4,	CALL ZERROR
	ERRU4-1
ERU5,	CALL ZERROR
	ERRU5-1
ERU6,	CALL ZERROR
	ERRU6-1
ERU7,	CALL ZERROR
	ERRU7-1
ERU11,	CALL ZERROR
	ERRU11-1

ERRU7,	ERRU7-ERRUUU+1
		/BAD KEY STMNT\
4342
4501
5446
7201
6465
5657
6500
ERRUUU,
	PAGE

/ROUTINE TO ANALYZE SORT KEY PARAMETERS AND CREATE THE COMPARE LIST
/THE COMPARE LIST IS A LIST OF DOUBLEWORDS WHICH
/IS USED BY THE COMPARE ROUTINE TO COMPARE TWO RECORDS
/ON A GIVEN KEY IN AN EFFICIENT MANNER.
/     THERE ARE TWO FORMATS FOR THE COMPARE DOUBLEWORDS:
/ 1)  PARTIAL WORD COMPARES
/	WORD 1 -	BITS 0-10 CONTAIN WORD OFFSET
/			BIT 11 CONTAINS SORT DIRECTION
/	WORD 2 - MASK (0077 OR 7700)
/
/ 2)  MULTIPLE FULL WORD COMPARES
/	WORD 1 - WORD COUNT (NEGATIVE)
/	WORD 2 -	BITS 0-10 CONTAIN WORD OFFSET -1
/			BIT 11 CONTAINS SORT DIRECTION
/	"WORD OFFSET" IS THE OFFSET OF THE DESIRED WORD FROM
/	THE RECORD HEADER
/	"SORT DIRECTION" IS 1 IF ASCENDING, 0 IF DESCENDING
/THE TWO TYPES OF ENTRIES ARE DISTINGUISHED BY THE SIGN BIT
/OF THE FIRST WORD.  THE LIST IS TERMINATED BY A ZERO WORD

/	KEYGET
KEYGET,	0
	TAD (BEGLST-1
	DCA CMXR
GETKEY,	CDF BASFLD
	JMS I	ZGETCHR	/GET A NON-BLANK CHARACTER
	JMP ILLKEY
	TAD	(-47
	SZA CLA		/IS IT AN F?
	JMP	ILLKEY	/NO - ERROR
	JMS I	(GTNUM	/GET THE F-NUMBER
	DCA	NAM
	TAD	NAM
	CIA
	TAD	TBRK	/CHECK TO SEE THAT ITS IN RANGE
	SPA CLA
	JMP	ILLKEY
	TAD	NAM
	TAD	(DSCTAB-2
	DCA	XR	/FORM POINTER INTO DESCRIPTOR TABLE
	CDF BASFLD+DSCFLD
	TAD I	XR	/GET THE DESCRIPTOR
	CLL RAR		/THROW AWAY THE TYPE
	DCA	LC	/SAVE THE ADDRESS
	CLL STA RAL
	TAD I	XR
	CDF BASFLD
	CLL RAR		/FROM THE ADDRESS OF THE NEXT DESCRIPTOR
	DCA	UC	/SAVE THE UPPER LIMIT
	CLA IAC
	DCA	DIR	/INITIALIZE DIRECTION TO ASCENDING
TSTDLM,	CALL ZGETCHR
	JMP	CRTBNT	/CARRIAGE RETURN - ALL FINISHED
	TAD	(-16
	SNA
	JMP	SMINUS	/MINUS SIGN - DESCENDING ORDER
	IAC
	SNA
	JMP	CRTBNT+1	/COMMA - END OF THIS KEY
	IAC
	SNA
	JMP	TSTDLM	/PLUS SIGN - ASCENDING ORDER
	TAD	(3
	SZA CLA		/NONE OF THE ABOVE - IS IT AN OPEN PAREN?
	JMP	ILLKEY	/NO - ERROR
	JMS I	(GTNUM	/SUBSTRING SPECIFICATION - GET LOWER LIMIT
	DCA	XR
	CALL ZGETCHR
	JMP ILLKEY
	TAD	(-15
	SZA CLA
	JMP	ILLKEY	/DELIMITER MUST BE COMMA
	JMS I	(GTNUM	/GET UPPER LIMIT
	TAD	LC
	TAD	M1
	DCA	UC	/SAVE NEW HIGH ADDRESS
	TAD	LC
	TAD	XR
	TAD	M1
	DCA	LC	/SAVE NEW LOW ADRESS
	CALL ZGETCHR
	JMP ILLKEY
	TAD	(-12
	SNA CLA		/DELIMITER MUST BE CLOSE PAREN
	JMP	TSTDLM
ILLKEY,	JMS I	ZERROR
	ERRU12-1

SMINUS,	DCA	DIR	/SET DIRECTION TO DESCENDING
	JMP	TSTDLM	/BACK TO THE SALT MINES
LC,	0
UC,	0
DIR,	0		/VARIABLES COLLECTED DURING KEY SCAN
CRTBNT,	DCA	JMPBAK	/CARRIAGE RETURN - SET FLAG TO TERMINATE
	CDF BASFLD+10	/COMMA - TURN THIS KEY INTO COMPARE TABLE ENTRIES
	TAD	LC
	CLL RAR
	DCA	LC	/CHANGE LC TO A WORD OFFSET
	SNL		/IS IT ON AN EVEN WORD BOUNDARY?
	JMP	NOHLF1	/YES
	ISZ	LC	/NO - BUMP IT TO THE NEXT WORD
	TAD	LC
	CLL RAL
	TAD	DIR
	DCA I	CMXR	/STORE OFFSET + DIRECTION
	TAD	P77	/(REMEMBER, OFFSET FROM RECORD HEADER IS =>1)
	DCA I	CMXR	/STORE MASK FOR LOW ORDER CHARACTER
NOHLF1,	TAD	UC
	CIA CLL
	CML RAR		/MAKE UC A WORD ADDRESS AS WELL
	TAD	LC
	SNA		/ARE THERE ANY FULLWORDS CONTAINED IN THIS FIELD?
	JMP	NOFUL0	/NO
	DCA I	CMXR	/YES - STORE WORD COUNT
	TAD	LC
	CLL RAL
	TAD	DIR	/STORE OFFSET MINUS ONE AND DIRECTION
	DCA I	CMXR
NOFUL0,	TAD	UC
	CLL RAR
	SZL CLA		/IS UC ON A WORD BOUNDARY?
	JMP	NOHLF2	/NO
	STL CLA RTL	/YES - WE HAVE TO GENERATE A COMPARE FOR
	TAD	UC	/THE CHARACTER IN THE TOP HALF OF THE
	TAD	DIR	/LAST WORD
	DCA I	CMXR
	TAD	Z7700
	DCA I	CMXR
NOHLF2,	
JMPBAK,	JMP	GETKEY	/THIS JUMP ZEROED BY CARRIAGE RETURN ROUTINE
	DCA I	CMXR	/INSERT TERMINATING ZERO
	CDF BASFLD
	TAD CMXR
	TAD (-BEGLST-61
	SMA CLA
	JMP ILLKEY
	EXIT KEYGET
NAM,	0
	PAGE

/	100 WORD LINE BUFFER GOES HERE
/OVERLAYS ONCE ONLY CODE
ONCE,	0
	TAD I (REALSYS
	DCA SYSHND
	TAD I (LISTSW	/GET SWITCH OPTION
	AND (7700
	TAD (-6200	/IS IT "2"?
	SNA CLA
	INCR PASS	/YES, PASS 2
	TAD I (LISTSW	/GET SWITCH OPTION
	AND P77		/SECOND ONE
	TAD (-14
	SNA 		/IS IT "L"?
	INCR LOPT	/YES
	TAD (14-16
	SNA CLA		/IS IT "N"?
	INCR NOPT	/YES
	STA
	TAD LOPT
	DCA LSTSW
	TAD I SYSDAT	/GET DATE
	SNA
	EXIT ONCE	/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 ONCE

OTEM,	0
		/-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

ERRU4,	ERRU4-ERRU5+1
		/BAD UPDATE STMNT\
4342
4501
6661
4542
6546
164
6556
5765
ERRU5,	ERRU5-ERRU6+1
		/BAD INPUT STMNT\
4342
4501
5257
6166
6501
6465
5657
6500
ERRU6,	ERRU6-ERRUV+1
		/BAD DEVICE\
4342
4501
4546
6752
4446
ERRUV,
	PAGE

/LINE INPUT AND CHARACTER FETCH ROUTINES
READLN,	0		/READ A LINE
	ISZ	FSTSW
	JMP	NORFST
RINIT,	TAD (7
	JMS I	KPTRST	/INITIALIZE IFN 1
	TAD	(INLEN^200+BUFFLD
	DCA I	W0
	TAD (INBUF
	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 (7700
	DCA LENGTH
	TAD (7
	JMS I	KRDOIO
	BUFFER+1
	JMP	RINIT	/SINCE THE BUFFER IS BIG, ERRORS MUST BE EOF'S
	STL CLA RAR
	DCA LENGTH
	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	Z101
	DCA I	(BUFFER+3
	TAD	(6
	DCA	CHCT
	CALL ZGETCHR
	JMP NORF	/IGNORE NULL LINE
	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
NAM1,	0
NAM2,	0

CARET,	0
	TAD CHCT
	CIA
	TAD (4
	DCA CARCNT
	TAD (4
	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
CARCNT,	0

SYSREAD,	0
	TAD ESY
	DCA EOFERR
	JMS READLN
	TAD (P1LOOP+1
	DCA READLN
	INCR SYSREAD
ESY,	EXIT SYSREAD
	PAGE

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
	JMS BACKUP	/BACKUP SCAN
	EXIT DIGIT	/RETURN 1
ERROR,	0		/ERROR ROUTINE
	ISZ ERKNT	/BUMP ERROR COUNT
	CLA
	CDF BASFLD	/JUST IN CASE
	DCA I (DOSW	/STOP BATCH
	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	/YES, RETURN
	ISZ GNBC	/";" INDICATES EOL
	TAD (34		/RESTORE CHAR
	JMP I	GNBC
ERKNT,	0		/# OF ERRORS
SEMIC,	JMS BACKUP
	EXIT GNBC
BACKUP,	0
	STA
	TAD CHCT
	DCA CHCT
	EXIT BACKUP
	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
LPRINT,	0
	TAD I (BUFFER	/NO
	SNA CLA		/IS WC=0?
	JMP LPND	/YES, RETURN
	CALL ZGETCHR
	JMP .+3
	CALL ZERROR
	ERR15-1
	TAD LSTSW
	SZA CLA		/IS NOLIST SPECIFIED? (LSTSW .NE. 0)
	JMP LPND	/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,	HEAD2-1
	CALL ZLPCRLF	/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

PGNM,	0		/PAGE NUMBER
HEADING,HEADING-Q5+1
		/COS UPDATE V 3.07 UNDATED                PAGE 00\
4460
6401
6661
4542
6546
0101
6701	/V
2417	/3.
2130	/07
0101
0101
DAY,6657
MONTH1,4542
MONTH2,6546
4501
YEAR,101
101
101
101
101
161
4250
PAGNUM,4601
2121
Q5,
HEAD2,	-10
		/   CONTROL FILE\
101
144
6057
6563
6055
147
5255
4600

/*******************************/
/				/
/   <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
	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
RESET,	0
	TAD (6
	DCA CHCT	/SET CHCT BACK TO 6
	EXIT RESET

/	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	/"

/	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
	PAGE

START,	TAD PMOUNT
	CDF 10
	DCA MOUNT	/GET ADDR OF MOUNT
	CDF 0
	TAD IZERO
	DCA GLOC
	CALL (INITI	/PERFORM INITIALIZATION
	TAD PASS
	SZA CLA		/WHICH PASS?
	JMP PASS2	/PASS2
PASS1,	TAD SORT
	SNA CLA
	CALL (OPENSC	/OPEN SCRATCH FILE
	TAD SORT
	SZA CLA
	CALL (OPEN2
P1LOOP,	CALL KINPUT	/READ UPDATE COMMAND
	JMP NOMORE	/NO MORE
	CALL (PROCUP	/PROCESS UPDATE COMMAND
	TAD SORT	/TO GET NEW RECORD
	SZA CLA		/ALREADY SORTED?
	JMP PRONE	/YES
	CALL (OUTSCR	/NO, OUTPUT NEW RECORD TO SCRATCH
	JMP P1LOOP
NOMORE,	CALL (CLOSE1	/CLOSE SCRATCH UNIT
	TAD FLAG
	SNA CLA		/WERE RECORDS SORTED?
	JMP PASS2	/YES, 'CHAIN' TO PASS2
	TAD SORT	/NO
	SZA CLA		/ALREADY SORTED?
FINI,	CALL (OVER	/YES, PASS THRU FILE AND CLOSE
	TAD PASS
	SZA CLA
	CALL (REPORT
	JMP I P7600	/NO, RETURN TO COS
PASS2,	INCR PASS
	CALL (OPEN2	/OPEN INPUT, OUTPUT, AND SCRATCH DATA FILES
P2LOOP,	TAD (SCRATCH
	CALL KRDOIO	/READ UPDATE RECORD
	NEW-1
	JMP FINI	/NO MORE
PRONE,	CALL (PRONEW	/PROCESS NEW RECORD
	TAD SORT
	SZA CLA		/ALREADY SORTED?
	JMP P1LOOP	/YES, CONTINUE LOOP 1
	JMP P2LOOP	/NO, CONTINUE PASS 2 LOOP

/	PROCUP
/PROCESS UPDATE COMMAND
/UPDATE COMMAND IS IN BUFFER.
PROCUP,	0
	CALL ZGETCHR	/GET FIRST CHAR
	JMP P1LOOP
	DCA CCHAR
	TAD RECSIZ
	CDF 10
	DCA I (NEW	/SET NEW RECORD SIZE
	CDF 0
	TAD CCHAR
	TAD (-52
	SNA		/IS IT "I"?
	JMP MOVED	/YES, MOVE DEFAULT RECORD TO NEW RECORD
	TAD (52-44	/NO
	SNA		/IS IT "C"?
	JMP MOVEZ	/YES, MOVE ZEROS TO NEW RECORD
	TAD M1		/NO
	SZA CLA		/IS IT "D"?
	JMP ERU1	/NO, ERROR
MAKE,	CALL (INSRT	/YES, INSERT COMMAND AND KEY
	ISZ FTT		/FIRST TIME THROUGH?
	JMP INS		/YES
	TAD (OLD
	CALL (COMPAR	/COMPARE OLD AND NEW RECORDS
	JMS OUTOFO	/OLD KEY GT NEW KEY
	NOP		/OLD KEY = NEW KEY
INS,	CALL (UPDAT	/OLD KEY LT NEW KEY
	STA
	DCA FTT
	CDF 10
	TAD RECSIZ
	CALL KMOVE
	CDF BASFLD+10
	NEW+1-1
	OLD+1-1
	EXIT PROCUP	/RETURN
FTT,	0		/0 IF FIRST TIME THRU, ELSE -1

OUTOFO,	0
	CLA IAC
	DCA FLAG	/NOTE OUT OF ORDER FACT
	TAD SORT
	SNA CLA		/DID HE CLAIM SORTED?
	EXIT OUTOFO	/NO, RETURN
	CALL ZERROR	/YES, LIAR
	ERRU15-1
ERU1,	CALL ZERROR
	ERRU1-1

/	MOVE DEFAULT RECORD TO NEW RECORD
MOVED,	CDF BASFLD+10
	TAD RECSIZ
	CALL KMOVE
	CDF BASFLD+10
	DATTAB-1
	NEW+1-1
	JMP MAKE

/	MOVE ZEROS TO NEW RECORD
MOVEZ,	TAD RECSIZ
	DCA MKNT
	TAD (NEW
	DCA XR
	CDF 10+BASFLD
	DCA I XR	/INSERT 0
	ISZ MKNT	/DONE?
	JMP .-2		/NO
	CDF BASFLD
	JMP MAKE	/YES
MKNT,	0
	PAGE

/	INITI
/PERFORM INITIALIZATION
INITI,	0
	CALL (ONCE
	CALL (FDR
	TAD FLIM
	TAD (DSCTAB
	DCA TEMP
	CDF DSCFLD
	TAD I TEMP
	CDF BASFLD
	CLL RAR
	IAC		/ADD 1 FOR CCHAR
	DCA SCRSIZ
	TAD SCRSIZ
	IAC		/ROUND UP
	CLL RAR
	CIA
	DCA RECSIZ
	TAD RECSIZ
	CIA
	TAD (NEW
	DCA CCLOC
	CDF DATFLD
	TAD RECSIZ
	DCA I (DATTAB-1
	CDF 0
	CALL (SCAN
	TAD NOPT
	DCA LSTSW
	STA
	DCA LINKNT
	TAD I ZERROR	/ANY ERRORS?
	SZA CLA
	JMP I P7600	/YES, RETURN TO COS
	CDF 10		/NO
	TAD (-1400
	CALL KMOVE	/MOVE DOWN OVERLAY
	CDF 0
	200-1
	200-1
	TAD (P1LOOP+1
	DCA I ZREADLN
/	TAD SORT
/	SNA CLA
/	JMS OPENSC	/OPEN SCRATCH UNIT
/BLANK NEW RECORD
	TAD (-400
	DCA KNT
	TAD (NEW-1
	DCA XR
	CDF 10
	TAD Z101
	DCA I XR
	ISZ KNT
	JMP .-3
	DCA I (FILE	/MAKE NOT THERE
	CDF 0
	EXIT INITI

OPENSC,	0		/OPEN SCRATCH FILE
	TAD SCRTRY
	DCA I GLOC
	TAD (SCRATCH
	CALL KINIT
	4000+200+10	/WRITE (400 WDS) FIELD 1
	SCRBUF
	SCRLAB-1
	TAD (XPASS1-1
	DCA I (SUBHD
	CALL (LPRINT
	CALL (EJEKT
	EXIT OPENSC

/	LABEL
/ENTERED WITH AC POINTING TO LOCS TO STORE LABEL
LABEL,	0
	DCA LPTR
	STA
	TAD LPTR
	DCA DPTR
	CLL STA RTL	/-3
	DCA LKNT
LLOOP,	CALL ZGETCHR	/GET LEFT CHAR
	EXIT LABEL
	TAD M20
	SNA
	JMP CD1
	TAD (20
	CLL RTL
	RTL
	RTL
	DCA TEMP
	CALL ZGETCHR	/GET RIGHT CHAR
	IAC		/BLANK IF MISSING
	TAD M20
	SNA
	JMP CDM1
	TAD (20
	TAD TEMP	/COMBINE
	DCA I LPTR	/STORE IT
	INCR LPTR
	ISZ LKNT
	JMP LLOOP
	CALL ZGETCHR
	EXIT LABEL
	TAD M20
	SNA CLA
	JMP CD1
ERU20,	CALL ZERROR
	ERRU20-1
CDM1,	TAD TEMP
	IAC
	DCA I LPTR
CD1,	CALL (GETNUM
	AND L17
	SNA
	JMP ERU20
	DCA I DPTR
	EXIT LABEL
	PAGE

LOG,	0
	TAD CCHAR
	CALL ZLPTCHR	/OUTPUT CONTROL CHAR
	IAC
	CALL ZLPTCHR
	JMS COMPRES
	EXIT LOG

/	COMPRES
/ROUTINE 'COMPRESSES' KEY IN NEW RECORD
/AND OUTPUTS IT TO LPT
COMPRES,	0
	TAD (BEGLST-1
	DCA CMXR
COMLUP,	TAD I CMXR	/GET ENTRY FROM COMPAR TABLE
	SPA
	JMP FULW	/FULLWORD ENTRY
	SNA		/DONE?
	JMP COMEND	/YES
	CLL RAR		/NO, GET WORD OFFSET
	TAD (NEW	/PT TO WORD
	DCA TEMP
	TAD I CMXR	/GET MASK
	DCA MASK
	TAD MASK
	RAL
	CLA
	CDF 10
	TAD I TEMP	/GET WORD
	CDF 0
	AND MASK
	SZL		/WHICH HALF?
	CALL (RAR6	/LEFT BYTE
	CALL ZLPTCHR	/RIGHT, OUTPUT IT
	JMP COMLUP
COMEND,	CALL ZLPCRLF
	EXIT COMPRES

FULW,	DCA COMKNT	/SAVE COUNT
	TAD I CMXR
	CLL RAR		/GET WORD OFFSET-1
	TAD (NEW	/PT TO WORD-1
	DCA GETXR
WFLOOP,	CDF 10
	TAD I GETXR	/GET WORD
	CDF 0
	DCA SAVEC
	TAD SAVEC
	AND Z7700
	CALL (RAR6
	CALL ZLPTCHR	/PRINT LEFT BYTE
	TAD SAVEC
	AND P77
	CALL ZLPTCHR	/PRINT RIGHT BYTE
	ISZ COMKNT
	JMP WFLOOP
	JMP COMLUP
COMKNT,	0

THEAD,	-7
		/   STATISTICS\
101
164
6542
6552
6465
5244
6400
S1,	CMES-1
	IMES-1
	DMES-1
	EMES-1
	RMES-1
	WMES-1
CMES,	-10
		/NO. OF CHANGES:\
5760
1701
6047
144
5142
5750
4664
3300
IMES,	-10
		/NO. OF INSERTS:\
5760
1701
6047
152
5764
4663
6564
3300
DMES,	-10
		/NO. OF DELETES:\
5760
1701
6047
145
4655
4665
4664
3300
EMES,	-7
		/NO. OF ERRORS:\
5760
1701
6047
146
6363
6063
6433
RMES,	-7
		/RECORDS READ:\
6346
4460
6345
6401
6346
4245
3300
WMES,	-10
		/RECORDS WRITTEN:\
6346
4460
6345
6401
7063
5265
6546
5733
	PAGE

/	OUTSCR
/OUTPUT NEW RECORD TO SCRATCH FILE
OUTSCR,	0
	TAD (SCRATCH
	CALL KRDOIO
	NEW-1
L5,	5
	EXIT OUTSCR

/	OVER
/PASS THROUGH FILE AND CLOSE
OVER,	0
	CDF 10
	TAD I (FILE
	CDF 0
	SNA CLA		/FILE RECORD STILL PRESENT?
	JMP RD		/NO
WR,	TAD (OUT	/YES, OUTPUT IT
	CALL KRDOIO
	FILE-1
L33,	33
	TAD (WTALLY
	CALL (TALLY
RD,	TAD INIFN	/READ NEXT RECORD
	SNA
	JMP ENDFIL
	CALL KRDOIO
	FILE-1
	JMP ENDFIL	/THROUGH
	TAD (RTALLY
	CALL (TALLY
	JMP WR		/LOOP
ENDFIL,	TAD (OUT
	CALL KFINI	/CLOSE OUTPUT FILE
	EXIT OVER

/	TALLIES
TTABLE,	-6		/MUST BE BEFORE CTALLY
CTALLY,	-12;-12;-12;-12;-12;-12	/# OF CHANGES
ITALLY,	-12;-12;-12;-12;-12;-12	/# OF INSERTS
DTALLY,	-12;-12;-12;-12;-12;-12	/# OF DELETES
ETALLY,	-12;-12;-12;-12;-12;-12	/# OF ERRORS
RTALLY,	-12;-12;-12;-12;-12;-12	/# OF RECORDS READ
WTALLY,	-12;-12;-12;-12;-12;-12	/# OF RECORDS WRITTEN

/	ENTERED WITH ADDRESS OF ONE OF ABOVE IN AC.
TALLY,	0
	TAD L5
	DCA TPTR	/POINT TO UNITS DIGIT
TISZ,	ISZ I TPTR	/INCREMENT DIGIT
	EXIT TALLY	/RETURN IF NO OVERFLOW
	TAD (-12	/OVERFLOW
	DCA I TPTR	/RESET TO -10 (DECIMAL)
	STA
	TAD TPTR
	DCA TPTR	/GO TO NEXT HIGHER DIGIT
	JMP TISZ
TPTR,	0		/PTS TO TALLY TABLE
SPTR,	0		/PTS TO STATISTIC MESSAGE ADDRESS
TKNT,	0		/TEMPORARY COUNTER

/	REPORT STATISTICS
REPORT,	0
	TAD (THEAD-1
	DCA I (SUBHD	/SET SUBTITLE
	TAD TTABLE	/-6
	DCA KNT
	CALL (LPRINT
	CALL (EJEKT
	TAD (TTABLE
	DCA TPTR
	TAD (S1
	DCA SPTR
RLOOP,	CALL ZLPCRLF
	TAD I SPTR	/GET ADDRESS OF MESSAGE
	DCA .+2
	CALL (CDOIOC
	0
	TAD TTABLE	/-6
	DCA TKNT	/6 DIGITS
RTLOOP,	INCR TPTR
	TAD I TPTR	/GET DIGIT
	TAD L33		/CONVERT TO -237 CODE
	CALL ZLPTCHR	/PRINT IT
	ISZ TKNT
	JMP RTLOOP
	CALL ZLPCRLF
	INCR SPTR
	ISZ KNT
	JMP RLOOP
	TAD (214
	CALL LPOCHR
/	TAD (214
/	CALL LPOCHR
	EXIT REPORT
	PAGE

/	UPDAT
UPDAT,	0
UPARSE,	CALL ZGETCHR	/GET CHAR
	EXIT UPDAT	/DONE
RESUME,	TAD (-47	/MUST BE F
	SZA CLA
	JMP ERU16	/AIN'T
	CALL (GETNUM	/GET NUMBER
	DCA NUMB	/SAVE IT
	TAD NUMB
	CIA
	TAD FLIM
	SPA CLA
	JMP ERU17	/FNUM TOO LARGE
	CALL ZGETCHR	/GET CHAR
	JMP ERU16
	TAD (-36	/MUST BE "="
	SZA CLA
	JMP ERU16	/AIN'T
	TAD (DSCTAB-1
	TAD NUMB
	DCA TEMP	/PT TO DESCRIPTOR ENTRY
	CDF DSCFLD+BASFLD
	CLA IAC
	AND I TEMP
	DCA TYPE	/GET TYPE
	TAD I TEMP
	CLL RAR
	DCA BYTOFF
	TAD BYTOFF
	CIA
	DCA GTEM
	INCR TEMP
	TAD I TEMP
	CLL RAR
	TAD GTEM
	SNA
	JMP ERU17	/LENGTH 0
	DCA SIZE	/GET SIZE
	CDF BASFLD
	TAD TYPE
	SZA CLA
	JMP DEC		/DECIMAL
	CALL (GETALPH	/ALPHA
	SKP
DEC,	CALL (GETDEC
	CALL ZGETCHR	/GET CHAR
	EXIT UPDAT	/DONE
	TAD (-15	/MUST BE COMMA
	SZA CLA
	JMP ERU16	/AIN'T
	CALL ZGETCHR	/GET CHAR
	SKP		/LINE ENDED WITH A COMMA
	JMP RESUME
	CALL KINPUT	/READ CONTINUATION LINE
	JMP ERU16	/NO MORE
	CALL (TAB
	JMP UPARSE
GTEM,	0
ERU16,	CALL ZERROR
	ERRU16-1
ERU17,	CALL ZERROR
	ERRU17-1

/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
KOUTPUT,	-6
	-60;-66;-65;-61;-66;-65
KEND,	-3
	-46;-57;-45
KUPDATE,	-6
	-66;-61;-45;-42;-65;-46
KSORT,	-4
	-64;-60;-63;-65
KKEY,	-3
	-54;-46;-72
KDEFINE,-6
	-45;-46;-47;-52;-57;-46
	PAGE

/	ERROR MESSAGES
ERRU1,	ERRU1-ERRU2+1
		/NOT I, D, OR C\
5760
6501
5215
145
1501
6063
144
ERRU2,	ERRU2-ERRU3+1
		/MISSING OR OUT OF ORDER\
5652
6464
5257
5001
6063
160
6665
160
4701
6063
4546
6300
ERRU3,	ERRU3-ERRU11+1
		/I RECORD ALREADY EXISTS\
5201
6346
4460
6345
142
5563
4642
4572
146
7152
6465
6400
ERRU11,	ERRU11-ERRU12+1
		/NO END STMNT\
5760
146
5745
164
6556
5765
ERRU13,
ERRU12,	ERRU12-ERRU14+1
		/BAD KEY\
4342
4501
5446
7200
ERRU14,	ERRU14-ERRU15+1
		/BAD VALUE\
4342
4501
6742
5566
4600
ERRU15,	ERRU15-ERRU16+1
		/OUT OF ORDER\
6066
6501
6047
160
6345
4663
ERRU16,	ERRU16-ERRU17+1
		/BAD UPDATE COMMAND\
4342
4501
6661
4542
6546
144
6056
5642
5745
ERRU17,	ERRU17-ERRU20+1
		/NON-EXISTENT FIELD\
5760
5716
4671
5264
6546
5765
147
5246
5545
ERRU20,	ERRU20-ERRU21+1
		/MISSING UNIT\
5652
6464
5257
5001
6657
5265
ERRU21,
ERRX,	-5
		/NO DEFINE!\
5760
145
4647
5257
4602

XPASS1,	-5
		/   PASS 1\
101
161
4264
6401
2200
XPASS2,	-5
		/   PASS 2\
101
161
4264
6401
2300
OUTTRY,	0
OUTLAB,	101;101;101
UPTRY,	0
UPLAB,	101;101;101
	401
		/$UPD00\
SCRLAB,	566
	6145
	2121
	
TAB,	0
	TAD (240
	CALL LPOCHR
	TAD (240
	CALL LPOCHR
	TAD (240
	CALL LPOCHR
	EXIT TAB
	PAGE

	FIELD 1
	*200
/	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 NEW RECORD AT
/THE OFFSET SPECIFIED BY 'BYTOFF'.
/	CALL (GETDEC
/	<NORMAL-RETURN>
GETDEC,	0
	DCA DSIGN
	DCA NUMPTR	/POINT TO FIRST (0TH) BYTE
	CALL ZGETCHR	/LOOK FOR SIGN
	JMP DEND	/NOTHING WILL BE ERROR
	TAD (-14
	SNA		/IS IT "+"?
	JMP DPL		/YES
	TAD (14-16	/NO
	SNA		/IS IT "-"?
	JMP DMI		/YES
	TAD (16		/NO, RESTORE CHAR
	JMP GETD2	/JUMP INTO LOOP
DMI,	TAD (40		/SET MINUS SIGN
DPL,	DCA DSIGN	/SET PLUS SIGN
GETD1,	CALL ZGETCHR	/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,	TAD NUMPTR
	SNA CLA		/WERE ANY DIGITS FOUND?
	JMP ERU14
	TAD SIZE
	CIA
	TAD NUMPTR
	SMA SZA CLA	/
	JMP ERU14
	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
	CALL (BMOVE	/MOVE NUMBER TO RECEIVING FIELD
	CDF NUMFLD+BASFLD
	NUMBUF
	0
	CDF 10
	NEW+1
OFSET,	0
/INSERT ZEROES
	TAD BYTOFF
	DCA OFST
	TAD DIF
	SNA
	EXIT GETDEC
	CIA
	DCA DIF
ZRO,	TAD (21
	CALL (PUTM
	CDF 10
	NEW+1
OFST,	0
	INCR OFST
	ISZ DIF
	JMP ZRO
	EXIT GETDEC
DSIGN,	0		/MINUS SIGN IS 40, + IS 0
NUMKNT,	0		/TEMPORARY COUNTER
DIF,	0
ERU14,	CALL ZERROR
	ERRU14-1

/	CLOSE 1
/CLOSES SCRATCH FILE
CLOSE1,	0
	TAD SORT
	SZA CLA		/ALREADY SORTED?
	JMP I (FINI	/YES, NO NEED
	TAD (SCRATCH	/NO
/	CALL KFINI
	CALL KRDOIO	/FAKE CLOSE
	ZERO-1
	CALL KGPBUF
	EXIT CLOSE1
ZERO,	0
	PAGE

/	GETALPH
/THIS ROUTINE SEARCHES THE INPUT LINE
/FOR AN ALPHA CONSTANT (NOT NECESSARILY IN QUOTES).
/MAXIMUM SIZE EXPECTED IS IN 'SIZE'.
/IT IS TO BE PUT LEFT JUSTIFIED (PADDED WITH
/BLANKS ON THE RIGHT) IN NEW RECORD,
/AT OFFSET SPECIFIED BY 'BYTOFF'.
/	CALL (GETALPH
/	<NORMAL-RETURN>
GETALPH,0
	TAD P7400
	DCA NUMCNT
	TAD (NUMBUF-1
	DCA X2
/	FILL NUMBUF WITH SPACES
	CDF NUMFLD+BASFLD
SPLUP,	TAD Z101
	DCA I X2
	ISZ NUMCNT
	JMP SPLUP
	CDF BASFLD
	DCA NUMPT	/POINT TO BYTE 0
	DCA QFLAG
	CALL ZGETCHR	/LOOK FOR QUOTE
	JMP I (ERU14	/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
	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
	JMP I (ERU14
	TAD (-10
	SZA CLA		/CLOSE QUOTE?
	JMP I (ERU14	/NO, ERROR
GETA4,	TAD NUMPT	/YES, OK
	SNA		/WERE ANY CHARS FOUND?
	JMP I (ERU14	/NO, ERROR
	CIA
	TAD SIZE
	SPA CLA
	JMP I (ERU14
	TAD BYTOFF
	DCA OFSET2
	CALL (BMOVE	/MOVE STRING TO RECEIVING FIELD
	CDF NUMFLD+BASFLD
	NUMBUF
	0
	CDF 10
	NEW+1
OFSET2,	0
	EXIT GETALPH	/RETURN
NUMCNT,	0		/TEMPORARY COUNTER
QFLAG,	0		/1 MEANS QUOTED STRING
CEND,	TAD QFLAG
	SZA CLA		/IS IT AN IMBEDDED ","?
	JMP CPUT	/YES
	JMP AEND	/NO
	PAGE

/COMPARE ROUTINE
/COMPARES RECORD WHOSE ADDRESS IS IN AC TO NEW RECORD 
/BOTH RECORDS MUST BE IN FIELD 1.
/NORMAL RETURN IF AC RECORD BEATS NEW RECORD; SKIP RETURN IF TIE;
/DOUBLE SKIP RETURN IF NEW RECORD BEATS CHALLENGER
COMPAR,	0
	DCA	CHALNG	/SAVE CHALLENGER ADDRESS
	TAD	(BEGLST-1
	DCA	CMXR
CMPLP1,	CDF BASFLD
	TAD I	CMXR	/GET AN ENTRY FROM THE COMPARE TABLE
	SPA
	JMP	CMPWDS	/NEGATIVE MEANS FULLWORD COMPARE
	SNA
	JMP	CRTN2	/END OF COMPARE LIST - RECORDS ARE EQUAL
	CLL RAR
	DCA	CMPOFF	/SAVE WORD OFFSET
	TAD	CHALNG
	TAD	CMPOFF
	DCA	CMTEMP	/GET WORD IN CHALLENGER
	TAD	(NEW
	TAD	CMPOFF
	DCA	CMPOFF	/GET WORD IN NEW RECORD
	TAD I	CMXR
	DCA	CMPMSK	/GET MASK FROM COMPARE TABLE
	CDF BASFLD+10
	TAD I	CMTEMP
	AND	CMPMSK
	DCA	CMTEMP	/SAVE MASKED PART OF CHALLENGER WORD
	TAD I	CMPOFF
	AND	CMPMSK	/MASK WINNER WORD
	CIA		/NOTE THAT BIT 11 OF COMPARE WORD 1 IS IN THE LINK HERE
	TAD	CMTEMP
	SNA		/EQUAL?
	JMP	CMPLP1	/YES - TRY NEXT FIELD
CDECID,	CDF BASFLD
	SNL CLA		/***MY VERSION CHALLENGER BEAT NEW RECORD?
	JMP I	COMPAR	/YES - IMMEDIATE RETURN
	ISZ	COMPAR	/NO - DOUBLE SKIP RETURN
CRTN2,	ISZ	COMPAR	/EQUAL - SINGLE SKIP RETURN
	JMP I	COMPAR

CMPWDS,	DCA	CMTEMP	/WORD COMPARE - FIRST WORD IS WORD COUNT
	TAD I	CMXR
	CLL RAR
	DCA	CMPOFF
	TAD	CMPOFF
	TAD	CHALNG
	DCA	GETXR	/FULL WORD COMPARE OFFSETS ARE OFFSET BY -1
	TAD	CMPOFF
	TAD	(NEW
	DCA	PUTXR
	CDF BASFLD+10
CMPLP2,	TAD I	PUTXR	/REMEMBER, BIT 11 OF WORD 1 IS IN THE LINK HERE
	CIA
	TAD I	GETXR
	SZA		/IF WORDS ARE EQUAL, GET NEXT PAIR OF WORDS
	JMP	CDECID	/OTHERWISE WE HAVE A WINNER
	CML		/RESTORE DIRECTION OF COMPARE TO LINK
	ISZ	CMTEMP	/BUMP WORD COUNTER
	JMP	CMPLP2	/KEEP GOING
	JMP	CMPLP1	/GET NEXT COMPARE CONTROL DOUBLEWORD
CHALNG,	0
CMPOFF,	0
CMTEMP,	0
CMPMSK,	0
BEGLST,	0		/KEY COMPARISON TABLE - UP TO 24 ENTRIES
	*.+60		/ALLOW ROOM FOR THE REST OF THE TABLE
	PAGE

/SPECIAL FILE INITIALIZATION ROUTINE
/DOESN'T CALL "MOUNT" UNLESS ABSOLUTELY NECESSARY
/	CALLING SEQUENCE:
/	TAD	(POINTER TO NEW W0, W1)-1
/	DCA	XR
/	TAD	(IFN
/	JMS	SINIT
/	POINTER TO (SEQUENCE #, LABEL) - 1
SINIT,	0
	JMS I	KPTRST
	TAD I	XR	/GET CONTROL WORD
	DCA I	W0	/SAVE IT
	TAD I	XR	/GET BUFFER ADDRESS
	AND	P7600	/REMOVE EXTRANEOUS CRAP
	TAD	M1
	DCA I	W2
	TAD I	W1
	AND	(377	/PRESERVE UNIT NUMBER
	TAD I	W2
	IAC		/ADD IN BUFFER ADDRESS
	DCA I	W1
	TAD I	W0
	CLL RAL
	AND	P7400
	CIA
	SNL		/INITIALIZE WORD COUNT
	CLA		/TO 0 IF INPUT FILE,
	DCA I	W3	/TO -(BUFFER SIZE) IF OUTPUT FILE
	DCA I	W4	/ZERO HIGH-ORDER BLOCK BITS
	TAD I	W5
	AND	(377
	TAD	(400
	DCA I	W5	/SET LOW ORDER BLOCK BITS TO 1
	JMS	SISETP	/INITIALIZE POINTERS & COUNT FOR COMPARE
SICMLP,	TAD I	PUTXR	/COMPARE THE LABEL IN THE FILE TABLE ALREADY
	CIA
	TAD I	GETXR	/WITH THE ONE WE WANT TO INSERT
	SZA CLA		/IF IT'S NOT A PERFECT MATCH (INC. SEQ #)
	JMP	CALLMT	/USE "MOUNT" TO GET THE LABEL CORRECTLY
	ISZ	SICT
	JMP	SICMLP
SIRETN,	TAD	IFN	/THESE TWO INSTRUCTIONS AREN'T REALLY NEEDED,
	JMS I	KPTRST	/THEY JUST SET UP THE UNIT BITS IN W0
	ISZ	SINIT
	JMP I	SINIT	/RETURN

/MOVE THE NEW LABEL INTO THE FILE TABLE AND CALL "MOUNT"
CALLMT,	JMS	SISETP
	STA
	TAD  I	GETXR
	DCA I	PUTXR	/BUMP THE SEQUENCE NUMBER DOWN BY ONE
	ISZ	SICT	/BEFORE MOVING IT SINCE "MOUNT" BUMPS
	JMP	.-3	/IT UP ONE.
	TAD SCRTRY
	JMS I	MOUNT
	JMP	SIRETN
SISETP,	0
	TAD I	SINIT
	DCA	GETXR
	TAD	W4
	DCA	PUTXR
	TAD	M4
	DCA	SICT
	JMP I	SISETP
SICT,	0

/	CREAD
/CHARACTER ORIENTED DEVICE READ ROUTINE
CREAD,	0
	CALL (LPRINT
	TAD L6
	DCA CHCT
CREED,	TAD DEVYCE	/GET DEVICE CODE
	CALL KCDOIO
	BUFFER-1+3
	JMP CEOF	/EOF
	INCR CREAD	/SKIP ON NORMAL RETURN
	TAD I (BUFFER+3
	TAD (-3		/GET WC
	DCA I (BUFFER
	TAD Z101
	DCA I (BUFFER+1
	TAD Z101
	DCA I (BUFFER+2
	TAD Z101
	DCA I (BUFFER+3
	EXIT CREAD
CEOF,	CALL (LPRINT
	TAD DEVYCE
	TAD M4
	SZA CLA
	EXIT CREAD	/EOF ON KBD OR CDR
	CLA IAC		/IS NOT AN ACCIDENT
	CALL KCDOIO	/MORE?
	KMORE-1
L6,	6
	CALL KCDOIO	/READ ANSWER
	BUFFER-1
	NOP
	TAD I (BUFFER+1
	AND Z7700
	TAD (-5700
	SNA CLA		/MORE?
	EXIT CREAD	/NO
	JMP CREED	/YES

/	CHANGE
/MOVES NON-ZERO FIELDS FROM NEW RECORD
/TO FILE RECORD.
CHANGE,	0
	DCA GBYTE	/STRAT AT BYTE 0
	DCA PBYTE
	CDF 10
	TAD I (FILE	/GET WC
	CDF 0
	CLL RAL		/GET BYTE COUNT
	DCA CHKNT
CHLOOP,	CALL (GETM	/GET BYTE FROM NEW RECORD
	CDF BASFLD+10
	NEW+1
GBYTE,	0
	SNA		/NON-ZERO?
	JMP SKIPIT	/NO, SKIP IT
	CALL (PUTM	/YES, INSERT IN FILE RECORD
	CDF BASFLD+10
	FILE+1
PBYTE,	0
SKIPIT,	INCR GBYTE	/GO TO NEXT BYTE
	INCR PBYTE
	ISZ CHKNT	/THROUGH?
	JMP CHLOOP	/NO
	EXIT CHANGE	/YES
CHKNT,	0		/TEMPORARY COUNTER
	PAGE

/	PRONEW
/PROCESS NEW RECORD
PRONEW,	0
PROLUP,	CDF 10
	TAD I CCLOC	/GET CONTROL CHAR
	AND P77
	DCA CCHAR
	TAD I (FILE	/GET FILE RECORD WORD COUNT
	CDF 0
	SZA CLA		/IS RECORD PRESENT?
	JMP CMP		/YES
	TAD INIFN
	SNA
	JMP FILBIG
	CALL KRDOIO	/READ NEXT FILE RECORD
	FILE-1
	JMP EOF		/EOF NOP'S *'ED ITEMS
	CDF 10
	TAD I (FILE
	CDF 0
	DCA REALWC
	TAD (RTALLY
	CALL (TALLY
CMP,	TAD (FILE	/COMPARE FILE KEY
	CALL (COMPAR	/AND NEW KEY
JFLBG,	JMP FILBIG	/FILE KEY GT NEW KEY
	JMP FILEQ	/FILE KEY EQ NEW KEY
	TAD (OUT	/FILE KEY LT NEW KEY
	CALL KRDOIO
	FILE-1
	NOP		/DNO
	TAD (WTALLY
	CALL (TALLY
	CDF 10
	DCA I (FILE
	CDF 0
	JMP PROLUP
EOF,	DCA INIFN
/FILBIG MUST FOLLOW

FILBIG,	TAD CCHAR	/LOOK AT CONTROL CHAR
	TAD (-52
	SZA CLA		/IS IT "I"?
	JMP ERU2	/NO
	TAD REALWC	/YES
	CDF 10
	DCA I (NEW
	TAD I CCLOC
	AND Q7700
	IAC
	DCA I CCLOC	/SET CONTROL CHAR TO BLANK
OUTNEW,	CDF 0
	TAD (OUT	/OUTPUT NEW RECORD
	CALL KRDOIO
	NEW-1
	NOP
	TAD (WTALLY
	CALL (TALLY
	TAD (ITALLY
LOGIT,	CDF 0
	CALL (TALLY
	CALL (LOG
	EXIT PRONEW
ERU2,	JMS QERROR
	ERRU2-1

FILEQ,	TAD CCHAR	/GET CONTROL CHAR
	TAD (-45
	SZA		/IS IT "D"?
	JMP NOTD	/NO
	CDF 10
	DCA I (FILE	/YES, DESTROY FILE RECORD
	TAD (DTALLY
	JMP LOGIT
NOTD,	IAC
	SZA CLA		/IS IT "C"?
	JMP ERU3	/NO, ERROR
	CDF 10		/0 CONTROL CHAR
	TAD I CCLOC
	AND Z7700
	DCA I CCLOC
	CDF 0
	CALL (CHANGE	/YES, PERFORM CHANGE
	TAD (CTALLY
	JMP LOGIT
ERU3,	JMS QERROR
	ERRU3-1

QERROR,	0
	TAD (ETALLY
	CALL (TALLY
	DCA I (DOSW	/STOP BATCH
	TAD I QERROR
	DCA PMISG
	CALL (LOG
	IAC
	CALL ZLPTCHR
	CALL (CDOIOC
PMISG,	0
	TAD PASS
	SZA CLA
	JMP I (P2LOOP
	JMP I (P1LOOP
	PAGE

/	INSRT
INSRT,	0
	TAD (BEGLST-1
	DCA CMXR
	CALL (GCH
	JMP ERU13
	TAD M1
	SZA CLA
	JMP ERU13
INSLUP,	TAD I CMXR	/GET ENTRY FROM COMPARE TABLE
	SPA
	JMP FULLW	/FULLWORD ENTRY
	SNA		/DONE?
	JMP INCC	/YES
	CLL RAR		/NO, HALFWORD ENTRY, GET WORD OFFSET
	TAD (NEW	/PT TO WORD
	DCA TEMP
	TAD I CMXR	/GET MASK
	CMA
	DCA MASK	/SAVE COMPLEMENT
	CDF 10
	TAD I TEMP
	AND MASK
	DCA I TEMP	/ZERO BYTE IN QUESTION
	CDF 0
	CALL (GCH	/GET NEXT CHAR
	JMP ERU13	/KEY TOO SMALL
	DCA SAVEC	/SAVE IT
	TAD MASK	/GET MASK
	RAL		/PUT SIGN INTO LINK
	CLA		/0 LINK MEANS LEFT BYTE
	TAD SAVEC
	SNL
	CALL (RAL6	/GET CHAR INTO POSITION
	CDF 10
	TAD I TEMP	/PUT INTO RECORD
	DCA I TEMP
	CDF 0
	JMP INSLUP	/CONTINUE WITH COMPARE TABLE

FULLW,	DCA INSKNT	/SAVE COUNT
	TAD I CMXR
	CLL RAR		/GET WORD OFFSET -1
	TAD (NEW	/PT TO WORD -1
	DCA GETXR
FWLOOP,	CALL (GCH	/GET CHAR
	JMP ERU13
	CALL (RAL6
	DCA TEMP	/MOVE TO LEFT BYTE
	CALL (GCH	/GET CHAR
	JMP ERU13
	TAD TEMP	/ADD TO RIGHT BYTE
	CDF 10
	DCA I GETXR	/STORE AWAY IN RECORD
	CDF 0
	ISZ INSKNT
	JMP FWLOOP	/MORE WORDS TO GO
	JMP INSLUP	/CONTINUE WITH COMPARE TABLE
INSKNT,	0

INCC,	CDF 10
	TAD I CCLOC
	AND Z7700
	TAD CCHAR
	DCA I CCLOC
	CDF 0
	EXIT INSRT
ERU13,	CALL ZERROR
	ERRU13-1

/	OPEN2
/OPEN INPUT, OUTPUT, AND SCRATCH FILES
OPEN2,	0
	TAD I (UPTRY
	DCA I GLOC
	TAD INIFN
	CALL KINIT
	600+10		/1400 WDS
	INBUFF
	UPLAB-1
	TAD I (OUTTRY
	DCA I GLOC
	TAD (OUT
	CALL KINIT
	4000+600+10	/1400 WDS LONG (WRITE)
	OUTBUF
	OUTLAB-1
	TAD (W0W1
	DCA XR
	TAD (XPASS2-1
	DCA I (SUBHD
	CALL (LPRINT
	TAD SORT
	SNA CLA
	CALL (EJEKT
	TAD SORT
	SZA CLA
	EXIT OPEN2
	TAD (SCRATCH
	CALL (SINIT
	SCRLAB-2
	DCA I GLOC
	EXIT OPEN2
W0W1,	0
	200+10		/READ
	SCRBUF
KMORE,	-3
		/MORE?\
5660
6346
4000
	PAGE
	$