/SORT PROGRAM FOR COS 300   EDITED 10/8/73
/COPYRIGHT 1972, 1973
/DIGITAL EQUIPMENT CORP.
/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.
/
/UTILIZES POLYPHASE MERGE TECHNIQUE WITH REPLACEMENT SELECTION PRESORT
/GEE, THATS A LOT OF BUZZWORDS - HOWEVER, ANY GOOD BOOK ON SORTING
/TECHNIQUES WILL GIVE YOU A GOOD EXPLANATION OF THEM.

/DEFINITIONS FOR EDP-8
RDOIO=	26
CDOIO=	27
KGPBUF=	41
IFN=	42
M1=	45
M4=	66
P7=	40
P17=	64
P70=	65
P77=	20
P7400=	02
P7600=	70
KMOVE=	23
KGETC=	24
LPOCHR=	35
TTOCHR=	31
TOPFLD=	7775
OPTCHR=	7776
LENGTH=	44
KPUTC=	25
OTOPD=	74
W0=	46
W1=	47
W2=	50
W3=	51
W4=	52
W5=	53
U0=	54
U1=	55
U2=	56
INIT=	72
FINI=	75
KPTRST=	43
SBT=	6370
PTF0=	62
PMOUNT=	60
PSRTFG=	61
SYSHND=	77

	/OTHER DEFINITIONS
BUFFLD=	10
INLEN=	1
INBUF=	4000
DSCTAB=	6000	/DESCRIPTOR TABLE AT 16000
DATTAB=	7000	/DATA TABLE AT 17000
DSCLEN=	-1000
DATLEN=	-2000
DSCFLD=	10
DATFLD=	10
AC7775=	CLL STA RTL
AC7776=	CLL STA RAL
AC4000=	CLA STL RAR
AC3777=	CLL STA RAR
AC2000=	CLA STL RTR
AC0002=	CLA STL RTL
	FIELD 0		/INITIALIZATION CODE IN THIS FIELD
			/OVERLAYED BY ACTUAL SORT ROUTINE

/PAGE ZERO - COMMON VARIABLES
	*6		/CELLS COMMON TO PHASES 1 AND 2
TF0,	0		/POINTER TO BATCH FLAG WORD
MRGFLG,	0		/1 IF DOING A MERGE
	*15
BXR,	0
XR,	0
CMXR,	0		/XR USED TO SET UP COMPARE LIST
	*100
NWORK,	4		/NUMBER OF WORK UNITS
NAM1,	0
NAM2,	0		/TEMPORARIES FOR "GETNAM" & OTHER ROUTINES
NAM3,	0
UNIT,	0		/"ASSUMED UNIT NUMBER"
DELIM,	0		/LAST DELIMITER SEEN
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
NUMOPT,	0		/NON-0 IF /2,3,4,5, OR 6 SPECIFIED
ASKFLG,	0		/1 IF /A SPECIFIED
NFILES,	1		/NUMBER OF FILES IN "INPUT" STMT
	PAGE

