/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 /AB 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 $