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