SORT,	TAD I	M4
	DCA	SYSHND	/SAVE SYSTEM HANDLER ADDRESS
	TAD	PTF0
	DCA	TF0
	TAD I	(OPTCHR
	AND	(7700
	TAD	(-1400
	DCA	T
	TAD	T
	SNA CLA
	DCA	LSTSW
	TAD	PMOUNT
	CDF 10
	DCA I	(MOUNT
	TAD	PSRTFG
	DCA I	(SRTFLG
	DCA I	(DSCTAB
	TAD	(1774
	DCA I	(DSCTAB+1
	CDF 0
	TAD I	M1
	JMS I	(DACODE
	TAD I	(OPTCHR
	AND	P77
	TAD	(-14
	SNA CLA
	DCA	LSTSW
	TAD	T	/GET FIRST OPTION CHAR
	TAD	(-100
	SNA
	ISZ	MRGFLG	/ "M" SWITCH MEANS STRAIGHT MERGE
	TAD	(1400
	SNA
	ISZ	ASKFLG	/ "A" SWITCH MEANS ASK FOR MERGE INPUT FILES
	CLL RTR
	RTR
	RTR
	TAD	(-66
	CLL
	TAD	[5
	SNL		/CHECK FOR /2,3,4,5,6
	STA		/NO
	IAC		/STORE 0 IF NO, #-1 IF YES
	DCA	NUMOPT
SORTLP,	JMS I	(READLN	/GET A LINE
	JMS	VERIFY
	-4546		/DE
	-4752		/FI
	-5746		/NE
	FDR
	JMS	VERIFY
UPDFLG,	-6661		/UP
	-4542		/DA
	-6546		/TE
	UPDATE
	JMS	VERIFY
	-5257		/IN
	-6166		/PU
	-6501		/T
	INPUT
	JMS	VERIFY
	-6460		/SO
	-6365		/RT
	-0101
	GETWKU
	JMS	VERIFY
	-6066		/OU
	-6561		/TP
	-6665		/UT
	OUTPUT
	JMS	VERIFY
KEYFLG,	-5446		/KE
	-7201		/Y
	-0101
	GKEY
	JMS	VERIFY
	-4657		/EN
	-4501		/D
	-0101
	END
UNRECG,	JMS I	[ERROR
	BADKWD-1

VERIFY,	0		/SUBROUTINE TO CHECK STATEMENT KEYWORD
	TAD	(6
	DCA CHCT	/INITIALIZE TO FIRST CHARACTER
	JMS I	(GETNAM
	0		/LEAVE NAME IN NAM1-NAM3
	TAD	UNIT
	SZA CLA
	JMP	UNRECG	/KEYWORD CONTAINED /
	TAD	VERIFY
	DCA	XR
	TAD	NAM1
	TAD I	VERIFY
	SNA CLA		/ALL THREE WORDS OF THE NAME MUST MATCH
	TAD	NAM2	/FOR A SKIP RETURN
	TAD I	XR
	SNA CLA
	TAD	NAM3
	TAD I	XR
	SZA CLA
	JMP	NOMACH
	AC7776
	AND	DELIM	/AND THE DELIMITER MUST BE BLANK OR CARRIAGE-
	SZA CLA		/RETURN
	JMP	NOMACH
	TAD I	XR
	DCA	T
	DCA I	VERIFY	/MAKE SURE NO STATEMENT IS REPEATED
	JMP I	T	/EXECUTE STATEMENT PROCESSOR
NOMACH,	ISZ	XR
	JMP I	XR
	PAGE

/GET NAME SUBROUTINE
GETNAM,	0
	SPA		/IF AC NEGATIVE,
	JMP	STONAM	/STORE EXISTING NAME
	TAD	[101
	DCA	NAM1
	TAD	NAM1
	DCA	NAM2
	TAD	NAM1
	DCA	NAM3	/INITIALIZE NAME TO BLANKS (OR ZEROS)
	DCA	UNIT
	TAD	(-7
	DCA	NMCT
	JMS I	[GETCHR	/IGNORE SPACES PRECEDING NAME
	NOP
	JMP	TSTLET	/NAME MUST START WITH A LETTER
PUTCHR,	ISZ	NMCT	/BUMP NAME CHAR CTR
	JMP	.+4
	STA
	DCA	NMCT	/IGNORE CHARACTERS PAST THE SIXTH
	JMP	NXTCHR
	TAD	NMCT
	CLL CML RAR
	TAD	(NAM1+3	/FORM A POINTER FROM THE COUNT
	DCA	GNPT
	TAD	P77
	SNL		/RIGHT OR LEFT HALF?
	TAD	(7601	/FORM A MASK
	AND I	GNPT
	DCA I	GNPT	/MASK OFF THE PROPER HALF
	TAD	DELIM
	SNL		/LEFT HALF OR RIGHT HALF?
	JMP	.+4	/RIGHT
	CLL RTL
	RTL
	RTL
	TAD I	GNPT	/ADD IT TO THE PROPER HALF
	DCA I	GNPT
NXTCHR,	JMS I	[GCH
	NOP
	TAD	[-34
	SZA
	TAD	[34	/SEMICOLON = C.R.
TSTLET,	DCA	DELIM
	TAD	DELIM
	SZA
	TAD	M1
	SZA
	TAD	(-14
	SNA
	JMP	STONAM	/CARRET OR COMMA TERMINATE
	TAD	(-3
	SZA CLA
	JMP	PUTCHR
	JMS I	(GTUNIT	/SLASH TERMINATES AND GETS ASSUMED UNIT
	DCA	UNIT
STONAM,	CLA
	TAD I	GETNAM	/FIND OUT WHERE TO PUT THE NAME
	ISZ	GETNAM
	SNA		/SHOULD WE PUT IT ANYWHERE?
	JMP I	GETNAM	/NO
	DCA	TOADR1
	TAD	M4
	JMS I	KMOVE	/MOVE IT INTO ITS PLACE IN FIELD 1
	CDF 10
	NAM1-1
TOADR1,	0
	JMP I	GETNAM	/RETURN
NMCT,	0
GNPT,	0
OUTPUT,	JMS	GETNAM
	OUTLBL-1
	JMP I	(SORTLP
	PAGE

/"INPUT" STMT PROCESSOR
INPUT,	TAD	ASKFLG
	SZA CLA
	JMP	UPDATE
	JMS	GTNAMS	/GET INPUT FILE NAMES
	JMP I	(SORTLP
GTNAMS,	0
	DCA	NFILES
	TAD	(MRGTAB
	DCA	MRGPTR	/STORE INPUT FILES IN MERGE LIST
MRGFLP,	JMS I	(GETNAM
MRGPTR,	0
	TAD	NAM1
	TAD	(-101
	SNA CLA
	JMP	SXERR
	TAD	MRGPTR
	TAD	[5
	DCA	MRGPTR
	ISZ	NFILES
	TAD	NFILES
	TAD	(-7
	SNA CLA		/NO MORE THAN 6 INPUT FILES ALLOWED
	JMP	TOOMNY
	JMS	DLMSBR
	SNA
	JMP I	GTNAMS	/CR - RETURN
	TAD	(-15
	SNA CLA
	JMP	MRGFLP	/COMMA - LOOP
SXERR,	JMS I	[ERROR
	SYNTAX-1
TOOMNY,	JMS I	[ERROR
	TOOMCH-1
UPDATE,	JMS I	[GETCHR
	JMP I	(SORTLP
	CLA
	JMP	UPDATE

/"SORT" STMT PROCESSOR
GETWKU,	JMS I	(GTNUM	/GET A NUMBER
	TAD	(4	/SUBSTITUTE 4 IF 0
	DCA	NWORK
	TAD	NWORK
	TAD	(-10
	CLL
	TAD	[5
	SNL CLA
	JMP	WNERR	/NUMBER OF WORK UNIT MUST BE 3,4,5,6, OR 7
	JMS	DLMSBR
	SNA
	JMP I	(SORTLP	/CR MEANS NO ASSUMED WORK UNITS
	TAD	(-20
	SZA CLA
	JMP	SXERR
	TAD	(WUNIT-1	/SLASH IS FOLLOWED BY UNIT NUMBERS
	DCA	XR
GTWKLP,	JMS I	(GTUNIT
	CDF 10
	DCA I	XR
	CDF 0
	TAD	XR
	TAD	(-WUNIT-7
	SMA CLA
	JMP	WNERR
	JMS	DLMSBR
	SNA
	JMP I	(SORTLP	/CR - EXIT
	TAD	(-15
	SZA CLA
	JMP	SXERR
	JMP	GTWKLP	/COMMA - LOOP
WNERR,	JMS I	[ERROR
	BADWN-1
DLMSBR,	0
	TAD	DELIM
	SZA CLA
	JMS I	[BACKUP	/ONLY BACKUP IF NOT AT EOL
	JMS I	[GETCHR
	NOP
	JMP I	DLMSBR
	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
GKEY,	TAD	(BEGLST-1
	DCA	CMXR
GETKEY,	CDF 0
	JMS I	[GETCHR	/GET A NON-BLANK CHARACTER
	NOP
	TAD	(-47
	SZA CLA		/IS IT AN F?
	JMP	ILLKEY	/NO - ERROR
	JMS I	(GTNUM	/GET THE F-NUMBER
	JMP	ILLKEY
	DCA	NAM1
	TAD	NAM1
	CIA
	TAD	TBRK	/CHECK TO SEE THAT ITS IN RANGE
	SPA CLA
	JMP	ILLKEY
	TAD	NAM1
	TAD	(DSCTAB-2
	DCA	XR	/FORM POINTER INTO DESCRIPTOR TABLE
	CDF 10
	TAD I	XR	/GET THE DESCRIPTOR
	CLL RAR		/THROW AWAY THE TYPE
	DCA	LC	/SAVE THE ADDRESS
	AC7776
	TAD I	XR
	CDF 0
	CLL RAR		/FROM THE ADDRESS OF THE NEXT DESCRIPTOR
	DCA	UC	/SAVE THE UPPER LIMIT
	TAD	DELIM
	SZA CLA
	JMS I	[BACKUP
	CLA IAC
SMINUS,	DCA	DIR	/INITIALIZE DIRECTION TO ASCENDING

TSTDLM,	JMS I	[GETCHR
	NOP
	SNA
	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
	SNA CLA		/NONE OF THE ABOVE - IS IT AN OPEN PAREN?
	JMS I	(GTNUM	/SUBSTRING SPECIFICATION - GET LOWER LIMIT
	JMP	ILLKEY
	DCA	XR
	TAD	DELIM
	TAD	(-15
	SNA CLA		/DELIMITER MUST BE COMMA
	JMS I	(GTNUM	/GET UPPER LIMIT
	JMP	ILLKEY
	TAD	LC
	TAD	M1
	DCA	UC	/SAVE NEW HIGH ADDRESS
	TAD	LC
	TAD	XR
	TAD	M1
	DCA	LC	/SAVE NEW LOW ADRESS
	TAD	DELIM
	TAD	(-12
	SNA CLA		/DELIMITER MUST BE CLOSE PAREN
	JMP	TSTDLM
ILLKEY,	JMS I	[ERROR
	ILKMSG-1
LC,	0
UC,	0
DIR,	0		/VARIABLES COLLECTED DURING KEY SCAN

CRTBNT,	DCA	JMPBAK	/CARRIAGE RETURN - SET FLAG TO TERMINATE
	CDF 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
	AC0002		/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	[7700
	DCA I	CMXR
NOHLF2,	
JMPBAK,	JMP	GETKEY	/THIS JUMP ZEROED BY CARRIAGE RETURN ROUTINE
	DCA I	CMXR	/INSERT TERMINATING ZERO
	CDF 0
	TAD	CMXR
	TAD	(-BEGLST-61
	SMA CLA
	JMP	ILLKEY
	JMP I	(SORTLP
	PAGE

/"END" STATEMENT PROCESSOR
END,	TAD	(KLUDG+1
	DCA I	(READLN	/SET UP FAKE ERROR RETURN
	TAD	ASKFLG
	SNA CLA
	JMP	NOASK
	TAD I	(ERKNT
	SZA CLA		/DON'T BOTHER ASKING IF THERE WERE ERRORS
	JMP	NOASK
MRGASK,	CLA IAC
	JMS I	CDOIO
	PROMPT-1	/ENTER INPUT FILES:
	NOP
	JMS I	CDOIO
PBF2,	BUFFER+2
	JMP	MRGASK	/^Z NOT NICE, BUT GIVE HIM A CHANCE
	TAD	[101
	DCA I	(BUFFER+1
	TAD	[101
	DCA I	PBF2
	AC7775
	TAD I	(BUFFER+3
	DCA I	(BUFFER
	TAD	[101
	DCA I	(BUFFER+3
	TAD	(6
	DCA	CHCT
	ISZ	MRGFLG	/SET MERGE FLAG ON
	JMS I	(GTNAMS	//AND GET INPUT NAMES
NOASK,	TAD	NUMOPT
	SNA
	JMP	NONUM
	IAC
	DCA	NFILES	/NUMOPT IS ONE TOO SMALL, REMEMBER?
	TAD	NUMOPT
	CIA
	DCA	T	/WE MUST CHANGE THE SECOND THROUGH
	TAD	(MRGTAB+5	/NTH FILE NAMES TO THE FIRST ONE
	DCA	TOPTR2
NUMVLP,	AC7775
	CDF 10
	JMS I	KMOVE
	CDF 10
	MRGTAB
TOPTR2,	0
	TAD	TOPTR2
	TAD	[5
	DCA	TOPTR2
	ISZ	T
	JMP	NUMVLP
	ISZ	MRGFLG	/SET MERGE FLAG - THIS TOO IS A MERGE
NONUM,	TAD	M4
	CDF 10
	JMS I	KMOVE
	CDF 10
	MRGTAB		/MOVE THE FIRST INPUT FILE INTO "INLBL"
	INLBL-1		/JUST IN CASE THIS IS A SORT (REMEMBER THEM?)
	TAD	MRGFLG
	SNA CLA
	JMP	.+4
	CLA IAC
	TAD	NFILES	/SET UP NWORK TO THE PROPER NUMBER
	DCA	NWORK	/FOR BUFFER ALLOCATION AND SUCH
	TAD I	(UPDFLG
	SZA CLA
	JMP	USENMS	/NOT UPDATE CONTROL - USE GIVEN NAMES
	AC7775
	JMS I	KMOVE
	CDF 10
	UPNAME-1
	INLBL-1		/CHANGE INPUT AND OUTPUT LABELS TO $UPD00
	CDF 10
	TAD	M4
	JMS I	KMOVE
	CDF 10
	INLBL-1
	OUTLBL-1		/AND SET THEIR ASSUMED UNITS EQUAL
USENMS,	TAD P7400
	DCA	LENGTH
	TAD I	(KEYFLG
	SZA CLA
	JMP I	(ILLKEY
KLUDG,	TAD I	(ERKNT
	SNA CLA
	TAD	LSTSW
	SZA CLA
	JMP	.+4
	JMS I	(LPRINT
	TAD	(214
	JMS I	LPOCHR
	TAD I	(ERKNT
	SZA CLA
	JMP I	P7600
	TAD	(CDF 10
	CIA
	TAD I	(TOPFLD	/GET FIELD COUNT FOR BUFFER ALLOCATOR
	CLL RTR
	RAR
	JMP I	.+1
	SSETUP		/SET UP BUFFERS FROM "NWORK" AND "TOPFLD"
	PAGE

BADKWD,	-12		/UNRECOGNIZEABLE LINE
	6657;6346;4460
	5057;5273;4642
	4355;4601;5552
	5746
GTNUM,	0		/ROUTINE TO COLLECT A NUMBER
	DCA	KNUM	/INITIALIZE NUMBER
	JMS I	[GCH	/GET A CHARACTER
	NOP
	TAD	[-34
	SZA
	TAD	[34	/SEMICOLON = C.R.
	DCA	DELIM
	TAD	DELIM
	TAD	(-33
	CLL
	TAD	(12
	SNL
	JMP	GTNUMR	/NON-DIGIT - RETURN
	DCA	GTNTMP
	TAD	KNUM
	CLL RTL
	TAD	KNUM
	RAL
	TAD	GTNTMP
	JMP	GTNUM+1	/KNUM=10*KNUM+NEW DIGIT
GTNUMR,	CLA
	TAD	KNUM
	SZA		/CHECK THAT THE NUMBER IS NON-ZERO
	ISZ	GTNUM	/SKIP RETURN IF NOT ZERO
	JMP I	GTNUM
GTNTMP,	0
KNUM,	0
GTUNIT,	0		/GET ASSUMED UNIT NUMBER
	JMS	GTNUM
	JMP	ILLUNT
	TAD	(-17
	SMA SZA
	JMP	ILLUNT
	TAD	P17
	JMP I	GTUNIT
UPNAME,	0566;6145;2121	/$UPD00
ILKMSG,	-10		/ILLEGAL SORT KEY
	5255;5546;5042
	5501;6460;6365
	0154;4672
/MISCELLANEOUS GARBAGE
TOOMCH,	-7		/TOO MANY FILES
	6560;6001;5642
	5772;0147;5225
	4664
SYNTAX,	-7		/ILLEGAL SYNTAX
	5255;5546;5042
	5501;6472;5765
	4271
PROMPT,	-11		/INPUT FILE LABELS:
	5257;6166;6501
	4752;5546;0155
	4243;4655;6433
ILLUNT,	JMS I	[ERROR
	ILUMES-1
ILUMES,	-6		/ILLEGAL UNIT
	5255;5546;5042
	5201;6657;5265
	PAGE

FDR,	CDF DATFLD	/FIELD DESCRIPTOR ROUTINE
	STL CLA RAR	/4000
	DCA I (DATTAB-1	/BOO ON GETC
	CDF 0
JFK,	JMS I (READLN	/READ NEXT LINE
LBJ,	JMS I (GETCHR	/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,	JMS I (COMA	/ENTER NEW DESCRIPTOR
	JMP ER5		/COMMA MUST FOLLOW
	JMS I (GETCHR	/GET A OR D CHARACTER (FIELD TYPE)
	JMP ER2	/***
	JMS I (CHECK	/CHECK FOR A OR D
	JMS GETNUM	/GET FIELD SIZE
	DCA SIZE
	CDF DSCFLD
	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
	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
	JMS I (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	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 0
	ISZ DSCKNT	/UPDATE # ITEMS
	JMP I DSCPUT	/RETURN
	JMS I 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,	JMS I (GETCHR	/LOOK FOR CHARACTER
	JMP NUMEND	/NO MORE IS AN ERROR
	JMS I (DIGIT	/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
	JMP I GETNUM	/RETURN WITH IT IN AC
ER3,	JMS I ZERROR	/YES, ERROR
	ERR3-1
DSCKNT,	-DSCLEN		/COUNTS NUMBER OF ENTRIES LEFT IN DSCTAB

ER2,	JMS I ZERROR
	ERR2-1
ER7,	JMS I ZERROR
	ERR7-1
ER5,	JMS I ZERROR
	ERR5-1
	PAGE

WAR,	TAD I (SAVE
	CDF DSCFLD
	JMS I (DSCPUT
	CDF DSCFLD
	JMS I (DSCPUT	/0 END OF DSCTAB
	JMS I (DATPUT	/0 END OF DATTAB
	NOP
	CDF 0
	TAD	(SORTLP+1
	DCA I	(READLN
	JMP I	(SORTLP+1	/RE-ENTER SORT LOOP

/*******************************/
/				/
/   <INITIAL-DVALUE> ::=	/
/				/
/	[+] <DIGIT>...		/
/	 -  <DIGIT>...		/
/	<DIGIT>...  -		/
/				/
/*******************************/
/SIZE OF INITIAL DVALUE IS # OF DIGITS.
DINIT,	JMS I (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 "+"?
	JMS I (BACKUP	/NO, BACK SCAN UP ONE
POS,	TAD (-40	/YES
NEG,	TAD (40
	DCA SIGN	/SET SIGN (0 FOR POSITIVE, 40 FOR NEGATIVE)
GETINT,	JMS I (GETCHR	/GET DIGIT
	JMP ER13	/NO MORE, ERROR
	JMS I (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
	JMS I (GETCHR	/AT END, BUT ANY MORE CHARACTERS?
	JMP ENDNUM	/NO, FINE
	JMS I (DIGIT	/YES, DIGIT?
	JMP .+3		/NO, FINE AGAIN
	JMS I ZERROR	/YES, ERROR
	ERR14-1		/TOO MANY DIGITS
	JMS I (GETCHR	/RETRIEVE CHARACTER
DATKNT,	-DATLEN-1	/DNO
	TAD (-16
	SNA CLA		/IS IT "-"?
	JMP .+3		/YES
	JMS I 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
	TAD (DATTAB-1
	JMS I KGETC
DATP,	0
	TAD SIGN	/ADD IN SIGN TO LAST DIGIT
	CDF DATFLD
	JMS I 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
	JMS I 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?
	JMP I DATPUT	/NO, RETURN 1
	ISZ DATPUT	/YES
	JMP I 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,	JMS I (GETCHR	/LOOK FOR ALPHA INIT
	JMP ER10	/NOTHING THERE IS ERROR
	TAD (-10
	SZA CLA		/IS IT QUOTE?
	JMP ER16	/NO, ERROR
GETAIN,	JMS I (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
	JMS I (GCH	/LOOK FOR CLOSE QUOTE
	JMP ER17	/ERROR-UNMATCHED QUOTE
	TAD (-10
	SNA CLA		/IS IT QUOTE?
	JMP I PJFK	/YES, GOOD
	JMS I ZERROR	/NO, ERROR
	ERR17-1
SIGN,	0		/SIGN OF NUMBER, 0-POSITIVE, 40-NEGATIVE

ER10,	JMS I ZERROR
	ERR10-1
ER12,	JMS I ZERROR
	ERR12-1
ER13,	JMS I ZERROR
	ERR13-1
ER16,	JMS I ZERROR
	ERR16-1
ER17,	JMS I ZERROR
	ERR17-1
	PAGE

/LINE INPUT AND CHARACTER FETCH ROUTINES
READLN,	0		/READ A LINE
	ISZ	FSTSW
	JMP	NORFST
RINIT,	CLA IAC
	JMS I	KPTRST	/INITIALIZE IFN 1
	TAD	(INLEN^200+BUFFLD
	DCA I	W0
	TAD (INBUF
	DCA I	W1
	TAD	(SBT-1
	DCA	RDNAM1
SYSILP,	ISZ	RDNAM1
	TAD I	RDNAM1
	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	RDNAM2
	TAD	RDNAM2
	AND	P7400
	DCA I	W5
	TAD	RDNAM2
	RAL
	AND	(377
	DCA I	W4
	STA
	DCA I	RDNAM1	/MARK THIS ENTRY USED
	DCA I	W3	/INITIALIZE BUFFER WC
	TAD	(7700
	DCA	LENGTH
	DCA I (BUFFER	/DON'T PRINT INITIALLY

NORFST,	JMS I (LPRINT	/PRINT PREVIOUS LINE
NORF,	IAC
	JMS I	RDOIO
	BUFFER+1
	JMP	RINIT	/SINCE THE BUFFER IS BIG, ERRORS MUST BE EOF'S
RDLNX,	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
	JMS I [GETCHR
	JMP NORF	/IGNORE NULL LINE
	CLA
	TAD (6
	DCA CHCT
	JMP I	READLN
EOFERR,	TAD	M4
	JMS I	KMOVE
	CDF 0
	ENDST-1
	BUFFER+1	/MOVE AN "END" STATEMENT INTO THE BUFFER
	JMP	RDLNX
FSTSW,	-1
ENDST,	-3;7777;4657;4500
RDNAM1,	0
RDNAM2,	0

CARET,	0
	TAD CHCT
	CIA
	TAD (4
	DCA CARCNT
	TAD (4
	DCA INK
BLINS,	TAD (BUFFER
	JMS I KGETC	/GET CHAR
INK,	0
	TAD (-75
	SNA CLA
	TAD (74		/OUTPUT TABS AS TABS
	IAC		/BUT RANDOM STUFF AS SPACES
	JMS I (LPTCHR
	ISZ INK		/GO TO NEXT CHAR
	ISZ CARCNT	/THROUGH?
	JMP BLINS	/NO
	TAD P77		/***YES, INSERT CARET
	JMS I (LPTCHR
	JMP I CARET
CARCNT,	0

	PAGE

/ERROR MESSAGES
BADWN,	-12		/BAD WORK UNIT COUNT
	4342;4501;7060
	6354;0166;5752
	6501;4460;6657
	6500
ERR2,	ERR2-ERR3		/NOTHING AFTER FIELD NAME
	5760;6551;5257
	5001;4247;6546
	6301;4752;4655
	4501;5742;5646
	0
ERR3,	ERR3-ERR4		/FIELD NUMBER MISSING OR 0
	4752;4655;4501
	5766;5643;4663
	156;5264;6452
	5750;160;6301
	2100
ERR4,	ERR4-ERR5		/DESCRIPTOR TABLE OVERFLOW
	4546;6444;6352
	6165;6063;165
	4243;5546;160
	6746;6347;5560
	7000
ERR5,	ERR5-ERR6		/NO COMMA AFTER FIELD NAME
	5760;144;6056
	5642;142;4765
	4663;147;5246
	5545;157;4256
	4600
ERR6,	ERR6-ERR7		/NOT A OR D
	5760;6501;4201
	6063;145;0
ERR7,	ERR7-ERR10		/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		/MISSING INITIAL VALUE
	5652;6464;5257
	5001;5257;5265
	5242;5501;6742
	5566;4600
ERR11,	ERR11-ERR12		/BAD DIGIT IN DECIMAL INITIAL VALUE
	4342;4501;4552
	5052;6501;5257
	145;4644;5256
	4255;152;5752
	6552;4255;167
	4255;6646;0
ERR12,	ERR12-ERR13		/DATA TABLE OVERFLOW
	4542;6542;165
	4243;5546;160
	6746;6347;5560
	7000
ERR13,	ERR13-ERR14		/INITIAL VALUE TOO SMALL
	5257;5265;5242
	5501;6742;5566
	4601;6560;6001
	6456;4255;5500
ERR14,ERR14-ERR15		/INITIAL VALUE TOO BIG
	5257;5265;5242
	5501;6742;5566
	4601;6560;6001
	4352;5000
ERR15,	ERR15-ERR16		/EXTRA CHAR AT STMNT END
	4671;6563;4201
	4451;4263;6401
	4265;164;6556
	5765;146;5745
	0
ERR16,	ERR16-ERR17	/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;0
ERR17,	ERR17-ERR20	/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
	0
ERR20,

CHECK,	0
	TAD (-42
	DCA TYPE
	TAD TYPE
	SNA
	JMP I CHECK
	TAD (-3
	SZA CLA
	JMP ER6
	IAC
	DCA TYPE
	JMP I CHECK
ER6,	JMS I 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

/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
	JMP I DIGIT
NONO,	CLA		/NOT NECESSARY
	JMS I (BACKUP	/BACKUP SCAN
	JMP I DIGIT	/RETURN 1
ERROR,	0		/ERROR ROUTINE
	ISZ ERKNT	/BUMP ERROR COUNT
	CLA
	CDF 0		/JUST IN CASE
	DCA I	TF0	/KILL BATCH
	JMS I	(CDOIOC
	BUFFER-1	/PRINT OFFENDING LINE ON LPT
	TAD I	ERROR
	DCA	PMESG	/GET MESSAGE
	TAD (252
	JMS I LPOCHR
	TAD (252
	JMS I LPOCHR
	TAD (252
	JMS I LPOCHR
	TAD (252
	JMS I LPOCHR
	JMS I (CARET
	JMS LPCRLF
	JMS I	(CDOIOC
PMESG,	0
	DCA I (BUFFER	/DON'T PRINT LINE AGAIN
/DO STUFF ABOUT LINKNT AND THINGS ***
	STA
	TAD I (READLN
	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
	JMP I GNBC
	TAD	M1
	SNA
	JMP	GNBC+1
	TAD (1-34
	SNA 		/IS IT ";"?
	JMP	SEMIC	/YES - BACKUP AND RETURN
	ISZ GNBC	/";" INDICATES EOL
	TAD (34		/RESTORE CHAR
	JMP I	GNBC
ERKNT,	0		/# OF ERRORS
SEMIC,	JMS I	(BACKUP
	JMP I	GNBC
	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
	PAGNUM=SBHDG-2
LPRINT,	0
	TAD LSTSW
	SZA CLA		/IS NOLIST SPECIFIED? (LSTSW .NE. 0)
	JMP XTRA	/YES, RETURN
	TAD I (BUFFER	/NO
	SNA CLA		/IS WC=0?
	JMP I LPRINT	/YES, RETURN
	ISZ LINKNT	/NO, WANT TO PRINT
	SKP
	JMS EJEKT	/PAGE FULL
	JMS I (CDOIOC	/PRINT LINE ON LPT
	BUFFER-1
XTRA,	JMS I (GETCHR
	JMP I LPRINT
	JMS I ZERROR
	ERR15-1		/EXTRA TEXT

EJEKT,	0
	TAD (-66
	DCA LINKNT	/RESET LINE COUNT
/PRINT HEADINGS, PAGE NUMBERS, TITLES, ETC.
	TAD (214
	JMS I LPOCHR	/PRINT FORM FEED
	ISZ PGNM	/INCREMENT PAGE NUMBER
	TAD PGNM
	JMS I OTOPD	/CONVERT PAGE NUM TO -237
	DCA I (PAGNUM	/INSERT IT
	JMS I (CDOIOC
HEAD,	HEADING-1
	JMS I (CDOIOC
SUBHD,	SBHDG-1
	JMS I (LPCRLF	/CR
	JMP I EJEKT	/RETURN
COMA,	0		/SKIP ON COMMA
	JMS I (GETCHR	/GET NEXT CHARACTER
	NOP
	TAD (-15
	SNA CLA		/IS IT ","?
	ISZ COMA	/YES, RETURN 2
	JMP I COMA	/NO, RETURN 1
BACKUP,	0		/BACKUP SCAN ONE CHARACTER
	STA
	TAD CHCT
	DCA CHCT
	JMP I BACKUP

PGNM,	0		/PAGE NUMBER
HEADING,HEADING-SBHDG
	4460;6401;101
	164;6063;6501
	6701	/V
	2417	/3.
	2130	/07
	101
DAY,	0
MONTH1,	0
MONTH2,	0
	1630	//7
YEAR,	0
	101;101;161
	4250;4601;2121
	0
SBHDG,	-1
	100
	PAGE

/ROUTINE TO SET UP I/O BUFFERS ACCORDING TO "NWORK" AND "TOPFLD"
SSETUP,	DCA	WKFLDS	/SAVE NUMBER OF EXTRA CORE BANKS
	TAD	WKFLDS
	CDF 10
	SZA CLA
	DCA I	(BIGBUF	/IF WE HAVE >8K, USE 4K FOR REPLACEMENT
	CDF 0	/SELECTION TREE STORAGE
	TAD	WKFLDS
	SNA CLA
	AC4000		/IF WE HAVE ONLY 8K, ASSIGN PRESORT BUFFERS
	SNA		/IN THE UPPER HALF OF FIELD 1, OTHERWISE
	TAD	P7600	/USE ALL OF FIELD 1 IN THE PRESORT ALGORITHM
	DCA	BFBEG	/(SO SET THRESHOLD IMPOSSIBLY HIGH - 7600)
	TAD	NWORK
	CLL RAL
	TAD	NWORK
	CLL RAL
	TAD	NWORK
	TAD	WKFLDS	/FORM 7*(NUMBER OF UNITS)+(NUMBER OF EXTRA FIELDS)
	CLL RAL
	TAD	(P1TABL-53	/AND USE IT AS A POINTER INTO THE
	DCA	XR	/PRESORT BUFFER CONTROL WORD TABLE
	TAD	(P1INPT-1
	JMS	GETBFS	/GET PRESORT BUFFERS
	STA
	TAD	NWORK
	CLL RTR	/RESERVE 400 WORDS IN FIELD 1
	RTR		/FOR EACH MERGE INPUT UNIT
	RAR		/AS A COMPARE BUFFER
	DCA	BFBEG
	TAD	XR
	TAD	(P2TABL-P1TABL-2
	DCA	XR	/GET POINTER TO MERGE BUFFER CONTROL WORD TABLE
	TAD	(P2OTPT-1
	JMS	GETBFS	/GET MERGE BUFFERS
	STA
	TAD	NWORK	/GET NUMBER OF WORK UNITS MINUS 1
	CDF CIF 10
	JMP I	.+1
	MOVDWN		/MOVE SORT PROGRAM INTO FIELD 0 AND START IT

/ROUTINE TO ALLOCATE BUFFERS
/THE LOCATION AND SIZE OF THE BUFFERS ALLOCATED DEPEND ON THE NUMBER
/OF WORK UNITS, THE AMOUNT OF FREE CORE, AND THE SORT PHASE (PRESORT
/ OR MERGE).  THE CALLING ROUTINE MIXES THESE AROUND AND COMES UP WITH
/A POINTER TO A DOUBLEWORD.  THE FIRST WORD OF THIS DOUBLEWORD IS THE
/"UNIQUE" BUFFER CONTROL WORD AND CONTROLS THE LOCATION AND SIZE OF THE
/UNIQUE BUFFER FOR THE PHASE (THE INPUT BUFFER IS UNIQUE IN THE PRESORT
/PHASE, THE OUTPUT BUFFER UNIQUE IN THE MERGE PHASE). THE UNIQUE BUFFER
/IS NESTLED AT THE TOP OF THE FIELD SPECIFIED BY THE UNIQUE BUFFER
/CONTROL WORD.
/	THE SECOND WORD OF THE DOUBLEWORD IS THE "MULTIPLE" BUFFER
/CONTROL WORD. THE "MULTIPLE" BUFFERS IN A PHASE OPERATE IN THE OPPOSITE
/DIRECTION FROM THE UNIQUE BUFFER. THE NUMBER OF MULTIPLE BUFFERS IS ONE
/LESS THAN THE NUMBER OF WORK UNITS. THE FIRST OF THE MULTIPLE BUFFERS
/START IN THE FIELD SPECIFIED BY THE MULTIPLE BUFFER CONTROL WORD
/AND AT AN ADDRESS WHICH DEPENDS ON THE PHASE AND NUMBER OF FIELDS.
/EACH SUCCESSIVE BUFFER STARTS AT THE END OF THE PREVIOUS ONE
/UNLESS THERE IS NOT ENOUGH ROOM IN THAT FIELD, IN WHICH CASE
/IT STARTS AT LOCATION 0 OF THE NEXT FIELD.
	/THE LOW ORDER 3 BITS OF THE MULTIPLE BUFFER CONTROL WORD MAY
/INDICATE A COUNT.  THIS COUNT IS THE NUMBER OF BUFFERS THAT SHOULD
/ACTUALLY BE ALLOCATED THE FULL AMOUNT INDICATED IN THE CONTROL WORD.
/ BUFFERS ALLOCATED AFTER THE COUNT RUNS OUT WILL BE 256 WORDS SHORTER
/THAN THOSE ALLOCATED BEFORE THE COUNT RAN OUT.  THIS ALLOWS BETTER CORE
/UTILIZATION.
	/THE VARIABLE "BFBEG" CONTROLS WHERE BUFFERS ARE TO BEGIN IN
/FIELD 1. IF BFBEG=7600 NO BUFFERS WILL BE ALLOCATED IN FIELD 1.
/BUFFERS IN FIELD 0 MUST START ABOVE THE END OF THE SORT CODE AT
/LOCATION 2000 AND END BEFORE THE I/O MONITOR RESIDENT CODE AT 4400.
GETBFS,	0
	DCA	BXR	/SAVE POINTER TO ARRAY OF CONTROL WORDS
	TAD I	XR
	DCA	NAM1	/GET UNIQUE BUFFER CONTROL WORD
	TAD I	XR
	DCA	NAM2	/GET MULTIPLE BUFFER CONTROL WORD
	CDF 10
	TAD	NAM1
	DCA I	BXR
	TAD	NAM1
	AND	P70
	SNA CLA		/IF WE ARE ALLOCATING IN FIELD 0,
	TAD	(1600	/PROTECT THE I/O MONITOR CODE
	TAD	NAM1
	CLL RAL
	AND	P7400
	CIA
	DCA I	BXR	/SET UP UNIQUE BUFFER AT TOP OF ITS FIELD
	STA
	TAD	NWORK
	CIA
	DCA	NAM3	/SET UP COUNT OF MULTIPLE BUFFERS
	TAD	NAM2
	AND	P7
	CIA		/GET THE COUNT(IF ANY) FROM THE MULTIPLE
	DCA	CBRK	/BUFFER CONTROL WORD
GBNFLD,	TAD	NAM2
	AND	[7770	/THIS IS THE ENTRY POINT IN THE LOOP WHEN
	DCA	NAM2	/WE GO TO THE NEXT FIELD.
	TAD	NAM2
	AND	P70
	SNA		/FIELD 0?
	JMP	GBFLD0	/YES - SPECIAL
	TAD	[-10	/IF THE MULTIPLE BUFFERS START IN FIELD 1,
	SNA CLA		/USE THE SPECIAL STARTING ADDRESS SET UP
	TAD	BFBEG	/BY THE CALLING PROGRAM
GBFSLP,	DCA	BUFORG	/OTHERWISE START THE BUFFERS AT 0 IN THE FIELD
	TAD	NAM2
	CLL RAL
	AND	P7400
	CLL CML
	TAD	BUFORG
	SZL SNA		/WILL THIS BUFFER FIT IN THIS FIELD?
	JMP	SAMFLD	/YES
	CLA
GBBMPF,	TAD	(10
	JMP	GBNFLD	/START FRESH IN A NEW FIELD
SAMFLD,	DCA	BFORG
	TAD	NAM2
	DCA I	BXR	/SAVE THE CONTROL WORD
	TAD	BUFORG
	DCA I	BXR	/SAVE THE ADDRESS
	ISZ	CBRK	/TEST THE SPECIAL COUNT
	JMP	.+4
	TAD	P7600	/IF IT OVERFLOWS,
	TAD	NAM2	/SHORTEN THE BUFFERS TO BE ALLOCATED
	DCA	NAM2	/FROM THIS POINT ON
	ISZ	NAM3
	JMP	GBDCID	/STORE NEW START ADDRESS AND LOOP
	CLA
	CDF 0
	JMP I	GETBFS
GBDCID,	TAD	NAM2	/THE ROUTINE ONLY ALLOWS ONE BUFFER IN FIELD 0
	AND	P70	/BECAUSE THE CHECKING GETS TOO HAIRY OTHERWISE.
	SZA CLA		/(BESIDES, HOW MANY BUFFERS FIT IN 10 PAGES?)
	TAD	BFORG	/SO IF WE ARE IN FIELD ZERO OR IF WE HAVE JUST
	SNA		/FILLED THE CURRENT FIELD TO THE BRIM,
	JMP	GBBMPF	/GO TO THE NEXT FIELD
	JMP	GBFSLP	/OTHERWISE UPDATE THE CORE ADDRESS AND CONTINUE.
GBFLD0,	AC2000		/FIELD ZERO IS SPECIAL
	JMP	GBFSLP	/BECAUSE THERE IS CODE IN IT
BFBEG,	0		/FIELD 1 CONTROLLING WORD
WKFLDS,	0
BFORG,	0
BUFORG,	0
	PAGE

/BUFFER CONTROL WORD TABLE FOR PRESORT PHASE
P1TABL,	1200	/3 UNITS, 8K	INPUT  AT 02000
	5010	/	  8K	OUTPUT AT 14000,16000
	2620	/	 12K	INPUT  AT 22400
	5200	/	 12K	OUTPUT AT 02000,20000
	3630	/	 16K	INPUT  AT 30400
	6020	/	 16K	OUTPUT AT 20000,24000
	3640	/	 20K	INPUT  AT 40400
	7620	/	 20K	OUTPUT AT 20000,30000
	3650	/	 24K	INPUT  AT 50400
	7620	/	 24K	OUTPUT AT 20000,30000
	3660	/	 28K	INPUT  AT 60400
	7620	/	 28K	OUTPUT AT 20000,30000
	3670	/	 32K	INPUT  AT 70400
	7620	/	 32K	OUTPUT AT 20000,30000
	1200	/4 UNITS, 8K	INPUT  AT 02000
	4612	/	  8K	OUTPUT AT 14000,15400,17000
	2020	/	 12K	INPUT  AT 24000
	5201	/	 12K	OUTPUT AT 02000,20000,22000
	2030	/	 16K	INPUT  AT 34000
	6020	/	 16K	OUTPUT AT 20000,24000,30000
	3640	/	 20K	INPUT  AT 40400
	6020	/	 20K	OUTPUT AT 20000,24000,30000
	3650	/	 24K	INPUT  AT 50400
	7620	/	 24K	OUTPUT AT 20000,30000,40000
	3660	/	 28K	INPUT  AT 60400
	7620	/	 28K	OUTPUT AT 20000,30000,40000
	3670	/	 32K	INPUT  AT 70400
	7620	/	 32K	OUTPUT AT 20000,30000,40000
	1200	/5 UNITS, 8K	INPUT  AT 02000
	4410	/	  8K	OUTPUT AT 14000,15000,16000,17000
	1200	/	 12K	INPUT  AT 02000
	5020	/	 12K	OUTPUT AT 20000,22000,24000,26000
	3630	/	 16K	INPUT  AT 30000
	5200	/	 16K	OUTPUT AT 02000,20000,22400,25000
	3640	/	 20K	INPUT  AT 40400
	6020	/	 20K	OUTPUT AT 20000,24000,30000,34000
	3650	/	 24K	INPUT  AT 50400
	6020	/	 24K	OUTPUT AT 20000,24000,30000,34000
	3660	/	 28K	INPUT  AT 60400
	7620	/	 28K	OUTPUT AT 20000,30000,40000,50000
	3670	/	 32K	INPUT  AT 70400
	7620	/	 32K	OUTPUT AT 20000,30000,40000,50000

	1200	/6 UNITS, 8K	INPUT  AT 02000
	4413	/	  8K	OUTPUT AT 14000,15000,16000,17000,17400
	1200	/	 12K	INPUT  AT 02000
	5021	/	 12K	OUTPUT AT 20000,22000,23400,25000,26400
	2630	/	 16K	INPUT  AT 32400
	5200	/	 16K	OUTPUT AT 02000,20000,22400,25000,30000
	2040	/	 20K	INPUT  AT 44000
	6020	/	 20K	OUTPUT AT 20000,24000,30000,34000,40000
	3650	/	 24K	INPUT  AT 50400
	6020	/	 24K	OUTPUT AT 20000,24000,30000,34000,40000
	3660	/	 28K	INPUT  AT 60400
	6020	/	 28K	OUTPUT AT 20000,24000,30000,34000,40000
	3670	/	 32K	INPUT  AT 70400
	7620	/	 32K	OUTPUT AT 20000,30000,40000,50000,60000
	1200	/7 UNITS, 8K	INPUT  AT 02000
	4412	/	  8K	OUTPUT AT 14000,15000,16000,16400,17000,17400
	1200	/	 12K	INPUT  AT 02000
	4624	/	 12K	OUTPUT AT 20000,21400,23000,24400,26000,27000
	3030	/	 16K	INPUT  AT 32000
	5201	/	 16K	OUTPUT AT 02000,20000,22000,24000,26000,30000
	3640	/	 20K	INPUT  AT 40400
	5220	/	 20K	OUTPUT AT 20000,22400,25000,30000,32400,35000
	3650	/	 24K	INPUT  AT 50400
	6020	/	 24K	OUTPUT AT 20000,24000,30000,34000,40000,44000
	3660	/	 28K	INPUT  AT 60400
	6020	/	 28K	OUTPUT AT 20000,24000,30000,34000,40000,44000
	3670	/	 32K	INPUT  AT 70400
	6020	/	 32K	OUTPUT AT 20000,24000,30000,34000,40000,44000

/BUFFER CONTROL WORD TABLE FOR MERGE PHASE
P2TABL,	5200	/3 UNITS, 8K	OUTPUT AT 02000
	1610	/	  8K	INPUT  AT 11000,14400
	7410	/	 12K	OUTPUT AT 11000
	2020	/	 12K	INPUT  AT 20000,24000
	7630	/	 16K	OUTPUT AT 30400
	3410	/	 16K	INPUT  AT 11000,20000
	7640	/	 20K	OUTPUT AT 40400
	3620	/	 20K	INPUT  AT 20000,30000
	7650	/	 24K	OUTPUT AT 50400
	3620	/	 24K	INPUT  AT 20000,30000
	7660	/	 28K	OUTPUT AT 60400
	3620	/	 28K	INPUT  AT 20000,30000
	7670	/	 32K	OUTPUT AT 70400
	3620	/	 32K	INPUT  AT 20000,30000
	5200	/4 UNITS, 8K	OUTPUT AT 02000
	1211	/	  8K	INPUT  AT 11400,14000,16000
	6420	/	 12K	OUTPUT AT 23000
	1410	/	 12K	INPUT  AT 11400,14400,20000
	7210	/	 16K	OUTPUT AT 11400
	2020	/	 16K	INPUT  AT 20000,24000,30000
	7640	/	 20K	OUTPUT AT 40400
	3210	/	 20K	INPUT  AT 11400,20000,30000
	7650	/	 24K	OUTPUT AT 50400
	3620	/	 24K	INPUT  AT 20000,30000,40000
	7660	/	 28K	OUTPUT AT 60400
	3620	/	 28K	INPUT  AT 20000,30000,40000
	7670	/	 32K	OUTPUT AT 70400
	3620	/	 32K	INPUT  AT 20000,30000,40000
	5200	/5 UNITS, 8K	OUTPUT AT 02000
	0610	/	  8K	INPUT  AT 12000,13400,15000,16400
	7020	/	 12K	OUTPUT AT 22000
	1010	/	 12K	INPUT  AT 12000,14000,16000,20000
	7010	/	 16K	OUTPUT AT 12000
	2020	/	 16K	INPUT  AT 20000,24000,30000,34000
	7640	/	 20K	OUTPUT AT 40400
	2020	/	 20K	INPUT  AT 20000,24000,30000,34000
	7650	/	 24K	OUTPUT AT 50400
	3010	/	 24K	INPUT  AT 12000,20000,30000,40000
	7660	/	 28K	OUTPUT AT 60400
	3620	/	 28K	INPUT  AT 20000,30000,40000,50000
	7670	/	 32K	OUTPUT AT 70400
	3620	/	 32K	INPUT  AT 20000,30000,40000,50000

	5200	/6 UNITS, 8K	OUTPUT AT 02000
	0611	/	  8K	INPUT  AT 12400,14000,15000,16000,17000
	5200	/	 12K	OUTPUT AT 02000
	1210	/	 12K	INPUT  AT 12400,15000,20000,22400,25000
	7630	/	 16K	OUTPUT AT 30400
	1210	/	 16K	INPUT  AT 12400,15000,20000,22400,25000
	7640	/	 20K	OUTPUT AT 40400
	2010	/	 20K	INPUT  AT 12400,20000,24000,30000,34000
	7650	/	 24K	OUTPUT AT 50400
	2010	/	 24K	INPUT  AT 12400,20000,24000,30000,34000
	7660	/	 28K	OUTPUT AT 60400
	2610	/	 28K	INPUT  AT 12400,20000,30000,40000,50000
	7670	/	 32K	OUTPUT AT 70400
	3620	/	 32K	INPUT  AT 20000,30000,40000,50000,60000
	5200	/7 UNITS, 8K	OUTPUT AT 02000
	0414	/	  8K	INPUT  AT 13000,14000,15000,16000,17000,17400
	5620	/	 12K	OUTPUT AT 24400
	0610	/	 12K	INPUT  AT 13000,14400,16000,20000,21400,23000
	7630	/	 16K	OUTPUT AT 30000
	1010	/	 16K	INPUT  AT 13000,15000,20000,22000,24000,26000
	6410	/	 20K	OUTPUT AT 13000
	2020	/	 20K	INPUT  AT 20000,24000,30000,34000,40000,44000
	7650	/	 24K	OUTPUT AT 50400
	2020	/	 24K	INPUT  AT 20000,24000,30000,34000,40000,44000
	7660	/	 28K	OUTPUT AT 60400
	2020	/	 28K	INPUT  AT 20000,24000,30000,34000,40000,44000
	7670	/	 32K	OUTPUT AT 70400
	2410	/	 32K	INPUT  AT 13000,20000,30000,40000,50000,60000

BUFFER,	0		/INPUT BUFFER FOR PARAMETER LINES
/	ROUTINE TO COMPUTE DATE IN READABLE FORM
/	COURTESY OF SGW
	1616
	1616
MONLST,	1653	/-JAN, -FEB, -MAR, ETC.
	4257
	1647
	4643
	1656
	4263
	1642
	6163
	1656
	4272
	1653
	6657
	1653
	6655
	1642
	6650
	1664
	4661
	1660
	4465
	1657
	6067
	1645
	4644
DACODE,	0		/DECODE INTO MONTH-DAY-YEAR
	DCA	TEMP
	TAD	TEMP
	CLL RTL
	RTL
	RAL
	AND	P17
	CLL RAL
	TAD	(MONLST-3
	DCA	XR
	TAD I	XR
	DCA I	(MONTH1
	TAD I	XR
	DCA I	(MONTH2
	TAD	TEMP
	AND	P7
	CLL RTL
	RTL
	RTL
	TAD	(2301
	DCA I	(YEAR
	TAD	TEMP
	CLL RTR
	RAR
	AND	(37
	JMS I	OTOPD
	DCA I	(DAY
	JMP I	DACODE
	FIELD 1

/ACTUAL SORT PROGRAM - MOVED INTO FIELD "0" BEFORE EXECUTION
GETXR=	12
PUTXR=	13
	*100
NOUT,	0	/NUMBER OF PRESORT OUTPUT UNITS AND MERGE INPUT UNITS
R,	0	/LENGTH OF RECORD + CONTROL WORD AS POSITIVE NUMBER
T,	0	/TEMPORARY
CURNOD,	0	/CURRENT NODE IN TOURNAMENT
NXTNOD,	0	/NEXT NODE IN TOURNAMENT
ODDNOD,	0	/POINTER TO ODD NODE DURING TOURNAMENT SETUP
WINNER,	0	/POINTER TO CURRENT TOURNAMENT WINNER
SEQNCE,	0	/NUMBER OF CURRENT OUTPUT SEQUENCE (<2048)
FINAL,	0	/FINAL OUTPUT SEQUENCE NUMBER
EOFFLG,	0	/0 MEANS EOF TERMINATED PRESORT, 2 MEANS EOU
OUNIT,	0	/COUNT OF OUTPUT UNITS
CPTR,	0
NPTR,	0
NPASS,	0	/NUMBER OF MERGE PASSES NEEDED
ODST,	0	/NUMBER OF STRINGS OUTPUT THIS MERGE PASS
OUT,	0	/IFN OF MERGE OUTPUT UNIT THIS PASS
MOUNT,	0	/ADDRESS OF MONITOR MOUNT ROUTINE
SRTFLG,	0	/ADDRESS OF SKIP IN RDOIO ZAPPED BY PRESORT
	PAGE

/STRING DISTRIBUTION TABLES
NXTDST,	ZBLOCK	7	/NEXT MAGIC NUMBER OF STRINGS ON OUTPUT UNIT N
CURDST,	ZBLOCK	7	/CURRENT NUMBER OF STRINGS ON OUTPUT UNIT N
/END OF MERGE ROUTINE - END FILE OUTPUT AND CHECK FOR
/MULTI-REEL INPUT
MRGOVR,	TAD	OUT
	JMS I	FINI	/PUT EOF ON OUTPUT AND UPDATE LABEL
	TAD	EOFFLG
	SNA CLA		/EOF OR EOU?
	JMP I	P7600	/EOF - GOODBYE
	ISZ	OUTLBL+2	/BUMP THE OUTPUT LABEL (WITH
	TAD	OUTLBL+2	/TRAILING ZEROS)
	AND	P77
	TAD	(-33
	SNA CLA		/CHECK FOR LOW-ORDER DIGIT OVERFLOW
	TAD	(66	/AND BUMP HIGH DIGIT IF IT OCCURS
	TAD	OUTLBL+2
	DCA	OUTLBL+2
/PRESORT INITIALIZATION:
P1INIT,	TAD	(NXTDST-1
	DCA	PUTXR
	TAD	(-16
	DCA	T
	CLA IAC		/INITIALIZE MAGIC NUMBER ON OUTPUT UNIT 1 TO 1,
	DCA I	PUTXR	/ON ALL OTHER OUTPUT UNITS TO 0
	ISZ	T
	JMP	.-2
	TAD	P7600
	DCA I	SRTFLG	/SET RDOIO FLAG TO RETURN END-OF-UNITS
	TAD	(P1INPT-1
	DCA	XR
	TAD	(WUNIT
	DCA	BXR	/START ASSUMED UNITS AT WORK UNIT 2
	TAD	(INSEQ-1	/INITIALIZE IFN 1 TO THE INPUT LABEL
	DCA	MLABEL
	ISZ	INSEQ	/BUMP INPUT UNIT SEQUENCE NUMBER
	CLA IAC
	JMS I	[SETCNT	/SET OUNIT=-(NOUT+1)
	TAD	(5422	/$WORK2,$WORK3,$WORK4, ETC.
	DCA	WRKNUM
P1MTLP,	JMS I	[GTONUM	/GET IFN NUMBER BY MAGIC FORMULA
	JMS I	[SINIT	/OPEN THE FILE USING SPECIAL SORT ROUTINE
MLABEL,	0		/POINTER TO (SEQ #, NAME) -1
	TAD	(DOLSEQ-1
	DCA	MLABEL	/FORCE $WORK FILES AFTER THE FIRST ONE
	ISZ	WRKNUM
	TAD I	BXR
	DCA	DOLUNT	/GET ASSUMED UNIT FOR THIS WORK FILE
	ISZ	OUNIT
	JMP	P1MTLP
	JMS I	[INIDST	/INITIALIZE DISTRIBUTION POINTERS
	DCA	NPASS	/RESET PASS COUNTER
	JMP I	.+1
	REPSEL		/START PHASE ONE!
FIXLBL,	CDF 0		/FIX UP $TMP00 LABEL
	AC7775		/THIS CODE IS EXECUTED WHEN THE FIRST
	JMS I KMOVE	/END-OF-UNIT MARK IS REACHED ON A MULTI-REEL FILE
	CDF 0
	DOLTMP-1	/SUBSTITUTE $TMP00 FOR THE OUTPUT LABEL
	OUTLBL-1
	DCA	OTUNIT	/PREVENT TEMPORARIES FROM ZAPPING EACH OTHER
	CDF 10
	IFNZRO	.&7000	<ERROR - JMS WON'T WORK>
	JMS I	(EOFONC	/ZAP ONCE-ONLY SWITCH AND RESUME
INSEQ,	400
INLBL,	6463;6552;5701	/SRTIN IS DEFAULT 
INUNIT,	0
OUTSEQ,	401
OUTLBL,	6463;6560;6665	/SRTOUT IS DEFAULT
OTUNIT,	0
DOLSEQ,	401
	0570		/$W
	6063		/OR
WRKNUM,	5421		/K0
DOLUNT,	0
P1INPT,	ZBLOCK	16	/TABLE OF PHASE 1 BUFFERS
P2OTPT,	ZBLOCK	16	/TABLE OF PHASE 2 BUFFERS
	PAGE

/REPLACEMENT SELECTION SORT
/FORM A TOURNAMENT AMONG AS MANY RECORDS AS CAN FIT INTO THE SORT
/BUFFER AT ONE TIME. PUT THE WINNER IN THE OUTPUT FILE AND REPLACE HIM
/IN CORE BY A NEW RECORD FROM THE INPUT TAPE. IF THE WINNER BEATS THE
/NEW RECORD , ASSIGN THE NEW RECORD THE CURRENT SEQUENCE NUMBER -
/OTHERWISE ASSIGN THE NEXT HIGHEST SEQUENCE NUMBER. (SINCE THE MOST
/SIGNIFICANT SORT FIELD IS THE SEQUENCE NUMBER, THE NEW RECORD WILL THEN
/LOSE TO ALL RECORDS OF THE CURRENT SEQUENCE).  BRING THE NEW MAN UP
/THROUGH THE TOURNAMENT BY THE SAME PATH AS THE WINNER - IF HE BEATS
/EVERYBODY, HE'S THE NEW WINNER, OTHERWISE TAKE THE GUY WHO BEAT HIM
/AND BRING HIM UP IN THE NEW GUYS PLACE. OUTPUT THE NEW WINNER AND
/ITERATE. IF THE NEW WINNER BEATS THE OLD WINNER (SEQUENCE BREAK) THEN
/OUTPUT AN END-OF-STRING CHARACTER AND (MAYBE) SWITCH OUTPUT UNITS.
/THIS IS A VERY CONCISE SUMMARY BUT IT SHOULD BE ENOUGH FOR YOU TO FOLLOW
/THE PROGRAM LOGIC.
/THIS PAGE IS ENTIRELY INITIALIZATION CODE WHICH SETS UP THE
/TOURNAMENT TREE STRUCTURE.
REPSEL,	TAD	[11
	JMS I	RDOIO	/READ IN THE FIRST RECORD TO DETERMINE THE
	-1		/RECORD LENGTH
	JMP	NULERR	/WHAT THE ?
	CDF 10
	TAD I	[0	/GET LENGTH WORD
	DCA	LENGTH	/SAVE AS PROTECTION AGAINST UNEQUAL LENGTH RECORDS
	TAD	LENGTH
	CIA
	IAC
	DCA	R	/SAVE CORE SPACE NEEDED FOR A RECORD
	DCA	NRECS
	AC0002
	TAD	R
	CLL RAL
	DCA	T
BIGBUF,	AC4000		/THIS LOCATION ZEROED IF > 8K CORE EXISTS
	TAD	R
	TAD	T	/COMPUTE INT((CORE-R)/(2*R+4))
	SNL		/WHERE "CORE" IS THE NUMBER OF FREE LOCS
	ISZ	NRECS	/(2048 OR 4096) AND R IS THE RECORD SIZE +1.
	SNL		/THIS GIVES THE NUMBER OF DOUBLE-RECORDS THAT WILL
	JMP	.-4	/FIT INTO THE AVAILABLE CORE BUFFER
	CLA
	TAD	R
	DCA	RPTR
	TAD	NRECS	/START ALLOCATING RECORDS, LEAVING A SPACE FOR
	CIA		/THE NEW INPUT RECORD AT 10000
	DCA	NCTR

RSETLP,	AC4000
	DCA I	RPTR	/LOWER RECORD OF PAIR GETS SIGN BIT FLAG
	TAD	RPTR
	TAD	R
	DCA	T
	TAD	RPTR
	DCA I	T	/IN BETWEEN THE TWO RECORDS OF THE PAIR IS A
	ISZ	T	/NODE WHICH POINTS TO BOTH MEMBERS OF THE PAIR
	CLA IAC
	TAD	T
	DCA I	T
	ISZ	T
	DCA I	T	/UPPER RECORD OF PAIR GETS ZERO SIGN BIT
	TAD	T
	TAD	R	/BOTH MEMBERS OF THE PAIR GET SEQUENCE NUMBER 0.
	DCA	RPTR	/THIS MAKES THEM BEAT ANY OTHER RECORD
	ISZ	NCTR
	JMP	RSETLP
	TAD	R
	CLL RAL
	DCA	CURNOD	/START SCANNING THE NODES
	AC0002
	TAD	CURNOD
	DCA	NSPACE	/LOW-LEVEL SPACING BETWEEN NODES IS 2 RECORDS + 2
	DCA	ODDSW	/ZERO "BYE" FLAG
NSETL1,	TAD	RPTR
	DCA	NXTNOD	/ASSIGN THE NEXT LEVEL OF NODES WHERE THIS LEVEL
	TAD	NRECS	/LEFT OFF
	CIA
	DCA	NCTR
NSETL2,	TAD	CURNOD
	TAD	NSPACE
	DCA	ODDNOD	/SAVE ADDRESS OF POSSIBLE BYE
	ISZ	NCTR
	JMP	NOTODD	/NOPE - HE GETS TO PLAY
	TAD	ODDSW	/ODD NUMBER OF NODES ON THIS LEVEL - GIVE SOMEBODY
	SZA		/A BYE UNLESS SOMEONE HAD A BYE FROM A
	JMP	OCMBIN	/PREVIOUS LEVEL, IN WHICH CASE THEY PLAY EACH OTHER.
	TAD	CURNOD
	DCA	ODDSW
	JMP	NXTLVL	/GRANT A BYE AND GO TO THE NEXT LEVEL
OCMBIN,	DCA	ODDNOD	/SAVE ADDRESS OF PREVIOUS BYE
	DCA	ODDSW	/RESET BYE FLAG
	STA
	DCA	NCTR	/FAKE OUT NCTR TO BUMP ON NEXT INCREMENT
	ISZ	NRECS	/BUMP NRECS TO NEXT EVEN NUMBER FOR HALVING LATER

NOTODD,	TAD I	CURNOD	/AT THIS POINT "CURNOD" AND "ODDNOD" ARE THE
	DCA I	RPTR	/PLAYERS OF THIS MATCH.
	TAD	RPTR	/RANDOMLY SELECT THE LOWER RECORD OF EACH NODE AS
	DCA I	CURNOD	/THE WINNER AND MOVE BOTH WINNERS UP TO THE NEXT
	ISZ	RPTR	/LEVEL, REPLACING THEM WITH POINTERS TO THE
	TAD I	ODDNOD	/HIGHER LEVEL NODE.
	DCA I	RPTR
	STA
	TAD	RPTR
	DCA I	ODDNOD
	TAD	ODDNOD
	TAD	NSPACE
	DCA	CURNOD	/BUMP TO BEGINNING OF NEXT PAIR OF NODES
	ISZ	RPTR	/BUMP NEW NODE CREATION POINTER
	ISZ	NCTR	/EXHAUSTED THIS LEVEL?
	JMP	NSETL2	/NOT YET
NXTLVL,	AC0002
	DCA	NSPACE	/NODES ON UPPER LEVELS ARE CONTIGUOUS
	TAD	NXTNOD
	DCA	CURNOD	/START NEW SCAN AT THIS LEVEL
	TAD	NRECS
	CLL RAR		/THIS LEVEL HAS HALF THE ENTRIES OF LAST LEVEL
	SNA		/WILL THIS LEVEL HAVE ANY ENTRIES?
	JMP	.+3	/NO - WE'RE FINISHED
	DCA	NRECS	/SAVE NEW NODE COUNT
	JMP	NSETL1	/SCAN THIS LEVEL
	TAD I	ODDSW	/GET A POINTER TO THE WINNER OF THEM ALL
	DCA	WINNER	/APPROPRIATE NAME, WHAT?
	DCA I	ODDSW	/STORE A ZERO TO BREAK THE CHAIN OF "NEXT LEVEL"
	CLA IAC		/POINTERS.
	DCA	SEQNCE	/SET SEQUENCE OF INITIAL INPUT TO 1
	DCA	FINAL	/INITIALIZE FINISHING-UP FLAG
	TAD	WINNER
	TAD	R	/FIND NODE THAT POINTS TO LOWEST LEVEL GUY
	DCA	CURNOD	/WHO LOST AGAINST OUR WINNER.
	JMP I	.+1	/REMEMBER, WE STILL HAVE AN INPUT RECORD AT 10000!
	CHKSEQ		/PROCESS IT.
NULERR,	JMS I	[EXEROR
	NULMSG-1
NULMSG,	-4		/NO INPUT
	5760;0152;5761;6665
ODDSW,	0
NSPACE,	0
RPTR,	0
NCTR,	0
NRECS,	0
	PAGE

/MAIN BODY OF REPLACEMENT SELECTION ALGORITHM - FAIRLY SHORT
INEOF,	TAD	(3	/COME HERE ON INPUT END-OF-FILE
	DCA	FINAL	/SET FINAL SEQUENCE NUMBER INCREMENT
	CDF 10
	TAD I	[0
	DCA	EOFFLG	/SAVE REASON FOR PRESORT TERMINATION
	TAD	EOFFLG
	CLL RTR
	SZA CLA		/IF NOT END-OF-FILE OR END-OF-UNIT,
	JMP	LENERR	/IT'S THE WRONG LENGTH - ERROR
	SZL
EOFONC,	JMP I (FIXLBL	/THIS LOC IS CLEARED BY "FIXLBL"
GETREC,	TAD	FINAL	/GET-A-RECORD - IF WE'VE SEEN END-OF-FILE,
	SZA		/INPUT A DUMMY LOSING RECORD TO FLUSH OUT THE
	JMP	SETSEQ	/PEOPLE REMAINING IN THE TOURNAMENT.
	CDF 0	/BACK TO FIELD 0 FOR READ
	TAD	[11
	JMS I	RDOIO	/READ A RECORD INTO 10000
	-1
	JMP	INEOF	/END-OF-FILE OR END-OF-UNIT (WE HOPE)
	CDF 10
	TAD I	[0
	CIA
	TAD	LENGTH	/SORT DOES NOT, REPEAT DOES NOT, WORK ON
	SZA CLA		/VARIABLE LENGTH RECORDS!
	JMP	LENERR	/SO THERE!
CHKSEQ,	AC3777
	AND I	WINNER
	SNA CLA		/IF THE CURRENT WINNER IS A DUMMY RECORD,
	JMP	SETSEQ	/NO NEED TO TEST - IT WINS HANDS DOWN.
	JMS I	[COMPAR	/COMPARE RECORD AT LOCATION ZERO (NEW GUY)
	CLA IAC		/WITH WINNER - IF HE WINS, ASSIGN HIM TO THE
	NOP		/NEXT SEQUENCE.
SETSEQ,	TAD	SEQNCE	/OTHERWISE HE'S IN THIS SEQUENCE
	DCA I	[0	/SAVE SEQUENCE NUMBER OVER WORD COUNT
	AC4000
	AND I	WINNER	/HEADER WORD OF WINNER RECORD CONTAINS SEQUENCE
	TAD I	[0	/NUMBER AND FLAG INDICATING POSITION RELATIVE TO
	DCA I	WINNER	/ITS LOW-LEVEL NODE - GRAFT NEW SEQ NUMBER IN.
	TAD	WINNER
	DCA	PUTXR
	DCA	GETXR	/MOVE NEW RECORD TO WINNER'S POSITION
	TAD	LENGTH
	DCA	T
	TAD I	GETXR
	DCA I	PUTXR
	ISZ	T
	JMP	.-3
TSTREE,	CLA IAC
	TAD	CURNOD
	DCA	ODDNOD	/GET THE ADDRESS OF THE GUY ON THIS LEVEL WHO
	TAD I	ODDNOD	/LOST TO THE PREVIOUS WINNER.
	DCA	T
	AC3777
	AND I	T	/GET THE LOSER'S SEQUENCE NUMBER
	DCA	T
	AC3777
	AND I	WINNER
	CIA		/COMPARE THE CHALLENGER'S SEQUENCE NUMBER
	TAD	T	/TO THAT OF THE LOSER
	SZA		/ONLY COMPARE KEYS IF THE SEQUENCES MATCH
	JMP	QUICKC	/OTHERWISE JUST COMPARE THE SEQUENCE NUMBERS
	TAD I	ODDNOD	/GET THE LOSER'S ADDRESS AGAIN
	JMS I	[COMPAR	/COMPARE HIM TO THE CHALLENGER
	JMP	SWITCH	/THE LOSER WINS - SWITCH HIM AND THE CHALLENGER
	JMP	UPTREE	/VICTORY FOR THE CHALLENGER - MOVE HIM UP A NOTCH
	JMP	UPTREE	/"
QUICKC,	SNL CLA		/THE GUY WITH THE LOWER SEQUENCE NUMBER
	JMP	UPTREE	/ALWAYS WINS
SWITCH,	TAD I	ODDNOD
	DCA	T	/THE CHALLENGER BECOMES A LOSER ON THIS LEVEL
	TAD	WINNER
	DCA I	ODDNOD	/AND THE OLD LOSER BECOMES THE NEW CHALLENGER
	TAD	T
	DCA	WINNER	/AND THE WORLD GOES ROUND AND ROUND - YEAH!
UPTREE,	TAD I	CURNOD
	SNA		/ARE WE AT THE TOP LEVEL?
	JMP	ATROOT	/YES - WE HAVE ANOTHAH WINNAH!!
	DCA	CURNOD	/MOVE UP A LEVEL
	JMP	TSTREE	/TEST ON THE NEW LEVEL
ATROOT,	TAD I	WINNER	/WE HAVE A WINNER - FIND OUT WHERE THE LOW-LEVEL
	SMA CLA		/NODE CORRESPONDING TO IT IS VIA THE SIGN BIT
	AC7776		/OF THE HEADER WORD.
	SNA
	TAD	R
	TAD	WINNER
	DCA	CURNOD	/GOT IT.
	AC3777
	AND I	WINNER	/ISOLATE THE WINNER'S SEQUENCE NUMBER
	SNA		/IS IT A DUMMY INITIAL RECORD?
	JMP	GETREC	/YES - IGNORE IT
	CIA
	TAD	SEQNCE	/IS IT OF THE CURRENT SEQUENCE?
	SNA
	JMP	OUTREC	/YES - OUTPUT IT.
	CMA
	SZA CLA		/IS IT IN THE NEXT SEQUENCE?
	JMP I	(ITSOVR	/NO - MUST BE A DUMMY OUTPUT RECORD - WE'RE DONE
	JMS I	(EOSTR	/SEQUENCE BREAK - OUTPUT END-OF-STRING
	ISZ	SEQNCE	/MAKE OLD "NEXT" SEQUENCE NEW "CURRENT" SEQUENCE
OUTREC,	TAD I	WINNER
	DCA	T	/SAVE CONTENTS OF WINNER HEADER WORD
	TAD	LENGTH
	DCA I	WINNER	/PREPARE RECORD FOR OUTPUT
	STA
	TAD	WINNER
	DCA	WRARG	/GET ADFRESS -1 FOR RDOIO
	JMS I	[GTONUM
	TAD	[10	/COMPUTE UNIT NUMBER TO OUTPUT ONTO
	JMS I	RDOIO
WRARG,	0
	JMP	SYSERR	/SOMETHING BAD HOPPEN!
	CDF 10
	TAD	T
	DCA I	WINNER	/RESTORE RECORD HEADER (JUST SIGN IS IMPORTANT)
	JMP	GETREC	/GET NEXT INPUT RECORD
LENERR,	JMS I	[EXEROR
	LENMSG-1
SYSERR,	JMS I	[EXEROR
	SYSMSG-1
	PAGE

/PRESORT TERMINATION - PAD DISTRIBUTION AND CLOSE OUTPUT FILES
ITSOVR,	TAD	NPASS
	SNA CLA		/DO WE NEED TO MERGE?
	JMS	EOSTR	/NO - DO A DUMMY MERGE ANYWAY
	ISZ	ENDFLG	/BUMP FLAG FOR "EOSTR"
	JMS	EOSTR
	TAD	ENDFLG
SZACLA,	SZA CLA		/ENDFLG BECOMES ZERO AT NEXT MAGIC DISTRIBUTION
	JMP	.-3
	CDF 0
	TAD	SZACLA
	DCA I	SRTFLG	/RESTORE RDOIO TO AUTOMATIC UNIT ADVANCES ON INPUT
	JMS I	[SETCNT
	TAD	(IFNTAB-1
	DCA	PUTXR
P1CLP,	JMS I	[GTONUM		/CLOSE ALL OF THE PRESORT OUTPUT FILES
	JMS I	RDOIO
	EOFCOD-1	/OUTPUT AN EOF
	JMS I	KGPBUF	/AND DUMP THE BUFFERS
	JMS I	[GTONUM
	TAD	[10
	DCA I	PUTXR	/SET UP THIS UNIT IN THE MERGE INPUT LIST
	ISZ	OUNIT
	JMP	P1CLP
	DCA I	PUTXR	/TERMINATE MERGE INPUT LIST WITH A ZERO
	TAD	(P2OTPT+1
	DCA	XR	/NOW WE MUST SET UP THE MERGE BUFFERS
	JMS I	[SETCNT
P2OLP,	JMS I	[GTONUM
	TAD	[10
	DCA	OUT	/INITIALIZE ALL THE WORK FILES
	JMS I	(INIOUT	/ACCORDING TO THE MERGE BUFFER TABLE
	ISZ	OUNIT
	JMP	P2OLP
	AC7776
	TAD	NPASS
	DCA	NPASS	/NORMALIZE NPASS FOR MERGE ALGORITHM
	TAD	[11
	JMP I	.+1
	MERGST		/INITIALIZE THE OUTPUT UNIT AND GO
GTONUM,	0
	AC0002
	TAD	NOUT
	TAD	OUNIT	/OUNIT IS BETWEEN -1 AND -NOUT
	CDF 0		/SO RESULT IS BETWEEN 1 AND NOUT+1
	JMP I	GTONUM

LENMSG,	-10		/BAD RECORD SIZE
	4342;4501;6346
	4460;6345;0164
	5273;4600
SYSMSG,	-6		/OUTPUT ERROR
	6066;6561;6665
	0146;6363;6063

/ROUTINE TO OUTPUT END-OF-STRING MARKER AND CHANGE TAPES IF NECESSARY
EOSTR,	0
	JMS I	[GTONUM	/OUTPUT ON THE APPROPRIATE OUTPUT UNIT
	JMS I	RDOIO
	EOSCOD-1		/AN END-OF-STRING CODE (COUNT OF +1)
	ISZ I	CPTR	/BUMP COUNT OF STRINGS ON THIS OUTPUT TAPE
EOSCMP,	TAD I	CPTR	/GET NEXT MAGIC NUMBER FOR THIS TAPE
	CMA CLL
	TAD I	NPTR	/HAVE WE REACHED IT YET?
	SZL CLA
	JMP	EOSRET	/NO - KEEP GOING
	ISZ	CPTR
	ISZ	NPTR	/YES - GO ON TO NEXT OUTPUT UNIT
	ISZ	OUNIT
	JMP	EOSCMP	/AND PERFORM THE SAME TEST
	DCA	ENDFLG	/OUT OF UNITS - SET "ENDFLG" TO SHOW THAT WE HAVE
	JMS I	[SETCNT	/REACHED A MAGIC DISTRIBUTION POINT
	ISZ	NPASS	/BUMP THE NUMBER OF MERGE PASSES NECESSARY
	TAD I	(NXTDST	/GET THE FIRST (LARGEST) OF THE MAGIC NUMBERS
	DCA	T	/SAVE IT
	TAD	(NXTDST
	DCA	GETXR
	TAD	(NXTDST
	DCA	NPTR
FBONHE,	TAD I	GETXR
	TAD	T	/ADD THE FIRST ELEMENT INTO THE ARRAY OF MAGIC
	DCA I	NPTR	/VALUES AND SHIFT IT LEFT ONE VALUE.
	ISZ	NPTR
	ISZ	OUNIT
	JMP	FBONHE	/LOOP FOR ALL VALUES (NXTDST(N+1)=0)
	JMS	INIDST
	JMP	EOSCMP	/NOT DONE YET - CHECK CURDST(CPTR) .LT. NXTDST(NPTR)
EOSRET,	CDF 10
	JMP I	EOSTR

INIDST,	0
	JMS I	[SETCNT	/INITIALIZE OUTPUT UNIT TO IFN 2
	TAD	(NXTDST
	DCA	NPTR
	TAD	(CURDST
	DCA	CPTR	/INITIALIZE NXTDST & CURDST POINTERS AS WELL
	JMP I	INIDST
EXEROR,	0		/EXECUTION TIME ERROR ROUTINE - PRINT AND QUIT
	CLA
	CDF 0
	TAD I	EXEROR
	DCA	EXCDOC
	CLA IAC
	JMS I	CDOIO
EXCDOC,	0
	NOP
	DCA I	TF0	/ZAP BATCH FLAG
	JMP I	P7600	/RETURN TO EDP-8
EOFCOD,	0
EOSCOD,	1
ENDFLG,	0	/SET TO 1 BY PRESORT TERMINATOR CODE
	PAGE

/COMPARE ROUTINE
/COMPARES RECORD WHOSE ADDRESS IS IN AC TO RECORD WHOSE ADDRESS IS
/IN "WINNER". BOTH RECORDS MUST BE IN FIELD 1.
/NORMAL RETURN IF AC RECORD BEATS WINNER; SKIP RETURN IF TIE;
/DOUBLE SKIP RETURN IF WINNER BEATS CHALLENGER
COMPAR,	0
	DCA	CHALNG	/SAVE CHALLENGER ADDRESS
	TAD	(BEGLST-1
	DCA	CMXR
CMPLP1,	CDF 0
	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	WINNER
	TAD	CMPOFF
	DCA	CMPOFF	/GET WORD IN WINNER
	TAD I	CMXR
	DCA	CMPMSK	/GET MASK FROM COMPARE TABLE
	CDF 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,	SZL CLA		/CHALLENGER BEAT WINNER?
	JMP I	COMPAR	/YES - IMMEDIATE RETURN
	ISZ	COMPAR	/NO - DOUBLE SKIP RETURN
CRTN2,	ISZ	COMPAR	/EQUAL - SINGLE SKIP RETURN
	CDF 10
	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	WINNER
	DCA	PUTXR
	CDF 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
DOLTMP,	0565		/$T
	5661		/MP
	2121		/00
	PAGE

/COME HERE WHEN WE HAVE COMPLETED THE MERGING OF ONE STRING.
EOMERG,	CDF 0
	DCA	OEXHST	/SET NO UNITS EXHAUSTED
	JMS I	[INIDST	/INITIALIZE DISTRIBUTION POINTERS
BMPDLP,	STA		/BUMP DOWN THE STRINGS-PER-UNIT COUNTS
	TAD I	CPTR	/THAT WE BUILT UP DURING THE PRESORT PHASE.
	SZA		/DID WE EXHAUST THIS UNIT?
	JMP	.+3	/NO
	TAD	CPTR	/YES - SAVE ITS "NUMBER"
	DCA	OEXHST
	DCA I	CPTR
	ISZ	CPTR
	ISZ	OUNIT
	JMP	BMPDLP
	ISZ	ODST	/BUMP THE NUMBER OF OUTPUT STRINGS
	TAD	OEXHST
	SZA CLA		/DID WE EXHAUST A UNIT?
	JMP	MSWTCH	/YES - TIME FOR A CHANGE
	TAD	OUT
	AND	P7	/KILL FIELD BITS!
	JMS I	RDOIO	/IF NOT, SIMPLY PUT AN END-OF-STRING
	EOSCOD-1	/ON THE OUTPUT UNIT,
	JMP	MERGE	/REPRIME THE COMPARE BUFFERS, AND CONTINUE
MSWTCH,	STA CLL
	TAD	NPASS
	DCA	NPASS	/BUMP DOWN PASS COUNT
	SNL
	JMP I	(MRGOVR	/ALL OVER BUT THE SHOUTING
	TAD	ODST	/SET THE STRING COUNT OF THE EXHAUSTED UNIT
	DCA I	OEXHST	/EQUAL TO THE STRINGS IN THE OUTPUT UNIT
	TAD	OUT	/SINCE WE WILL SWITCH THE TWO SHORTLY.
	AND	P7	/SET FIELD BITS TO 0
	JMS I	RDOIO	/PUT THE FINAL END-OF-STRING MARK ON THE OUTPUT
	EOSCOD-1
	JMS I	KGPBUF	/FORCE OUT THE FINAL BUFFER
	TAD	OEXHST
	TAD	(IFNTAB-CURDST	/GET THE IFN OF THE EXHAUSTED UNIT
	DCA	T
	TAD I	T
	DCA	OUNIT	/AND IN ITS PLACE,
	TAD	OUT
	DCA I	T	/PUT THE IFN OF THE OLD OUTPUT UNIT.

/WE MUST NOW RE-INITIALIZE THE FILE-TABLE ENTRIES FOR THE
/TWO UNITS WE ARE SWITCHING TO REFLECT THEIR NEW STATUS.
	TAD	OUNIT
	JMS I	KPTRST
	STA
	TAD	W0	/WE WILL INITIALIZE THE IFN WHICH
	DCA	XR	/CONTAINED THE OLD OUTPUT UNIT
	JMS	INIOUT	/TO BE AN INPUT UNIT, USING THE BUFFER
	TAD	OUNIT	/OF THE EXHAUSTED INPUT UNIT.
MERGST,	DCA	OUT
	TAD	(P2OTPT-1	/SIMILIARLY, WE WILL INITIALIZE THE
	DCA	XR	/IFN OF THE OLD EXHAUSTED UNIT FOR OUTPUT.
	DCA	ODST	/ZERO THE STRING COUNT ON THE NEW OUTPUT FILE
	TAD	NPASS
	SNA CLA		/SPECIAL CASE - ON THE LAST PASS,
	JMP	USEUSE	/USE THE USER'S OUTPUT LABEL FOR OUTPUT.
	JMS	INIOUT
	JMP	MERGE	/REPRIME AND KEEP GOING.
OEXHST,	0
INIOUT,	0
	TAD	OUT
	TAD	(5411
	DCA I	[WRKNUM	/COMPUTE THE $WORK NUMBER OF THE FILE
	TAD	OUT
	TAD	(WUNIT-11
	DCA	T
	TAD I	T	/GET THE ASSUMED UNIT
	DCA I	(DOLUNT
	TAD	OUT
	JMS I	[SINIT
	DOLSEQ-1
	JMP I	INIOUT
UFMESG,	-10		/ UNIT XX IS FREE
	0166;5752;6501
UNITNO,	0000;0152;6401
	4763;4646
USEUSE,	TAD	OUT
	JMS I	KPTRST
	DCA I	W5	/FORCE A MOUNT MESSAGE FOR THE OUTPUT FILE
	TAD I	W1
	AND	P17	/GET THE UNIT PREVIOUSLY ASSIGNED TO THIS IFN
	SNA		/ANY?
	JMP	OUINIT	/NO
	JMS I	OTOPD	/CONVERT TO DECIMAL
	DCA	UNITNO
	DCA I	W1	/THIS MAY NOT BE NECESSARY
	IAC
	JMS I	CDOIO	/ANNOUNCE THAT IT'S FREE
	UFMESG-1
	NOP		/IMPOSSIBLE RETURN
OUINIT,	TAD	OUT
	JMS I	[SINIT
	OUTSEQ-1
			/FALL INTO "MERGE"

/MERGE PHASE OF SORT PROGRAM - PERFORMS AN N-WAY MERGE
/UNTIL ONE OF THE INPUT TAPES IS EXHAUSTED. THAT INPUT TAPE
/THEN BECOMES THE NEW OUTPUT TAPE AND THE OLD OUTPUT TAPE
/TAKES ITS PLACE AMONNG THE INPUT FILES. THAT'S WHAT A
/POLYPHASE MERGE IS.  THAT'S ALSO WHY WE NEED A "MAGIC" STRING
/DISTRIBUTION ON THE TAPES FOR THINGS TO WORK OUT RIGHT.
/ THE ACTUAL MERGE PROCEDURE IS SIMPLE - WE READ A RECORD FROM
/EACH TAPE AND FIND THE "WINNER" (END-OF-STRING MARKS ALWAYS
/LOSE). WE OUTPUT THE WINNER, REPLACE IT WITH THE NEXT RECORD FROM
/ITS TAPE, AND CONTINUE UNTIL ALL THE BUFFERS CONTAIN END-OF-STRING
/MARKS. WE THEN OUTPUT AN END OF STRING MARK AND RE-PRIME THE BUFFERS.
MERGE,	TAD	(IFNTAB-1
	DCA	GETXR
	STA
	DCA	INRADR
INRDLP,	TAD I	GETXR	/GET THE IFN AND FIELD
	SNA
	JMP I	(MERGLP	/DONE - START MERGING
	JMS I	RDOIO
INRADR,	0
	NOP		/FAITH, FAITH - MUST BE A NULL STRING
	TAD	INRADR
	TAD	[400
	DCA	INRADR	/BUMP BUFFER POINTER
	JMP	INRDLP	/GO TO READ NEXT UNIT
IFNTAB,	ZBLOCK	7	/SET UP AT END OF PRESORT, SHUFFLED BY MERGE
			/CONTAINS THE INPUT IFN'S FOR THIS MERGE PASS (+10)
	PAGE

/INNER LOOP OF MERGE ROUTINE
/FINDS THE WINNER AMONGST THE REPRESENTATIVES OF THE INPUT UNITS
MERGLP,	DCA	ODDNOD
	CDF 10
	JMS I	[SETCNT	/INITIALIZE FOR WINNER SCAN
MGETWN,	TAD I	ODDNOD
	SPA CLA		/CHECK FOR A VALID RECORD
	JMP	MGOT1	/GOT ONE - MAKE IT THE TENTATIVE WINNER
	TAD	ODDNOD
	TAD	[400
	DCA	ODDNOD	/BUMP BUFFER POINTER
	ISZ	OUNIT	/AND GUESS AGAIN
	JMP	MGETWN
	JMP I	.+1	/WHOOPS - RAN OUT OF GUESSES - ALL EOS'S
MRGEND,	EOMERG
MCMPLP,	TAD	ODDNOD
	TAD	[400
	DCA	ODDNOD	/BUMP ODDNOD TO NEXT CHALLENGER
	TAD I	ODDNOD
	SMA CLA		/SHOULD WE EVEN CONSIDER HIM?
	JMP	MNXTCH	/NO
	TAD	ODDNOD
	JMS I	[COMPAR	/SEE WHO WINS
	JMP	.+3	/THE CHALLENGER
	JMP	MNXTCH
	JMP	MNXTCH	/THROW DA BUM OUT
MGOT1,	TAD	ODDNOD	/ALL HAIL THE NEW CHAMP!
	DCA	WINNER
MNXTCH,	ISZ	OUNIT
	JMP	MCMPLP	/CONSIDER ALL POSSIBLE CHALLENGERS
	CDF 0
	STA
	TAD	WINNER
	DCA	RARG1	/SET UP TO WRITE AND REPLACE THE WINNER
	TAD	RARG1
	DCA	RARG2
	TAD	OUT
	JMS I	RDOIO
RARG1,	0
	JMP I	(SYSERR	/WHA HOPPEN?
	TAD	WINNER
	CLL RTL
	RTL		/COMPUTE THE WINNER'S UNIT
	RAL		/FROM HIS BUFFER ADDRESS
	TAD	(IFNTAB	/AND THE IFN TABLE
	DCA	T
	TAD I	T
	JMS I	RDOIO	/GET A NEW ENTRY FROM THE WINNING UNIT
RARG2,	0
	NOP		/RAN OUT - TOUGH NUGGIES
	JMP	MERGLP	/GET A NEW WINNER

/SPECIAL SORT 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, ASSUMED UNIT) - 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 I	GETXR	/GET ASSUMED UNIT IN AC
	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
SETCNT,	0
	TAD	NOUT
	CIA
	DCA	OUNIT
	JMP I	SETCNT
WUNIT,	ZBLOCK 7	/TABLE OF ASSUMED WORK UNITS
	PAGE

/CODE TO MOVE ACTUAL SORT FROM FIELD 1 TO FIELD 0
MOVDWN,	DCA	NOUT	/SAVE NUMBER OF OUTPUT FILES FOR PRESORT
MOVDLP,	TAD I	SORTPT
	CDF 0
	DCA I	SORTPT
	CDF 10
	ISZ	SORTPT
	ISZ	SORTCT
	JMP	MOVDLP	/MOVE CORE TO FIELD 0
	CDF CIF 0
	TAD I	(MRGFLG
	SNA CLA
	JMP I	(P1INIT
	JMP I	(MGINIT
SORTPT,	100
SORTCT,	-4300
MRGTAB,	401;6463;6552;5701;0	/SRTIN
	401;0;0;0;0
	401;0;0;0;0
	401;0;0;0;0
	401;0;0;0;0
	401;0;0;0;0
	401;0;0;0;0

/ONCE-ONLY CODE TO ENABLE SORT TO BE USED AS A STAND-ALONE MERGE.
MGINIT,	DCA	EOFFLG	/FAKE PHASE 2 INTO THINKING ITS IN THE
	DCA	NPASS	/FINAL MERGE PASS
	STA
	TAD	NOUT
	SNA CLA
	JMP I	(NULERR
	TAD	(P2OTPT+1
	DCA	XR
	JMS I	[SETCNT	/MOST OF THIS CODE IS COPIED FROM THE
	TAD	(IFNTAB-1	/PRESORT TERMINATION ROUTINE (ITSOVR)
	DCA	CMXR
MILOOP,	JMS I	[GTONUM
	JMS I	[SINIT
MRGPT2,	MRGTAB-1	/INITIALIZE THE MERGE INPUT FILES
	TAD	MRGPT2
	TAD	(5
	DCA	MRGPT2
	JMS I	[GTONUM
	TAD	[10
	DCA I	CMXR	/ALSO INITIALIZE THE IFN TABLE
	ISZ	OUNIT
	JMP	MILOOP
	TAD	(MRGOVR
	DCA I	(MRGEND
	TAD	[11
	JMP I	(MERGST
	PAGE
	$-$-$