Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-06 - decus/20-158/trees.mac
There are no other files named trees.mac in the archive.
00100	    	TITLE	TREES	TREE-HANDLING PROCEDURES -- VERSION 2 (JUNE 1983)
00200		SUBTTL	DEFINITIONS
00300	
00400	COMMENT \
00500	
00600		These procedures create and process a balanced tree
00700	structure with the following structure for the nodes:
00800	
00900		|--------------------------------------------------|
01000	Word 0	|   Pointer to ASCIZ string in variable part       |
01100		|--------------------------------------------------|
01200	Word 1	|   Ptr. to left subtree | Ptr. to right subtree   |
01300		|--------------------------------------------------|
01400		|   Height-balancing flag	  		   |
01500		|--------------------------------------------------|
01600		|                                                  |
01700		|                                                  |
01800		|     fixed-length section of tree node            |
01900		|		length = n-3 words		   |
02000		|						   |
02100		|					           |
02200		|--------------------------------------------------|
02300	Word n	|     variable-length section of tree node	   |
02400		|   (contains ASCIZ string which represents value) |
02500		|		length = m words		   |
02600		|						   |
02700		|--------------------------------------------------|
02800	
02900			total size of node = n + m words
03000	
03100	Given this structure for tree nodes, a value can be located or
03200	inserted into the tree by the following sequence of code:
03300	
03400		MOVEI	P1,<tree root pointer>	;ADDRESS of pointer to root node
03500		HRL	P1,<size of fixed-length part of node = n>
03600		MOVE	P2,<pointer to ASCIZ string to find or add>
03700		MOVE	P3,<length of test string in words = m>
03800		CALL	GETNOD
03900	
04000		returns +1 always with the following conditions:
04100			P1 contains the size of the fixed-length portion in
04200			   the left half-word and the address of the node
04300			   in the right halfword
04400	
04500			If the node already existed before the call, P1
04600			simply points to it.
04700	
04800			If the node did not already exist before the call,
04900			the node was created from available free memory
05000			(using .JBFF to record its use), the node was
05100			inserted into the tree at the appropriate location,
05200			the fixed portion of the tree node was set to zeros,
05300			and the variable part was set to the ASCIZ string
05400			which represents the value of the node.
05500			The first word of the node points to this ASCIZ string.
05600	
05700			If there was insufficient memory for a new node,
05800			P1 contains 0 on return as a flag of the error condition
05900	
06000		The height-balancing algorithm is taken from Knuth, The Art of
06100	Computer Programming, Vol. 3, "Searching and Sorting", 1972,
06200	pp. 451-463.  Refer to that volume to understand the comments in
06300	the height-balancing section.
06400	
06500		The tree may be processed by the following sequence of code:
06600	
06700		MOVEI	P1,<address of tree root>
06800		MOVE	P2,<address of processing routine>
06900		CALL	DMPTRE
07000	
07100		Note that the processing routine is called by DMPTRE using
07200	a PUSHJ P,<routine> with P1 containing a pointer to the currently
07300	selected node of the tree which is to be processed.  The processing
07400	routine must return P1 with its original contents.
07500	
07600	
07700	
07800				EDIT HISTORY
07900	
08000	[1]	By HDT, June 1983:  Install height-balancing algorithm and
08100		metering counters
08200	[2]	By HDT, July, 1983:  Fix DMPTRE so it returns immediately
08300		if there is no tree at all (fixing bug in earlier version)
08400	
08500	
08600	
08700	\
08800	
08900		ENTRY	GETNOD,DMPTRE,GETBLK
09000		INTERN	.SROTS,.DROTS,.ADJBF	;[1]metering counts in balancing
09100		SALL
09200		SEARCH	MACSYM,MONSYM,CMD
09300		.REQUIRE	SYS:MACREL
09400	
09500	;Accumulator definitions
09600	
09700		T0==0
09800		A==1
09900		B==2
10000		C==3
10100		D==4
10200		Q1==5
10300		Q2==6
10400		Q3==7
10500		P1==10
10600		P2==11
10700		P3==12
10800		P4==13
10900		F==15
11000		L==16
11100		P=17
11200	
11300	;Definition of constants
11400	
11500		.JBFF==121
11600		MAXCOR=777000
11700	
11800	
11900	;Offsets in tree nodes
12000		KEYPTR==0	;OFFSET TO KEY VALUE POINTER
12100		SUBPTR==1	;OFFSET TO SUBTREE POINTER WORD
12200		BALFLG==2	;OFFSET TO BALANCING FLAG VALUE
12300	
12400		SUBTTL	GETNOD - ROUTINE TO FIND OR ADD A NODE
12500	
12600	GETNOD:	SKIPN	(P1)		;IS THERE A TREE?
12700		 JRST	INITRE		;NO - CREATE ONE
12800	
12900	;[1]	Height balancing:  Step A1 of algorithm
13000		HRRZM	P1,HEAD		;SAVE HEAD WORD FOR HEIGHT RECORDING
13100		MOVEI	T0,-1(P1)	;MAKE HEAD WORD APPEAR AS A NODE
13200		HRRZM	T0,TPTR		;T <-- HEAD
13300		HRRZ	T0,(P1)  	;GET RLINK(HEAD)
13400		MOVEM	T0,SPTR		;S <-- RLINK(HEAD)
13500		MOVEM	T0,PPTR		;P <-- RLINK(HEAD)
13600	;[1]	End step A1
13700	
13800		HRR	P1,(P1)		;YES - GET ADDRESS OF FIRST NODE
13900	NODLUP:	MOVE	B,(P1)		;GET POINTER TO ASCIZ VALUE OF NODE
14000		MOVE	A,P2		;GET TEST STRING
14100		STCMP			;COMPARE STRINGS
14200		SKIPN	A		;WERE STRINGS EQUAL?
14300		 RET			;YES - ALL DONE
14400		TXNE	A,FLD(1,SC%LSS)!FLD(1,SC%SUB)		;TEST < BASE ?
14500		 JRST	LHWPRC		;YES - GET LEFT SUBTREE
14600	RHWPRC:	HRRZ	A,1(P1)		;MUST BE TEST > BASE. GET RIGHT SUBTREE
14700		JUMPE	A,CRHW		;IS THERE A RIGHT SUBTREE? IF NOT MAKE ONE
14800	
14900	;[1]	Height balancing:  Step A4 of algorithm A
15000		SKIPN	BALFLG(A)	;Check balance of new node
15100		 JRST	RHW1		;In balance
15200		HRRM	P1,TPTR		;RESET FATHER POINTER
15300		HRRM	A,SPTR		;AND CANDIDATE FOR REBALANCING
15400	;[1]	End step A4
15500	
15600	RHW1:	HRR	P1,A		;GO SEARCH THE RIGHT SUBTREE
15700		JRST	NODLUP
15800	
15900	
16000	LHWPRC:	HLRZ	A,1(P1)		;GET LEFT SUBTREE
16100		JUMPE	A,CLHW		;OR CREATE IT IF NECESSARY
16200	
16300	;[1]	Height balancing:  Step A3 of algorithm A
16400		SKIPN	BALFLG(A)	;Check balance flag of new node
16500		 JRST	LHW1		;In balance -- leave alone
16600		HRRM	P1,TPTR		;RESET FATHER POINTER
16700		HRRM	A,SPTR		;AND CANDIDATE FOR REBALANCING
16800	;[1]	End step A3
16900	
17000	LHW1:	HRR	P1,A		;GO SEARCH  THE LEFT SUBTREE
17100		JRST	NODLUP
17200	
17300	CRHW:	HLRZ	A,P1		;GET SIZE OF FIXED PART
17400		ADDI	A,(P3)		;ADD SIZE OF VARIABLE PART
17500		CALL	GETBLK		;GET MEMORY BLOCK FOR THIS NODE
17600		 JRST	[SETZ P1,	;CAN'T GET MEMORY - GIVE UP WITH FLAG
17700			 RET]
17800		HRRM	A,1(P1)		;STORE LINK POINTER TO NEW NODE
17900		JRST	FILEAF		;GO FILL THE NODE
18000	CLHW:	HLRZ	A,P1		;GET SIZE OF FIXED PART
18100		ADDI	A,(P3)		;ADD SIZE OF VARIABLE PART
18200		CALL	GETBLK		;GET MEMORY BLOCK FOR THIS NODE
18300		 JRST	[SETZ P1,	;CAN'T GET MEMORY - GIVE UP WITH FLAG
18400			 RET]
18500		HRLM	A,1(P1)		;STORE LINK POINTER TO NEW NODE
18600	
18700	FILEAF:	HRR	P1,A		;POINT TO NEW NODE
18800		SETZM	(P1)		;ZERO FIRST WORD
18900		HRLI	A,0(P1)		;CREATE A BLT INDEX TO ZERO BLOCK
19000		HRRI	A,1(P1)		; THIS WILL MOVE 0'S FROM HEADER
19100		HLRZ	B,P1		; TO HEADER+1 AND REPEAT UNTIL THE LAST
19200		ADDI	B,-1(P1)	; WORD OF THE FIXED PART OF THE NODE IS ZEROED
19300		BLT	A,(B)		;ZERO FIXED PART
19400		HRLI	B,(POINT 7,)	;CREATE POINTER TO ASCIZ STRING IN NODE
19500		AOS	B
19600		MOVEM	B,(P1)		;ABD SAVE IN HEADER WORD OF NODE
19700		MOVE	A,P2		;NOW COPY STRING INTO NODE
19800		SETZB	C,D
19900		SIN
20000	
20100	;[1]	Height balancing.
20200	;This section performs the height-balancing.  Refer to the Knuth ref above
20300	;for details.
20400	
20500	ADJBAL:	SKIPN	B,SPTR		;STEP A6 OF ALGORITHM A -- GET POINTER TO
20600		 RET			;CANDIDATE FOR REBALANCING UNLESS NEW TREE
20700		MOVE	B,KEYPTR(B)	;KEY OF CANDIDATE FOR REBALANCING
20800		MOVE	A,P2		;GET KEY OF NODE ADDED
20900		STCMP			;K < K(S)
21000		TXNE	A,FLD(1,SC%LSS)!FLD(1,SC%SUB)
21100		 JRST	BALLFT		;YES -- BALANCE TO LEFT
21200	
21300	BALRGT:	MOVE	A,SPTR		;K > OR = KEY(S);  GET S
21400		HRRZ	C,SUBPTR(A)	;P <-- RLINK(S)
21500		MOVEM	C,RPTR		;R <-- P <-- RLINK(S)
21600		JRST	BALLUP
21700	
21800	BALLFT:	MOVE	A,SPTR		;GET S
21900		HLRZ	C,SUBPTR(A)	;P <-- LLINK(S)
22000		MOVEM	C,RPTR		;R <-- P <-- LLINK(S)
22100	
22200	BALLUP:	CAIN	C,(P1)		;WHILE P#Q DO
22300		 JRST	REBAL		; NOPE -- WE'RE DONE
22400		AOS	.ADJBF		;INC COUNT OF BALANCE FACTOR ADJUSTMENTS
22500		MOVE	A,P2		;GET KEY
22600		MOVE	B,KEYPTR(C)	;KEY(P)
22700		STCMP			;COMPARE
22800		TXNE	A,FLD(1,SC%LSS)!FLD(1,SC%SUB)	;K < KEY(P)?
22900		 JRST	REBLFT		;YES -- REBALANCE TO LEFT
23000	
23100	REBRGT:	MOVEI	A,1		;SET BALANCE FLAG
23200		MOVEM	A,BALFLG(C)	;B(P) <-- +1
23300		HRRZ	C,SUBPTR(C)	;P <-- RLINK(P)
23400		JRST	BALLUP		;ITERATE
23500	
23600	REBLFT:	SETOM	BALFLG(C)	;B(P) <-- -1
23700		HLRZ	C,SUBPTR(C)	;P <-- LLINK(P)
23800		JRST	BALLUP		;ITERATE
23900	
24000	REBAL:	MOVE	A,P2		;STEP A7 OF ALGORITHM A
24100		MOVE	B,SPTR
24200		MOVE	B,KEYPTR(B)	;KEY(S)
24300		MOVEI	D,1		;ASSUME A <-- +1
24400		STCMP
24500		TXNE	A,FLD(1,SC%LSS)!FLD(1,SC%SUB)	;IS K < KEY(S)
24600		 SETO	D,		;YES -- SET A <-- -1
24700		MOVE	B,SPTR
24800		SKIPE	BALFLG(B)	;IS B(S) = 0?
24900		 JRST	CHKBAL		;NO
25000		MOVEM	D,BALFLG(B)	;YES -- SET FLAG AS B(S) <-- A
25100		MOVE	T0,[1,,0]	;INCREMENT HEIGHT COUNTER
25200		ADDM	T0,@HEAD
25300		RET			;AND WE'RE DONE
25400	
25500	CHKBAL:	MOVN	C,D		;-A FOR TESTING
25600		CAME	C,BALFLG(B)	;IF B(S) = -A?
25700		 JRST	CLASRB		;NO -- CLASSIFY REBALANCE TYPE
25800		SETZM	BALFLG(B)	;B(S) <-- 0 (TREE IS MORE BALANCED)
25900		RET			;AND WE'RE DONE
26000	
26100	CLASRB:	CAME	D,BALFLG(B)	;IS B(S) = +A?
26200		 JRST	[SETZM	BALFLG(B)
26300			 TMSG<%TREE: Balance flag B(S) is out of range in step A7
26400	>
26500			 RET]
26600		MOVE	B,RPTR		;GET R
26700		CAMN	D,BALFLG(B)	;B(R) = A?
26800		 JRST	SNGROT		;YES -- DO SINGLE ROTATION
26900		CAMN	C,BALFLG(B)	;B(R) = -A?
27000		 JRST 	DBLROT		;YES -- DO DOUBLE ROTATION
27100		RET			;NO -- MUST BE 0 WHICH IMPLIES LOWER
27200					;SUBTREES ARE BALANCED.  NO ROTS NECESSARY
27300	
27400	SNGROT:	AOS	.SROTS		;COUNT IT
27500		MOVEM	B,PPTR		;P <-- R
27600		MOVE	A,SPTR
27700		JUMPL	D,NEGA		;IS A < 0?
27800	POSA:	HLRZ	T0,SUBPTR(B)	;RLINK(S) <-- LLINK(R)
27900		HRRM	T0,SUBPTR(A)
28000		HRLM	A,SUBPTR(B)	;LLINK(R) <-- S
28100		SETZM	BALFLG(A)	;B(S) <-- 0
28200		SETZM	BALFLG(B)	;B(R) <-- 0
28300		JRST	FINTOU
28400	
28500	NEGA:	HRRZ	T0,SUBPTR(B)	;LLINK(S) <-- RLINK(R)
28600		HRLM	T0,SUBPTR(A)
28700		HRRM	A,SUBPTR(B)	;RLINK(R) <-- S
28800		SETZM	BALFLG(A)	;B(S) <-- 0
28900		SETZM	BALFLG(B)	;B(R) <-- 0
29000		JRST 	FINTOU
29100	
29200	DBLROT:	AOS	.DROTS		;COUNT THE ROTATION
29300		MOVE	A,SPTR		;SET UP S
29400		JUMPL	D,DNEGA		;IF A < 0 GO DO FOR NEGATIVE A
29500	
29600	DPOSA:	HLRZ	C,SUBPTR(B)	;P <-- LLINK(R)
29700		MOVEM	C,PPTR
29800		HRRZ	T0,SUBPTR(C)	;LLINK(R) <-- RLINK(P)
29900		HRLM	T0,SUBPTR(B)
30000		HRRM	B,SUBPTR(C)	;RLINK(P) <-- R
30100		HLRZ	T0,SUBPTR(C)	;RLINK(S) <-- LLINK(P)
30200		HRRM	T0,SUBPTR(A)
30300		HRLM	A,SUBPTR(C)	;LLINK(P) <-- S
30400		JRST	DBLCMN
30500	
30600	DNEGA:	HRRZ	C,SUBPTR(B)	;P <-- RLINK(R)
30700		MOVEM	C,PPTR
30800		HLRZ	T0,SUBPTR(C)	;RLINK(R) <-- LLINK(P)
30900		HRRM	T0,SUBPTR(B)
31000		HRLM	B,SUBPTR(C)	;LLINK(P) <-- R
31100		HRRZ	T0,SUBPTR(C)	;LLINK(S) <-- RLINK(P)
31200		HRLM	T0,SUBPTR(A)
31300		HRRM	A,SUBPTR(C)	;RLINK(P) <-- S
31400	
31500	DBLCMN:	SETZM	BALFLG(A)	;ASSUME B(S) <-- 0
31600		SETZM	BALFLG(B)	;ASSUME B(R) <-- 0
31700		CAMLE	D,BALFLG(C)	;B(P) = A?
31800		 MOVNM	D,BALFLG(A)	;YES -- SET B(S) <-- -A
31900		MOVN	D,D		; (D) = -A NOW
32000		CAMGE	D,BALFLG(C)	;B(P) = -A?
32100		 MOVNM	D,BALFLG(B)	;YES -- SET B(R) <-- +A
32200		SETZM	BALFLG(C)	;B(P) <-- 0
32300	
32400	FINTOU:	MOVE	B,TPTR
32500		MOVE	C,PPTR
32600		HRRZ	A,SPTR
32700		HRRZ	T0,SUBPTR(B)
32800		CAMN	T0,A		;RLINK(T) = S?
32900		 JRST	SRGT		;YES
33000		HRLM	C,SUBPTR(B)	;NO -- SET LLINK(T) <-- P
33100		RET
33200	SRGT:	HRRM	C,SUBPTR(B)	;SET RLINK(T) <-- P
33300		RET
33400	;[1]	End height-balancing steps.
33500	
33600	
33700	
33800	INITRE:	SETZM	SPTR		;FLAG FOR NOT ATTEMPTING TO BALANCE TREE
33900		SOS	P1		;FAKE A TREE NODE POINTER
34000		CALL CRHW		;AND CREATE A RIGHT HALF-WORD POINTER
34100		JUMPE	A,[TMSG <?CAN'T CREATE TREE>
34200			    HALTF
34300			    JRST .-1]
34400		SETZM	.SROTS		;SINGLE ROTATIONS NEEDED TO MAINTAIN BALANCE
34500		SETZM	.DROTS		;DOUBLE ROTATIONS NEEDED TO MAINTAIN BALANCE
34600		SETZM	.ADJBF		;NUMBER OF BALANCE FACTOR ADJUSTMENTS MADE
34700		RET
34800	
34900	
35000	;	CALL	GETBLK		WITH AC A GIVING SIZE OF BLOCK NEEDED
35100	;				RETURNS +1 IF INSUFFICIENT MEMORY
35200	;				(IE, WOULD EXCEED VALUE OF 'MAXCOR')
35300	;				RETURNS + 2 WITH A POINTING TO LOCATION
35400	;					    OF MEMORY BLOCK ASSIGNED
35500	
35600	GETBLK:	ADD	A,.JBFF
35700		CAILE	A,MAXCOR	;TOO MUCH MEMORY?
35800		 RET			;YES - GIVE NON-SKIP RETURN
35900		EXCH	A,.JBFF		;NO - ALLOCATION IS OK.  RECORD IT
36000		AOS	(P)		;DO A SKIP RETURN
36100		RET
36200	
36300		SUBTTL	DMPTRE	ROUTINE TO DUMP A BINARY TREE
36400	
36500	COMMENT \
36600		THIS ROUTINE DOES AN INORDER TRAVERSAL OF A BINARY TREE.
36700		THE PROCESSING OF EACH NODE IS DONE BY A ROUTINE WHICH IS
36800		SUPPLIED AS A PARAMETER IN THE CALL TO THIS ROUTINE.
36900		CALLING SEQUENCE IS:
37000	
37100			MOVE	P1,<TREE ROOT POINTER>
37200			MOVEI	P2,<ADDRESS OF NODE-PROCESSING ROUTINE>
37300			CALL	DMPTRE
37400	
37500		NOTE THAT THE NODE-PROCESSING ROUTINE MUST LEAVE P1 AND P2
37600		INTACT UPON RETURN TO DMPTRE.  THE NODE-PROCESSING ROUTINE
37700		IS CALLED BY A PUSHJ P, CALLING SEQUENCE AND SHOULD DO A
37800		RET (POPJ P,) RETURN.
37900	\
38000	
38100	DMPTRE:	TRNN	P1,777777	;[2] Is there a tree at all?
38200		 RET		;[2] No -- quit now
38300	DMPTR2:	HRLM	P1,(P)		;SAVE POINTER TO NODE
38400		MOVS	P1,1(P1)	;GET LEFT SUBTREE
38500		TRNE	P1,777777	;IS THERE ONE?
38600		 CALL DMPTR2		;YES - SEARCH IT
38700		HLRZ	P1,(P)		;GET POINTER TO CENTRAL NODE AGAIN
38800		CALL	(P2)		;PROCESS THAT NODE
38900		HLRZ	P1,(P)		;GET POINTER TO CENTRAL NODE AGAIN
39000		HRRZ	P1,1(P1)	;GET LEFT SUBTREE
39100		TRNE	P1,777777	;IS THERE ONE?
39200		 CALL	DMPTR2		;YES - SEARCH IT
39300		RET			;AND RETURN TO CALLER
39400	
39500	;[1]	metering counts and pointers for height balancing
39600	.ADJBF:	Z
39700	.DROTS:	Z
39800	.SROTS:	Z
39900	PPTR:	Z
40000	RPTR:	Z
40100	SPTR:	Z
40200	TPTR:	Z
40300	HEAD:	Z
40400	
40500		END