kolibrios/programs/develop/oberon07/Source/REG.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2018, 2019, Anton Krotov
    All rights reserved.
*)

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;

    NVR = 32;


TYPE

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

    REGS* = RECORD

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

        vregs*:  SET;
        offs:    ARRAY NVR OF INTEGER;
        size:    ARRAY NVR OF INTEGER;

        push, pop:  OP1;
        mov,  xch:  OP2;
        load, save: OP3

    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, n: INTEGER;

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

    IF i > n THEN
        i := -1
    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, n: 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
        n := InStk(R, reg);
        IF n # -1 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;
            res := TRUE
        ELSE
            res := FALSE
        END
    END

    RETURN res
END GetReg;


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

BEGIN
    res := FALSE;

    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);
            res := TRUE
        ELSIF (n1 # -1) & (reg2 IN R.regs) THEN
            R.stk[n1] := reg2;
            INCL(R.regs, reg1);
            EXCL(R.regs, reg2);
            R.mov(reg2, reg1);
            res := TRUE
        ELSIF (n2 # -1) & (reg1 IN R.regs) THEN
            R.stk[n2] := reg1;
            EXCL(R.regs, reg1);
            INCL(R.regs, reg2);
            R.mov(reg1, reg2);
            res := TRUE
        END
    ELSE
        res := TRUE
    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[R.top]
    ELSIF R.top < 0 THEN
        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 Lock* (VAR R: REGS; reg, offs, size: INTEGER);
BEGIN
    ASSERT(reg IN R.vregs);
    ASSERT(offs # 0);
    R.offs[reg] := offs;
    IF size = 0 THEN
        size := 8
    END;
    R.size[reg] := size
END Lock;


PROCEDURE Release* (VAR R: REGS; reg: INTEGER);
BEGIN
    ASSERT(reg IN R.vregs);
    R.offs[reg] := 0
END Release;


PROCEDURE Load* (R: REGS; reg: INTEGER);
VAR
    offs: INTEGER;

BEGIN
    ASSERT(reg IN R.vregs);
    offs := R.offs[reg];
    IF offs # 0 THEN
        R.load(reg, offs, R.size[reg])
    END
END Load;


PROCEDURE Save* (R: REGS; reg: INTEGER);
VAR
    offs: INTEGER;

BEGIN
    ASSERT(reg IN R.vregs);
    offs := R.offs[reg];
    IF offs # 0 THEN
        R.save(reg, offs, R.size[reg])
    END
END Save;


PROCEDURE Store* (R: REGS);
VAR
    i: INTEGER;

BEGIN
    FOR i := 0 TO NVR - 1 DO
        IF i IN R.vregs THEN
            Save(R, i)
        END
    END
END Store;


PROCEDURE Restore* (R: REGS);
VAR
    i: INTEGER;

BEGIN
    FOR i := 0 TO NVR - 1 DO
        IF i IN R.vregs THEN
            Load(R, i)
        END
    END
END Restore;


PROCEDURE Reset* (VAR R: REGS);
VAR
    i: INTEGER;

BEGIN
    FOR i := 0 TO NVR - 1 DO
        IF i IN R.vregs THEN
            R.offs[i] := 0
        END
    END
END Reset;


PROCEDURE GetVarReg* (R: REGS; offs: INTEGER): INTEGER;
VAR
    i, res: INTEGER;

BEGIN
    res := -1;
    i := 0;
    WHILE i < NVR DO
        IF (i IN R.vregs) & (R.offs[i] = offs) THEN
            res := i;
            i := NVR
        END;
        INC(i)
    END

    RETURN res
END GetVarReg;


PROCEDURE GetAnyVarReg* (R: REGS): INTEGER;
VAR
    i, res: INTEGER;

BEGIN
    res := -1;
    i := 0;
    WHILE i < NVR DO
        IF (i IN R.vregs) & (R.offs[i] = 0) THEN
            res := i;
            i := NVR
        END;
        INC(i)
    END

    RETURN res
END GetAnyVarReg;


PROCEDURE Init* (VAR R: REGS; push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET);
VAR
    i: INTEGER;

BEGIN
    R.regs := regs;
    R.pushed := 0;
    R.top := -1;

    R.push := push;
    R.pop  := pop;
    R.mov  := mov;
    R.xch  := xch;
    R.load := load;
    R.save := save;

    R.vregs := vregs;

    FOR i := 0 TO NVR - 1 DO
        R.offs[i] := 0;
        R.size[i] := 0
    END

END Init;


END REG.