(*
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.