Subversion Repositories Kolibri OS

(*

    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);

    ASSERT(size IN {1, 2, 4, 8});

    R.offs[reg] := offs;

    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.