kolibrios-fun/programs/develop/oberon07/source/REG.ob07

(*
    BSD 2-Clause License

    Copyright (c) 2018-2021, 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;


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.