Subversion Repositories Kolibri OS

(*

    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.