1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-06 19:11:04 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

218 lines
6.3 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE WHOSRT --SORT ROUTINES
SEARCH WHOMAC
$SETUP (WHOSRT)
SUBTTL .SORT2 - USE QUICKSORT TO SORT TWO WORD PAIRS
;
; SOME NON-STANDARD AC DEFINITIONS
;
I=T3 ;INDEX TO LOW END OF SWAP LIST
J=T4 ;INDEX TO HIGH END OF SWAP LIST
L=P1 ;POINTER TO LEFT END OF LIST TO SORT
R=P2 ;POINTER TO RIGHT END OF LIST TO SORT
X1=P3 ;HIGH ORDER VALUE TO SPLIT WITH
X2=P4 ;LOW ORDER VALUE TO SPLIT WITH
Q==16 ;FORTRAN ARG POINTER
; PURGE T3,T4,P1,P2,P3,P4 ;NOT NEEDED
; .SORT2 - SORT TWO WORD PAIRS INTO ASCENDING ORDER
; INPUT: T1/ AOBJN POINTER TO LIST TO BE SORTED
; MUST BE EVEN NUMBER OF WORDS
; T2/ FLAGS,,SORT CODE
; FLAGS ARE 400000 FOR UNSIGNED SORT
; 200000 FOR DESCENDING SORT
; SORT CODE IS
; 0 NONE
; 1 NONE
; 2 KEY IS 1234
; 3 KEY IS 3124
; 4 KEY IS 4123
; WHERE HALF WORDS ARE NUMBERED 1-4 FOR
; THE TWO WORD PAIR
; CALL: PUSHJ P,.SORT2##
; RETURN: NON-SKIP
; OUTPUT: NONE
; USES: T1-4
;
SUBTTL ENTRY AND INITIALIZATION CODE
ENTRY SORT2,.SORT2
SORT2: SKIPA ;THIS WILL BOMB IN THE HIGH SEG
PUSH P,[[JRA Q,3(Q)]]
HRRZ T1,@(Q) ;GET THE LENGTH OF THE ARG LIST
MOVN T1,T1 ;MAKE IT NEGATIVE
HRLI T1,(T1) ;AND PUT IT IN THE LEFT HALF
HRRI T1,@1(Q) ;PUT ADDRRESS IN RIGHT HALF
MOVE T2,@2(Q)
SUBTTL ENTRANCE AND INITIALIZATION CODE
.SORT2::PUSHJ P,.SAVE4## ;GET SOME ACS
JUMPGE T1,.POPJ## ;RETURN IF LIST EMPTY
MOVEI T3,(T2) ;GET JUST TYPE OF SORT
CAIG T3,1 ;SEE IF ANYTHING TO DO
POPJ P, ;NO--RETURN
DMOVEM T1,USRARG ;SAVE USERS ARGS
HLRE R,T1 ;GET -LENGTH IN R
MOVM R,R ;MAKE +LENGTH
SUBI R,1 ;SUBTRACT ONE, SO POINTING TO LAST PAIR
CAIE R,1 ;SEE IF ONLY 1
TRNN R,1B35 ;ENSURE AN ODD COUNT NOW
POPJ P, ;JUST RETURN
MOVE P1,USRARG ;GET IOWD POINTER
PUSHJ P,@INISRT-2(T2) ;DO INITIAL SETUP
MOVE P1,USRARG ;PICKUP IOWD POINTER AGAIN
MOVE T2,USRARG+1 ;PICKUP USER FLAGS
TLNE T2,200000 ;DESCENDING ORDER?
PUSHJ P,NEGSRT ;YES--FIX UP
MOVE P1,USRARG ;PICKUP IOWD POINTER AGAIN
MOVE T2,USRARG+1 ;PICKUP USER FLAGS
TLNE T2,400000 ;USER WANT UNSIGNED?
PUSHJ P,FLPSRT ;YES--FIX UP
MOVE T1,USRARG ;GET IOWD PNTR
ADDI R,-1(T1) ;ADD IN BASE ADR, GET ADR OF RIGHT END
MOVEI L,(T1) ;GET BASE ADR IN L, ADR OF LEFT END
MOVEM P,SAVPDP ;STORE P FOR TERMINATION CHECK
JRST SOR.02 ;JUMP INTO "SORT THIS L,R PAIR"
SUBTTL SORT A PARTITION
SOR.01: POP P,T1 ;TAKE OFF TOP REQUEST
HRRZI R,(T1) ;EXTRACT RIGHT END ADR
HLRZ L,T1 ;EXTRACT LEFT END ADR
SOR.02: MOVEI I,(L) ;SET UP POINTERS FOR THIS
MOVEI J,(R) ; SCAN AND SWAP SEQUENCE
MOVE X1,(L) ;USE FIRST PAIR FOR SCAN AND SWAP
MOVE X2,1(L) ; SO GET FIRST AND SECOND WORDS
JRST SOR.06 ;AND SKIP TO CHECK RIGHT,SINCE LEFT .EQ.
SOR.03: CAME X1,(I) ;SEE IF HIGH ORDER MATCH
JRST SOR.05 ;NO, USE THAT TO DECIDE
CAMG X2,1(I) ;YES, CHECK NEXT WORD
JRST SOR.06 ;WE FOUND AN I ENTRY LESS THAN X
SOR.04: ADDI I,2 ;MOVE UP TO NEXT SPOT
JRST SOR.03 ;BACK TO FIND A SWAPPABLE ENTRY
SOR.05: CAML X1,(I) ;CHECK FIRST WORD AGAIN
JRST SOR.04 ;NO SWAP, BACK TO INCREMENT AND LOOP
SOR.06: CAME X1,(J) ;NOW SAME PROCEDURE FOR RIGHT END
JRST SOR.08 ;DON'T HAVE TO CHECK X2
CAML X2,1(J) ;CHECK LOW ORDER WORD
JRST SOR.09 ;YES, MAKE A SWAP
SOR.07: SUBI J,2 ;ELSE DECREMENT J
JRST SOR.06 ;AND BACK TO FIND A SWAPPABLE ENTRY
SOR.08: CAMG X1,(J) ;CHECK FIRST ENTRY AGAIN, SINCE .NE.
JRST SOR.07 ;NO SWAP, BACK TO DECREMENT AND LOOP
SOR.09: CAILE I,(J) ;CHECK IF POINTERS HAVE SWAPPED
JRST SOR.10 ;YES, THIS SWAP AND SCAN COMPLETE
DMOVE T1,(I) ;NO, MAKE A SWAP
EXCH T1,(J) ;EXCH EACH WORD
EXCH T2,1(J) ; ...
DMOVEM T1,(I) ;FINISH THE EXCHANGE
ADDI I,2 ;MOVE THE POINTERS
SUBI J,2 ; TOWARD EACH OTHER
CAILE I,(J) ;CHECK IF POINTERS HAVE SWAPPED
JRST SOR.10 ;YES, THIS SWAP AND SCAN COMPLETE
JRST SOR.03 ;AND BACK TO CONTINUE
SUBTTL SELECT NEXT PARTITION FOR SORT
SOR.10: MOVEI T1,(J) ;CALCULATE J-L
SUBI T1,(L) ; ...
MOVEI T2,(R) ;AND CALCULATE R-I
SUBI T2,(I) ; ...
CAML T1,T2 ;SEE WHICH IS LONGER
JRST SOR.11 ;(J-L) .GE. (R-I)
CAIL I,(R) ;IS I .LT. R? (IE, MORE TO SORT?)
JRST SOR.12 ;NO, CHECK IF OTHER SIDE NEEDS
MOVEI T1,(R) ;STACK REQUEST TO SORT THIS
HRLI T1,(I) ;T1/ XWD I,R
PUSH P,T1 ;STICK IT ON THE STACK
SOR.12: MOVEI R,(J) ;AND MOVE DOWN THE R POINTER
JRST SOR.13 ;THEN GO CHECK IF DONE
SOR.11: CAIL L,(J) ;IS L .LT. J?
JRST SOR.14 ;NO, GO MOVE UP THE L POINTER
MOVEI T1,(J) ;YES, STACK REQUEST TO SORT THIS
HRLI T1,(L) ;FROM L TO J
PUSH P,T1 ;STACK IT
SOR.14: MOVEI L,(I) ;MOVE UP L, SINCE ALL BELOW SORTED
SOR.13: CAIGE L,(R) ;ARE WE DONE WITH THIS PARTITION?
JRST SOR.02 ;NO, BACK TO REPEAT THE WHOLE MESS
CAME P,SAVPDP ;YES, IS THE PARTITION THE WHOLE LIST?
JRST SOR.01 ;NO, LOOP TO PICK NEXT REQUEST
MOVE P1,USRARG ;GET IOWD POINTER
MOVE T2,USRARG+1 ;GET SORT TYPE
TLNE T2,400000 ;USER WANT UNSIGNED?
PUSHJ P,FLPSRT ;YES--FIX BACK
MOVE P1,USRARG ;GET IOWD POINTER
MOVE T2,USRARG+1 ;GET SORT TYPE
TLNE T2,200000 ;DESCENDING?
PUSHJ P,NEGSRT ;YES--FIX BACK
MOVE P1,USRARG ;GET IOWD POINTER
MOVE T2,USRARG+1 ;GET SORT TYPE
PUSHJ P,@FINSRT-2(T2) ;FINISH UP
POPJ P, ;AND RETURN
SUBTTL INITIAL/FINAL SORT ARRANGING ROUTINES
INISRT: I1234
I3124
I4123
FINSRT: F1234
F3124
F4123
I1234:
F1234: POPJ P, ;T1/ 1,,2 T2/ 3,,4
I3124: DMOVE T1,(P1) ;T1/ 1,,2 T2/ 3,,4
MOVSS T2 ;T1/ 1,,2 T2/ 4,,3
ROTC T1,-^D18 ;T1/ 3,,1 T2/ 2,,4
DMOVEM T1,(P1) ;STORE
AOBJN P1,.+1
AOBJN P1,I3124 ;AND LOOP FOR ALL
POPJ P,
F3124: DMOVE T1,(P1) ;T1/ 3,,1 T2/ 2,,4
ROTC T1,^D18 ;T1/ 1,,2 T2/ 4,,3
MOVSS T2 ;T1/ 1,,2 T2/ 3,,4
DMOVEM T1,(P1) ;STORE
AOBJN P1,.+1
AOBJN P1,F3124 ;AND LOOP FOR ALL
POPJ P,
I4123: DMOVE T1,(P1) ;T1/ 1,,2 T2/ 3,,4
ROTC T1,-^D18 ;T1/ 4,,1 T2/ 2,,3
DMOVEM T1,(P1) ;STORE
AOBJN P1,.+1
AOBJN P1,I4123 ;AND LOOP FOR ALL
POPJ P,
F4123: DMOVE T1,(P1) ;T1/ 4,,1 T2/ 2,,3
ROTC T1,^D18 ;T1/ 1,,2 T2/ 3,,4
DMOVEM T1,(P1) ;STORE
AOBJN P1,.+1
AOBJN P1,F4123 ;AND LOOP FOR ALL
POPJ P,
FLPSRT: MOVSI T1,(1B0) ;GET THE SIGN BIT
FLPS.1: XORM T1,(P1) ;TOGGLE SIGN BIT
AOBJN P1,.+1
AOBJN P1,FLPS.1 ;AND LOOP FOR ALL
POPJ P,
NEGSRT: SETCMM (P1) ;NEGATE
AOBJN P1,.+1
AOBJN P1,NEGSRT ;AND LOOP FOR ALL
POPJ P,
SUBTTL STORAGE
$LOW
SAVPDP: BLOCK 1
USRARG: BLOCK 2
END