File SORT.

Directory of image this file is from
This file as a plain text file

/RASTYM SORT,
/ ENTER WITH (CHANNEL NO. IN ACC.,MULTI.),(FILE PTR IN ACC.,SINGLE)
OCTAL
IFNDEF WAIT < XFLD=1
		XCDF=10 >
SORT,	0;0
	STORE1	;SP1
IFDEF WAIT < 	CHANNEL	;SP1	;NAMFIL	;GETAIW	> /ADD.INFO.WORDS
IFNDEF WAIT < LOADX1	;SP1
	MOVE-1	;0;NAMFIL	;11	>
	GONEG	;SORT
	CLRWDS	;7;SP1
	MOVE1	;NAMFIL+4	;SORTNB	/FIRST UNUSED BLOCK
	INCREM	;SORTNB
	LOAD1	;NAMFIL+10	/IS THE FILE FULL?
	SIGN1
	NEGATE
	SUBT1	;NAMFIL+3	/NO.OF INDEX BLOCKS
	SUBT1	;SORTNB
	GOIF	;SRTB4	;SRTB4	/YES
	INCREM	;SORTNB
SRTB4,	LOAD	;NAMFIL
	STORE 	;BFIRST	/DEVICE
	LOAD1	;NAMFIL+1	/FIRST BLOCK OF FILE
	ADD1	;NAMFIL+3
	SUBTIM	;1
	STORE1	;BFIRST+1	/FIRST DATA BLOCK
	LOADIM	;400	/256
	DIVID1	;LENREC
	STORE1	;SORTN
	MULT1	;LENREC
	STORE1	;LENGTH
	LOAD1	;LENREC
	STORE1	;SORLEN
	MOVE	;KEYS	;SORKEY	;10
	LOAD1	;SORTN
	MULTIM	;2
	STORE1	;SORTN	/NO. OF RECORDS IN SORT AREA
	LOAD1	;SORTNB
	STORE1	;SORTMB
SRTB20,	LOAD1	;SORTMB
	SHIFTR 1
	STORE1	;SORTMB
	GOIF	;SORT	;.+1
SRTB30,	LOAD1	;SORTNB
	SUBT1	;SORTMB
	STORE1	;SORTKB
	MOVIM	;1;SORTJB
SRTB41,	MOVE1	;SORTJB	;SORTIB
SRTB49,	LOAD1	;SORTIB
	ADD1	;SORTMB
	STORE1	;SORTLB
	GOSUB	;BGETCOM	/GET BLOCKS, SORT, WRITE BACK
	GOIFZO	;SRTB60	;SWITCH
	LOAD1	;SORTIB
	SUBT1	;SORTMB
	STORE1	;SORTIB
	SUBTIM	;1
	GOIF	;SRTB49	;SRTB60
	GOTO	;SRTB49
SRTB60,	LOAD1	;SORTJB
	ADDIM	;1
	STORE1	;SORTJB
	SUBT1	;SORTKB
	GOIF	;SRTB41	;SRTB41
	GOTO	;SRTB20
BGETCOM,	0;0
	LOAD2	;BFIRST
	ADD1	;SORTIB
	READAB
	GONEG	;ERRORT
	LOAD2	;LENGTH
	GETREC	;SORTA
	LOAD2	;BFIRST
	ADD1	;SORTLB
	READAB
	GONEG	;ERRORT
	LOAD2	;LENGTH
	LOADX1	;LENGTH
	GETREC	;SORTA
IFDEF WAIT <	WAIT >
	GOSUB	;CORSORT
	GOIFZO	;BGETCOM	;SWITCH
	LOAD2	;LENGTH
	LOADX1	;LENGTH
	PUTREC	;SORTA
	LOAD2	;BFIRST
	ADD1	;SORTLB
	WRITAB
	GONEG	;ERRORT
	LOAD2	;LENGTH
	PUTREC	;SORTA
	LOAD2	;BFIRST
	ADD1	;SORTIB
	WRITAB
	GONEG	;ERRORT
	GOTO	;BGETCOM
CORSORT,	0;0
	CLEARW	;SWITCH
	LOADIM	;2
	STORE1	;SORTM
	GOPAL XFLD;SORT20
	GOIFZO	;CORSORT	;SWITCH
	LOAD1	;SORTN
	STORE1	;SORTM
	GOPAL XFLD;SORT20
	GOTO	;CORSORT
ERRORT,	PRINT 21	;TEXT '_SORT DISK ERROR_'
	LOADIM	;1
	NEGATE
	GOTO	;SORT

