Google
 

Trailing-Edge - PDP-10 Archives - tops10_tools_bb-fp64b-sb - 10,7/who/whosrt.mac
There are 3 other files named whosrt.mac in the archive. Click here to see a list.
	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