Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-04 - 43,50325/reshuf.rtn
There are no other files named reshuf.rtn in the archive.
! File:   RESHUF.RTN
!
!    This work was supported by the Advanced Research
!    Projects Agency of the Office of the Secretary of
!    Defense (F44620-73-C-0074) and is monitored by the
!    Air Force Office of Scientific Research.

!	THE FOLLOWING ROUTINES TRY TO ASSIGN A TEMP-NAME TO A REGISTER
!	IN SPITE OF CONFLICTING TEMP-NAMES PREVIOUSLY ASSIGNED TO THAT
!	REGISTER, BY MOVING THEM AROUND TO OTHER REGISTERS IF POSSIBLE.

    BIND SRCHWIDTH=3,
	 SRCHDEPTH=4;

    MACRO TRYREGSEARCH(T,DEPTH)=(IF TRYOPREG(T) THEN 1 ELSE
				   IF SLOW THEN TRS(T,DEPTH))$,
	  XTRYREGSEARCH(T,DEPTH)=(IF TRYOPREG(T) THEN 1 ELSE
				    TRS(T,DEPTH))$;

    FORWARD TRS;

    STRUCTURE INDVEC[I]=(@.INDVEC+.I)<0,36>;

    ROUTINE SORT(V,N)=
	BEGIN
	  ! SIMPLE BUBBLE SORT OF THE INDIRECT VECTOR V OF SIZE N.
	MAP INDVEC V;
	DECR I FROM .N-2 TO 0 DO
	    DECR J FROM .I TO 0 DO
		IF .V[.J] GTR .V[.I+1] THEN SWAP(V[.J],V[.I+1])
	END;

    MACRO ENCLOSES(T,TN)=
	! TRUE IF LIFETIME OF TN
	! IS ENTIRELY WITHIN THAT OF T.
	(IF T[LONFU] LEQ TN[LONFU] THEN
	 IF T[LONLU] GEQ TN[LONLU] THEN
	 IF T[FONFU] LEQ TN[FONFU] THEN
	    T[FONLU] GEQ TN[FONLU] )$;

    ROUTINE SPLCASE(TN)=
	  ! TRUE IF TN MUST REMAIN IN THE REG TO WHICH IT IS ALREADY ASSIGNED.
	BEGIN MAP GTVEC TN;
	REGISTER GTVEC T;
	IF .TN[REQD] EQL SRREQDB THEN RETURN 1;
	IF .TN[PREFF] EQL 0 THEN RETURN 0;
	IF .TN[BNDTYP] EQL BNDPREF THEN RETURN 1;
	FORALLTN(T,.TN[PREFF],
	    (IF .T[BNDTYP] EQL BNDPREF THEN
		IF .T[REGF] EQL .TN THEN RETURN 1));
	RETURN 0
	END;

    ROUTINE COUNTCONFLICTS(TN,REGLIST,CLIST)=
	  ! THIS ROUTINE COUNTS THE NUMBER OF CONFLICTS BETWEEN TN AND THE
	  ! TEMP-NAMES ALREADY ON REGLIST, AND RECORDS IN THE VECTOR CLIST
	  ! THE TN REPRESENTATIVES OF THE CONFLICTING TN'S.
	BEGIN
	MAP GTVEC TN,TNREPR REGLIST,INDVEC CLIST;
	MACRO OVERLAPFON=(((.T[FONFU]-.TN[FONLU])*(.TN[FONFU]-.T[FONLU])) GEQ 0)$;
	BIND INF=SRCHWIDTH+1;
	REGISTER CNT, GTVEC T;

	IF .RESERVED[.REGLIST-REGS<0,0>,1] THEN RETURN INF;
	IF EMPTY(@.REGLIST) THEN RETURN INF;
	CNT_0;
	FORALLTN(T,.REGLIST,
	    (BEGIN DUMMYBLOCK;
		IF .T[LONLU] LSS .TN[LONFU] THEN CONTINUE;
		IF .T[LONFU] GTR .TN[LONLU] THEN RETURN .CNT;
		IF OVERLAPFON THEN
		    IF (IF .CNT EQL 0 THEN ENCLOSES(.T,.TN)) THEN RETURN INF ELSE
		    IF SPLCASE(.T) THEN RETURN INF ELSE
		    IF (CNT_.CNT+1) LEQ SRCHWIDTH THEN CLIST[.CNT-1]_.TR
	    END));
	.CNT
	END;

    ROUTINE TEMPINSERT(TN,LIST)=
	BEGIN
	MAP GTVEC TN,TNREPR LIST;
	REGISTER L,TNREPR X,GTVEC T;
	FORALLTN(T,.LIST,
	    (IF .T[LONFU] LSS .TN[LONFU]
		THEN L_.TR
		ELSE (LINK((X_TNREP(.TN)),.L); EXITLOOP)));
	X[TNR]_.TN[REQD];
	TN[REQD]_SRREQDB;
	RETURN .X
	END;

    ROUTINE MAKEPERM(T,LST)=
	BEGIN
	MAP TNREPR T;
	REGISTER GTVEC TN; TN_.T[TNPTR];
	TN[REQD]_.T[TNR];
	NOTEBOUND(TN,.LST);
	NOVALUE
	END;

    ROUTINE REINSERT(TP,LST)=
	BEGIN
	MAP TNREPR TP:LST;
	REGISTER L,GTVEC TN:T;
	TN_.TP[TNPTR];
	FORALLTN(T,.LST,
	    (IF .T[LONFU] LSS .TN[LONFU]
		THEN L_.TR
		ELSE (LINK(.TP,.L); EXITLOOP)));
	NOVALUE
	END;

    ROUTINE TRYALT(TN,CNT,LIST,CONFLIX,DEPTH)=
	  ! TRIES TO LINK A TEMP NAME ONTO A REGLIST, IN SPITE OF CONFLICTING
	  ! TEMP NAMES ALREADY ON SAME. IT REMOVES THE CONFLICTING TN'S,
	  ! TRYING TO FIT THEM ONTO OTHER REGLISTS. (IN FITTING THEM
	  ! IT COULD END UP CALLING TRS, WHICH WOULD CALL THIS ROUTINE. THE
	  ! DEPTH OF THIS INDIRECT RECURSION IS LIMITED BY "SRCHDEPTH", AND
	  ! PARAMETER "DEPTH".)
	BEGIN
	MAP GTVEC TN, INDVEC CONFLIX;
	LOCAL LSTLON,LSTFON,GTSTLON,GTSTFON;
	LOCAL SVLONF,SVLONL,SVFONF,SVFONL;
	LOCAL SVPMIT;
	REGISTER Z,TNREPR TP;
	IF .CNT GTR SRCHWIDTH THEN FAIL;

	! REMOVE ALL CONFLICTS TEMPORARILY
	SVPMIT_.TN[TNPERMIT];
	SVLONF_LSTLON_.TN[LONFU];
	SVLONL_GTSTLON_.TN[LONLU];
	SVFONF_LSTFON_.TN[FONFU];
	SVFONL_GTSTFON_.TN[FONLU];
	DECR I FROM .CNT-1 TO 0
	 DO BEGIN
	    REGISTER GTVEC T;
	    TP_.CONFLIX[.I];
	    T_.TP[TNPTR];
	    DELINK(.TP);
	    IF .T[LONFU] LSS .LSTLON
		THEN LSTLON_.T[LONFU];
	    IF .T[LONLU] GTR .GTSTLON
		THEN GTSTLON_.T[LONLU];
	    IF .T[FONFU] LSS .LSTFON
		THEN LSTFON_.T[FONFU];
	    IF .T[FONLU] GTR .GTSTFON
		THEN GTSTFON_.T[FONLU];
	    END;

	! INSERT TN INTO LIST, ALSO TEMPORARILY
	TP_TEMPINSERT(.TN,.LIST);
	TN[TNPERMIT]_0;
	TN[LONFU]_.LSTLON; TN[LONLU]_.GTSTLON;
	TN[FONFU]_.LSTFON; TN[FONLU]_.GTSTFON;

	! NOW TRY TO PUT THE CONFLICTING TN'S ELSEWHERE.
	Z_.CNT;
	DECR I FROM .CNT-1 TO 0 DO
	    BEGIN
	    BIND TNREPR T=CONFLIX[.I];
	    IF XTRYREGSEARCH(.T[TNPTR],.DEPTH-1)
	      THEN (Z_.Z-1; RELTNREP(.T))
	      ELSE EXITLOOP
	    END;

	TN[TNPERMIT]_.SVPMIT;
	TN[LONFU]_.SVLONF; TN[LONLU]_.SVLONL;
	TN[FONFU]_.SVFONF; TN[FONLU]_.SVFONL;
	IF .Z EQL 0 THEN (MAKEPERM(.TP,.LIST); RETURN 1) ELSE
	    BEGIN
	    DELINK(.TP);
	    TN[REQD]_.TP[TNR];
	    RELTNREP(.TP);
	    DECR I FROM .Z-1 TO 0 DO REINSERT(.CONFLIX[.I],.LIST);
	    RETURN 0
	    END
	END;

    ROUTINE TRS(TN,DEPTH)=
	  ! THIS IS THE CONTROLLING ROUTINE FOR REGISTER REPACKING.
	BEGIN
	IF .DEPTH LEQ 0 THEN FAIL ELSE
	BEGIN
	STRUCTURE ARY2[I,J]=[I*J](.ARY2+.I*J+.J)<0,36>;
	STRUCTURE HVEC[I,J]=[I](.HVEC+.I)<18*.J,18>;
	BIND RPART=0,CPART=1;
	LOCAL HVEC R[6], ARY2 C[6,SRCHWIDTH];

	DECR I FROM 5 TO 0 DO
	    BEGIN
	    R[.I,RPART]_.I;
	    R[.I,CPART]_COUNTCONFLICTS(.TN,REGS[.I]<0,0>,C[.I,0])
	    END;
	SORT(R,6);
	INCR I FROM 0 TO 5 DO
	    IF TRYALT(.TN,.R[.I,CPART],REGS[.R[.I,RPART]]<0,0>,C[.R[.I,RPART]],.DEPTH)
		THEN SUCCESS
		ELSE IF .I NEQ 5 THEN
		   (DECR J FROM 5 TO .I+1 DO
			BEGIN LOCAL RG;
			RG_.R[.J,RPART];
			R[.J,CPART]_COUNTCONFLICTS(.TN,REGS[.RG]<0,0>,C[.RG,0])
			END;
		    SORT(R+1+.I,5-.I));
	FAIL
	END
	END;