/PAL SUBROUTINE, CORE SORT(INSERT "PAGE" PSEUDO-OP HERE IF "PE" MESSAGES) PAGE SORT20, 0 CDI XCDF SORT21, CLA CLL /*** CIF 0 /*** JMS I (6 /PFAIL CDI XCDF TAD SORTM /M RAR /DIVIDE BY 2 DCA SORTM /M=M/2 TAD SORTM SPA SNA CLA JMP OUT20 /JMP I SORT20 SORT30, TAD SORTM CIA TAD SORTN DCA SORTK /K=N-M CLA CLL IAC DCA SORTJ /J=1 SORT41, CLA CLL TAD SORTJ DCA SORTI /I=J SORT49, CLA CLL TAD SORTI TAD SORTM DCA SORTL /L=I+M DCA SORSW /CLEAR SW JMS SORCOM CLA CLL TAD SORSW SNA JMP SORT60 CLA CLL TAD SORTM CIA TAD SORTI DCA SORTI /I=I-M CLA CLL CMA TAD SORTI SMA /IF I-1<0 JMP SORT49 /NO SORT60, CLA CLL IAC /=1 TAD SORTJ DCA SORTJ /J=J+1 TAD SORTK CIA TAD SORTJ /IF J-K>0 SPA SNA CLA JMP SORT41 JMP SORT21 OUT20, CDF CIF 0 JMP I SORT20 /OFF PAGE LITERALS FIT HERE PAGE SORCOM, 0 CLA CLL CMA TAD SORTI JMS MULLEN /I-1 X LENGTH OF RECORD DCA SXI /START OF RECRD 1 CLA CLL CMA /-1 TAD SORTL JMS MULLEN DCA SXL /ST. OF REC. 2 DCA SX1 /CLEAR SLOOPS, TAD SX1 /KEY COUNT TAD TADKEYS / (TAD KEYS DCA .+1 0 /TAD KEYS INSTR. TAD ADSORTA /ADDRESS OF SORTA DCA SP3 /POINT TO WORD IN REC. TO BE COMPARED TAD SP3 TAD SXI /PLUS REC. 1 DCA SP1 /WORD IN REC 1 TAD SP3 TAD SXL DCA SP2 /WORD IN REC 2 TO BE COMP. /COMPARE KEY WORDS LOGICALLY TAD I SP1 /GET WORD 1 SPA CLA JMP SXGLAM /NEG. TAD I SP2 SPA JMP SXCRES /A<B SXGAB, CIA /NEGATE TAD I SP1 JMP SXCRES /RESULT IN AC. SXGLAM, CLA CLL TAD I SP2 SPA JMP SXGAB / CLA CLL IAC /=1 SXCRES, SPA SNA /RESULT IN AC HERE,SKIP IF A>B JMP SXINC /AROUND SWAP ROUTINE /SWAP TWO RECORDS CLA CLL TAD SXI TAD ADSORTA DCA SP4 /POINT REC. 1 TAD SXL TAD ADSORTA DCA SP5 /REC 2 TAD SORLEN /LENGTH CIA DCA SP3 /COUNT DOWN SWALOP, TAD I SP4 MLD TAD I SP5 DCA I SP4 SWP DCA I SP5 ISZ SP4 ISZ SP5 ISZ SP3 /COUNTER JMP SWALOP ISZ SORSW ISZ SWITCH JMP I SORCOM /OUT /COUNT DOWN KEYS SXINC, SZA /EQUAL COMPARE JMP I SORCOM / NO ISZ SX1 /KEY COUNT + 1 CLA CLL IAC RTL /=4 RAL /=8 CIA /=-8 TAD SX1 SMA CLA JMP I SORCOM /OUT EQUAL COMPARE JMP SLOOPS MULLEN, 0 /MULTIPLY BY LENGTH SPA SNA JMP I MULLEN /EXIT IF ZERO CIA DCA SP3 /COUNTER TAD SORLEN ISZ SP3 JMP .-2 JMP I MULLEN /DATA AREAS----------------- SP1,0 SP2,0 SP3,0 SP4,0 SP5,0 SXI,0 SXL,0 SX1,0 SORSW,0 TADKEYS, TAD SORKEY ADSORTA, SORTA SORLEN,0 SORKEY, ZBLOCK 10 /KEYS SWITCH,0 SORTI,0 SORTJ,0 SORTK,0 SORTL,0 SORTM,0 SORTN,0 SORTNB, 0 SORTIB, 0 SORTMB, 0 SORTLB, 0 SORTJB, 0 SORTKB, 0 LENGTH, 0;0 BFIRST, 0;0;0 KEYS, ZBLOCK 10 NAMFIL, ZBLOCK 11 LENREC=NAMFIL+6 SORTA, ZBLOCK 1000 /2 X 256 /TEMP END $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search