ruberon/source/REG.ob07

MODULE REG;


CONST

    N = 16;

    R0*  =  0;  R1*  =  1;  R2*  =  2;  R3*  =  3;
    R4*  =  4;  R5*  =  5;  R6*  =  6;  R7*  =  7;
    R8*  =  8;  R9*  =  9;  R10* = 10;  R11* = 11;
    R12* = 12;  R13* = 13;  R14* = 14;  R15* = 15;


TYPE

    OP1 = PROCEDURE (arg: INTEGER);
    OP2 = PROCEDURE (arg1, arg2: INTEGER);

    REGS* = RECORD

        regs*:   SET;
        stk*:    ARRAY N OF INTEGER;
        top*:    INTEGER;
        pushed*: INTEGER;

        push, pop:  OP1;
        mov,  xch:  OP2

    END;


PROCEDURE push (VAR R: REGS);
    VAR
        i, reg: INTEGER;

    BEGIN
        reg := R.stk[0];
        INCL(R.regs, reg);
        R.push(reg);
        FOR i := 0 TO R.top - 1 DO
            R.stk[i] := R.stk[i + 1]
        END;
        DEC(R.top);
        INC(R.pushed)
    END push;


PROCEDURE pop (VAR R: REGS; reg: INTEGER);
    VAR
        i: INTEGER;

    BEGIN
        FOR i := R.top + 1 TO 1 BY -1 DO
            R.stk[i] := R.stk[i - 1]
        END;
        R.stk[0] := reg;
        EXCL(R.regs, reg);
        R.pop(reg);
        INC(R.top);
        DEC(R.pushed)
    END pop;


PROCEDURE InStk (R: REGS; reg: INTEGER): INTEGER;
    VAR
        i: INTEGER;

    BEGIN
        i := R.top;
        WHILE (i >= 0) & (R.stk[i] # reg) DO
            DEC(i)
        END

        RETURN i
    END InStk;


PROCEDURE GetFreeReg (R: REGS): INTEGER;
    VAR
        i: INTEGER;

    BEGIN
        i := 0;
        WHILE (i < N) & ~(i IN R.regs) DO
            INC(i)
        END;

        IF i = N THEN
            i := -1
        END

        RETURN i
    END GetFreeReg;


PROCEDURE Put (VAR R: REGS; reg: INTEGER);
    BEGIN
        EXCL(R.regs, reg);
        INC(R.top);
        R.stk[R.top] := reg
    END Put;


PROCEDURE PopAnyReg (VAR R: REGS): INTEGER;
    VAR
        reg: INTEGER;

    BEGIN
        reg := GetFreeReg(R);
        ASSERT(reg # -1);
        ASSERT(R.top < LEN(R.stk) - 1);
        ASSERT(R.pushed > 0);
        pop(R, reg)

        RETURN reg
    END PopAnyReg;


PROCEDURE GetAnyReg* (VAR R: REGS): INTEGER;
    VAR
        reg: INTEGER;

    BEGIN
        reg := GetFreeReg(R);
        IF reg = -1 THEN
            ASSERT(R.top >= 0);
            reg := R.stk[0];
            push(R)
        END;

        Put(R, reg)

        RETURN reg
    END GetAnyReg;


PROCEDURE GetReg* (VAR R: REGS; reg: INTEGER): BOOLEAN;
    VAR
        free: INTEGER;
        res:  BOOLEAN;


        PROCEDURE exch (VAR R: REGS; reg1, reg2: INTEGER);
        VAR
            n1, n2: INTEGER;

        BEGIN
            n1 := InStk(R, reg1);
            n2 := InStk(R, reg2);
            R.stk[n1] := reg2;
            R.stk[n2] := reg1;
            R.xch(reg1, reg2)
        END exch;


    BEGIN
        IF reg IN R.regs THEN
            Put(R, reg);
            res := TRUE
        ELSE
            res := InStk(R, reg) # -1;
            IF res THEN
                free := GetFreeReg(R);
                IF free # -1 THEN
                    Put(R, free);
                    exch(R, reg, free)
                ELSE
                    push(R);
                    free := GetFreeReg(R);
                    ASSERT(free # -1);
                    Put(R, free);
                    IF free # reg THEN
                        exch(R, reg, free)
                    END
                END
            END
        END

        RETURN res
    END GetReg;


PROCEDURE Exchange* (VAR R: REGS; reg1, reg2: INTEGER): BOOLEAN;
    VAR
        n1, n2: INTEGER;
        res: BOOLEAN;

    BEGIN
        res := TRUE;

        IF reg1 # reg2 THEN
            n1 := InStk(R, reg1);
            n2 := InStk(R, reg2);

            IF (n1 # -1) & (n2 # -1) THEN
                R.stk[n1] := reg2;
                R.stk[n2] := reg1;
                R.xch(reg2, reg1)
            ELSIF (n1 # -1) & (reg2 IN R.regs) THEN
                R.stk[n1] := reg2;
                INCL(R.regs, reg1);
                EXCL(R.regs, reg2);
                R.mov(reg2, reg1)
            ELSIF (n2 # -1) & (reg1 IN R.regs) THEN
                R.stk[n2] := reg1;
                EXCL(R.regs, reg1);
                INCL(R.regs, reg2);
                R.mov(reg1, reg2)
            ELSE
                res := FALSE
            END
        END

        RETURN res
    END Exchange;


PROCEDURE Drop* (VAR R: REGS);
    BEGIN
        INCL(R.regs, R.stk[R.top]);
        DEC(R.top)
    END Drop;


PROCEDURE BinOp* (VAR R: REGS; VAR reg1, reg2: INTEGER);
    BEGIN
        IF R.top > 0 THEN
            reg1 := R.stk[R.top - 1];
            reg2 := R.stk[R.top]
        ELSIF R.top = 0 THEN
            reg1 := PopAnyReg(R);
            reg2 := R.stk[1]
        ELSE (* R.top = -1 *)
            reg2 := PopAnyReg(R);
            reg1 := PopAnyReg(R)
        END
    END BinOp;


PROCEDURE UnOp* (VAR R: REGS; VAR reg: INTEGER);
    BEGIN
        IF R.top >= 0 THEN
            reg := R.stk[R.top]
        ELSE
            reg := PopAnyReg(R)
        END
    END UnOp;


PROCEDURE PushAll* (VAR R: REGS);
    BEGIN
        WHILE R.top >= 0 DO
            push(R)
        END
    END PushAll;


PROCEDURE PushAll_1* (VAR R: REGS);
    BEGIN
        WHILE R.top >= 1 DO
            push(R)
        END
    END PushAll_1;


PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; regs: SET);
    BEGIN
        R.regs := regs;
        R.pushed := 0;
        R.top := -1;

        R.push := push;
        R.pop  := pop;
        R.mov  := mov;
        R.xch  := xch;
    END Init;


END REG.