Web pdp-10.trailing-edge.com

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
13100		MOVEI	T0,-1(P1)	;MAKE HEAD WORD APPEAR AS A NODE
13200		HRRZM	T0,TPTR		;T <-- 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
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
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
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
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?
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
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
29900		HRLM	T0,SUBPTR(B)
30000		HRRM	B,SUBPTR(C)	;RLINK(P) <-- R
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
30900		HRRM	T0,SUBPTR(B)
31000		HRLM	B,SUBPTR(C)	;LLINK(P) <-- R
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
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
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
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
39400
39500	;[1]	metering counts and pointers for height balancing