/SORT08   TWM 2/23/77 1000

/ CLYDE G. ROBY, JR.
/ DEPARTMENT OF PHYSIOLOGY
/ WEST VIRGINIA UNIVERSITY
/ MORGANTOWN, WEST VIRGINIA
/ JULY, 1973

	XLIST 1
/ MODIFIED MAY 14, 1974 BY CGR, JR. (V2)
/ ADDED IN NUMERIC FIELD CAPABILITY

/ MODIFIED SEPTEMBER 26, 1974 BY CGR, JR. (V3)
/ ADDED IN MULTIPLE-LINE RECORD CAPABILITY

/ MODIFIED OCTOBER 14, 1974 BY CGR, JR. (V4)
/ ADDED IN ABILITY TO CHAIN TO 'SORT'

/ MODIFIED OCTOBER 28, 1974 BY CGR, JR. (V5)
/ FIXED BUG IN NUMERIC COMPARE ROUTINE...ON EQUAL COMPARE
/    OF A NUMERIC FIELD, IT WOULD NOT CHECK MINOR FIELDS

/MODIFIED MAY 8, 1975 BY TOM MCINTYRE
/INSTALLED FIX FOR MULTI LINE BUG
/INSTALLED CHANGES FOR LARGE FILES
/CHANGED HANDLER ALLOCATION SEQUENCE SO ONLY 4 PAGES MAXIMUM
/ ARE NEEDED
/ALSO DELETES REDUNDANT WORK FILE BEFORE FINAL OUTPUT

/MODIFIED JUNE 5,1975 BY TOM MCINTYRE
/INSTALLED "/S" OPTION FOR STRIPPED
/ ASCII SORTING (COMPATIBLE WITH BASIC).

/MODIFIED 9 AUGUST 1975 FIXED BUF RE SHORT INPUT FILES
/FIXED BUG RE DELETING OF FINAL WORK FILE
/FIXED BUG RE DESCENDING SORT WITH SHORT DELIMITED FIELDS
/ADDED CODE TO PAD LINE WITH SPACES FOR BASIC STRIPPED CODE
/WHEN USING DELIMITERS

/MODIFIED SEPTEMBER 4, 1975 BY TOM MCINTYRE
/FIXED BUG RE A 3 BLOCK FILE

/MODIFIED NOVEMBER 26, 1975 BY JAMES CORYELL, DATAPRODUCTS
/REMOVED TABLE OF BLOCKS TO ALLOW LARGER FILES.


/MODIFIED FEBRUARY 16, 1976 BY JAMES CORYELL, DATAPRODUCTS FOR ROBERT HASSINGER
/ADDED # TO FIELD DELIMITERS AND RECORD MARK. FOLLOW # WITH OCTAL VALUE OF CHAR.
/MODIFIED MARCH 30, 1976 BY JAMES CORYELL, DATAPRODUCTS
/FIXED BUG RE 6 BLOCK FILE. THIS CHANGE REMOVES THE PRE-SIZEING OF
/THE WORK FILES. NOW WE OPEN #2, FILL IT, THEN CLOSE AT REAL SIZE.
/OPEN #1 SAME SIZE, DELETE BOTH.

/MODIFIED AUGUST 76 TMC - BUG FIXES
/1.  SEVERAL SMALL TYPOS I.E. MISSING PAGE PSEUDO OP
/2.  LOCATION OF PASS1 BUFFER CHANGED FOR LARGER RECORD SIZE
/3.  ORDER OF CHECKING OF CONTROL CHARS FIXED.
/4.  ORDER OF LOADING HANDLERS FIXED - LOAD WORK1 AFTER INPUT IS DONE
/ADDED /Z SWITCH TO FORCE AN EVEN NUMBER OF PASSES
/ON TAPE ONLY SYSTEM THIS WILL OPTIMIZE SORT BY FORCING AN EXTRA PASS IF
/NECESSARY TO MAKE TOTAL EVEN
/	SPECIFICATION IS:
/DEV1:OFILE,DEV2;,DEV1:<DEV2:INFILE/Z
/DEVICE 1 NEED NOT HAVE ENOUGH ROOM FOR BOTH THE OUTPUT AND THE WORK FILE.

	XLIST 0
/1 JAN 77 - TMC
/THE VERSION IS 7C AND INCLUDES:  FIX FOR THE PASS 2 EVEN BUFFER BUG
/                                 NEW OPTION /Y TO IGNORE FF IN INPUT FILE

/	23 FEB 77 - TMC
/VERSION BECOMES 7D THE PROGRAM WILL RECOGNIZE CTRL/C WHENEVER IT IS
/WRITING ITS OUTPUT BUFFER
/MINOR MODIFICATION TO CLEAN UP INPUT CHARACTER CHECKING
/MERGE IS NOW COORDINATED WITH SORT

	VERS1="0&77	/TEN'S DIGIT OF VERSION
	VERS2="8&77	/KEEP THE VERSION UPDATED
	PATCH=" &77	/PATCH LEVEL

RECSIZ=1000		/SIZE OF LINE BUFFER.
FIXMRI	INC=2000	/'ISZ' WHEN NOT EXPECTED TO SKIP
/ PAGE ZERO LOCATIONS

*10

SORTXR,	0
SORTX1,	0
SORTX2,	0

INXR1,	0
INXR2,	0

LINEXR,	0
LINEX2,	0

*20

INHAND,	0		/ADDRESS OF INPUT HANDLER
OUHAND,	0		/ADDR OF OUTPUT HANDLER

NWRITE,	0		/NO. OF SEGMENTS IN SORT FILE

CHAR,	0
NCHAR,	0		/NO. OF CHARS ON A LINE
FCHAR,	0		/CHAR DURING FINAL PASS

BACKPT,	0		/PTR USED IN BACKING UP ON A LINE

SPRPT1,	0		/PTRS USED IN SPREADING A LINE APART
SPRPT2,	0

COMPTR,	0		/PTR USED FOR COMPARE TABLE
COMCOL,	0		/NO. OF COLUMNS TO SKIP
COMCTR,	0		/LENGTH OF SORT FIELD
COMPCN,	0		/0 = CHAR, 7777 = NUMERIC
COMPT1,	0		/PTR FOR LINE DURING COMPARE
COMPT2,	0		/PTR FOR LINE2 DURINT COMPARE
COMCH1,	0		/CHAR FROM LINE
COMCH2,	0		/CHAR FROM LINE2
COMG1C,	0		/COLUMN CTR FOR LINE
COMG2C,	0		/COLUMN CTR FOR LINE2
COMPTM,	0		/TEMP

NLINES,	1		/NO. OF LINES PER RECORD
LINECT,	0		/CTR USED FOR NLINES

INTRLV,	0
PASNUM,	0		/NUMBER OF PASSES USED

ICHR1C,	0		/CHAR CTR FOR SEGMENT 1
ICHR2C,	0		/CHAR CTR FOR SEGMENT 2

SORTPT,	0		/GENERAL SORT POINTER

FCHRCT,	0		/CHAR CTR FOR FINAL PASS

WKDEV1,	0		/DEVICE NUM OF WRK1
WRK1,	FILENAME SRTWK1.TM

WKDEV2,	0		/DEVICE NUM OF WRK2
WRK2,	FILENAME SRTWK2.TM
SBLK1,	0		/STARTING BLOCK OF WORK-FILE #1.
SBLK2,	0		/STARTING BLOCK OF WORK-FILE #2.

WCHKPT,	0		/CHECKING POINTER
WCHKCH,	0		/HOLDS CHAR DURING WRITE PACK

ISEGPT,	0		/INPUT SEGMENT TABLE POINTER
OSEGPT,	0		/DITTO OUTPUT SEGMENT TABLE

DELIM,	0		/SORT DELIMITER CHARACTER
STRTNF,	0		/NO. OF SORT FIELDS (PHASE II)
FILCNT,	0		/COUNTER FOR BUFF OVERFLOW
LENGTH,	0		/(-)NOTE SIZE FOR 1
STPFLG,	0		/6 BIT STIPPING FLAG- 77 ON
STPTMP,	0		/TEMP FOR STRIP FLAG

ISEGCT,	-1		/COUNT OF INPUT SEGMENTS.
RCDMK,	0		/-RECORD MARK CHARACTER.
RCDMKP,	0		/RECORD MARK CHARACTER FOR FINAL PASS.

FFOPTK,	0		/FORM FEED OPTION CONSTANT 1 IF FF'S TO BE IGNORED
TYPMESS=JMS I .
	  TYPMSX

PAGE
/ SORT PROGRAM

/ NOW CAN BE CHAINED TO
/ ASSUMES THE CD AREA IN FIELD 1 IS ALL SET UP

SORT,	SKP		/SKIP CHAIN START.
	JMP NOCD	/CHAIN START.
	TYPMESS		/START: OUTPUT "SORT VN"
	  VMESS
	JMS GETUSR	/LOCK USR IN CORE
