(*
BSD 2-Clause License
Copyright (c) 2018-2020, 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: 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 := 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.