439 lines
7.5 KiB
Plaintext
439 lines
7.5 KiB
Plaintext
(*
|
|
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.
|