SORTGO,	CIF 10		/START, GET ALL I/O FILES
	JMS I [200
	  5		/CALL COMMAND DECODER
	  0
NOCD,	TAD I (1000)
	TAD (-7001
	SNA CLA		/OS/8 OR PS/8?
	TAD (1600-1000)	/PS/8 BUFFER AT 1600
	TAD (1000-1)	/OS/8 BUFFER AT 1000
	JMS INIT
	JMS COUNTI	/COUNT LENGTH OF ALL INPUTS
	JMS MAKEFA	/MAKE FILE WORK 2
	TAD SBLK2
	DCA W1BLK	/WRITE BLK NO. FOR PASS 1
	TAD [6]
	DCA INTRLV	/INITIAL INTERLEAVING FACTOR
	JMS PASS1	/DO INCORE SORT PASS
	JMS MAKEFB	/MAKE FILE WORK 1
	STA		/RELEASE USR FROM CORE
	DCA USRSTAT

PASS2L,	JMS REVERSE	/NOW REVERSE INPUT AND OUTPUT FILES
	TAD SBLK2
	DCA OSEGPT
	TAD SBLK1
	DCA ISEGPT
	STA
	TAD NWRITE	/JUST 1 WRITE?
	SNA CLA
	JMP FINALG	/TIME FOR FINAL COPY
	DCA NWRITE	/ZAP THE CTR
	JMS PASS2	/DO ANOTHER SORT PASS
	TAD INTRLV
	CLL RAL		/DOUBLE INTERLEAVING FACTOR
	DCA INTRLV	/RESET INTERLEAVING FACTOR
	JMP PASS2L

FINALG,	TAD INTRLV	/RESET THE INTERLEAVE
	CLL RAR
	DCA INTRLV
	DCA NWRITE
	CDF 10
	TAD I (7644	/DID HE ASK FOR THIS?
	CDF 0
	CLL RTL;RAL	/EVEN CONDITIONED TO LINK
	AND PASNUM
	RAR		/PUT CONDITION IN LINK
	CLA SNL		/DO WE NEED IT?
	JMP FINALP	/OK NOW DO FINAL PASS
	JMS PASS2	/YES, DO A DUMMY PASS2
	JMP PASS2L	/THIS FALLS THROUGH TO FINALP THIS TIME
PAGE
MAKEFA,	0
	CIF 10
	JMS I [200
	  12		/ASCERTAIN WHAT 'DSK' IS
MDEV,	  DEVICE DSK
	  0
	HLT
	CDF 10
	TAD  7605	/IS THERE AN OUTPUT WORK 1?
	SNA
	TAD MDEV+1	/NO, ASSUME 'DSK'
	CDF 00
	DCA WKDEV1	/SAVE DEVICE NO.
	TAD WKDEV1
	JMS OTYPE	/GET ITS DEVICE TYPE
	SMA CLA
	JMP SRTER1	/ERROR, MUST BE DIRECTORY ORIENTED
	CDF 10
	TAD  7612	/IS THERE AN OUTPUT WORK 1?
	SNA
	TAD MDEV+1	/NO, ASSUME 'DSK'
	CDF 00
	DCA WKDEV2	/SAVE DEVICE NO.
	TAD WKDEV2
	JMS OTYPE	/GET ITS DEVICE TYPE
	SMA CLA
	JMP SRTER1	/ERROR, MUST BE DIRECTORY ORIENTED
	TAD (7605
	DCA SORTXR
	CDF 10
	TAD I SORTXR	/WAS A NAME GIVEN TO WORK#1?
	SNA
	JMP MAKEF2	/NO.
	DCA WRK1	/MOVE NAME DOWN
	TAD I SORTXR
	DCA WRK1+1
	TAD I SORTXR
	DCA WRK1+2
	TAD I SORTXR
	DCA WRK1+3
MAKEF2,	CLA
	TAD (7612
	DCA SORTXR
	TAD I SORTXR
	SNA		/WAS A NAME GIVEN FOR WORK#2?
	JMP MAKEF3	/NO.
	DCA WRK2	/MOVE IT DOWN
	TAD I SORTXR
	DCA WRK2+1
	TAD I SORTXR
	DCA WRK2+2
	TAD I SORTXR
	DCA WRK2+3

MAKEF3,	CLA
	CDF
	TAD WKDEV2	/DEVICE NO.
	CIF 10
	JMS I [200
	  1		/FETCH DEVICE HANDLER
MAKEHA,	  WKHND2+1
	HLT
	TAD WKDEV2
	CIF 10
	JMS I [200
	  3		/ENTER OUTPUT FILE
FNAMFB,	  WRK2		/OVERLAID WITH STARTING BLK NO.
FLNG,	  0		/ALLOWABLE LENGTH (-)
	HLT
	CLL CLA
	TAD FLNG
	DCA LENGTH
	TAD MAKEHA
	DCA OUHAND	/SAVE THIS HANDLER ADDRESS
	TAD FNAMFB	/STARTING BLOCK OF OUTPUT
	DCA SBLK2	/SAVE BEGINNING BLK NUM
	JMP I MAKEFA	/RETURN TO CALLER

/ SUBROUTINE TO BACKUP A PTR TO START OF LINE
/ ENTER AND EXIT WITH PTR IN ACC

BACKUP,	0
	DCA BACKPT	/SAVE PTR TO BUFFER
BAKUP1,	STA
	TAD BACKPT
	DCA BACKPT	/BACKUP ONE WORD
	TAD BACKPT
	TAD [-P1OBUF+1]
	SNA CLA
	JMP BAKUP2	/IF AT BEGINNING OF BUFFER, GO RETURN
	CDF 10
	TAD I BACKPT	/GET CHAR
	CDF 00
	SZA CLA
	JMP BAKUP1	/NON-ZERO, KEEP LOOKING
BAKUP2,	TAD BACKPT	/ZERO, END OF PREV. LINE
	JMP I BACKUP	/RETURN WITH PTR IN ACC

/ GET LINE2 FROM OUTPUT BUFFER

GLINE,	0		/SKIP LINES STARTING WITH CONTROL-CHAR.
	TAD [LINE2-1]
	DCA LINEX2
GLINEA,	CDF 10
	TAD I SORTX1	/MOVE CHARS FROM OUTPUT BUFFER
	CDF 00
	SNA
	JMP GLINEB
	DCA I LINEX2	/SAVE IN LINE2
	JMP GLINEA
GLINEB,	DCA I LINEX2	/ZERO TO END LINE2
	TAD I [LINE2
	JMS I [TESTC
	JMP GLINE+1
	TAD I [LINE2
	SZA CLA
	INC GLINE	/.+2 IF GOOD LINE
	JMP I GLINE	/.+1 IF NO LINE

PAGE
/ PASS 1 SORT
/ READ IN INPUT FILES AND SORT AS MUCH IN CORE
/ WRITE THESE SEGMENTS ONTO OUTPUT FILE

PASS1,	0
	JMS IOPEN	/PREPARE FOR INPUT
	TAD [P1OBUF-1]
	DCA SORTXR	/INITIALIZE SORT XR
	CDF 10
	DCA I SORTXR	/MUST BE A ZERO IN THE BUFFER
	CDF 00

P1GO,	DCA NCHAR	/NO. OF CHARS ON LINE
	TAD NLINES	/NO. OF LINES PER RECORD
	CIA
	DCA LINECT	/USE AS CTR
	TAD [LINE-1]
	DCA LINEXR
P1NXT,	JMS I [ICHARX
	JMP P1EOF	/END OF FILE
	DCA CHAR	/SAVE THE CHAR
	TAD CHAR
	TAD RCDMK	/IS IT THE RECORD MARK?
	SNA CLA
	JMP P1EOL5	/YES COMPARE IT
	TAD CHAR	/NO, GET THE CHAR BACK
	TAD (-216)
	SPA CLA
	JMP P1EOLQ	/<216, MAYBE USE AS END OF LINE, MAYBE
P1SAV1,	TAD CHAR	/SAVE CURRENT IN LINE
P1SAV2,	DCA I LINEXR	/SAVE CHAR LINE IN BUFFER
	INC NCHAR	/COUNT IT
	TAD NCHAR
	TAD [-RECSIZ+1]	/LINE LENGTH
	SPA CLA
	JMP P1NXT	/STILL ROOM, RETURN FOR MORE
	TAD NCHAR	/TEST TO SEE IF MESSAGE GIVEN.
	TAD [-RECSIZ+1]
	SZA CLA
	JMP .+3		/MESSAGE WAS GIVEN. SO SKIP MESSAGE.
	TYPMESS
	  ERROR3	/INPUT LINE TOO LONG, USING 383 CHARS
	STA
	TAD LINEXR
	DCA LINEXR	/BACK UP POINTER SO RECORD MARK WILL FIT.
	JMP P1NXT

P1EOLQ,	TAD CHAR	/CHECK CHAR OUT
	TAD (-215)	/IS IT A CARRIAGE RETURN?
	SNA
	JMP P1NXT	/IGNORE CARRIAGE RETURN
	TAD FFOPTK	/DOES HE WANT TO IGNORE FF'S
	SNA CLA		/IF HE DOES, FLAG IS -1
	JMP P1NXT	/YES, IGNORE IT TOO
	TAD CHAR	/LF, FF, VT ARE EOL CHARS
	TAD [-212]
	SPA CLA		/IF EOL FALL THROUGH
	JMP P1SAV1	/TAB, SAVE IT

P1EOL3,	STL CLA RAR	/4000 INDICATES EOL
	ISZ LINECT	/ABSOLUTE END OF RECORD?
	JMP P1SAV2	/NO, SAVE 4000 AS A CHAR
	CLA		/YES
P1EOL5,	TAD NCHAR	/ANY CHARS IN LINE?
	SNA CLA
	JMP P1GO	/NO, GO GET A LINE
P1EOL4,	DCA I LINEXR	/YES, END LINE WITH 0000
	INC NCHAR	/COUNT THE EOL CHAR
	JMS INSORT	/FIND OUT WHERE LINE GOES
	JMP P1GO

P1EOF,	SMA CLA		/HARD OR SOFT ERROR (OR EOF)?
	JMP P1EOFG	/END-OF-FILE
	TAD (ERR4)	/HARD ERROR
	JMP ERRPRT	/GO GIVE ERROR MESSAGE

P1EOFG,	STA
	TAD SORTXR
	DCA SORTXR	/BACKUP TO STORE OVER THE ZERO
	STA
	CDF 10
	DCA I SORTXR	/"EOF" FLAG
	CDF 00
	JMS WRITE1	/OUTPUT FINAL BUFFER
	JMP I PASS1	/PASS 1 NOW OVER

/ COMPARE CURRENT LINE WITH LINES IN BUFFER
/ INSERT CURRENT LINE INTO APPROPRIATE PLACE

INSORT,	0
	TAD [P1OBUF-1]
	DCA SORTX1
ISORT1,	JMS GLINE	/GET LINE FROM OUTPUT BUFFER
	JMP ISORT6	/NOTHING IN BUFFER, CHECK CONTROL
	TAD I [LINE
	JMS I [TESTC	/CKECK FOR CONTROL-CHAR START.
	JMP CONTRL	/STARTS WITH CONTROL-CHAR.
	JMS COMPAR	/TO COMPARE WITH CURRENT LINE
	JMP ISORT2	/LINE < LINE2
	JMP ISORT1	/LINE = LINE2
	JMP ISORT1	/LINE > LINE2

ISORT2,	TAD SORTX1
	JMS BACKUP	/BACKUP PTR TO START OF LINE
	DCA SORTX1
	JMS SPREAD	/MAKE ROOM FOR NEW LINE
	TAD [LINE-1]
	DCA SORTX2

ISORT3,	TAD I SORTX2	/GET CHAR FROM LINE
	SNA
	JMP ISORT4	/END OF LINE
	CDF 10
	DCA I SORTX1	/SAVE CHAR IN OUTPUT BUFFER
	CDF 00
	JMP ISORT3

ISORT4,	CDF 10
	DCA I SORTX1	/ZERO TO END THE LINE
	CDF 00
	JMS WCHECK	/CHECK FOR NEED TO WRITE
	JMP I INSORT	/RETURN TO CALLER

ISORT6,	TAD I [LINE	/CHECK FOR CONTROL-CHAR START.
	JMS I [TESTC
	JMP CONTRL	/STARTS WITH A CONTROL-CHAR.
	JMP ISORT2	/INSERT LINE

PAGE

IFZERO	.-1001&4000	< /PRINTX ASSEMBLY ERROR AT 01000
E1000,	ZZZ
>
*2000

/ SUBROUTINE TO COMPARE THE CHARACTERS IN LINE AND LINE2
/ ACCORDING TO THE SORT FIELDS SPECIFIED BY USER
/ RETURNS .+1 IF LINE < LINE2 (ASSUMEING ASCENDING SORT)
/ RETURNS .+2 IF LINE = LINE2
/ RETURNS .+3 IF LINE > LINE2

COMPAR,	0
	KSF		/CHECK THE CONSOLE
	JMP CMNOCC	/NOT NEEDED
	TAD [7600	/MASK PARITY
	KRS
	TAD [-7603	/IS IT CTRL/C?
	SNA CLA
	JMP I [7605	/YES, RETURN TO MONITOR
CMNOCC,	TAD [SORTAB]
	DCA COMPTR	/POINTS TO SORT FIELD DESCRIPTION TABLE
COMP0,	TAD STRTNF	/ANY "FIELDS" BY DELIMITERS?
	SNA CLA
	JMP COMP1	/NO, FIELDS BY COLUMN AND LENGTH
	TAD I COMPTR	/YES, GET FIELD NO.
	SNA
	JMP COMPEQ	/LINES ARE EQUAL
	JMP COMP11	/GO SAVE FIELD NO.

COMP1,	TAD I COMPTR	/GET STARTING COLUMN
	SNA
	JMP COMPEQ	/END OF SORT FIELDS; EQUAL COMPARE
	INC COMPTR
	DCA COMCOL	/NO. OF COLS TO SKIP
	TAD I COMPTR	/GET LENGTH OF FIELD
COMP11,	INC COMPTR
	DCA COMCTR	/LENGTH OF FIELD, OR NO. OF FLDS TO SKIP
	TAD I COMPTR
	INC COMPTR
	DCA COMPCN	/0 = CHAR; 7777 = NUMBER
	TAD I COMPTR	/0 = ASCENDING
	INC COMPTR
	SZA CLA
	TAD (SMACLA-SPACLA) /7777 = DESCENDING
	TAD (SPACLA)
	DCA COMP5	/SAVE COMPARE INSTRUCTION

	TAD [LINE]	/INITIALIZE STUFF FOR LINE
	DCA COMPT1
	DCA COMG1C	/"COLUMN" NO.
	TAD (COMG11)
	DCA COMG1R	/CO-ROUTINE ENTRY
	TAD [LINE2]	/INITIALIZE THINGS FOR LINE2
	DCA COMPT2
	DCA COMG2C	/"COLUMN" NO.
	TAD (COMG21)
	DCA COMG2R	/CO-ROUTINE ENTRY
	TAD STRTNF	/FIELDS OR BY COLUMNS?
	SNA CLA
	JMP COMP2	/BY COLUMNS
	JMP COMP14	/BY FIELDS

COMP12,	JMS COMG1	/GET NEXT CHAR FROM LINE
	TAD COMCH1
	SNA
	JMP COMP13	/END OF LINE, ALSO END OF FIELD
	TAD DELIM	/IS IT DELIMITER CHAR?
	SZA CLA
	JMP COMP12	/NO, KEEP LOOKING FOR END OF FIELD
COMP13,	JMS COMG2	/NOW LOOK AT LINE2
	TAD COMCH2
	SNA
	JMP COMP14	/END OF LINE IS END OF FIELD
	TAD DELIM
	SZA CLA		/WATCH OUT FOR DELIMITER, TOO
	JMP COMP13	/NOT YET, KEEP LOOKING

COMP14,	ISZ COMCTR	/ARE WE AT CORRECT FIELD YET?
	JMP COMP12	/NO, GO FOR NEXT FIELD
	TAD COMPCN	/SORT BY CHAR OR NUMBER?
	SZA CLA
	JMP COMP1N	/NUMERIC SORT
COMP15,	JMS COMG1	/GET CHAR FROM LINE
	TAD COMCH1
	SZA CLA
	JMP COMP16	/WE GOT A GOOD CHAR
	TAD DELIM	/END OF LINE, USE DELIMITER CHAR
	CIA
	DCA COMCH1
COMP16,	JMS COMG2	/GET CHAR FROM LINE2
	TAD COMCH2	/CHECK THE CHAR OUT
	SZA CLA
	JMP COMP17	/GOOD CHAR
	TAD DELIM	/USE DELIMITER AS END OF FIELD
	CIA
	DCA COMCH2

COMP17,	TAD COMCH2	/COMPARE THE TWO CHARS
	CIA
	TAD COMCH1
	SZA
	JMP COMP18	/UNEQUAL
	TAD COMCH2	/EQUAL, AT END OF FIELD?
	TAD DELIM
	SZA CLA
	JMP COMP15	/NO, CHECK MORE CHARS
	JMP COMP0	/YES, NOW DO NEXT FIELD

COMP2,	JMS COMG1	/GET A CHAR FROM LINE
	JMS COMG2	/GET A CHAR FROM LINE 2
	ISZ COMCOL	/AT START OF SORT FIELD?
	JMP COMP2	/NO, CONTINUE
	TAD COMPCN	/CHARACTER OR NUMERIC SORT?
	SZA CLA
	JMP COMP2N	/NUMERIC SORT BY COLUMNS
	JMP COMP4	/YES, GO COMPARE

COMP3,	JMS COMG1	/GET NEXT CHAR FOR LINE
	JMS COMG2	/GET NEXT CHAR FROM LINE2
COMP4,	TAD COMCH2
	CIA
	TAD COMCH1
	SZA
	JMP COMP5	/UNEQUAL
	ISZ COMCTR	/EQUAL COMPARE, ALL OF FIELD CHECKED?
	JMP COMP3	/NO, GET NEXT CHARS
	JMP COMP1	/YES, GO CHECK NEXT FIELD

COMP5,	SPA CLA		/"SMA CLA" FOR DESCENDING
COMPLT,	JMP I COMPARE	/.+1 IF LINE < LINE2
COMPGT,	INC COMPARE	/.+3 IF LINE > LINE2
COMPEQ,	INC COMPAR	/.+2 IF LINE = LINE2
	JMP I COMPAR	/RETURN TO CALLER

	SPACLA=SPA CLA
	SMACLA=SMA CLA

PAGE
/ PASSES 2 TO N-1
/ READ FROM INPUT FILE AND MERGE IN SORTED ORDER
/ UNTIL THERE IS JUST ON SORTED OUTPUT FILE

PASS2,	0
PASS20,	DCA I [LINE	/NOTHING IN LINE BUFFERS YET
	DCA I [LINE2
	TAD OSEGPT	/GET THE STARTING OUTPUT BLOCK NUM
	DCA W2BLK	/AND INITIALIZE IT
	STA
	DCA ICHR1C
	STA
	DCA ICHR2C
	TAD [P2OUT-1]
	DCA SORTX1	/INITIALIZE THE OUTPUT POINTER
	JMS NXISEG		/GET NEXT SEG NUMBER.
	DCA IBLK1	/SAVE SEGMENT 1 BLK NUM
	ISZ ISEGCT	/CHECK FOR LAST.
	SKP
	JMP P2EOR2	/ASSUME END OF FILE
	JMS NXISEG	/FORM NEXT NUMBER.
	DCA IBLK2	/USE SEGMENT 2 BLK NO.

PASS21,	JMS GLINE1	/GET LINE FROM SEGMENT 1
	JMP P2EOR1	/END OF SEGMENT OR EOF
	JMS GLINE2	/GET LINE FROM SEGMENT 2
	JMP P2EOR2	/END OF SEGMENT OR EOF
	TAD I [LINE
	JMS I [TESTC	/TEST FOR CONTROL-CHAR.
	JMP PA1		/OUTPUT CONTROL LINE NOW.
	TAD I [LINE2
	JMS I [TESTC
	JMP PA2		/OUTPUT CONTROL LINE NOW.
	JMS SORT2	/SORT THEM
	JMP PASS21
PA1,	TAD [LINE-1
	SKP
PA2,	TAD [LINE2-1
	JMS SRTOUT	/OUTPUT CONTROL-LINE.
	JMP PASS21

/ SUBROUTINE TO GET A LINE FROM SEGMENT 1

GLINE1,	0
	TAD I [LINE	/IS LINE EMPTY?
	SZA CLA
	JMP GLNE1R	/NO, GO RETURN
	TAD [LINE-1]
	DCA LINEXR
GLNE11,	JMS ICHAR1	/GET CHAR FROM SEGMENT 1
	JMP I GLINE1	/END OF FILE OR SEGMENT
	DCA I LINEXR	/SAVE CHAR IN LINE BUFFER
	TAD CHAR
	SZA CLA
	JMP GLNE11
GLNE1R,	INC GLINE1	/RET. .+2 IF GOOD LINE
	JMP I GLINE1

/ SUBROUTINE TO GET A LINE FROM SEGMENT 2

GLINE2,	0
	TAD I [LINE2
	SZA CLA
	JMP GLNE2R	/LINE ALREADY THERE, GO RETURN
	TAD [LINE2-1]
	DCA LINEX2
GLNE2L,	JMS ICHAR2	/GET CHAR FROM SEGMENT 2
	JMP I GLINE2	/EOF OR END OF SEGMENT
	DCA I LINEX2	/SAVE CHAR IN LINE BUFFER
	TAD CHAR
	SZA CLA
	JMP GLNE2L
GLNE2R,	INC GLINE2	/RET .+2 IF GOOD LINE
	JMP I GLINE2

/ END OF SEGMENT OR END OF FILE ON SEGMENT 1

P2EOR1,
P2ER11,	JMS GLINE2	/KEEP GETTING LINES FROM SEGMENT 2
	JMP P2EOF	/END OF FILE ON IT
	TAD [LINE2-1]
	JMS SRTOUT	/PUT LINE2 INTO OUTPUT BUFFER
	JMP P2ER11

/ END OF SEGMENT OR END OF FILE ON SEGMENT 2

P2EOR2,
P2ER21,	JMS GLINE1	/GET LINES FROM SEGMENT 1
	JMP P2EOF	/END OF FILE ON SEGMENT 1
	TAD [LINE-1]
	JMS SRTOUT	/PUT LINE INTO OUTPUT BUFFER
	JMP P2ER21

/ COMMON END OF SEGMENT ON END OF FILE

P2EOF,	STA
	JMS SAVEP2	/SAVE THE ENDING CHAR
	INC NWRITE	/ONE MORE SEGMENT OUT
	TAD SORTX1
	TAD (-P2OUT+1)
	SZA CLA
	JMS WRITE2	/OUTPUT THE LAST BUFFER
	TAD ISEGCT
	SMA CLA
	JMP I PASS2
	ISZ ISEGCT	/CHECK FOR LAST.
	SKP
	JMP I PASS2
	TAD INTRLV	/INTERLEAVING FACTOR
	CLL RAL
	TAD OSEGPT	/ADD CURRENT OUT SEGMENT BN
	DCA OSEGPT	/INITIALIZE NEXT WRITE SEGMENT
	JMP PASS20


/ OUTPUT APPROPRIATE LINE TO OUTPUT BUFFER
/ ADDRESS OF LINE BUFFER TO MOVE IN ACC

SRTOUT,	0
	DCA SORTXR	/SAVE THE ADDRESS
	CLA IAC
	TAD SORTXR
	DCA SORTPT	/PTS TO FIRST CHAR OF LINE
SRTOU3,	TAD I SORTXR
	SNA
	JMP SRTOU4	/END OF LINE
	JMS SAVEP2	/MOVE LINE TO OUTPUT BUFFER
	JMP SRTOU3
SRTOU4,	JMS SAVEP2	/END THE LINE WITH ZERO
	DCA I SORTPT	/NEED A NEW LINE
	JMP I SRTOUT

/ SUBROUTINE TO SAVE A CHAR IN OUTPUT BUFFER
/ DURING PASSES 2 THRU ...

SAVEP2,	0
	CDF 10
	DCA I SORTX1	/SAVE CHAR IN BUFFER
	CDF 00
	TAD SORTX1
	TAD (-P2OUTE)	/AT END OF BUFFER?
	SZA CLA
	JMP I SAVEP2	/NO, RETURN FOR NEXT CHAR
	JMS WRITE2	/YES, WRITE CURRENT BUFFER LOAD
	TAD [P2OUT-1]
	DCA SORTX1	/RE-INITIALIZE AUTOXR
	JMP I SAVEP2

PAGE
/ DO NUMERIC SORT BY FIELDS (WITH DELIMITER)

COMP1N,	JMS COMG1	/GET FIRST CHARS OF FIELDS
	JMS COMG2	/FOR BOTH LINES

/ DO NUMERIC SORT BY COLUMNS

COMP2N,	JMS GNUM	/GET NO. OUT OF LINE
	  NUM1
	  COMG1
	  COMCH1
	JMS GNUM	/GET NO. OUT OF LINE2
	  NUM2
	  COMG2
	  COMCH2
	STL CLA RAR	/4000 TO ACC
	TAD NUM1	/TRANSLATE 3777 DOWN TO 4000
	DCA NUM1	/TO 7777 DOWN TO 0
	TAD STPTMP	/PUT BACK STRIP FLAG
	DCA STPFLG
	TAD COMP5	/CHECK TO SEE IF A OR D SORT
	TAD (-SPACLA)	/"SPA CLA" FOR ASCENDING SORT
	SZA CLA
	TAD (SZL-SNL) /IF DESCENDING
	TAD (SNL)	/IF ASCENDING
	DCA COMP6	/SAVE FOR COMPARISON
	STL CLA RAR	/4000 TO ACC
	TAD NUM2	/TRANSLATE 3777 DOWN TO 4000
			/TO 7777 DOWN TO 0000
	CIA		/DON'T COMBINE "CLL" WITH "CIA"
	CLL		/BECAUSE 0000 AFTER "CIA" SETS LINK
	TAD NUM1	/COMPARE NUM1 AND NUM2
	SNA CLA
	JMP COMP0	/=, GO RETURN FOR NEXT FIELD
COMP6,	SNL		/OR "SZL" IF DESCENDING
	JMP COMPLT	/NUM1 < NUM2
	JMP COMPGT	/NUM1 > NUM2

NUM1,	0
NUM2,	0

/ SUBROUTINE TO GET A SIGNED NO.
/ ARG1 IS LOCATION TO STORE FINAL NUMBER
/ ARG2 IS ADDRESS OF CHARACTER FETCH ROUTINE
/ ARG3 IS ADDRESS OF CHARACTER TO USE

GNUM,	0
	TAD COMCTR	/LENGTH OF FIELD
	DCA GETNCT	/SAVE IN CASE USING COLUMNS
	TAD I GNUM	/PICK UP ADDRESS OF FINAL NO.
	INC GNUM
	DCA NUMPTR	/AND STORE IT
	TAD I GNUM
	INC GNUM
	DCA GETCPT	/ADDR OF CHAR FETCH ROUTINE
	TAD I GNUM
	INC GNUM
	DCA CHRPTR	/ADDRESS OF CHARACTER
	DCA I NUMPTR	/CLEAR OUT THE NUMBER
	DCA SIGN	/ASSUME + SIGN
	SKP

GETN1,	JMS I GETCPT	/GET NEXT CHAR IN FIELD
	TAD I CHRPTR	/LOAD IT TO ACC
	TAD (-" )
	SNA
	JMP GETN2	/LEADING BLANK, IGNORE THEM
	TAD (" -"+)
	SNA
	JMP GETN3	/+, SET SIGN FOR POSITIVE
	TAD ("+-"-)
	SZA CLA
	JMP GETN5	/MAYBE A DIGIT IF NOT A SIGN
	STA		/-, SET SIGN FOR NEGATIVE
GETN3,	DCA SIGN	/SAVE SIGN
GETN2,	JMS GETENQ	/END OF FIELD?
	JMP GETN1	/NO, GET ANOTHER CHAR

GETN4,	JMS I GETCPT	/FETCH ANOTHER CHAR
GETN5,	TAD I CHRPTR	/GET IT
	TAD (-"9)	/AND CHECK TO SEE IF IT
	SMA SZA		/ IS A LEGAL DIGIT OR NOT
	JMS GETN7
	TAD ("9-"0)
	SPA
	JMP GETN7
	DCA DIGIT	/SAVE LEGAL DIGITS 0-9
	TAD I NUMPTR	/GET THE NUMBER
	CLL RTL		/ NUMBER * 4
	TAD I NUMPTR	/ NUMBER * 5
	CLL RAL		/ NUMBER * 10 (DECIMAL)
	TAD DIGIT	/ADD IN NEW DIGIT
	DCA I NUMPTR	/AND SAVE UPDATED NO.
	JMS GETENQ	/ALL CHARS CHECKED OUT?
	JMP GETN4	/GO GET ANOTHER ONE

GETN8,	ISZ SIGN	/END OF NUMBER, IS SIGN NEG?
	JMP I GNUM	/NO, POSITIVE, RETURN
	TAD I NUMPTR	/NEGATE NO. IF NEGATIVE
	CIA
	DCA I NUMPTR
	JMP I GNUM

	JMS I GETCPT	/FETCH A CHAR
GETN7,	CLA CLL		/IGNORE BAD CHARS
	JMS GETENQ	/TO END OF FIELD
	JMP .-3

GETNCT,	0
NUMPTR,	0
GETCPT,	0
CHRPTR,	0
DIGIT,	0
SIGN,	0

/ SUBROUTINE TO CHECK IF END OF A FIELD
/ FOR THE GNUM ROUTINE

GETENQ,	0
	TAD STRTNF	/FIELDS OR COLUMNS?
	SNA CLA
	JMP GETEN5	/COLUMNS
	TAD I CHRPTR	/FIELDS, GET CURRENT CHAR
	SNA
	JMP GETN8	/END-OF-LINE, ALSO END OF FIELD
	TAD DELIM	/IS IT THE DELIMITER?
	SNA CLA
	JMP GETN8	/YES, ALSO END OF FIELD
	SKP		/NO, RETURN FOR ANOTHER CHAR
GETEN5,	ISZ GETNCT	/COLUMNS, ALL COLS USED?
	JMP I GETENQ	/NO, RETURN FOR ANOTHER CHAR
	JMP GETN8	/YES, END OF NO.

PAGE
/ SUBROUTINE TO GET A CHAR FROM SEGMENT 1
/ RET .+1 IF END OF ILE OR END OF SEGMENT
/ RET .+2 IF GOOD CHAR. WITH CHAR IN ACC.

ICHAR1,	0
	ISZ ICHR1C	/BUFFER EMPTY?
	JMP ICHR15	/NO, GO GET A CHAR

ICHR12,	JMS I INHAND	/YES, READ NEW BUFFER
	  1010		/10 PAGES, FIELD 1
	  P2IN1		/THIS BUFFER ADDRESS
IBLK1,	  0		/BLOCK NUMBER
	HLT
	TAD IBLK1
	TAD [4]
	DCA IBLK1	/INCREMENT BLK NO.
	TAD [-2000]
	DCA ICHR1C	/SET WORD CTR
	TAD (P2IN1-1)
	DCA INXR1	/INITIALIZE INPUT PTR

ICHR15,	CDF 10
	TAD I INXR1
	CDF 00
	DCA CHAR	/SAVE THE CHAR FROM BUFFER
	CLA IAC		/-1 IS END OF SEGMENT
	TAD CHAR
	SZA
	IAC		/-2 IS END-OF-FILE
	SNA CLA
	JMP I ICHAR1	/END OF SEMGNET OR END OF FILE
	TAD CHAR
	INC ICHAR1	/.+2 IF GOOD CHAR
	JMP I ICHAR1	/RET WITH CHAR IN ACC

/ SUBROUTINE TO READ INPUT CHARS FROM SEGMENT 2
/ RET .+1 IF END OF SEGMENT OR END OF FILE
/ RET .+2 IF GOOD CHAR, WITH CHAR IN ACC

ICHAR2,	0
	ISZ ICHR2C	/BUFFER EMPTY?
	JMP ICHR25	/NO, GO GET CHAR

ICHR22,	JMS I INHAND	/YES, READ NEXT BUFFER LOAD
	  1010		/10 PAGES, FIELD 1
	  P2IN2		/INTO THIS BUFFER
IBLK2,	  0		/FROM THIS BLOCK NUMBER
	HLT
	TAD IBLK2
	TAD [4]
	DCA IBLK2	/INCREMENT BLOCK NUMBER
	TAD [-2000]
	DCA ICHR2C	/REINITIALIZE WORD CTR
	TAD (P2IN2-1)
	DCA INXR2	/SET UP PTR TO BUFFER

ICHR25,	CDF 10
	TAD I INXR2
	CDF 00
	DCA CHAR	/SAVE INPUT CHAR
	CLA IAC		/-1 IS END OF SEGMENT
	TAD CHAR
	SZA
	IAC		/-2 IS END OF FILE
	SNA CLA
	JMP I ICHAR2	/.+1 IF END
	TAD CHAR
	INC ICHAR2	/.+2 IS GOOD CHAR
	JMP I ICHAR2	/RET WITH CHAR IN ACC

/ INPUT CHAR ROUTINE FOR FINAL PASS
/ RET .+1 IF END OF FILE
/ RET .+2 IF GOOD CHAR, CHAR IN ACC

FICHAR,	0
	ISZ FCHRCT	/IS BUFFER EMPTY?
	JMP FCHR15	/NO, GO GET CHAR

	JMS I INHAND	/YES, READ IN NEW BUFFERLOAD
	  2010		/20 PAGES, FLD 1
	  P3IBUF	/BUFFER LOCATION IN FIELD 1
FIBLK,	  0		/BLOCK NUM
	HLT
	TAD FIBLK
	TAD [10]
	DCA FIBLK	/INCREMENT BLK NO.
	TAD [-4000]
	DCA FCHRCT	/RESET CHAR CTR
	TAD (P3IBUF-1)
	DCA INXR1	/END RESET BUFFER PTR

FCHR15,	CDF 10
	TAD I INXR1
	CDF 00
	DCA CHAR	/SAVE THE INPUT CHAR
	CLA IAC		/-1 IS END OF SEGMENT
	TAD CHAR
	SZA
	IAC		/-2 IS END OF FILE
	SNA CLA
	JMP I FICHAR	/RET .+1 IF EITHER
	TAD CHAR
	INC FICHAR	/RET .+2 IF GOOD CHAR
	JMP I FICHAR	/RETURNS WITH GOOD CHAR IN ACC

/ SUBROUTINE TO SPREAD THE OUTPUT BUFFER APART
/ IN ORDER TO MAKE ROOM FOR NEW LINE

SPREAD,	0
	TAD SORTXR
	DCA SPRPT1	/STARTING PTR FOR MOVE
	TAD NCHAR	/LENGTH OF LINE TO BE INSERTED
	TAD SORTXR
	DCA SORTXR	/END PTR FOR MOVE
	TAD SORTXR
	DCA SPRPT2	/DITTO FOR COMPARISON
	CDF 10
SPRED1,	TAD I SPRPT1	/MOVE A CHAR
	DCA I SPRPT2
	STA
	TAD SPRPT1
	DCA SPRPT1	/DECREMENT PTRS
	STA
	TAD SPRPT2
	DCA SPRPT2
	TAD SPRPT1	/ARE WE DONE MOVING?
	CIA
	TAD SORTX1
	SZA CLA
	JMP SPRED1	/NO, CONTINUE MOVEING
	CDF 00		/YES, BACK TO THIS FIELD
	JMP I SPREAD	/RETURN TO CALLER

/ SUBROUTINE TO CHECK COMMAND LINE CHAR FOR A COMMA
/ RETURN .+1 IF COMMA, .+2 IF NOT

COMMAQ,	0
	TAD STRTCH	/GET THE CHAR
	TAD (-",)
	SZA CLA
	INC COMMAQ	/.+2 IF NOT COMMA
	JMP I COMMAQ	/.+1 IF COMMA

PAGE
/ THE FINAL PASS OVER THE SORTED FILE
/ CONVERT FROM SORT FILE FORMAT TO OS/8 3-2 FORMAT

FINALP,	7600
	TAD [-4]
	DCA FCHRCT	/PREPARE TO MOVE FILE NAME DOWN HERE
	TAD (OUFILE-1)	/ADDRESS TO MOVE IT
	DCA SORTX1
	TAD [7600]
	DCA SORTX2
FINAL7,	CDF 10		/MOVE FROM FIELD 1
	TAD I SORTX2
	CDF 00
	DCA I SORTX1	/MOVE IT TO CURRENT FIELD
	ISZ FCHRCT
	JMP FINAL7
	TAD SBLK1
	DCA FIBLK	/INITIALIZE INPUT BLK NO.
	STA
	DCA FCHRCT	/AND CTR
	JMS OOPEN	/OPEN THE OS/8 OUTPUT FILE
	JMS PUTUSR	/RELEASE USR FROM CORE

FINAL1,	JMS FICHAR	/GET AN INPUT CHAR
	JMP FINAL5	/END OF FILE
	DCA FCHAR
	TAD FCHAR
	SPA SNA CLA
	JMP FINAL3	/END OF LINE
	TAD FCHAR	/REGULAR CHAR
	JMS XXPUT	/OUTPUT THE CHARACTER
	JMP FINAL1

FINAL3,	TAD [215]	/END OF LINE
	JMS XXPUT	/GIVE CR/LF COMBINATION
	TAD [212]
	JMS XXPUT
	TAD FCHAR	/CHECK FOR RECORD MARK
	SZA CLA
	JMP FINAL1
	TAD RCDMKP	/FETCH RECORD MARK
	SNA
	JMP FINAL1	/NO RECORD MARK.
	JMS XXPUT	/OUTPUT IT
	STA
	DCA FCHAR
	JMP FINAL3	/FOLLOW WITH A CR/LF.

FINAL5,	CLA IAC		/+1 TO ACC
	TAD CHAR	/BETTER BE END-OF-FILE
	SZA CLA
	JMP SRTER4	/ERROR
	JMS OCLOSE	/CLOSE OUT THE GOOD FILE
	JMP I FINALP	/RETURN FROM FINAL PASS

/ CHECK IF OUTPUT BUFFER IS FULL FOR PASS 1 OUTPUT
/ IF IT IS, WRITE OUT WITH END-OF-SEGMENT MARKER

WCHECK,	0
	TAD SORTXR
	CLL
	TAD [-P1OBFE]
	SNL CLA
	JMP I WCHECK	/STILL ROOM IN BUFFER

	STA
	TAD SORTXR
	DCA SORTXR
	STA
	CDF 10
	DCA I SORTXR	/END THE BUFFER
	CDF 00
	TAD SORTXR	/WENT OUT OF BUFFER
	DCA WCHKPT
WCHK3,	TAD WCHKPT	/MOVE BACK ANOTHER LINE
	JMS BACKUP	/BACK UP TO BEGINNING OF LINE
	DCA WCHKPT
	TAD WCHKPT
	CLL
	TAD (-P1OBFE+1)	/ARE WE BACK IN BUFFER YET?
	SZL CLA
	JMP WCHK3	/NO, KEEP BACKING UP
	INC WCHKPT	/PTS TO START OF LINE
	CDF 10
	TAD I WCHKPT	/GET CHAR
	DCA WCHKCH	/AND SAVE IT
	STA		/-1, END OF SEGMENT
	DCA I WCHKPT	/SAVE IT
	CDF 00
	JMS WRITE1	/OUTPUT BUFFER DURING PASS1
	CDF 10
	TAD WCHKCH
	DCA I WCHKPT	/PUT CHAR BACK
	TAD [P1OBUF-1]
	DCA SORTXR	/INITIALIZE XR'S FOR MOVE
	STA
	TAD WCHKPT
	DCA SORTX2
WCHK1,	TAD I SORTX2	/MOVE LINE THAT WOULDN'T FIT
	SPA
	JMP WCHK2
WCHKS,	DCA I SORTXR	/TO START OF OUTPUT BUFFER
	JMP WCHK1
WCHK2,	TAD [-4000]
	SZA CLA
	JMP WCHK4
	STL CLA RAR
	JMP WCHKS
WCHK4,	STA
	TAD SORTXR
	DCA SORTXR
	DCA I SORTXR	/0 TO END THE LINE
	DCA I SORTXR	/0 TO END THE BUFFER, TOO
	CDF 00
	JMP I WCHECK

/ SUBROUTINE TO OUTPUT A BUFFER LOAD DURING PASS 1

WRITE1,	0
	JMS FILCHK	/CK IF FILE TOO BIG

	JMS I OUHAND	/CALL CURRENT OUTPUT HANDLER
	  5410	/WRITE 14 PAGES, FLD 1
	  P1OBUF
W1BLK,	  0		/CURRENT OUTPUT BN
	HLT
	TAD W1BLK
	TAD [6]
	DCA W1BLK	/INCREMENT FOR NEXT WRITE
	INC NWRITE	/WE OUTPUT A SEGMENT
	JMP I WRITE1

PAGE
/ COMPARE LINE AND LINE2
/ OUTPUT THE APPROPRIATE ONE TO OUTPUT FILE

SORT2,	0
	JMS COMPAR	/COMPARE LINE WITH LINE2
	JMP SORT22	/LINE < LINE2
	JMP SORT23	/LINE = LINE2
	TAD [LINE2-1]	/LINE > LINE2, MOVE LINE2 OUT
SORT21,	JMS SRTOUT	/OUTPUT APPROPRIATE LINE
	JMP I SORT2

SORT22,
SORT23,	TAD [LINE-1]	/MOVE LINE OUT
	JMP SORT21


/ WRITE OUT A BUFFER LOAD DURING PASSES 2 THRU ...

WRITE2,	0
	JMS I OUHAND	/CALL OUTPUT HANDLER
	  5410	/WRITE 14 PAGES, FLD 1
	  P2OUT
W2BLK,	  0		/CURRENT OUTPUT BLOCK
	HLT
	TAD W2BLK
	TAD [6]
	DCA W2BLK	/INCREMENT FOR NEXT WRITE
	JMP I WRITE2

/ SUBROUTINE TO REVERSE INPUT AND OUTPUT FILES
/ DURING PASS 2

REVERSE, 0
	TAD INHAND
	DCA REVTMP
	TAD OUHAND
	DCA INHAND
	TAD REVTMP
	DCA OUHAND
	TAD SBLK1
	DCA REVTMP
	TAD SBLK2
	DCA SBLK1
	TAD REVTMP
	DCA SBLK2
	TAD WKDEV1
	DCA REVTMP
	TAD WKDEV2
	DCA WKDEV1
	TAD REVTMP
	DCA WKDEV2
	STA
	DCA REVTMP	/SET FLAG FOR FIRST LINE.
	TAD NWRITE
	CIA
	DCA ISEGCT
	ISZ PASNUM	/COUNT THE PASSES WE DIE LONG BEFORE THIS SKIPS
	JMP I REVERSE

REVTMP,	0

/SUBROUTINE TO FORM NEXT INPUT SEGEMENT NUMBER.

NXISEG,	0
	ISZ REVTMP	/SKIP IF FIRST TIME THROUGH
	SKP
	JMP .+4		/DON'T ADD COUNT THIS TIME
	TAD INTRLV	/GET INTERVAL OF BLOCKING
	TAD ISEGPT	/ADD OLD VALUE FOR BLOCK
	DCA ISEGPT	/SAVE NEW VALUE
	TAD ISEGPT	/RETURN WITH VALUE IN ACC
	JMP I NXISEG	/RETURN

/ ERROR MESSAGES FOR SORT

SRTER1,	TYPMESS
	  ERROR1	/WORK DEVICE NOT DIRECTORY ORIENTED
	JMP I [7600

SRTER2,	TYPMESS
	  ERROR2	/NO ROOM FOR WORK FILE
	JMP I [7600

SRTER4,	TYPMESS
	  ERROR4	/FATAL SORT PROGRAM ERROR
	JMP I [7600

/ SUBROUTINE TO SETUP /S OPTION.

COUNTI,	0
	CDF 10
	TAD I (MPARAM+1	/LOOKING FOR /S OPTION
	AND [40		/ "S" BIT TEST
	SZA CLA		/NO /S OPTION
	TAD [7700	/FLAG IS 7700 OR 0
	DCA STPFLG	/SET STIP FLAG
	TAD STPFLG
	CMA		/FLAG IS HELD IN COMPLEMENT FORM
	AND DELIM	/STRIP DELIM IF NECESSARY
	TAD STPFLG	/DELIM IS NEGATIVE
	DCA DELIM	/SAVE STRIPPED DELIM
	TAD I (MPARAM+2
	SPA CLA		/IS /Y SET?
	IAC		/YES
	DCA FFOPTK	/STORE RESULT IN PAGE 0 CONSTANT
	CDF 0
	JMP I COUNTI
VMESS,	TEXT	"SORT V"
*.-1			/KILL THE ZERO
		VERS1^100+VERS2
		PATCH^100+00

ILLSYN,	TEXT	\IS\

PAGE
/ THE SORT PARAMETER TABLE

/ 4 WORDS PER ENTRY FOR COLUMN SORT
/	START COLUMN OF FIELD
/	(-) LENGTH OF FIELD
/	0 = CHAR, 7777 = NUMERIC SORT
/	0 = ASCENDING, 7777 = DESCENDING SORT

/ 3 WORDS PER ENTRY FOR DELIMITER SORT
/	FIELD NUMBER
/	0 = CHAR, 7777 = NUMERIC SORT
/	0 = ASCENDING, 7777 = DESCENDING SORT

SORTAB,	-1		/FIRST COLUMN
	-120		/LENGTH OF FIELD ASSUME 80
	0		/CHAR SORT
	0		/ASCENDING

	0		/END OF SORT FIELDS

PAGE		/128 LOCATIONS FOR SORT TABLE

FILCHK,	0		/CHECK FOR BUFF OVERFLOW ROUTINE
	CLA CLL
	TAD FILCNT	/GET CURRENT OUTPUT LENGTH
	TAD (6		/WE WANT TO WRITE 6 BLKS
	DCA FILCNT
	TAD FILCNT
	TAD LENGTH
	SNL CLA 	/IS BUFF FULL?
	JMP I FILCHK	/NO, LETS WRITE IT
	TYPMESS		/YES, TYPE FATAL ERROR MSG!
	  ERRFI		/INPUT EXCEEDED WORKING BUFF
	JMP I [7600	/RETURN TO MONITOR

TESTC,	0		/ENTER WITH CHAR IN ACC,EXIT +1 FOR CONTROL
	SNA		/.+2 FOR TAB OR PRINTING CHAR.
	JMP TESTE	/GET OUT IF ACC=0.
	TAD (-240
	SMA		/SKIP IF CONTROL
	JMP TESTE		/NOT A CONTROL
	TAD (240-211	/TEST FOR TAB.
	SNA		/SKIP IF NOT TAB.
TESTE,	ISZ TESTC	/IF NOT A CONTROL
	CLA
	JMP I TESTC	/RETURN

CONTRL,	TAD I [LINE	/GET CONTROL-CHAR
	AND (37		/MASK OFF PARITY.
	CIA		/MAKE A COUNT CONTROL OUT OF IT
	DCA TESTCC	/SAVE FOR COUNTER.
	CLL STL		/SET LINK TO 1
	RAR
	SNA
	RAR		/ONLY IF ACC=0
	ISZ TESTCC	/DONE?
	JMP .-4		/NO TRY AGAIN
	DCA TESTCC	/STORE AS MASK BIT.
	TAD I [LINE	/GET CONTROL-CHAR AGAIN.
	TAD (-214
	CDF 10
	SPA CLA		/WAS IT AFTER LETTER L.
	JMP .+3		/NO.
	TAD 7644	/YES.
	SKP
	TAD 7643	/GET C.D. SWITCH OPTION WORD.
	CDF
	AND TESTCC	/COMBINE WITH TEST BIT.
	SNA CLA		/SKIP IF FLAG MATCHES.
	JMP .+3
	TAD [LINE-1	/MATCHES SO SET-UP NEW SORT TABLE.
	JMS INIT	/SET UP NEW CONTROL TABLE FROM FILE.
	TAD I [LINE
	TAD (-214
	SPA CLA		/TEST TO SEE IF WE SHOULD PASS LINE ON TO OUTPUT.
	JMP ISORT2	/YES SAVE LINE.
	JMP P1GO	/NO. FORGET LINE.
TESTCC,	0

/CONTINUATION OF PASS 2 COMPARES TO MAKE ROOM FOR BASIC STUFF

COMP18,	DCA COMPTM	/SAVE UNEQUAL COMPARE
	TAD STPFLG	/FLAG IS ZERO IF NOT STRIPPING
	SZA CLA		/STRIPPING?
	JMP COMPBA	/YES, DO IT BASIC STYLE
			 /NO, JUST DO IT NATURALLY
	TAD COMCH1	/IS FIELD IN LINE ENDED?
	TAD DELIM
	SNA CLA
	JMP COMPGQ	/YES, LINE < LINE2 IF ASCENDING
	TAD COMCH2	/NO, IS FIELD IN LINE2 ENDED?
	TAD DELIM
	SNA CLA
	JMP COMP5	/YES, LINE > LINE2
COMPB4,	TAD COMPTM	/NO, JUST CHECK CHAR DIFFERENCE NOW
	JMP COMP5
COMPGQ,	STA
	JMP COMP5	/GREATER IF ASCENDING

/FOLLOWING CODE CODE IMPLEMENTS BASIC'S SCREWY COMPARES WITH DELIMITERS

COMPBA,	TAD COMCH1	/GET FIRST CHAR
	TAD DELIM	/IS THIS END OF FIELD
	SZA CLA
	JMP COMPB1	/NO, MUST BE OTHER FIELD
	TAD COMCH2	/CHECK CHAR FROM OTHER LINE
	TAD [-40	/AGAINST THE STRIPPED SPACE CHAR
	SZA
	JMP COMPB2	/NOT A SPACE - COULD BE DELIM
			/DECIDE ASCENDING OR DESCENDING
	JMS COMG2	/CHAR WAS A SPACE, GET NEXT
	TAD COMCH2
	TAD [-40	/IS NEXT A SPACE?
	SNA
	JMP .-4		/WAS A SPACE, KEEP LOOKING
COMPB2,	TAD DELIM	/COULD BE THE DELIM
	TAD [40		/RESTORE AND COMPARE TO DELIM
	SNA CLA
	JMP COMPEQ	/THEY WERE EQUAL AFTER ALL
	TAD COMCH2	/RESTORE THE DIFFERENCE
	TAD [-40
	CIA		/REVERSE THE SENSE
	JMP COMP5	/LET MAIN CODE DECIDE
COMPB1,	TAD COMCH2	/THIS ONE MUST BE DELIM
	TAD DELIM
	SZA CLA		/COULD BE JUST A CHAR
	JMP COMPB4	/IT IS JUST A CHAR
	TAD COMCH1	/DELIM, IS OTHER A SPACE?
	TAD [-40
	SZA
	JMP COMPB3	/NO, WHICH WAY?
	JMS COMG1	/IT IS A SPACE, GET NEXT
	TAD COMCH1
	TAD [-40
	SNA
	JMP .-4		/KEEP ON LOOKING
COMPB3,	TAD DELIM	/IT MIGHT BE THE DELIM
	TAD [40		/RESTORE THE CHAR - DELIM
	SNA CLA		/IS IT DELIM
	JMP COMPEQ	/THEY WERE EQUAL
	TAD COMCH1
	TAD [-40	/NOT EQUAL, GET DIFFERENCE
	JMP COMP5	/AND LET MAIN CODE DECIDE

PAGE
/ IOPEN:	INITIALIZE INPUT FILES

IN7400,	7400		/*****MUST BE FIRST LOC OF PAGE*****

IOPEN,	0
	CLA CMA
	DCA INCHCT	/SET INCHCT TO FORCE A READ
	ISZ INEOF	/SET E-O-F FLAG TO FORCE A NEW FILE
	TAD (7617
	DCA INFPTR	/RESET FILE POINTER
	JMP I IOPEN

/ ICHAR:	GET A CHAR FROM INPUT FILES
/		EOF RTN
/		RETURN .+1 WITH CHAR IN ACC

ICHARX,	0
IN7600,	7600
INCHRX,	CDF INFLD
	ISZ INJMP	/BUMP THREE-WAY UNPACK SWITCH
	ISZ INCHCT
INJMPP,	JMP INJMP
	TAD INEOF
	SNA CLA		/DID LAST READ YIELD END-OF-FILE?
	JMP INGBUF	/NO - DO ANOTHER
GETNEW,	JMP INNEWF	/OPEN A NEW INPUT FILE
INGBUF,	TAD INKTR
	CLL
	TAD (INRECS
	SNL
	DCA INKTR	/RESTORE INKTR IF IT HASN'T OVERFLOWED
	SZL		/IS THIS THE LAST READ?
	ISZ INEOF	/YES - SET END-OF-FILE FLAG
	CLL CML CMA RTR	/CONSTRUCT A CTRL WORD FOR THE READ
	RTR		/FROM THE AMOUNT OF THE OVERFLOW
	RTR		/(IF ANY) AND THE STANDARD CTRL WORD
	TAD (INCTL+1
	DCA INCTLW
INCDIF,	CDF CIF 0
	JMS I INHNDA	/CALL THE DEVICE HANDLER
INCTLW,	0
INBUFP,	INBUF
INREC,	0
	JMP INERRX	/INPUT HANDLER ERROR
INBREC,	TAD INREC
	TAD (INRECS
	DCA INREC	/UPDATE THE RECORD NUMBER
	TAD INCTLW
	AND IN7600
	CLL RAL
	TAD INCTLW
	AND IN7600
	CMA
	DCA INCHCT	/COMPUTE THE NEW CHARACTER COUNT
	TAD INJMPP
	DCA INJMP	/RESET THE CHARACTER SWITCH
	TAD INBUFP
	DCA INPTR	/AND THE WORD POINTER
	JMP INCHRX	/GO BACK AND MAKE BELIEVE
			/ THIS NEVER HAPPENED
INERRX,	ISZ INEOF	/EITHER AN END-OF-FILE OR A BADDIE
	SMA CLA		/WHICH TYPE WAS IT?
	JMP INBREC	/END OF FILE - RESUME THY PROCESSING
INERR,	CLA CLL CML RAR	/BADDIE - GIVE ERR RETURN WITH NEG AC
EOFERR,	JMP INRTRN
INJMP,	HLT		/THIS IS THE 3 - WAY CHARACTER SWITCH
	JMP ICHRX1
	JMP ICHRX2
ICHRX3,	TAD INJMPP
	DCA INJMP
	TAD I INPTR
IN200,	AND IN7400
	CLL RTR
	RTR		/COMBINE THE HIGH-ORDER FOUR BITS OF
	TAD INCTLW
	RTR		/THE TWO WORD TO FORM THE 3RD CHAR
	RTR
	ISZ INPTR
	JMP INCOMN
ICHRX2,	TAD I INPTR
	AND IN7400
	DCA INCTLW	/SAVE HI-ORDER BITS FOR THE 3RD CHAR
	ISZ INPTR	/BUMP THE WORD POINTER
ICHRX1,	TAD I INPTR
INCOMN,	AND (177)
	SZA		/NULL CHAR?
	TAD (-177)	/OR RUBOUT CHAR?
	SNA
	JMP INCHRX	/YES, IGNORE THEM
	TAD (200+177)	/NO, MAKE 8-BIT ASCII
	TAD (-232
	SNA		/IS THE CHARACTER A ^Z?
	JMP GETNEW	/YES - GET A NEW FILE
	TAD (232	/RESTORE THE CHARACTER
	ISZ ICHARX	/BUMP RETURN TO NORMAL RETURN
INRTRN,	CDF 00
	JMP I ICHARX	/AND RETURN
			/IOPEN IS UNNECESSARY.

INCHCT,	-1		/INPUT CHARACTER COUNT
INPTR,	0

INNEWF,	TAD (INDEVH+1	/NEW INPUT FILE
	DCA INHNDA	/INITIALIZE HANDLER ADDRESS
	CDF 10
	TAD I INFPTR	/GET NEXT CD INPUT FILE ENTRY
	CDF 00
	SNA		/ANY MORE?
	JMP EOFERR	/NO - OUT OF INPUT
	JMS FETCHH	/FETCH DEVICE HANDLER
INHNDA,	0		/WILL HOLD RETURN ADDR
	CDF 10
	TAD I INFPTR
	AND (7760	/GET LENGTH PART OF WORD
	SZA		/LENGTH OF 0 MEANS LENGTH >=256
	TAD (17		/ADD HIGH-ORDER BITS
	CLL CML RTR
	RTR
	DCA INKTR	/STORE LENGTH OF FILE
	ISZ INFPTR
	TAD I INFPTR
	DCA INREC	/STORE STARTING RECORD NUMBER OF FILE
	ISZ INFPTR
	DCA INEOF	/ZERO END-OF-FILE FLAG
	JMP INGBUF	/GO READ

	INKTR=IOPEN

INFPTR,	0		/INPUT FILE POINTER
INEOF,	0		/INPUT END-OF-FILE INDICATOR

PAGE
/ OOPEN:	SET UP OUTPUT FILE

OOPEN,	0
OU7600,	7600
	TAD OUFILN
	DCA OUBLK
	DCA OUHNDA	/LET HIM ASSIGN SPACE FOR US
	CDF 10
	TAD I OU7600	/GET DEV NUM WORD OF OUTPUT FILE ENTRY
	CDF 00
	AND [17		/STRIP OFF ANY LENGTH INFO
	SNA		/IS THERE AN OUTPUT DEVICE?
	JMP ONOFIL	/NO - INHIBIT OUTPUT
	JMS FETCHH	/FETCH DEVICE HANDLER
OUHNDA,	0		/OUTPUT DEVICE HANDLER ENTRY
OUENTR,	CDF 10
	TAD I OU7600
	CDF 00
	CIF 10
	JMS I [200
	  3		/ENTER OUTPUT FILE
OUBLK,	  OUFILE	/REPLACED WITH STARTING BLOCK
OUELEN,	  0		/REPLACED WITH LENGTH OF HOLE
	JMP OEFAIL	/FAILED - MAYBE WE ASKED TOO MUCH
	DCA OUCCNT
	DCA I (OUTINH	/ZERO OUTPUT INHIBIT FLAG
	JMS I (OUSETP
OORETN,	CDF 00
	JMP I OOPEN
OEFAIL,	CDF 10
	TAD I OU7600
	AND [7760	/GET REQUESTED LENGTH
	SNA CLA		/WAS IT AN INDEFINITE REQUEST
	JMP ONTERR	/YES - CANNOT ENTER THE FILE
	TAD I OU7600
	AND [17		/MAKE THE REQUESTED LENGTH ZERO
	DCA I OU7600
	JMP OUENTR	/TRY, TRY AGAIN
ONTERR,	CLA CLL CML RAR
	JMP XXPUTE	/TAKE THE ERROR RETURN WITH AC<0
ONOFIL,	ISZ I (OUTINH
	JMP XXPUTE	/TAKE THE ERROR RETURN WITH AC=0

OUTDMP,	0
	DCA OUCTLW	/STORE THE CONTROL WORD
	TAD I (OUTINH
	SZA CLA
	JMP OUNOWR
	TAD OUCCNT
	SNA
	ISZ OUCTLW
	TAD OUBLK
	DCA OUREC	/COMPUTE START BN OF THIS TRANSFER
	TAD OUCTLW
	CLL RTL
	RTL
	RTL
	AND [17		/COMPUTE THE NUMBER OF RECORDS
	TAD OUCCNT	/UPDATE NUMBER OF BLOCKS IN THE FILE
	DCA OUCCNT
	TAD OUCCNT
	CLL CML
	TAD OUELEN
	SNL SZA CLA	/DOES LENGTH EXCEED GIVEN LENGTH?
	JMP I OUTDMP	/YES - SIGNAL OUTPUT ERROR
OUCDIF,	CDF CIF 0
	JMS I OUHNDA
OUCTLW,	  0
	  OUBUF
OUREC,	  0
	JMP XXPUTE	/OUTPUT HANDLER ERROR
OUNOWR,	JMP I OUTDMP	/.+1 IF ERROR RTN

/ OCLOSE:	CLOSE THE OUTPUT FILE

OCLOSE,	0
	TAD I (OUTINH
	SZA CLA		/IS OUTPUT INHIBITED?
	JMP OCISZ	/YES - CLOSE IS A NOP
	CDF 10
	TAD I [7600
	JMS I (OTYPE	/FIND OUT WHAT IT'S TYPE IS
	AND [770
	TAD (-PTP	/CHECK FOR PAPER TAPE PUNCH OUTPUT
	SZA CLA		/AND SKIP ^Z OUTPUT IF TRUE
	TAD [232	/OUTPUT A ^Z
	JMS I (OCHARX
	JMS I (OCHARX
FILLLP,	JMS I (OCHARX
	CDF 10
	TAD I [7600	/GET DEVICE AGAIN
	JMS I (OTYPE	/GET TYPE OF OUTPUT DEVICE
	SPA CLA
	TAD [100	/IF ITS A DIRECTORY DEV FORCE A RECORD
	TAD [77		/BOUNDARY - OTHERWISE A HALF-RECORD
	AND I (OUDWCT
	SZA CLA		/UP TO THE BOUNDARY YET?
	JMP FILLLP	/NO - FILL WITH ZEROS
	TAD I (OUDWCT	/GET DOUBLEWORD COUNT LEFT
	TAD (OUCTL&3700
	SNA		/A FULL WRITE LEFT?
	JMP NODUMP	/YES, DON'T DO IT; THE ^Z IS ALREADY OUT
	TAD (4000+OUFLD	/PUT IN THE FIELD BITS AND THE WRITE BIT
	JMS OUTDMP
NODUMP,	JMS GETUSR	/GET USR IN CORE
	CDF 10
	TAD I OU7600	/GET THE DEVICE NUMBER
	CDF 00
	CIF 10
	JMS I [200	/JUST A ONE-SHOT
	  4		/CLOSE THE OUTPUT FILE
OUFILN,	  OUFILE	/POINTER TO THE OUTPUT FILE NAME
OUCCNT,	  0
	JMP XXCLSE	/ERROR WHILE CLOSING THE FILE - BAD!
OCISZ,	CDF 00
OCRET,	JMP I OCLOSE

PAGE
OUSETP,	0		/ROUTINE TO INITIALIZE CHAR POINTERS
	TAD (OUCTL&3700	/GET SIZE OF BUFFER IN DOUBLEWORDS
	CIA		/NEGATE IT (PAL10 BLOWS)
	DCA OUDWCT
	TAD (OUBUF
	DCA OUPTR	/INITIALIZE WORD POINTER
	TAD OUJMPE
	DCA OUJMP	/INITIALIZE THREE-WAY CHARACTER SWITCH
	JMP I OUSETP

/ OCHAR:	OUTPUT A CHAR TO OUTPUT DEVICE

OCHARX,	0
	AND (377
	DCA OUTEMP
	TAD OUTINH
	SZA CLA		/IS THERE AN OUTPUT FILE?
	JMP OUCOMN	/NO - EXIT
OUCHAR,	CDF OUFLD	/SET DATA FIELD TO BUFFER'S FIELD
	ISZ OUJMP	/BUMP THE CHARACTER SWITCH
OUJMP,	HLT		/THREE WAY CHARACTER SWITCH
	JMP OCHRX1
	JMP OCHRX2
OCHRX3,	TAD OUTEMP
	CLL RTL
	RTL
	AND [7400
	TAD I OUPOLD
	DCA I OUPOLD	/UPDATE FIRST WORD OF TWO WITH HIGH
			/ORDER 4 BITS OF THIRD CHAR
	TAD OUTEMP
	CLL RTR
	RTR
	RAR
	AND [7400
	TAD I OUPTR
	DCA I OUPTR	/UPDATE 2ND WORD FROM LOW ORDER 4 BITS
	TAD OUJMPE
	DCA OUJMP	/RESET SWITCH
	ISZ OUPTR
	ISZ OUDWCT	/BUMP DOUBLEWORD COUNTER EVERY 3 CHARS
	JMP OUCOMN
	CDF 00
	TAD (OUCTL	/LOAD CONTROL WORD FOR A FULL WRITE
	JMS I (OUTDMP	/DUMP THE BUFFER
	JMS OUSETP	/RE-INITIALIZE THE POINTERS
	JMP OUCOMN
OCHRX2,	TAD OUPTR
	DCA OUPOLD	/SAVE POINTER TO FIRST WORD OF TWO
	ISZ OUPTR	/BUMP WORD POINTER TO 2ND WORD
OCHRX1,	TAD OUTEMP
	DCA I OUPTR
OUCOMN,	CDF 00
	JMP I OCHARX

OUTEMP,	0
OUPOLD,	0
OUPTR,	0
OUJMPE,	JMP OUJMP
OUDWCT,	0
OUTINH,	0

/ OTYPE:	GET DEVICE TYPE OF OUTPUT DEVICE

OTYPE,	0
	CDF 10
	AND (17
	TAD (DCB-1
	DCA OUTEMP
	TAD I OUTEMP
	CDF 00
	JMP I OTYPE

/ GET USR INTO CORE

GETUSR,	0
	TAD USRSTAT	/IS USR ALREADY IN CORE?
	SNA CLA
	JMP I GETUSR	/YES, JUST RETURN
	CIF 10
	JMS I [7700	/NO, GET USR INTO CORE
	  10
	DCA USRSTAT	/USR NOW IN CORE
	JMP I GETUSR

USRSTAT, 7777		/7777 NOT IN CORE; 0 IN CORE

/ PUT USR BACK OUT OF CORE

FETCHD,			/FETCH HANDLER DEVICE NUMBER
PUTUSR,	0		/SAVES A LOC ON PAGE
	TAD USRSTAT	/IS USR ALREADY OUT?
	SZA CLA
	JMP I PUTUSR	/YES, JUST RETURN
	CIF 10
	JMS I [200	/NO, PUT USR AWAY
	  11
	STA
	DCA USRSTAT	/NOW USR IS NOT IN CORE
	JMP I PUTUSR

/ FETCH DEVICE HANDLER

FETCHH,	0
	DCA FETCHD	/SAVE DEVICE NUM TO FETCH
	JMS GETUSR	/MAKE SURE USR IS IN CORE
	TAD I FETCHH	/GET LOC TO LOAD HANDLER
	SNA
	JMP FETCHQ	/IF ZERO, HELP HIM
FETQR,	DCA FETCHA
	TAD FETCHD	/GET DEVICE TO LOAD
	CIF 10
	JMS I [200
	  1		/FETCH DEVICE HANDLER
FETCHA,	  0		/HANDLER ADDR GOES HERE
	HLT		/HUH!!
	TAD FETCHA
	DCA I FETCHH	/SAVE FOR ROUTINE TO USE
	ISZ FETCHH
	JMP I FETCHH	/RETURN

FETCHQ,	CIF 10
	JMS I [200	/USR IS IN CORE
	  13		/RESET SYSTEM TABLES
	TAD INHAND	/GET ENTRY POINT (AND DELETE TENTS)
	AND [7600	/JUST THE PAGE BITS
	TAD (-SLOT2	/IS IT ABOVE SLOT 2?
	SPA CLA
	TAD [400	/IF NOT GIVE HIM SLOT 2
	TAD (SLOT1+1	/OTHERWISE SLOT 1
	JMP FETQR	/RETURN TO FETCHH

OUFILE,	ZBLOCK	4	/OUTPUT FILENAME


PAGE
/ PUT OR CLOSE ERROR ROUTINE

XXCLSE,
XXPUTE,	SMA CLA		/HARD OR SOFT ERROR?
	TAD (ERR0-ERR2	/SOFT: ERR0
	TAD (ERR2)	/HARD: ERR2
	JMP ERRPRT	/PRINT ERROR MESSAGE

/ OUTPUT NO. OF RUBOUTS OR NULLS IN AC
/ UNLESS OUTPUT IS TO A DIRECTORY DEVICE

XXRUB,	0
	DCA XXXTMP	/SAVE COUNT
	CDF 10
	TAD I [7600	/GET DEVICE NUMBER
	JMS I (OTYPE	/GET TYPE OF OUTPUT DEV
	SPA CLA
	JMP I XXRUB	/DIRECTORY DEVICE - DON'T BOTHER
XXRUBL,	TAD XXPUTC	/GET THE CHAR
	TAD (-214)
	SNA CLA		/IS THE CTRL CHAR A FORM-FEED?
	IAC		/YES - OUTPUT BLANK TAPE INSTEAD
	TAD (377	/OTHERWISE, OUTPUT RUBOUTS
	JMS I (OCHARX	/OUTPUT THEM
	ISZ XXXTMP
	JMP XXRUBL	/LOOP FOR THE REQUIRED COUNT
	JMP I XXRUB

XXXTMP,	0		/USED AS COUNTER AND POINTER

XXXTTY,	0
	TLS
	TSF
	JMP .-1
XXXCLA,	7600		/LOC TO RETURN TO PS/8 SYSTEM
	JMP I XXXTTY	/NOT DEVICE INDEPENDENT - TOUGH!!

/ ERROR MESSAGE PRINTOUT ROUTINE FOR I/O

ERRPRT,	DCA .+2		/SAVE ADDR OF MESSAGE
	TYPMESS
	  0
	JMP I [7600	/FATAL, RETURN TO SYSTEM

/ TYPE A MESSAGE ROUTINE

TYPMSX,	0
	TAD I TYPMSX
	INC TYPMSX
	DCA XXXTMP	/SAVE LOC OF ERROR MESSAGE
ERLP,	TAD I XXXTMP
	RTR
	RTR
	RTR
	JMS ERPCH	/PRINT HIGH-ORDER CHARACTER
	TAD I XXXTMP
	JMS ERPCH	/PRINT LOW-ORDER CHARACTER
	ISZ XXXTMP
	JMP ERLP

ERPCH,	0
	AND (77
	SNA
	JMP ERCRLF	/0 CHARACTER TERMINATES
	TAD (-37
	SNA
	JMP FILENR	/"_" CHARACTER IS SPECIAL
	SPA
	TAD (100
	TAD (237
	JMS XXXTTY	/OUTPUT THE CHAR
	JMP I ERPCH

FILENR,	TAD ("#
	JMS XXXTTY
	TAD INFPTR	/GET PTR TO CURRENT INPUT FILE
	TAD (321	/MAGIC NUMBER
	CLL RAR
	JMP FILENR-2

ERCRLF,	TAD (215
	JMS XXXTTY
	TAD (212
	JMS XXXTTY
	JMP I TYPMSX	/RETURN TO CALLER

/ PUT AS USER SEES IT

XXPUT,	0
	AND (377)	/JUST WANT ASCII CHAR
	DCA XXPUTC	/SAVE OUTPUT CHAR
	TAD XXPUTC
	JMS I (OCHARX	/OUTPUT THE CHAR
	TAD XXPUTC
	TAD (-214	/SPECIAL CHAR CHECKING
	SNA
	JMP XXPFF	/FORM FEED
	IAC		/213
	SNA
	JMP XXPVT	/VERTICAL TAB
	TAD (213-211
	SNA CLA
	JMP XXPHT	/HORIZONTAL TAB
XXPUTR,	JMP I XXPUT	/RETURN O.K.

XXPFF,	TAD (11-5	/FORM FEED, OUTPUT 9 ZEROS
XXPVT,	TAD (5-2	/VERTICAL TAB, OUTPUT 5 RUBOUTS
XXPHT,	TAD (2		/HORIZONTAL TAB, OUTPUT 2 RUBOUTS
	CIA
	JMS XXRUB	/OUTPUT RUBOUTS OR ZEROES
	JMP XXPUTR

XXPUTC,	0		/SAVE CHAR HERE

ERR2,	TEXT	"OE?"

ERR0,	TEXT	"OER"

ERR4,	TEXT	"IE _"

/ ERROR MESSAGES USED BY MAIN SORT PROGRAM

ERROR1,	TEXT	"WD"

ERROR2,	TEXT	"NRW"

ERROR3,	TEXT	"IE 511"

ERROR4,	TEXT	"FE"

ERRFI,	TEXT	"FI"
PAGE
/ INITIALIZE THE SORT PROGRAM
/ READ COMMAND LINE AND GET USER SORT FIELD DEFINITIONS
/ EXAMPLES:

/	.R SORT (5,3,C,A;10,4)
/	.R SORT (5,,,D;10,4,,D)
/	.R SORT (5,3,C,A;10,4) 2
/	.R SORT (5,,,D;10,4,,D) 5#341   <LITTLE A WOULD BE RECORD MARK>
/	.R SORT (=%, 2; 3,,D)
/	.R SORT (=%, 2,N; 1)
/	.R SORT (=%, 2; 3,,D) 3
/	.R SORT (=%, 2,N; 1) 3

INIT,	0
	DCA INXR1	/INITIALIZE FETCHING XR
	TAD (SORTAB-1)
	DCA INXR2	/SOTRE SORT FIELD INFO HERE

STRT1,	TAD I INXR1	/GET CHARS FROM BUFFER
	SNA
	JMP I INIT	/NOTHING ON LINE, ASSUME WHAT WE HAVE
	TAD (-"()
	SZA CLA
	JMP STRT1	/KEEP LOOKING FOR '('
	DCA DELIM
	DCA STRTNF
	JMS STGETC	/GET CHAR AFTER '('
	TAD STRTCH
	TAD (-"#)	/CHECK FOR OCTAL VALUE.
	SZA
	JMP STRT4	/GO CHECK FOR "=".
	TAD (7000
	DCA GETNU3	/SET UP FOR OCTAL CONVERSION.
	JMS GETNUM	/GET OCTAL NUMBER.
	DCA DELIM	/SAVE VALUE
	TAD GETNU4
	DCA GETNU3	/CONVERT BACK TO DECIMAL.
	TAD DELIM
	JMP STRT2
STRT4,	TAD (-"=+"#)
	SZA CLA
	JMP STRT5	/REGULAR SORT FIELD DEFINITIONS
	TAD I INXR1	/GET DELIMITER CHAR
STRT2,	CIA
	DCA DELIM	/AND SAVE IT
	SKP		/SKIP THE FIRST TIME, MAY BE AT COMMA NOW.
	JMS STGETC	/NOW LOOK FOR A COMMA
	JMS COMMAQ
	SKP
	JMP .-3		/NOT YET
	JMS STGETC	/GET CHAR AFTER COMMA

STRT3,	JMS GETNUM	/GET THE FIELD NO.
	JMS STARGS	/SAVE IT, GET 'C' OR 'N', 'A' OR 'D'
	INC STRTNF	/ONE MORE FIELD
	JMS ENDQ	/END OF SPECS?
	JMS STGETC	/NO, GET NEXT CHAR
	JMP STRT3

STRT5,	JMS GETNUM	/REGULAR SORT FIELD SPECS
	CIA
	DCA I INXR2	/SAVE STARTING COLUMN
	JMS COMMAQ
	JMP .+3		/END CHAR WAS COMMA
	CLA IAC		/NOT COMMA, ASSUME 1 FOR NEXT FIELD
	JMP .+3
	JMS STGETC	/GET NEXT CHAR AFTER COMMA
	JMS GETNUM	/GET LENGTH OF FIELD
	SNA
	CLA IAC		/IF ZERO, ASSUME 1
	JMS STARGS	/STORE IT, GET 'C' OR 'N', 'A' OR 'D'
	JMS ENDQ
	JMS STGETC	/GET ANOTHER CHAR
	JMP STRT5	/AND THEN NEXT FIELD SPEC

/ SUBROUTINE TO SAVE THE NO. IN THE TABLE
/ THEN GET THE TYPE OF SORT (CHARACTER OR NUMERIC)
/ AND FINALLY THE ORDER OF THE SORT (ASCENDING OR DESCENDING)

STARGS,	0
	CIA
	DCA I INXR2	/SAVE THE FIELD NO. OR LENGTH OF FLD
	JMS COMMAQ	/ENDING CHAR A COMMA? (SKIP IF NOT)
	JMS GETYPE	/YES, GET TYPE OF SORT
	  "C		/0000 IF CHARACTER
	  "N		/7777 IF NUMERIC
	DCA I INXR2	/ASSUME CHARACTER SORT
	JMS COMMAQ	/SKIP IF NOT COMMA
	JMS GETYPE	/GET THE ORDER
	  "A		/0000 IF ASCENDING
	  "D		/7777 IF DESCENDING
	DCA I INXR2	/OR ASSUME ASCENDING ORDER
	JMP I STARGS

/ CHECK CHAR FOR ENDING CHAR ';' OR ')'
/ RET IF ';', RETURN ALL IF ')'

ENDQ,	0
	TAD STRTCH
	TAD (-";)
	SNA
	JMP I ENDQ	/RETURN TO CALLER IF ';'
	TAD (";-"))
	SZA CLA
	JMP STGETE	/NOT ')', GIVE ERROR
	DCA I INXR2	/END THE SORT TABLE
	JMS GETNR	/GET NO. OF LINES PER RECORD
	TAD NLINES	/LINES PER RECORD
	SNA
	IAC		/USE 1 IF 0 GIVEN
	DCA NLINES	/KEEP GOOD NO.
	TAD (STGERR
	DCA STERR	/RESET-UP INCASE WE COME THROUGH AGAIN.
	JMP I INIT	/AND RETURN TO CALLER


/ SUBROUTINE TO GET A CHARACTER FROM COMMAND LINE
/ ALSO IGNORE SPACES

STGETC,	0
STGET1,	TAD I INXR1	/GET CHAR FROM COMMAND LINE
	SNA
	JMP I STERR	/PREMATURE END-OF-LINE
	TAD [-" ]
	SNA
	JMP STGET1	/IGNORE SPACES
	TAD [" ]
	DCA STRTCH	/REGENERATE CHAR AND SAVE IT
	JMP I STGETC

STRTCH,	0		/SAVE THE CHAR HERE
STERR,	STGERR		/INITIAL ERROR ROUTINE

STGETE,	TYPMESS
	  ILLSYN	/ILLEGAL SYNTAX
	JMP I [7600	/THEN RETURN TO SYSTEM

PAGE
/ SUBROUTINE TO CHECK A CHAR AGAINST 2 ARGS FOLLOWING CALL
/ IF EQUAL TO FIRST CHAR, RETURN WITH CLEAR ACC
/ IF EQUAL TO SECOND CHAR, RETURN WITH 7777 IN ACC

GETYPE,	0
	JMS STGETC	/GET THE CHAR
	JMS COMMAQ	/IS IT COMMA?
	JMP I GETYPE	/YES, RETURN
	TAD STRTCH
	CIA
	TAD I GETYPE	/FIRST CHAR
	INC GETYPE
	SNA CLA
	JMP GETYP2	/0 = MATCH OF FIRST CHAR
	TAD STRTCH	/GET CHAR BACK AGAIN
	CIA
	TAD I GETYPE	/COMPARE AGAINST 2ND CHAR
	INC GETYPE
	SZA CLA
	JMP STGETE	/BAD SYNTAX
	STA		/7777 = MATCH OF SECOND CHAR
GETYP2,	DCA GETYPC
	JMS STGETC	/GET NEXT CHAR
	TAD GETYPC	/AND RETURN WITH 0 OR 7777
	JMP I GETYPE

CNCHR,
GETYPC,	0

/ SUBROUTINE TO GET A CHAR FROM LINE

COMG1,	0
	JMP I .+1
COMG1R,	0
	JMS CNCHK	/IF NONNUMERIC FIELD STRIP IF NEEDED
	DCA COMCH1	/SAVE THE CHAR
	INC COMG1C	/COUNT THE COLUMN
	JMP I COMG1

COMG11,	TAD I COMPT1	/GET A CHAR FROM LINE
	INC COMPT1
	SPA		/SPECIAL END-OF-LINE CHAR?
	JMP COMG17	/YES
	SNA
	JMP COMG15	/NO, REGULAR END OF LINE
	TAD [-211]
	SNA
	JMP COMG16	/TAB, EXPAND TO SPACES
COMG14,	TAD [211]	/REGENERATE CHAR
	JMS COMG1R
	JMP COMG11

COMG15,	TAD STRTNF	/USING DELIMITER?
	SNA CLA
	TAD [" ]	/END OF LINE, KEEP SENDING SPACES
	JMS COMG1R	/YES, EOL = 0000
	JMP COMG15

COMG16,	TAD STRTNF	/USING A DELIMITER?
	SZA CLA
	JMP COMG14	/YES, SEND THE REAL TAB
	TAD [" ]	/EXPAND TAB TO EVERY 8TH COLUMN
	JMS COMG1R
	TAD COMG1C
	AND [7]
	SZA CLA
	JMP COMG16
	JMP COMG11	/THEN GET NEXT CHAR

COMG17,	TAD STRTNF	/DELIMITER CHAR BEING USED?
	SNA CLA
	JMP COMG11	/NO, IGNORE THE "EOL" CHAR
	TAD DELIM	/YES
	CIA
	JMP COMG14+1	/USE THE DELIMITER CHAR FOR "EOL"

/ GET A CHAR FROM LINE 2

COMG2,	0
	JMP I .+1
COMG2R,	0
	JMS CNCHK	/STRIP AFTER CHECKING
	DCA COMCH2	/SAVE THE CHAR
	INC COMG2C	/INCREMENT COLUMN NO.
	JMP I COMG2

COMG21,	TAD I COMPT2	 /GET A CHAR FROM LINE 2
	INC COMPT2
	SPA
	JMP COMG27	/PSEUDO-EOL
	SNA
	JMP COMG25	/END OF LINE
	TAD [-211]
	SNA
	JMP COMG26	/EXPAND TAB TO SPACES
COMG24,	TAD [211]	/REGENERATE CHAR
	JMS COMG2R
	JMP COMG21

COMG25,	TAD STRTNF	/ARE WE USING A DELIMITER?
	SNA CLA
	TAD [" ]	/END OF LINE, KEEP SENDING SPACES
	JMS COMG2R	/USING DELIMITER, SEND 0000
	JMP COMG25

COMG26,	TAD STRTNF	/ARE WE USING A DELIMITER?
	SZA CLA
	JMP COMG24	/YES, SEND A REAL LIVE TAB
	TAD [" ]	/TAB, EXPAND TAB TO SPACES
	JMS COMG2R	/FOR EVERY 8TH COLUMN
	TAD COMG2C
	AND [7]
	SZA CLA
	JMP COMG26
	JMP COMG21	/THEN GET NEXT CHAR

COMG27,	TAD STRTNF	/DELIMITER CHAR BEING USED?
	SNA CLA
	JMP COMG21	/NO, IGNORE THE PSEUDO-EOL
	TAD DELIM	/YES
	CIA
	JMP COMG24+1	/USE DELIM CHAR AS PSEUDO-EOL

CNCHK,	0		/CHECK IF CHARACTER OR NUMERIC
	DCA CNCHR	/SAVE THE CHAR
	TAD COMPCN	/IF NUMERIC DON'T EVER STRIP
	SNA CLA		/0=CHAR, 7777=NUMERIC
	TAD STPFLG	/7700 STRIP, 0 NO STRIPPING
	CMA		/ACC=7777 IF NUM OR NO STRIP
	AND CNCHR	/ACC=0077 IF CHAR STRIPPING
	JMP I CNCHK	/CHAR IS BACK IN ACC

PAGE

/ SUBROUTINE TO CONVERT CHARS TO A NUMBER

GETNUM,	0
	DCA GETNO	/ZAP THE NUMBER
GETNU1,	TAD STRTCH	/GET CURRENT CHAR
	TAD (-"9)
	SMA SZA
	JMP GETNU2	/END OF NUMBER
	TAD ("9-"0)
	SPA
	JMP GETNU2	/DITTO
	DCA GETDIG
	TAD GETNO
	CLL RTL
GETNU3,	TAD GETNO
	CLL RAL		/MULT BY 10
	TAD GETDIG	/ADD IN CURRENT DIGIT
	DCA GETNO	/UPDATE THE NUMBER
	JMS STGETC	/GET NEXT CHAR
	JMP GETNU1

GETNU2,	CLA CLL
	TAD GETNO
	JMP I GETNUM	/RETURN WITH NUMBER IN ACC

GETNU4,	TAD GETNO	/VALUE TO CONVERT BACK TO DECIMAL.

GETNO,	0
GETDIG,	0


/ SUBROUTINE TO GET NO. OF LINES PER RECORD

GETNR,	0
	INC STERR	/IN CASE END OF CMD LINE AFTER ")"
	JMS STGETC	/GET A CHAR AFTER THE ")"
	INC STERR	/WHILE PROCESSING NUMBER
	JMS GETNUM	/GET A NUMBER
	DCA NLINES	/AND SAVE IT
	TAD STRTCH	/IS IT #?
	TAD (-"#	/TEST FOR # SIGN.
	SZA CLA
	JMP I GETNR	/NOT THERE THEN LEAVE.
	JMS STGETC	/NOW SKIP OVER THE # AND ANY SPACES
	TAD (7000	/CONVERT TO OCTAL
	DCA GETNU3
	JMS GETNUM	/GET OCTAL VALUE OF RECORD MARK.
	DCA RCDMKP	/SAVE FOR FINAL PASS.
	TAD RCDMKP
	SZA		/SKIP IF ZERO
	CIA		/MAKE - VALUE
	DCA RCDMK
	TAD GETNU4
	DCA GETNU3	/CONVERT BACK TO DECIMAL.
	JMP I GETNR
	JMP I GETNR	/RETURN

STGERR,	JMP STGETE	/ERROR IN CASE END OF CMD LINE BEFORE ")"
	JMP I GETNR	/ERROR IN CASE OF END OF CMD LINE
	JMP GETNU2	/END OF LINE WHILE PROCESSING NUMBER


MAKEFB,	0	/CLOSES 2ND WORK AND OPENS FIRST.
	TAD FILCNT
	DCA LENGT2
	CIF 10
	JMS I [7700	/RECALL USR.
	10
	TAD WKDEV2
	CIF 10
	JMS I [200
	  4		/CLOSE OUTPUT FILE
MAKEFN,	  WRK2		/PTS TO FILENAME
LENGT2,	  0		/ACTUAL LENGTH
	HLT
	TAD WKDEV1	/DEVICE NO.
	CIF 10
	JMS I [200
	  1		/FETCH DEVICE HANDLER
MAKEHB,	  WKHND1+1
	HLT
	TAD MAKEHB	/MOVE ADDRESS TO INHAND.
	DCA INHAND
	CIF 10
	TAD WKDEV1	/OPEN FIRST WORK FILE.
	JMS I [200
	  3
	  WRK1
FLNG1,	0
	HLT
	CLL CLA
	TAD FLNG1
	TAD FILCNT
	SZL CLA		/SEE IF HOLE IS LARGE ENOUGH.
	JMP SRTER2	/TOO SMALL
	TAD FLNG1-1
	DCA SBLK1
	TAD WKDEV2
	CIF 10
	JMS I [200	/DELETE BOTH WORK FILES.
	  4
	  WRK2
LENGT1,	0
	HLT
	JMP I MAKEFB

	PAGE
/ DEFINE SOME ADDRESSES FOR FIELD 0

	LINE=.	/MAIN LINE BUFFER
	LINE2=LINE+RECSIZ	/RECSIZ CHAR LINE BUFFER
	DOT=LINE2+RECSIZ	/RECSIZ FOR BOTH
	SLOT1=1000	/PUT INTO COMAND LINE BUFFER.
	SLOT2=SLOT1+400	/MUST BE ABOVE SLOT 1 AND 400 EACH
	INHNDL=SLOT2	/INPUT FROM SECOND SLOT
	OUHNDL=SLOT1	/THIS IS IGNORED
	WKHND1=SLOT2	/OVERLAYS INPUT HANDLER AFTER PASS 1
	WKHND2=SLOT1	/LOADED INITIALLY WITH INPUT HANDLER

/HANDLERS ARE LOADED IN THE ORDER:
/          WKHND2 IN SLOT1
/          INPUT IN SLOT2
/          WKHND1 IN SLOT2
/   DELETE UNUSED TEMPORARY WORK FILE AFTER ALL PASS 2'S
/       RESET SYSTEM TABLES AFTER WORK PASSES
/          OUTPUT IN UNUSED SLOT CURRENTLY OCCUPIED BY OUTPUT WORK HANDLER
/          RELOAD REMAINING WORK HANDLER TO DELETE REMAINING WORK TEMP.


/REMEMBER 2 PAGES EACH FOR SLOT 1 AND SLOT2
IFZERO	DOT-7601&4000	< /PRINTX NO ROOM FOR HANDLERS!!
E7600,	ZZZZ
>
/ NOW TO DUMP PAGE 0 LITERALS

	FIELD 1
/ BUFFERS DEFINED FOR VARIOUS PASSES IN FIELD 1

	P1IBUF=2000-RECSIZ	/12000-13777
/P1OBUF MUST END RECSIZ BELOW MONITOR
	P1OBUF=4000-RECSIZ	/14000-16777
	P1OBFE=7000-RECSIZ	/17000

	P2IN1=0000	/10000-11777
	P2IN2=2000	/12000-13777
	P2OUT=4000	/14000-16777
	P2OUTE=6777	/16777

	P3IBUF=0000	/10000-13777
	P3OBUF=4000	/14000-16777

/ SOME PARAMETERS FOR I/O ROUTINES

	INBUF=P1IBUF
	INCTL=1010	/READ 10 PAGES, FLD 1
	OUBUF=P3OBUF
	OUCTL=5410	/WRITE 14 PAGES, FLD 1
	INRECS=INCTL%200
	INDEVH=INHNDL
	OUDEVH=OUHNDL

	INFLD=INCTL&70
	OUFLD=OUCTL&70

	DCB=7760	/DEVICE CONTROL BLOCK TABLE
	MPARAM=7643	/CD PARAMETER AREA
	PTP=20		/INTERNAL TYPE CODE: PAPER TAPE PUNCH

	$ * $ * $ * $