TREE: PROC(HEAD,NOWPTR,TYPLENG,OFFSET,RETPTR) OPTIONS(IDENT('V1B'));
    /* LIKE SAS $TREE, TO INSERT A NODE PTD TO BY NOWPTR IN A BINARY TREE
       PTD TO BY HEAD.  LEFT AND RIGHT PTRS ARE FIRST IN THE NODE, WITH 
       BALANCING INFO IN THE FIRST BYTE FOLLOWING THESE PTRS.  KEY IS "OFFSET"
       BYTES FROM NODE START, OF TYPE AND LENGTH TYPELENG:
        +N  N CHARS(NOT VARYING)
    	0   FIXED BIN(31)
    	-1  FLOAT BIN(21)
    	-2  FLOAT BIN(53)
       USES MACRO PGM TREECMPR TO COMPARE THE KEYS
       IF RETPTR=NOWPTR, THE SKELETON NODE HAS BEEN INSERTED, OTHERWISE 
    	RETPTR POINTS TO THE NODE IN THE TREE WITH THE SAME KEY
       SEE KNUTH, SORTING AND SEARCHING P455-457

       VERSION 1  T. DOW 10/26/81
	
	VERSION 1A 3/26/82 T DOW FIX DBL ROT FINAL BAL P_BAL='0'
        VERSION 1B 3/29/82 T DOW FIX DBL ROT T,P=++ SBAL REBAL
	******************************** */

    DCL (HEAD,NOWPTR,RETPTR) PTR;
    DCL (OFFSET,TYPLENG) FIXED BIN(31);

    DCL 1 NODE BASED,
    	2 LEFT PTR,
    	2 RIGHT PTR,
    	2 BAL CHAR(1)  /*'+','0',OR '-'*/;

    DCL (S,T,Q,P,R) PTR;
    DCL NULL BUILTIN;
    DCL ORD FIXED BIN(31);
    DCL TREECMPR ENTRY(PTR,PTR,FIXED BIN(31),FIXED BIN(31),FIXED BIN(31));
    DCL NEW BIT(1);
    DCL TBAL CHAR(1);

    IF HEAD = NULL THEN DO;
    	RETPTR = NOWPTR;
    	HEAD = NOWPTR;
    	RETPTR->LEFT = NULL;
    	RETPTR->RIGHT = NULL;
    	RETPTR->BAL = '0';
    END;
    ELSE DO; /*EXISTING TREE IS NON-EMPTY*/
	T = ADDR(HEAD); /*S->REBALANCING NODE, T->FATHER OF S*/
	S = HEAD;
	P = HEAD;
	NEW = '0'B;
	CALL TREECMPR(NOWPTR,P,TYPLENG,OFFSET,ORD);
	DO WHILE (ORD^=0 & ^NEW);
	    IF ORD = -1 THEN DO; /*MOVE LEFT, KNUTH STEP A3*/
		Q = P->LEFT;
		IF Q = NULL THEN DO;
		    P->LEFT = NOWPTR;
		    Q = NOWPTR;
		    NEW = '1'B;
		END;
		ELSE DO;
		    IF Q->BAL ^='0' THEN DO;
		        T = P;
		        S = Q;
		    END;
		END;
	    END;
	    ELSE /*IF ORD = +1*/ DO; /*MOVE RIGHT, KNUTH A4*/
		Q = P->RIGHT;
		IF Q = NULL THEN DO; /*INSERT*/
		    P->RIGHT = NOWPTR;
		    Q = NOWPTR;
		    NEW = '1'B;
		END;
		ELSE DO;
		    IF Q->BAL ^= '0' THEN DO;
			T = P;
			S = Q;
		    END;
		END;
	    END;
	    P = Q;
	    IF ^NEW THEN DO;
                CALL TREECMPR(NOWPTR,P,TYPLENG,OFFSET,ORD);
            END;
	END; /*SEARCH*/
	RETPTR = P;
	IF NEW THEN DO;
	    /* INIT, KNUTH A5*/
	    P->LEFT = NULL;
	    P->RIGHT = NULL;
	    P->BAL = '0';
	    /* ADD BAL FACTORS, KNUTH A6*/
	    CALL TREECMPR(NOWPTR,S,TYPLENG,OFFSET,ORD);
	    IF ORD = -1 THEN DO;
		P = S->LEFT;
		TBAL = '-';
                R = P;
	    END;
	    ELSE IF ORD = +1 THEN DO;
		P = S->RIGHT;
		R = P;
		TBAL = '+';
	    END;
	    DO WHILE(P^=Q);
		CALL TREECMPR(NOWPTR,P,TYPLENG,OFFSET,ORD);
		IF ORD = -1 THEN DO;
		    P->BAL = '-';
		    P = P->LEFT;
		END;
		ELSE IF ORD = +1 THEN DO;
		    P->BAL = '+';
		    P = P->RIGHT;
		END;
	    END;
	    IF S->BAL = '0' THEN S->BAL = TBAL;
	    ELSE IF S->BAL ^= TBAL THEN S->BAL = '0';
	    ELSE DO; /*REBALANCE*/
		IF R->BAL = TBAL THEN DO;
		    /*SINGLE ROTATION, KNUTH A8*/
		    /*PUT LIST ('SING ROT');*/
		    P = R;
		    IF TBAL = '+' THEN DO;
			S->RIGHT = R->LEFT;
			R->LEFT = S;
		    END;
		    ELSE DO;
			S->LEFT = R->RIGHT;
			R->RIGHT = S;
		    END;
		    R->BAL = '0';
		    S->BAL = '0';
		END /*SINGLE ROT*/;
		ELSE DO;
		    /*DOUBLE ROTATION, KNUTH A9 */
		    /*PUT LIST ('DOUB ROT');*/
		    IF TBAL = '+' THEN DO;
			P = R->LEFT;
			R->LEFT = P->RIGHT;
			P->RIGHT = R;
			S->RIGHT = P->LEFT;
			P->LEFT = S;
			IF P->BAL = '+' THEN DO;
			    S->BAL = '-'; /*FIX V1B 3/29/82 TD********/
			    R->BAL = '0';
			END;
			ELSE IF P->BAL = '0' THEN DO;
			    S->BAL = '0';
			    R->BAL = '0';
			END;
			ELSE IF P->BAL = '-' THEN DO;
			    S->BAL = '0';
			    R->BAL = '+';
			END;
			ELSE DO; /*SHOULD NEVER GET HERE*/
			    PUT SKIP EDIT(' TREE: DBL ROTATION CRASH +')(A);
			    STOP;
			END;
		    END /*DBL + */;
		    ELSE IF TBAL = '-' THEN DO;
			P = R->RIGHT;
			R->RIGHT = P->LEFT;
			P->LEFT = R;
			S->LEFT = P->RIGHT;
			P->RIGHT = S;
			IF P->BAL = '-' THEN DO;
			    S->BAL = '+';
			    R->BAL = '0';
			END;
			ELSE IF P->BAL = '0' THEN DO;
			    S->BAL = '0';
			    R->BAL = '0';
			END;
			ELSE IF P->BAL = '+' THEN DO;
			    S->BAL = '0';
			    R->BAL = '-';
			END;
			ELSE DO; /*SHOULD NEVER GET HERE*/;
			    PUT SKIP EDIT(' TREE: DBL ROTATION CRASH -')(A);
			    STOP;
			END;
                    END; /*DBL ROT -*/
                    ELSE DO;
	                PUT SKIP EDIT(' TREE: DBL ROT CRASH TBAL:',TBAL)(A,A);
                        STOP;
                    END;
		    P->BAL = '0'; /******FIX ADDED 3/26/82 TD*/
		END /*DBL ROT*/;

		/*FINISHING THOUCH, KNUTH A10*/
		IF S = T->LEFT THEN T->LEFT = P;
		ELSE IF S=T->RIGHT THEN T->RIGHT = P;
		ELSE DO;
		    PUT SKIP EDIT (' TREE: CRASH A10')(A);
		    STOP;
		END;
	    END /*REBALANCE*/;
	END /*NEW NODE*/;
    END /*NON EMPTY*/;
  END TREE;