File: SORT.02 of Tape: Various/Decus/decus-2
(Source file text)
/SORT OF INVENT 8 / /COPYRIGHT 1972 DIGITAL EQUIPMENT CO / / / / /LETS DEFINE THE PAGE ZERO VARS / *20 SWNO, 0 /NO SWAPS PER PASS STREC, 0 /START REC NO STREC1, 0 /FIRST BUFFER STARTER STREC2, 0 /SECOND BUFFER STARTER HISWL, 0 /HIGHEST SWAP NO THIS PASS LOSWL, 0 /LOWEST SWAP NO THIS PASS RECLN, 0 /RECORD LEGNTH MRECLN, 0 /MINUS REC LN BLKLN, 0 /BLOCK LEGNTH MBLKLN, 0 /MINUS BLK LN RECAD1, 0 /LOWER RECORD ADDRESS RECAD2, 0 /HIGHER REC ADDRESS RECBUF, 0 /NO OF RECS/BUFFER T1, 0 /TEMPORARY T2, 0 T3, 0 T4, 0 RMAX, 0 /HIGHEST SWAPPED SO FAR RMIN, 0 /LOWEST SWAPPED SO FAR LOREC, 0 /LOW RWC ISZ COUNTER HIREC, 0 /HI REC ISZ COUNTER SKPREC, 0 /SKIPS AFTER PASS ALL DONE SCNTR, 0 /SKIP COUNTER HIBOND, 0 /HIGH BOUNBRY DEVENT, 0 /ENTRY TO DEVICE HANDLER MEXTWD, 0 /LOC OF LAST REC IN A DUAL PAGE SAVORG, GOOPEN /STARTING LOCATION IF SAVED STLOC, 0 /STARTING LOC OF COMSWP STRPNT, 0 /BLK NO NOW IN 0-3377 ORGIN, 0 /ORIGIN BLOCK NO ENDREC, 0 /ENDING RECORD MIDREC, 0 /LAST BUBBER THAT WAS IN ORDER CHNSWT, 0 /CHAINING SWITCH=-1:YES CHAIN *200 CLA CLL TLS /LETS CLEAR THE FLAGS KRB CLA CLL TAD (MSG1 /PRINT HEADER JMS I (TMSG TAD (TYP0-1 DCA 11 TAD (LOC0A-1 /SET THE AUTO POINTERS DCA 12 TAD (-20 DCA T1 GETFMT, TAD (MSG2 /PRINT WHAT FORMAT JMS I (TMSG JMS I (TYIN /AND GET A CHARACTER TAD T2 TAD (-"I SNA CLA JMP ISI /ITS AN I FMT TAD T2 TAD (-"F SNA CLA JMP ISF /ITS AN F FMT TAD T2 TAD (-"A SNA CLA JMP ISA /ITS AN A FMT TAD (MSG4 /ISSUE CR/LF ERRCH, JMS I (TMSG TAD (MSG3 /I,A2,A6,OR F ONLY! JMS I (TMSG JMP GETFMT /AND TRY AGAIN ISA, JMS I (TYIN /GET ANOTHER CHAR TAD T2 TAD (-"2 /A 2? SNA CLA JMP ISA2 TAD T2 TAD (-"6 SNA CLA JMP ISA6 /ITS A A6 JMP ERRCH /RATS ISA6, TAD (A3CMP /SET THE LOCATION JMP GETLOC ISA2, TAD (A1CMP JMP GETLOC ISF, TAD (FADCMP JMP GETLOC ISI, TAD (INTCMP GETLOC, DCA I 11 /STORE AWAY THE LOCATION OF THE COMPARISON TAD (MSG4 /ISSUE CR/LF JMS I (TMSG TAD (MSG5 /"START AT WORD NO? JMS I (TMSG JMS I (TYIN /GET A CHAR TAD T2 TAD (-260 /MAKE IT BINARY DCA T2 TAD T2 /AND SAVE IT SPA CLA />=0?? JMP I (ERLOC TAD T2 TAD (-12 SMA CLA /<=9(DECIMAL)?? JMP I (ERLOC TAD T2 DCA T3 /SAVE IT JMS I (TYIN /GET ANOTHER CHAR TAD T2 TAD (-215 /RETURN?? SNA CLA JMP I (ENDLOC /YUP TAD T2 TAD (-260 /MAKE IT BINARY DCA T2 TAD T2 /AND SAVE IT SPA CLA JMP I (ERLOC TAD T2 TAD (-12 SMA CLA JMP I (ERLOC CLA CLL TAD T3 /NOW * BY 10(DEC) RTL /*4 TAD T3 RAL /:2=(4X+X)*2=10 TAD T2 DCA T3 JMS I (TYIN /GET ANOTHER CHAR TAD T2 TAD (-215 /A RETURN?? SNA CLA JMP I (ENDLOC TAD T2 TAD (-260 DCA T2 JMP I (PAGE1 /SKIP TO A NEW PAGE PAGE PAGE1, TAD T2 SPA CLA JMP I (ERLOC TAD T2 TAD (-12 SMA CLA JMP I (ERLOC /STILL BAD CLA CLL TAD T3 RTL TAD T3 RAL TAD T2 DCA T3 /NOW HAVE ALL GOOD NOS ENDLOC, TAD (MSG4 /ISSUE A CR/LF JMS I (TMSG TAD T3 SPA CLA JMP I (ERLOC TAD T3 TAD (-176 / =125(10) SMA CLA JMP I (ERLOC /DIDNT MAKE IT TAD T3 DCA I 12 /AND STORE IT AWAY ISZ 12 YNAGIN, TAD (MSG8 /ALL OK??? JMS I (TMSG JMS I (TYIN /FET A CHAR TAD T2 TAD (-"Y /IS IT A Y??? SNA CLA JMP ALLOK /YUP TAD T2 TAD (-"N SNA CLA JMP NOTOK /WAS AN "N" TAD (MSG7 /Y OR N ONLY JMS I (TMSG JMP YNAGIN NOTOK, CLA CLL CMA RAL /RESET AUTO INDEX TAD 12 DCA 12 CLA CLL CMA TAD 11 DCA 11 JMP I (GETFMT /AND DO IT ALL OVER AGAIN ERLOC, TAD (MSG9 /0 TO 125 PLEASE JMS I (TMSG JMP .-3 /DO NOT PASS GO ALLOK, TAD (MSG4 /ISSUE A CR/LF JMS I (TMSG ISZ T1 /OUT OF SPACE??? SKP JMP GOSORT /YUP TAD (MSG6 /MORE VARS??? JMS I (TMSG MORCHK, JMS I (TYIN /GET A CHAR TAD T2 TAD (-"N SNA JMP ALLDON /THATS ALL FOLKS TAD ("N-"Y SNA CLA JMP I (GETFMT /STILL MORE TAD (MSG7 /Y OR N ONLY JMS I (TMSG JMP MORCHK /AND TRY AGAIN ALLDON, TAD (NOSWP+1 /FORCE NO SWAPPING EXIT DCA I 11 /TO COMPARISON ROUTINE ISZ T1 /MORE LOCATIONS??? JMP ALLDON GOSORT, TAD (MSG4 /ISSUE A CR/LF JMS I (TMSG JMP I (OPFILE PAGE TYOUT, 0 /PRINT A CHAR TSF /FLAG SET??? JMP .-1 TLS /YUP CLA CLL /PRINT IT KSF /KEYBOARD FLAG SET??? JMP I TYOUT /NOPE-GO BACK KRS /READ IT BUT DONT CLEAR FLAG TAD (-203 /^C??? SZA CLA JMP .-4 JMP ABORT /MUST BE KAPUT!!! ERROR, 0 /ERROR PROCESSOR CLA CLL TAD (MSG16 /"ERROR DETECTED" MESSAGE JMS TMSG /AND PUINT IT JMP ABORT /ZAP!!!!!!! TYIN, 0 /GET CHARACTER CLA CLL KSF /KBD FLAG SET??? JMP .-1 KRB /READ IT AND CLEAR THE FLAG DCA T2 TAD T2 /SAVE THE GOODIE JMS TYOUT /ECHO IT TAD T2 TAD (-203 SZA CLA /A ^C??? JMP I TYIN /NOPE! ABORT, CLA CLL /LETS WAIT A WHILE DCA T1 TAD (-20 DCA T2 ISZ T1 JMP .-1 ISZ T2 JMP .-3 CIF CDF 0 JMP I (7600 /BYE NOW TMSG, 0 /PRINT A STRING OF CHARS TERMINATED CMA IAC /BY A ZERO (0) CMA /SUBTRACT 1 FOR AUTO INDEX DCA 10 TAD I 10 SNA JMP I TMSG /END OF MESSAGE JMS TYOUT /PRINT IT JMP .-4 /AND GET ANOTHER CHAR PAGE RWPAR, 1610 /READ 16(8) PAGES INTO FLD 1 RWROT, 0 /READ/WRITE SUBROUTINE SPA CLA /AC=0; USE LOWER BUFFER JMP HIBUF /AC=-1; USE UPPER BUFFER TAD (0 DCA RW2 JMP .+3 HIBUF, TAD (3400 DCA RW2 TAD STREC DCA RW3 RAR /GET THE LINK TAD RWPAR /READ OR WRITE DCA RW1 KSF /CHECK FOR CTL C JMP .+5 /NO TTY FLAG KRB /GET THE CHARACTER TAD (-203 /ADD MINUS CTL C SNA CLA JMP CTLC /ABORT IT CIF CDF 0 /MAKE SURE WE END UP BACK HERE! JMS I DEVENT RW1, 0 /0=R/W PARAMETER RW2, 0 /BUFFER ADDRESS RW3, 0 /BLOCK NOMBER JMP MAYERR /CHECK IF HARD ERROR CLA CLL JMP I RWROT /AND GO BACK MAYERR, SPA CLA /WAS IT A HARD ERROR??? JMS I (ERROR /IT WAS HARD TAD (MSG15 /TYPE A SOFT ERROR MESSAGE JMS I (TMSG /PRINT IT JMS I (TYIN /WAIT FOR A CHAR CLA CLL JMP RW1-1 /AND TRY AGAIN CTLC, TAD (MSG99 /"ABORTED",CR/LF JMS TMSG JMP ABORT PAGE MSG99, 215;212;"A;"B;"O;"R;"T;"E;"D;215;212;0 MSG1, 215;212;"I;"N;"V;"E;"N;"T;"-;"8;" ;"S;"O;"R;"T;"I;"N "G;" ;"P;"R;"O;"G;"R;"A;"M;215;212;"P;"L;"E;"A;"S "E;" ;"I;"N;"P;"U;"T;" ;"S;"O;"R;"T;" ;"K;"E "Y;"S;215;212;0 MSG2, 215;212;"W;"H;"A;"T;" ;"F;"O;"R;"M;"A;"T;"?;" ;0 MSG3, 215;212;"I;",;" ;"A;"2;",;" ;"A;"6;",;" ;"O;"R;" "F;" ;"O;"N;"L;"Y;"!;215;212;0 MSG4, 215;212;0 MSG5, "S;"T;"A;"R;"T;"I;"N;"G;" ;"A;"T;" ;"W;"O;"R;"D;" "N;"O;".;" ;0 MSG6, "M;"O;"R;"E;" ;"V;"A;"R;"S;"?;" ;0 MSG7, 215;212;" ;"Y;" ;"O;"R;" ;"N;" ;"O;"N;"L;"Y;215;212;0 MSG8, 215;212;"A;"L;"L;" ;"O;"K;"?;" ;0 MSG9, 215;212;" ;"0;" ;"T;"O;" ;"1;"2;"5;" ;"P;"L;"E;"A;"S;"E;215;212;0 MSG10, "W;"H;"A;"T;" ;"D;"E;"V;"I;"C;"E;" ;0 MSG11, 215;212;"W;"H;"A;"T;" ;"F;"I;"L;"E;" ;0 MSG12, 215;212;"F;"I;"L;"E;" ;"N;"O;" ;"G;"O;"O;"D;215;212;0 MSG14, 215;212;"D;"E;"V;"I;"C;"E;" ;"N;"O;" ;"G;"O;"O;"D;215;212;0 MSG15, "D;"E;"V;"I;"C;"E;" ;"W;"R;"I;"T;"E " ;"P;"R "O;"T;"E;"C;"T;"E;"D;" ;"O;"R;" ;"U;"N;"A;"V;"A;"I "L;"A;"B;"L;"E;215;212;0 MSG16, 215;212;"E;"R;"R;"O;"R;" ;"D;"E;"T;"E;"C;"T;"E;"D;215;212;0 PAGE MSG17, 215;212;"S;"A;"V;"E;" ;"I;"T;"?;" ;0 OPFILE, TAD (MSG10 /WHAT DEVICE JMS I (TMSG DCA I (DEVIC /MAKE IT RESTARTABLE DCA I (DEVIC+1 DCA T3 /ZERO OLD LOC DCA T1 /AND T1 JMS I (TYIN /GET THE FIRST CHAR TAD T2 TAD (-215 /A RETURN? SNA CLA JMP DEV1 TAD T2 AND (77 CLL RTL /MAKE IT THE LEFT CHAR RTL RTL DCA T3 /SAVE IT JMS I (TYIN /GET ANOTHER TAD T2 TAD (-215 SNA CLA /A RETURN? JMP DEV1 TAD T2 AND (77 TAD T3 DCA T3 JMS I (TYIN /GET THE THIRD TAD T2 TAD (-215 SNA CLA JMP DEV1 TAD T2 AND (77 CLL RTL RTL RTL DCA T1 JMS I (TYIN TAD T2 TAD (-215 SNA CLA JMP DEV2 TAD T2 AND (77 DEV2, TAD T1 DCA I (DEVIC+1 DEV1, TAD T3 DCA I (DEVIC TAD (-3 DCA T1 /NOW GET THE FILE TAD (FILNM-1 DCA 11 /SET UP AUTO INDEX TAD (-2 DCA T3 TAD (MSG11 /WHAT FILE? JMS I (TMSG GETFIL, JMS I (TYIN TAD T2 TAD (-215 /A RETURN? SNA CLA JMP ENDFIL TAD T2 AND (77 ISZ T3 /ODD OR EVEN JMP ODD TAD T4 DCA I 11 /STORE IT AWAY TAD (-2 DCA T3 ISZ T1 JMP GETFIL JMP ENDFUL ODD, CLL RTL RTL RTL DCA T4 JMP GETFIL ENDFIL, ISZ T3 /NAME FILLED YET? JMP ODDX /NOPE TAD T4 DCA I 11 ODDX, ISZ T1 JMP .-2 ENDFUL, TAD (MSG8 /OK??? JMS I (TMSG JMS I (TYIN TAD T2 TAD (-"Y SNA CLA JMP I (CHNQUS /GO OPEN THE FILE -ASK IF TO BE SAVED TAD T2 TAD (-"N SNA CLA JMP OPFILE /GO BACK!!! TAD (MSG7 /Y OR N ONLY JMS I (TMSG JMP ENDFUL PAGE CHNQUS, TAD (CHQUS /ASK IF TO BE CHAINED JMS I (TMSG JMS I (TYIN TAD (MSG4 JMS I (TMSG /ISSUE CR/LF TAD T2 TAD (-"Y SZA CLA JMP OPNQUS GNAME, TAD (-3 DCA T1 TAD (PROGN-1 DCA 11 TAD (-2 DCA T3 TAD (MSGSV JMS I (TMSG GETPRG, JMS I (TYIN TAD T2 TAD (-215 SNA CLA JMP ENDNAM TAD T2 AND (77 ISZ T3 JMP PODD TAD T4 DCA I 11 TAD (-2 DCA T3 ISZ T1 JMP GETPRG JMP ENDPRG PODD, CLL RTL RTL RTL DCA T4 JMP GETPRG ENDNAM, ISZ T3 JMP PODDX TAD T4 DCA I 11 PODDX, ISZ T1 JMP .-2 ENDPRG, TAD (MSG8 JMS I (TMSG /OK??? JMS I (TYIN TAD T2 TAD (-"Y SNA CLA JMP SETUP TAD T2 TAD (-"N SNA CLA JMP CHNQUS TAD (MSG7 JMS I (TMSG JMP ENDPRG PROGN, 0 /PROGRAM NAME 0 0 TEXT 'SV' /ONLY SAVED IMMAGES MSGSV, 215;212;"C;"H;"A;"I;"N;" ;"T;"O;" ;"W;"H;"A;"T;" "P;"R;"O;"G;"R;"A;"M;"?;" ;0 SETUP, CLA CLL CMA DCA CHNSWT /SET THE CHAIN SWITCH OPNQUS, TAD (MSG4 /ISSUE A CR/LF JMS I (TMSG TAD (MSG17 JMS I (TMSG /ASK IF TO BE SAVED JMS I (TYIN /GET A CHAR TAD (MSG4 /ISSUE CR/LF JMS I (TMSG TAD T2 TAD (-"Y SZA CLA JMP I (GOOPEN /DONT SAVE THIS ONE TAD (JMP I SAVORG /PUT A JMP TO GOOPEN IN 201 DCA I (203 JMP I (ABORT /AND GO TO THE MONITOR PAGE GOOPEN, CLA CLL /NOW OPEN THE FILE TAD (3001 /SET THE JOB STATUS TO NOT RESTARTABLE DCA I (7746 /AND DONT WORY ABOUT 00000-01777 TAD (7001 /TWO PAGE 7000-7377!!! DCA ENTRY CDF 0 CIF 10 JMS I (7700 /GO TO USR 1 /FETCH HANDLER DEVIC, 0 0 ENTRY, 0 /PUT 2 PAGE HANDLER IN 7000-7377 JMP I (NODEV /ERROR RETURN CLA CLL TAD (FILNM /GET LOC OF FILE NAME DCA STNO TAD DEVIC+1 CDF 0 CIF 10 JMS I (7700 /GO TO USR 2 /OPEN PERMINENT FILE STNO, 0 /START BLOCK NO,ALSO FILNAM NEGNO, 0 /NEG NO OF BLOCKS JMP I (NOFILE /ERROR RETURN JMP FILEOK /WHEW!!!!!! !!!!!! NOFILE, TAD (MSG12 /FILE NO GOOD JMS I (TMSG JMP I (ABORT /YOU LOOSE NODEV, TAD (MSG14 /BAD DEVICE JMS I (TMSG JMP NOFILE+2 /GO TO ABORT! FILNM, 0 /FIRST TWO CHARS GO HERE 0 /NEXT TWO HERE 0 /LAST TWO HERE 0401 /WITH A "DA" ASSUMED! FILEOK, CLA CLL /NOW LETS LOOK AT THE ARGS! TAD STNO /GET THE START BLOCK NO DCA STREC TAD ENTRY DCA DEVENT CLA CLL JMS I (RWROT /GET THE FIRST BLOCK CLA CLL CMA DCA 10 CDF 10 IAC /SET START TO 1 DCA I 10 /SET FREE TO 0 DCA I 10 CLA CLL CML /REWRITE THE BLOCK CDF 0 JMS I (RWROT CDF 10 TAD I 10 DCA MRECLN /GET M NO W/REC TAD MRECLN CIA DCA RECLN TAD I 10 DCA MBLKLN /GET M NO REC/BLOCK TAD MBLKLN CIA DCA BLKLN ISZ NEGNO /BUMP NEG NO DATA BLKS BY 1 ISZ STREC /BUMP START REC NO TAD MBLKLN /COMPUTE THE LAST ADD IN A DUAL PAGE IAC DCA T1 TAD RECLN ISZ T1 JMP .-2 IAC DCA MEXTWD /AND SAVE IT CLA CLL JMS I (RWROT /AND GET A FULL BUFFER TAD STREC DCA ORGIN /SAVE THE ORIGINAL LOCATION TAD STREC DCA STREC1 TAD STREC1 TAD (7 DCA STREC2 TAD STREC2 DCA STREC CLA CLL CMA JMS I (RWROT /AND GET THE SECOND BUFFER IAC DCA STRPNT JMS SETPNT DCA I (ENDSW /SET THE ENDING SWITCH CLA CLL CMA DCA ENDREC JMP I (FPAS PAGE SETPNT, 0 /SET ALL THE POINTERS TAD (-7 DCA T3 DCA T1 TAD (377 DCA T2 SETMRE, CDF 10 CLA CLL CMA TAD STRPNT DCA I T1 CLA CLL IAC TAD STRPNT DCA I T2 CDF 0 ISZ STRPNT ISZ T3 SKP JMP I SETPNT /ALL DONE TAD T1 TAD (400 DCA T1 TAD T2 TAD (400 DCA T2 JMP SETMRE /AND DO IT AGAIN FPAS, JMS I (SUBUF /MAKE AN UPWARD MASS PASS TAD MIDREC SNA /DID WE SWAP AT ALL? JMP DONE /NOT A SINGLE TIME CMA TAD ORGIN TAD (16 SMA CLA JMP DONE /ALL DONE FOLKS TAD MIDREC TAD (-7 DCA ENDREC TAD ENDREC DCA STREC CLA CLL CMA JMS I (RWROT TAD ENDREC DCA STREC2 TAD ENDREC TAD (-7 DCA STREC1 TAD STREC1 DCA STREC CLA CLL JMS I (RWROT JMS I (SDBUF TAD MIDREC CMA TAD ENDREC TAD (-16 SPA CLA JMP DONE /THATS ALL TAD MIDREC TAD (7 DCA ORGIN TAD ORGIN DCA STREC1 TAD ORGIN DCA STREC CLA CLL JMS I (RWROT TAD STREC1 TAD (7 DCA STREC2 TAD STREC2 DCA STREC CLA CLL CMA JMS I (RWROT JMP FPAS DONE, TAD (MSG20 JMS I (TMSG TAD CHNSWT /CHAIN IT??? SNA CLA JMP I (ABORT JMP I (GOCHAN /SO CHAIN ALREADY MSG20, 215;212;"D;"O;"N;"E;" ;"S;"O;"R;"T;"I;"N;"G 215;212;212;212;212;212;0 PAGE /LETS SORT ONE BUFFER'S WORTH SUBUF, 0 /SORT A FILE UPWARDS SRAGIN, CLA CLL TAD MEXTWD TAD (6400 DCA HISWL /SET HIGHEST SWAP NO IAC DCA LOSWL /SET LOWEST SWAP NO TAD (1 DCA RECAD1 /SET LOWER ADDRESS TAD RECAD1 TAD RECLN DCA RECAD2 /AND THE SECOND POINT X1, DCA SWNO /RESET THE NO OF SWAPS JMS I (PASUP /MAKE AN UPWARD PASS X3, TAD SWNO SNA CLA JMP SRTDON /NO SWAPS SO DONE DCA SWNO /ZERO IT AGAIN TAD STREC2 DCA MIDREC X2, JMS I (PASDWN /AND THEN A DOWNWARD PASS TAD SWNO /DONE YET? SNA CLA JMP SRTDON /YUP JMP X1 /NOPE SRTDON, TAD STREC1 /SET UP THE POINTERS FOR WRITE OPERATION DCA STREC /NOW HAVE A CORRECT SEQUENCE BUFFER CLA STL JMS I (RWROT /WRITE OUT THE LOWER HALF TAD (-1 DCA 10 /SET UP A 2K SHIFT TAD (3377 DCA 11 TAD (-3400 DCA T1 CDF 10 SWMRE, TAD I 11 DCA I 10 ISZ T1 JMP SWMRE /KEEP SHIFTING CDF 0 TAD STREC2 DCA STREC1 TAD STREC2 TAD (7 DCA STREC2 /BUMP POINTERS BY 7! TAD STREC2 DCA STREC TAD ENDSW SNA CLA JMS I (SETPNT /AND SET THE POINTERS TAD ENDREC CLL CML CIA TAD STREC1 SNL CLA JMP ENDAT1 CLA CLL CMA /USE THE UPPER BUFFER JMS I (RWROT /AND GET ANOTHER HALF BUFFER JMP SRAGIN /AND DO IT ALL OVER AGAIN ENDATA, CLA CLL /HIT AN EOF!!! TAD RECAD1 DCA HISWL TAD RECAD1 TAD (-3400 SPA CLA JMP I (SHORT CLA CLL CMA DCA ENDSW DCA ENDREC TAD RECAD2 TAD RECLN /ADD ONE LAST RECORD TO MAKE SURE WE HAVE TAD RECLN /ONE LAST BLOCK, AVOIDING A GETX ERROR DCA RCEND JMP X3 RCEND, 0 /LOCATION OF EOF ENDAT1, TAD ENDSW /RESET THE POINTER SPA CLA JMP EOF TAD STREC1 DCA STREC CLA CLL CML JMS I (RWROT JMP I SUBUF EOF, JMS I (SETPNT /SET THE POINTERS ONE LAST TIME TAD RCEND AND (7400 TAD (-3400 TAD (377 DCA T2 CDF 10 DCA I T2 CDF 0 TAD RCEND TAD (-3400 AND (3400 CLL RAR TAD (210 /AND WRITE FROM FIELD 1 DCA I (RWPAR TAD STREC1 DCA STREC STL CLA JMS I (RWROT /AND WRITE IT TAD (1610 /NOW RESET RWPAR DCA I (RWPAR IAC DCA ENDSW TAD STREC1 DCA ENDREC JMP I SUBUF /NOW GO SORT THE REST ENDSW, 0 /END SWITCH /=1 : UPWARD NORMAL PASS /=0 : FIRST UPWARD PASS /=-1 : HIT AN EOF! PAGE /NOW SORT A MASS STOR DOWNWARDS SDBUF, 0 /DOWN WE GO Y2, CLA CLL TAD MEXTWD TAD (6400 DCA HISWL IAC DCA LOSWL IAC DCA RECAD1 TAD RECAD1 TAD RECLN DCA RECAD2 Y1, DCA SWNO JMS I (PASUP TAD SWNO SNA CLA JMP SRDDN DCA SWNO TAD STREC1 DCA MIDREC JMS I (PASDWN TAD SWNO SNA CLA JMP SRDDN JMP Y1 SRDDN, TAD STREC2 DCA STREC CLA CLL CMA CML JMS I (RWROT CLA CLL CMA DCA 10 TAD (3377 DCA 11 TAD (-3400 DCA T1 CDF 10 MVMORE, TAD I 10 DCA I 11 ISZ T1 JMP MVMORE CDF 0 TAD ORGIN CIA TAD STREC1 SNA CLA JMP ATBOTT TAD STREC1 DCA STREC2 TAD STREC1 TAD (-7 DCA STREC1 TAD STREC1 DCA STREC CLA CLL JMS I (RWROT JMP Y2 ATBOTT, TAD STREC1 DCA STREC CLA CLL CML JMS I (RWROT JMP I SDBUF PAGE /MAKE AN UPWARD PASS PASUP, 0 DCA T1 TAD LOSWL /MAKE SURE WE SKIP WHEN NECESSARY AND (377 TAD RECLN TAD (-400 SMA JMP .+4 ISZ T1 TAD (400 JMP .-6 CLA CLL TAD T1 CMA IAC DCA LOREC TAD LOSWL DCA RECAD1 TAD T1 CIA IAC SMA TAD MBLKLN DCA HIREC TAD T1 CIA IAC SMA CLA JMP NEWURC TAD RECAD1 TAD RECLN DCA RECAD2 JMP UPSWP NEWURC, TAD RECAD1 AND (7400 TAD (401 DCA RECAD2 UPSWP, CDF 10 /TEST FOR AN EOF TAD I RECAD2 CDF 0 TAD (-1747 /IS IT -999(DECIM)??? SMA CLA JMP ENDATA /YUP! JMS I (COMSWP /TEST (AND SWAP IF NECESSARY) ISZ LOREC SKP JMP LOSET TAD RECAD1 TAD RECLN /ADDING REC LEN TO RECAD DCA RECAD1 JMP SUCHK /NOW CKECK SECOND UPWARDS LOSET, TAD RECAD1 /SET TO NEW BIPAGE AND (7400 TAD (401 DCA RECAD1 /SET! TAD MBLKLN DCA LOREC SUCHK, ISZ HIREC SKP JMP SUHI /SET THE UPWARD HI REC TAD RECAD2 TAD RECLN DCA RECAD2 JMP UPCHK SUHI, TAD RECAD2 AND (7400 TAD (401 DCA RECAD2 TAD MBLKLN DCA HIREC UPCHK, CLA CLL TAD RECAD2 /NOW TEST THE HI LIMIT CMA IAC CML TAD HISWL SNL CLA JMP UPSWP DONUP, TAD RMAX DCA HISWL JMP I PASUP /AND GO HOME PAGE /MAKE A DOWNWARD PASS PASDWN, 0 /DOWN WE GO DCA T1 TAD HISWL AND (377 TAD MRECLN SPA JMP .+3 ISZ T1 JMP .-4 CLA CLL TAD T1 CMA NOP DCA LOREC TAD HISWL DCA RECAD2 TAD T1 CIA NOP SNA TAD MBLKLN DCA HIREC TAD T1 CIA SNA CLA JMP NEWDRC TAD RECAD2 TAD MRECLN DCA RECAD1 JMP DONSWP NEWDRC, TAD RECAD2 AND (7400 TAD (-400 TAD MEXTWD DCA RECAD1 CLA CLL TAD RECAD1 CMA IAC TAD LOSWL SZL CLA JMP DONDWN DONSWP, JMS I (COMSWP TAD RECAD1 CMA IAC TAD LOSWL SZL CLA JMP DONDWN /ALL DONE HERE ISZ LOREC SKP JMP XLOSET TAD MRECLN TAD RECAD2 DCA RECAD2 JMP SDCHK XLOSET, TAD RECAD2 AND (7400 TAD MEXTWD TAD (-400 DCA RECAD2 TAD MBLKLN DCA LOREC SDCHK, ISZ HIREC SKP JMP SDHL TAD MRECLN TAD RECAD1 DCA RECAD1 JMP DONSWP SDHL, TAD RECAD1 AND (7400 TAD MEXTWD TAD (-400 DCA RECAD1 TAD MBLKLN DCA HIREC JMP DONSWP DONDWN, TAD RMAX DCA LOSWL JMP I PASDWN /ALL DONE!!! PAGE /COMPARE AND SWAP IF NECESSARY COMSWP, 0 /COMPARE AND SWAP IF NECESSARY JMS I TYP0 LOC0A, 0 JMS I TYP1 LOC1A, 0 JMS I TYP2 LOC2A, 0 JMS I TYP3 LOC3A, 0 JMS I TYP4 LOC4A, 0 JMS I TYP5 LOC5A, 0 JMS I TYP6 LOC6A, 0 JMS I TYP7 LOC7A, 0 JMS I TYP10 LOC10A, 0 JMS I TYP11 LOC11A, 0 JMS I TYP12 LOC12A, 0 JMP I TYP13 LOC13A, 0 JMS I TYP14 LOC14A, 0 JMS I TYP15 LOC15A, 0 JMS I TYP16 LOC16A,0 JMS I TYP17 LOC17A, 0 JMP NOSWP /FELL ALL THE WAY THROUGH SWAP, CLA CLL /SET ISZ LOOP TAD MRECLN DCA SCNTR CLA CLL CMA TAD RECAD1 DCA 10 TAD 10 DCA 12 CLA CLL CMA TAD RECAD2 DCA 11 TAD 11 DCA 13 CDF 10 /SET THE DATA FIELD TO THE DATA SMRE, TAD I 10 /GET THE FIRST WORD DCA 177 TAD I 11 /GET THE SECOND DCA I 12 /AND MOVE IT TAD 177 /AND GET THE OLD WD DCA I 13 /AND STORE IT ISZ SCNTR /DONE YET??? JMP SMRE /NOPE CDF 0 /CHANGE IT BACK TAD RECAD2 /REMEMBER THE HIGHEST LOC SWAPPED DCA RMAX /SAVE THE HIGHEST LOC SWAPPED ISZ SWNO /BUMP SWAP COUNTER NOSWP, SKP /AND GO HOME NOP /A JMS TYPXX MAY END HERE!!! CLA CLL JMP I COMSWP /BYE - BYE / / / TYP0, 0 /ADDRESS OF TYPE OF FIELD FOR TYP1, 0 TYP2, 0 /THE VARIOUS COMPARISONS TYP3, 0 TYP4, 0 TYP5, 0 TYP6, 0 TYP7, 0 TYP10, 0 TYP11, 0 TYP12, 0 TYP13, 0 TYP14, 0 TYP15, 0 TYP16, 0 TYP17, 0 PAGE /COMPARE AN INTEGER FIELD INTCMP, 0 /ENTRY TAD I INTCMP /GET THE REL ADDRESS TAD RECAD1 DCA IT1 /AND SAVE THE LOCATION TAD I INTCMP TAD RECAD2 DCA IT2 /AND SAVE THE SECOND ISZ INTCMP CDF 10 CLA STL RAR TAD I IT1 /GET THE LOW WORD DCA IT /SAVE IT CLA STL RAR TAD I IT2 /AND ADD THE SECOND CDF 0 CLL CML CIA TAD IT SZL /MINUS? JMP I (NOSWP /SO DONT SWAP SZA CLA JMP I (SWAP JMP I INTCMP /EQUAL IT1, 0 /ADDRESS OF LOWER WORD IT2, 0 /ADDRESS OF HIGHER WORD IT, 0 /TEMP PAGE /COMPARE AN ALPHA FIELD A1CMP, 0 /COMPARE ONE ALPHA WORD TAD I A1CMP /GET THE REL ADD TAD RECAD1 DCA AT1 /SAVE ABS ADD TAD I A1CMP TAD RECAD2 DCA AT2 /SAVE ADD OF HIGHER ISZ A1CMP CDF 10 TAD I AT2 /GET THE HIGHER CLL RTR RTR RTR AND (77 TAD (-40 /SPACE IS SPECIAL SZA TAD (40 DCA A1TEMP /SAVE THE HIGH ORDER 6 BITS TAD I AT1 /GET THE LOWER WORD CDF 0 CLL RTR RTR RTR AND (77 TAD (-40 /SPACE IS SPECIAL SZA TAD (40 CMA IAC TAD A1TEMP /GET THE OTHER BITS SPA JMP I (SWAP SZA CLA JMP I (NOSWP /SO SWAP CDF 10 TAD I AT2 /GET THE HI WD AGAIN AND (77 TAD (-40 SZA TAD (40 DCA A1TEMP TAD I AT1 CDF 0 AND (77 TAD (-40 SZA TAD (40 CMA IAC TAD A1TEMP SPA JMP I (SWAP SZA CLA JMP I (NOSWP JMP I A1CMP /EQUAL A1TEMP, 0 /TEMP STOR AT1, 0 /ADD OF LOW AT2, 0 /ADD OF HI A3CMP, 0 /COMPARE THREE ALPHA WDS TAD I A3CMP DCA ARG1 /AND SAVE IT ISZ A3CMP JMS A1CMP /AND GO COMPARE ARG1, 0 /REL ADD TAD ARG1 IAC /BUMP IT BY 1 DCA ARG2 JMS A1CMP ARG2, 0 /REL ADD TAD ARG2 IAC DCA ARG3 JMS A1CMP ARG3, 0 /REL ADD AGAIN JMP I A3CMP /EQUAL PAGE /LETS COMPARE FLOATING POINT FADCMP, 0 /FLOAT COMPARE TAD I FADCMP TAD RECAD1 DCA FT1 TAD I FADCMP TAD RECAD2 DCA FT2 ISZ FADCMP CDF 10 CLA STL RAR /AC=4000 TAD I FT1 DCA FT CLA STL RAR /AC=4000 TAD I FT2 CDF 0 CLL CML CIA TAD FT SZL JMP I (NOSWP SZA CLA JMP I (SWAP ISZ FT1 ISZ FT2 CDF 10 CLA CLL TAD I FT2 CMA IAC TAD I FT1 CDF 0 SNL JMP I (NOSWP SZA CLA JMP I (SWAP CLA CLL CDF 10 ISZ FT1 ISZ FT2 TAD I FT2 CMA IAC TAD I FT1 CDF 0 SNL JMP I (NOSWP SZA CLA JMP I (SWAP JMP I FADCMP FT1, 0 /ADD OF TEMP1 FT2, 0 /ADD OF TEMP2 FT, 0 /TEMPORARY PAGE XTEMP, 0 /TEMPORARY SHORT, TAD RECAD2 DCA XTEMP TAD SWNO SNA CLA JMP DSHORT DCA SWNO JMS I (PASDWN TAD SWNO SNA CLA JMP DSHORT DCA SWNO JMS I (PASUP JMP SHORT+2 DSHORT, TAD XTEMP TAD RECLN /MAKE SURE THAT THIS IS NOT THE TAD RECLN /LAST RECORD IN A BLOCK AND (3400 DCA XTEMP TAD XTEMP TAD (377 DCA T2 CDF 10 DCA I T2 CDF 0 TAD XTEMP CLL RAR TAD (210 DCA I (RWPAR TAD STREC1 DCA STREC STL CLA JMS I (RWROT JMP I (DONE PAGE /NOW LETS CHAIN TO ANOTHER PROGRAM GOCHAN, CLA CLL CDF 0 CIF 10 JMS I (7700 13 /RESET ALL TABLES!!! CLA CLL TAD (7000 DCA ENTRX CDF 0 CIF 10 JMS I (7700 1 /FETCH HANDLER DVCE, TEXT 'SYS' /SYS ONLY ENTRX, 0 /ONE PAGE IN 7000-7177 NOP /WHAT, NO SYS??? CLA CLL TAD (PROGN DCA ENTRXX TAD DVCE+1 CDF 0 CIF 10 JMS I (7700 2 /LOOKUP UP PERM FILE ENTRXX, 0 0 JMP NOPROG /CANT FIND IT TAD ENTRXX DCA BLOCK CLA CLL CDF 0 CIF 10 JMS I (7700 6 /CHAIN TO ANOTHER PROGRAM! BLOCK, 0 /STARTING BLOCK NO NOPROG, TAD (NONAM JMS I (TMSG JMP I (ABORT /CRASH!!!! NONAM, 215;212;"C;"H;"A;"I;"N;" ;"P;"R;"O;"G;"R;"A;"M;" "N;"O;"T;" ;"F;"O;"U;"N;"D;215;212;212;212;212;0 CHQUS, 215;212;"C;"H;"A;"I;"N;" ;"T;"O;" ;"A;"N;"O;"T;"H;"E;"R;" "P;"R;"O;"G;"R;"A;"M;"?;" ;0 $$$$$$$$$$$$$$$$$$$$$$$$$$