File GSORT.

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

/GENERAL SORT
FILE=XFILES
	OCTAL
START,	PRINT 5	;TEXT '_DEV='
	TYPTEX	;DEV	;4
	PRINT 6	;TEXT ' FILE='
	TYPTEX	;FILEN	;6
	PRINT 7	;TEXT ' EXTN=.'
	TYPTEX	;EXTN	;2
	CLEARW	;COUNT
	LOADIM	;10
	STORE1	;COUNT2
	PRINT 14	;TEXT '_SORT ORDER='
LOOP,	TYPIN 10
	PRINTU	;MASK	;4
	LOADX1	;COUNT
	STORE1	;KEYS
	INCREM	;COUNT
	DECGOZ	;NEXT	;COUNT2
	GOTO	;LOOP
NEXT,	PRINT 4	;TEXT '_OK?'
	YESNO	;OUT
	MOVE	;DEV	;.+3	;6
	OPEN	;DEVICE 0	;FILENA 0	;FILE
	GOIF	;.+2	;OPENER
	LOADIM	;FILE
	GOSUB	;SORT
OUT,	EXIT
OPENER,	PRINT 13	;TEXT '_OPEN ERROR'
	EXIT
COUNT,0
COUNT2,0
DEV,0;0
FILEN,0;0;0
EXTN,0
MASK,	TEXT '        0-'

/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