1302 lines
26 KiB
Plaintext
1302 lines
26 KiB
Plaintext
(*
|
|
BSD 2-Clause License
|
|
|
|
Copyright (c) 2020, Anton Krotov
|
|
All rights reserved.
|
|
*)
|
|
|
|
MODULE RVM32I;
|
|
|
|
IMPORT
|
|
|
|
PROG, WR := WRITER, IL, CHL := CHUNKLISTS, REG, UTILS, STRINGS, ERRORS;
|
|
|
|
|
|
CONST
|
|
|
|
LTypes = 0;
|
|
LStrings = 1;
|
|
LGlobal = 2;
|
|
LHeap = 3;
|
|
LStack = 4;
|
|
|
|
numGPRs = 3;
|
|
|
|
R0 = 0; R1 = 1;
|
|
BP = 3; SP = 4;
|
|
|
|
ACC = R0;
|
|
|
|
GPRs = {0 .. 2} + {5 .. numGPRs + 1};
|
|
|
|
opSTOP = 0; opRET = 1; opENTER = 2; opNEG = 3; opNOT = 4; opABS = 5;
|
|
opXCHG = 6; opLDR8 = 7; opLDR16 = 8; opLDR32 = 9; opPUSH = 10; opPUSHC = 11;
|
|
opPOP = 12; opJGZ = 13; opJZ = 14; opJNZ = 15; opLLA = 16; opJGA = 17;
|
|
opJLA = 18; opJMP = 19; opCALL = 20; opCALLI = 21;
|
|
|
|
opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32;
|
|
opSTR8 = 34; opSTR16 = 36; opSTR32 = 38; opINCL = 40; opEXCL = 42;
|
|
opIN = 44; opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54;
|
|
opLSL = 56; opROR = 58; opMIN = 60; opMAX = 62; opEQ = 64; opNE = 66;
|
|
opLT = 68; opLE = 70; opGT = 72; opGE = 74; opBT = 76;
|
|
|
|
opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33;
|
|
opSTR8C = 35; opSTR16C = 37; opSTR32C = 39; opINCLC = 41; opEXCLC = 43;
|
|
opINC = 45; opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55;
|
|
opLSLC = 57; opRORC = 59; opMINC = 61; opMAXC = 63; opEQC = 65; opNEC = 67;
|
|
opLTC = 69; opLEC = 71; opGTC = 73; opGEC = 75; opBTC = 77;
|
|
|
|
opLEA = 78; opLABEL = 79;
|
|
|
|
inf = 7F800000H;
|
|
|
|
|
|
VAR
|
|
|
|
R: REG.REGS; count: INTEGER;
|
|
|
|
|
|
PROCEDURE OutByte (n: BYTE);
|
|
BEGIN
|
|
WR.WriteByte(n);
|
|
INC(count)
|
|
END OutByte;
|
|
|
|
|
|
PROCEDURE OutInt (n: INTEGER);
|
|
BEGIN
|
|
WR.Write32LE(n);
|
|
INC(count, 4)
|
|
END OutInt;
|
|
|
|
|
|
PROCEDURE Emit (op, par1, par2: INTEGER);
|
|
BEGIN
|
|
OutInt(op);
|
|
OutInt(par1);
|
|
OutInt(par2)
|
|
END Emit;
|
|
|
|
|
|
PROCEDURE drop;
|
|
BEGIN
|
|
REG.Drop(R)
|
|
END drop;
|
|
|
|
|
|
PROCEDURE GetAnyReg (): INTEGER;
|
|
RETURN REG.GetAnyReg(R)
|
|
END GetAnyReg;
|
|
|
|
|
|
PROCEDURE GetAcc;
|
|
BEGIN
|
|
ASSERT(REG.GetReg(R, ACC))
|
|
END GetAcc;
|
|
|
|
|
|
PROCEDURE UnOp (VAR r: INTEGER);
|
|
BEGIN
|
|
REG.UnOp(R, r)
|
|
END UnOp;
|
|
|
|
|
|
PROCEDURE BinOp (VAR r1, r2: INTEGER);
|
|
BEGIN
|
|
REG.BinOp(R, r1, r2)
|
|
END BinOp;
|
|
|
|
|
|
PROCEDURE PushAll (NumberOfParameters: INTEGER);
|
|
BEGIN
|
|
REG.PushAll(R);
|
|
DEC(R.pushed, NumberOfParameters)
|
|
END PushAll;
|
|
|
|
|
|
PROCEDURE push (r: INTEGER);
|
|
BEGIN
|
|
Emit(opPUSH, r, 0)
|
|
END push;
|
|
|
|
|
|
PROCEDURE pop (r: INTEGER);
|
|
BEGIN
|
|
Emit(opPOP, r, 0)
|
|
END pop;
|
|
|
|
|
|
PROCEDURE mov (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opMOV, r1, r2)
|
|
END mov;
|
|
|
|
|
|
PROCEDURE xchg (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opXCHG, r1, r2)
|
|
END xchg;
|
|
|
|
|
|
PROCEDURE addrc (r, c: INTEGER);
|
|
BEGIN
|
|
Emit(opADDC, r, c)
|
|
END addrc;
|
|
|
|
|
|
PROCEDURE subrc (r, c: INTEGER);
|
|
BEGIN
|
|
Emit(opSUBC, r, c)
|
|
END subrc;
|
|
|
|
|
|
PROCEDURE movrc (r, c: INTEGER);
|
|
BEGIN
|
|
Emit(opMOVC, r, c)
|
|
END movrc;
|
|
|
|
|
|
PROCEDURE pushc (c: INTEGER);
|
|
BEGIN
|
|
Emit(opPUSHC, c, 0)
|
|
END pushc;
|
|
|
|
|
|
PROCEDURE add (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opADD, r1, r2)
|
|
END add;
|
|
|
|
|
|
PROCEDURE sub (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opSUB, r1, r2)
|
|
END sub;
|
|
|
|
|
|
PROCEDURE ldr32 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opLDR32, r1, r2)
|
|
END ldr32;
|
|
|
|
|
|
PROCEDURE ldr16 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opLDR16, r1, r2)
|
|
END ldr16;
|
|
|
|
|
|
PROCEDURE ldr8 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opLDR8, r1, r2)
|
|
END ldr8;
|
|
|
|
|
|
PROCEDURE str32 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opSTR32, r1, r2)
|
|
END str32;
|
|
|
|
|
|
PROCEDURE str16 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opSTR16, r1, r2)
|
|
END str16;
|
|
|
|
|
|
PROCEDURE str8 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opSTR8, r1, r2)
|
|
END str8;
|
|
|
|
|
|
PROCEDURE GlobalAdr (r, offset: INTEGER);
|
|
BEGIN
|
|
Emit(opLEA, r + 256 * LGlobal, offset)
|
|
END GlobalAdr;
|
|
|
|
|
|
PROCEDURE StrAdr (r, offset: INTEGER);
|
|
BEGIN
|
|
Emit(opLEA, r + 256 * LStrings, offset)
|
|
END StrAdr;
|
|
|
|
|
|
PROCEDURE ProcAdr (r, label: INTEGER);
|
|
BEGIN
|
|
Emit(opLLA, r, label)
|
|
END ProcAdr;
|
|
|
|
|
|
PROCEDURE jnz (r, label: INTEGER);
|
|
BEGIN
|
|
Emit(opJNZ, r, label)
|
|
END jnz;
|
|
|
|
|
|
PROCEDURE CallRTL (proc, par: INTEGER);
|
|
BEGIN
|
|
Emit(opCALL, IL.codes.rtl[proc], 0);
|
|
addrc(SP, par * 4)
|
|
END CallRTL;
|
|
|
|
|
|
PROCEDURE translate;
|
|
VAR
|
|
cmd: IL.COMMAND;
|
|
opcode, param1, param2: INTEGER;
|
|
r1, r2, r3: INTEGER;
|
|
|
|
BEGIN
|
|
cmd := IL.codes.commands.first(IL.COMMAND);
|
|
|
|
WHILE cmd # NIL DO
|
|
|
|
param1 := cmd.param1;
|
|
param2 := cmd.param2;
|
|
opcode := cmd.opcode;
|
|
|
|
CASE opcode OF
|
|
|
|
|IL.opJMP:
|
|
Emit(opJMP, param1, 0)
|
|
|
|
|IL.opLABEL:
|
|
Emit(opLABEL, param1, 0)
|
|
|
|
|IL.opCALL:
|
|
Emit(opCALL, param1, 0)
|
|
|
|
|IL.opCALLP:
|
|
UnOp(r1);
|
|
Emit(opCALLI, r1, 0);
|
|
drop;
|
|
ASSERT(R.top = -1)
|
|
|
|
|IL.opPUSHC:
|
|
pushc(param2)
|
|
|
|
|IL.opCLEANUP:
|
|
IF param2 # 0 THEN
|
|
addrc(SP, param2 * 4)
|
|
END
|
|
|
|
|IL.opNOP, IL.opAND, IL.opOR:
|
|
|
|
|IL.opSADR:
|
|
StrAdr(GetAnyReg(), param2)
|
|
|
|
|IL.opGADR:
|
|
GlobalAdr(GetAnyReg(), param2)
|
|
|
|
|IL.opLADR:
|
|
r1 := GetAnyReg();
|
|
mov(r1, BP);
|
|
addrc(r1, param2 * 4)
|
|
|
|
|IL.opPARAM:
|
|
IF param2 = 1 THEN
|
|
UnOp(r1);
|
|
push(r1);
|
|
drop
|
|
ELSE
|
|
ASSERT(R.top + 1 <= param2);
|
|
PushAll(param2)
|
|
END
|
|
|
|
|IL.opONERR:
|
|
pushc(param2);
|
|
Emit(opJMP, param1, 0)
|
|
|
|
|IL.opPRECALL:
|
|
PushAll(0)
|
|
|
|
|IL.opRES, IL.opRESF:
|
|
ASSERT(R.top = -1);
|
|
GetAcc
|
|
|
|
|IL.opENTER:
|
|
ASSERT(R.top = -1);
|
|
Emit(opLABEL, param1, 0);
|
|
Emit(opENTER, param2, 0)
|
|
|
|
|IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
|
|
IF opcode # IL.opLEAVE THEN
|
|
UnOp(r1);
|
|
IF r1 # ACC THEN
|
|
GetAcc;
|
|
ASSERT(REG.Exchange(R, r1, ACC));
|
|
drop
|
|
END;
|
|
drop
|
|
END;
|
|
|
|
ASSERT(R.top = -1);
|
|
|
|
IF param1 > 0 THEN
|
|
mov(SP, BP)
|
|
END;
|
|
|
|
pop(BP);
|
|
|
|
Emit(opRET, 0, 0)
|
|
|
|
|IL.opLEAVEC:
|
|
Emit(opRET, 0, 0)
|
|
|
|
|IL.opCONST:
|
|
movrc(GetAnyReg(), param2)
|
|
|
|
|IL.opDROP:
|
|
UnOp(r1);
|
|
drop
|
|
|
|
|IL.opSAVEC:
|
|
UnOp(r1);
|
|
Emit(opSTR32C, r1, param2);
|
|
drop
|
|
|
|
|IL.opSAVE8C:
|
|
UnOp(r1);
|
|
Emit(opSTR8C, r1, param2 MOD 256);
|
|
drop
|
|
|
|
|IL.opSAVE16C:
|
|
UnOp(r1);
|
|
Emit(opSTR16C, r1, param2 MOD 65536);
|
|
drop
|
|
|
|
|IL.opSAVE, IL.opSAVE32, IL.opSAVEF:
|
|
BinOp(r2, r1);
|
|
str32(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opSAVEFI:
|
|
BinOp(r2, r1);
|
|
str32(r2, r1);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opSAVE8:
|
|
BinOp(r2, r1);
|
|
str8(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opSAVE16:
|
|
BinOp(r2, r1);
|
|
str16(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opGLOAD32:
|
|
r1 := GetAnyReg();
|
|
GlobalAdr(r1, param2);
|
|
ldr32(r1, r1)
|
|
|
|
|IL.opVADR, IL.opLLOAD32:
|
|
r1 := GetAnyReg();
|
|
mov(r1, BP);
|
|
addrc(r1, param2 * 4);
|
|
ldr32(r1, r1)
|
|
|
|
|IL.opVLOAD32:
|
|
r1 := GetAnyReg();
|
|
mov(r1, BP);
|
|
addrc(r1, param2 * 4);
|
|
ldr32(r1, r1);
|
|
ldr32(r1, r1)
|
|
|
|
|IL.opGLOAD16:
|
|
r1 := GetAnyReg();
|
|
GlobalAdr(r1, param2);
|
|
ldr16(r1, r1)
|
|
|
|
|IL.opLLOAD16:
|
|
r1 := GetAnyReg();
|
|
mov(r1, BP);
|
|
addrc(r1, param2 * 4);
|
|
ldr16(r1, r1)
|
|
|
|
|IL.opVLOAD16:
|
|
r1 := GetAnyReg();
|
|
mov(r1, BP);
|
|
addrc(r1, param2 * 4);
|
|
ldr32(r1, r1);
|
|
ldr16(r1, r1)
|
|
|
|
|IL.opGLOAD8:
|
|
r1 := GetAnyReg();
|
|
GlobalAdr(r1, param2);
|
|
ldr8(r1, r1)
|
|
|
|
|IL.opLLOAD8:
|
|
r1 := GetAnyReg();
|
|
mov(r1, BP);
|
|
addrc(r1, param2 * 4);
|
|
ldr8(r1, r1)
|
|
|
|
|IL.opVLOAD8:
|
|
r1 := GetAnyReg();
|
|
mov(r1, BP);
|
|
addrc(r1, param2 * 4);
|
|
ldr32(r1, r1);
|
|
ldr8(r1, r1)
|
|
|
|
|IL.opLOAD8:
|
|
UnOp(r1);
|
|
ldr8(r1, r1)
|
|
|
|
|IL.opLOAD16:
|
|
UnOp(r1);
|
|
ldr16(r1, r1)
|
|
|
|
|IL.opLOAD32, IL.opLOADF:
|
|
UnOp(r1);
|
|
ldr32(r1, r1)
|
|
|
|
|IL.opLOOP, IL.opENDLOOP:
|
|
|
|
|IL.opUMINUS:
|
|
UnOp(r1);
|
|
Emit(opNEG, r1, 0)
|
|
|
|
|IL.opADD:
|
|
BinOp(r1, r2);
|
|
add(r1, r2);
|
|
drop
|
|
|
|
|IL.opSUB:
|
|
BinOp(r1, r2);
|
|
sub(r1, r2);
|
|
drop
|
|
|
|
|IL.opADDC:
|
|
UnOp(r1);
|
|
addrc(r1, param2)
|
|
|
|
|IL.opSUBR:
|
|
UnOp(r1);
|
|
subrc(r1, param2)
|
|
|
|
|IL.opSUBL:
|
|
UnOp(r1);
|
|
subrc(r1, param2);
|
|
Emit(opNEG, r1, 0)
|
|
|
|
|IL.opMULC:
|
|
UnOp(r1);
|
|
Emit(opMULC, r1, param2)
|
|
|
|
|IL.opMUL:
|
|
BinOp(r1, r2);
|
|
Emit(opMUL, r1, r2);
|
|
drop
|
|
|
|
|IL.opDIV:
|
|
BinOp(r1, r2);
|
|
Emit(opDIV, r1, r2);
|
|
drop
|
|
|
|
|IL.opMOD:
|
|
BinOp(r1, r2);
|
|
Emit(opMOD, r1, r2);
|
|
drop
|
|
|
|
|IL.opDIVR:
|
|
UnOp(r1);
|
|
Emit(opDIVC, r1, param2)
|
|
|
|
|IL.opMODR:
|
|
UnOp(r1);
|
|
Emit(opMODC, r1, param2)
|
|
|
|
|IL.opDIVL:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
movrc(r2, param2);
|
|
Emit(opDIV, r2, r1);
|
|
mov(r1, r2);
|
|
drop
|
|
|
|
|IL.opMODL:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
movrc(r2, param2);
|
|
Emit(opMOD, r2, r1);
|
|
mov(r1, r2);
|
|
drop
|
|
|
|
|IL.opEQ:
|
|
BinOp(r1, r2);
|
|
Emit(opEQ, r1, r2);
|
|
drop
|
|
|
|
|IL.opNE:
|
|
BinOp(r1, r2);
|
|
Emit(opNE, r1, r2);
|
|
drop
|
|
|
|
|IL.opLT:
|
|
BinOp(r1, r2);
|
|
Emit(opLT, r1, r2);
|
|
drop
|
|
|
|
|IL.opLE:
|
|
BinOp(r1, r2);
|
|
Emit(opLE, r1, r2);
|
|
drop
|
|
|
|
|IL.opGT:
|
|
BinOp(r1, r2);
|
|
Emit(opGT, r1, r2);
|
|
drop
|
|
|
|
|IL.opGE:
|
|
BinOp(r1, r2);
|
|
Emit(opGE, r1, r2);
|
|
drop
|
|
|
|
|IL.opEQC:
|
|
UnOp(r1);
|
|
Emit(opEQC, r1, param2)
|
|
|
|
|IL.opNEC:
|
|
UnOp(r1);
|
|
Emit(opNEC, r1, param2)
|
|
|
|
|IL.opLTC:
|
|
UnOp(r1);
|
|
Emit(opLTC, r1, param2)
|
|
|
|
|IL.opLEC:
|
|
UnOp(r1);
|
|
Emit(opLEC, r1, param2)
|
|
|
|
|IL.opGTC:
|
|
UnOp(r1);
|
|
Emit(opGTC, r1, param2)
|
|
|
|
|IL.opGEC:
|
|
UnOp(r1);
|
|
Emit(opGEC, r1, param2)
|
|
|
|
|IL.opJNZ1:
|
|
UnOp(r1);
|
|
jnz(r1, param1)
|
|
|
|
|IL.opJG:
|
|
UnOp(r1);
|
|
Emit(opJGZ, r1, param1)
|
|
|
|
|IL.opJNZ:
|
|
UnOp(r1);
|
|
jnz(r1, param1);
|
|
drop
|
|
|
|
|IL.opJZ:
|
|
UnOp(r1);
|
|
Emit(opJZ, r1, param1);
|
|
drop
|
|
|
|
|IL.opMULS:
|
|
BinOp(r1, r2);
|
|
Emit(opAND, r1, r2);
|
|
drop
|
|
|
|
|IL.opMULSC:
|
|
UnOp(r1);
|
|
Emit(opANDC, r1, param2)
|
|
|
|
|IL.opDIVS:
|
|
BinOp(r1, r2);
|
|
Emit(opXOR, r1, r2);
|
|
drop
|
|
|
|
|IL.opDIVSC:
|
|
UnOp(r1);
|
|
Emit(opXORC, r1, param2)
|
|
|
|
|IL.opADDS:
|
|
BinOp(r1, r2);
|
|
Emit(opOR, r1, r2);
|
|
drop
|
|
|
|
|IL.opSUBS:
|
|
BinOp(r1, r2);
|
|
Emit(opNOT, r2, 0);
|
|
Emit(opAND, r1, r2);
|
|
drop
|
|
|
|
|IL.opADDSC:
|
|
UnOp(r1);
|
|
Emit(opORC, r1, param2)
|
|
|
|
|IL.opSUBSL:
|
|
UnOp(r1);
|
|
Emit(opNOT, r1, 0);
|
|
Emit(opANDC, r1, param2)
|
|
|
|
|IL.opSUBSR:
|
|
UnOp(r1);
|
|
Emit(opANDC, r1, ORD(-BITS(param2)))
|
|
|
|
|IL.opUMINS:
|
|
UnOp(r1);
|
|
Emit(opNOT, r1, 0)
|
|
|
|
|IL.opASR:
|
|
BinOp(r1, r2);
|
|
Emit(opASR, r1, r2);
|
|
drop
|
|
|
|
|IL.opLSL:
|
|
BinOp(r1, r2);
|
|
Emit(opLSL, r1, r2);
|
|
drop
|
|
|
|
|IL.opROR:
|
|
BinOp(r1, r2);
|
|
Emit(opROR, r1, r2);
|
|
drop
|
|
|
|
|IL.opLSR:
|
|
BinOp(r1, r2);
|
|
Emit(opLSR, r1, r2);
|
|
drop
|
|
|
|
|IL.opASR1:
|
|
r2 := GetAnyReg();
|
|
Emit(opMOVC, r2, param2);
|
|
BinOp(r1, r2);
|
|
Emit(opASR, r2, r1);
|
|
mov(r1, r2);
|
|
drop
|
|
|
|
|IL.opLSL1:
|
|
r2 := GetAnyReg();
|
|
Emit(opMOVC, r2, param2);
|
|
BinOp(r1, r2);
|
|
Emit(opLSL, r2, r1);
|
|
mov(r1, r2);
|
|
drop
|
|
|
|
|IL.opROR1:
|
|
r2 := GetAnyReg();
|
|
Emit(opMOVC, r2, param2);
|
|
BinOp(r1, r2);
|
|
Emit(opROR, r2, r1);
|
|
mov(r1, r2);
|
|
drop
|
|
|
|
|IL.opLSR1:
|
|
r2 := GetAnyReg();
|
|
Emit(opMOVC, r2, param2);
|
|
BinOp(r1, r2);
|
|
Emit(opLSR, r2, r1);
|
|
mov(r1, r2);
|
|
drop
|
|
|
|
|IL.opASR2:
|
|
UnOp(r1);
|
|
Emit(opASRC, r1, param2 MOD 32)
|
|
|
|
|IL.opLSL2:
|
|
UnOp(r1);
|
|
Emit(opLSLC, r1, param2 MOD 32)
|
|
|
|
|IL.opROR2:
|
|
UnOp(r1);
|
|
Emit(opRORC, r1, param2 MOD 32)
|
|
|
|
|IL.opLSR2:
|
|
UnOp(r1);
|
|
Emit(opLSRC, r1, param2 MOD 32)
|
|
|
|
|IL.opCHR:
|
|
UnOp(r1);
|
|
Emit(opANDC, r1, 255)
|
|
|
|
|IL.opWCHR:
|
|
UnOp(r1);
|
|
Emit(opANDC, r1, 65535)
|
|
|
|
|IL.opABS:
|
|
UnOp(r1);
|
|
Emit(opABS, r1, 0)
|
|
|
|
|IL.opLEN:
|
|
UnOp(r1);
|
|
drop;
|
|
EXCL(R.regs, r1);
|
|
|
|
WHILE param2 > 0 DO
|
|
UnOp(r2);
|
|
drop;
|
|
DEC(param2)
|
|
END;
|
|
|
|
INCL(R.regs, r1);
|
|
ASSERT(REG.GetReg(R, r1))
|
|
|
|
|IL.opSWITCH:
|
|
UnOp(r1);
|
|
IF param2 = 0 THEN
|
|
r2 := ACC
|
|
ELSE
|
|
r2 := R1
|
|
END;
|
|
IF r1 # r2 THEN
|
|
ASSERT(REG.GetReg(R, r2));
|
|
ASSERT(REG.Exchange(R, r1, r2));
|
|
drop
|
|
END;
|
|
drop
|
|
|
|
|IL.opENDSW:
|
|
|
|
|IL.opCASEL:
|
|
GetAcc;
|
|
Emit(opJLA, param1, param2);
|
|
drop
|
|
|
|
|IL.opCASER:
|
|
GetAcc;
|
|
Emit(opJGA, param1, param2);
|
|
drop
|
|
|
|
|IL.opCASELR:
|
|
GetAcc;
|
|
Emit(opJLA, param1, param2);
|
|
Emit(opJGA, param1, cmd.param3);
|
|
drop
|
|
|
|
|IL.opSBOOL:
|
|
BinOp(r2, r1);
|
|
Emit(opNEC, r2, 0);
|
|
str8(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opSBOOLC:
|
|
UnOp(r1);
|
|
Emit(opSTR8C, r1, ORD(param2 # 0));
|
|
drop
|
|
|
|
|IL.opINCC:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
ldr32(r2, r1);
|
|
addrc(r2, param2);
|
|
str32(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opINCCB, IL.opDECCB:
|
|
IF opcode = IL.opDECCB THEN
|
|
param2 := -param2
|
|
END;
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
ldr8(r2, r1);
|
|
addrc(r2, param2);
|
|
str8(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opINCB, IL.opDECB:
|
|
BinOp(r2, r1);
|
|
r3 := GetAnyReg();
|
|
ldr8(r3, r1);
|
|
IF opcode = IL.opINCB THEN
|
|
add(r3, r2)
|
|
ELSE
|
|
sub(r3, r2)
|
|
END;
|
|
str8(r1, r3);
|
|
drop;
|
|
drop;
|
|
drop
|
|
|
|
|IL.opINC, IL.opDEC:
|
|
BinOp(r2, r1);
|
|
r3 := GetAnyReg();
|
|
ldr32(r3, r1);
|
|
IF opcode = IL.opINC THEN
|
|
add(r3, r2)
|
|
ELSE
|
|
sub(r3, r2)
|
|
END;
|
|
str32(r1, r3);
|
|
drop;
|
|
drop;
|
|
drop
|
|
|
|
|IL.opINCL, IL.opEXCL:
|
|
BinOp(r2, r1);
|
|
IF opcode = IL.opINCL THEN
|
|
Emit(opINCL, r1, r2)
|
|
ELSE
|
|
Emit(opEXCL, r1, r2)
|
|
END;
|
|
drop;
|
|
drop
|
|
|
|
|IL.opINCLC, IL.opEXCLC:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
ldr32(r2, r1);
|
|
IF opcode = IL.opINCLC THEN
|
|
Emit(opINCLC, r2, param2)
|
|
ELSE
|
|
Emit(opEXCLC, r2, param2)
|
|
END;
|
|
str32(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opEQB, IL.opNEB:
|
|
BinOp(r1, r2);
|
|
Emit(opNEC, r1, 0);
|
|
Emit(opNEC, r2, 0);
|
|
IF opcode = IL.opEQB THEN
|
|
Emit(opEQ, r1, r2)
|
|
ELSE
|
|
Emit(opNE, r1, r2)
|
|
END;
|
|
drop
|
|
|
|
|IL.opCHKBYTE:
|
|
BinOp(r1, r2);
|
|
r3 := GetAnyReg();
|
|
mov(r3, r1);
|
|
Emit(opBTC, r3, 256);
|
|
jnz(r3, param1);
|
|
drop
|
|
|
|
|IL.opCHKIDX:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
mov(r2, r1);
|
|
Emit(opBTC, r2, param2);
|
|
jnz(r2, param1);
|
|
drop
|
|
|
|
|IL.opCHKIDX2:
|
|
BinOp(r1, r2);
|
|
IF param2 # -1 THEN
|
|
r3 := GetAnyReg();
|
|
mov(r3, r2);
|
|
Emit(opBT, r3, r1);
|
|
jnz(r3, param1);
|
|
drop
|
|
END;
|
|
INCL(R.regs, r1);
|
|
DEC(R.top);
|
|
R.stk[R.top] := r2
|
|
|
|
|IL.opEQP, IL.opNEP:
|
|
ProcAdr(GetAnyReg(), param1);
|
|
BinOp(r1, r2);
|
|
IF opcode = IL.opEQP THEN
|
|
Emit(opEQ, r1, r2)
|
|
ELSE
|
|
Emit(opNE, r1, r2)
|
|
END;
|
|
drop
|
|
|
|
|IL.opSAVEP:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
ProcAdr(r2, param2);
|
|
str32(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opPUSHP:
|
|
ProcAdr(GetAnyReg(), param2)
|
|
|
|
|IL.opPUSHT:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
mov(r2, r1);
|
|
subrc(r2, 4);
|
|
ldr32(r2, r2)
|
|
|
|
|IL.opGET, IL.opGETC:
|
|
IF opcode = IL.opGET THEN
|
|
BinOp(r1, r2)
|
|
ELSIF opcode = IL.opGETC THEN
|
|
UnOp(r2);
|
|
r1 := GetAnyReg();
|
|
movrc(r1, param1)
|
|
END;
|
|
drop;
|
|
drop;
|
|
|
|
CASE param2 OF
|
|
|1: ldr8(r1, r1); str8(r2, r1)
|
|
|2: ldr16(r1, r1); str16(r2, r1)
|
|
|4: ldr32(r1, r1); str32(r2, r1)
|
|
END
|
|
|
|
|IL.opNOT:
|
|
UnOp(r1);
|
|
Emit(opEQC, r1, 0)
|
|
|
|
|IL.opORD:
|
|
UnOp(r1);
|
|
Emit(opNEC, r1, 0)
|
|
|
|
|IL.opMIN:
|
|
BinOp(r1, r2);
|
|
Emit(opMIN, r1, r2);
|
|
drop
|
|
|
|
|IL.opMAX:
|
|
BinOp(r1, r2);
|
|
Emit(opMAX, r1, r2);
|
|
drop
|
|
|
|
|IL.opMINC:
|
|
UnOp(r1);
|
|
Emit(opMINC, r1, param2)
|
|
|
|
|IL.opMAXC:
|
|
UnOp(r1);
|
|
Emit(opMAXC, r1, param2)
|
|
|
|
|IL.opIN:
|
|
BinOp(r1, r2);
|
|
Emit(opIN, r1, r2);
|
|
drop
|
|
|
|
|IL.opINL:
|
|
r1 := GetAnyReg();
|
|
movrc(r1, param2);
|
|
BinOp(r2, r1);
|
|
Emit(opIN, r1, r2);
|
|
mov(r2, r1);
|
|
drop
|
|
|
|
|IL.opINR:
|
|
UnOp(r1);
|
|
Emit(opINC, r1, param2)
|
|
|
|
|IL.opERR:
|
|
CallRTL(IL._error, 4)
|
|
|
|
|IL.opEQS .. IL.opGES:
|
|
PushAll(4);
|
|
pushc(opcode - IL.opEQS);
|
|
CallRTL(IL._strcmp, 5);
|
|
GetAcc
|
|
|
|
|IL.opEQSW .. IL.opGESW:
|
|
PushAll(4);
|
|
pushc(opcode - IL.opEQSW);
|
|
CallRTL(IL._strcmpw, 5);
|
|
GetAcc
|
|
|
|
|IL.opCOPY:
|
|
PushAll(2);
|
|
pushc(param2);
|
|
CallRTL(IL._move, 3)
|
|
|
|
|IL.opMOVE:
|
|
PushAll(3);
|
|
CallRTL(IL._move, 3)
|
|
|
|
|IL.opCOPYA:
|
|
PushAll(4);
|
|
pushc(param2);
|
|
CallRTL(IL._arrcpy, 5);
|
|
GetAcc
|
|
|
|
|IL.opCOPYS:
|
|
PushAll(4);
|
|
pushc(param2);
|
|
CallRTL(IL._strcpy, 5)
|
|
|
|
|IL.opROT:
|
|
PushAll(0);
|
|
mov(ACC, SP);
|
|
push(ACC);
|
|
pushc(param2);
|
|
CallRTL(IL._rot, 2)
|
|
|
|
|IL.opLENGTH:
|
|
PushAll(2);
|
|
CallRTL(IL._length, 2);
|
|
GetAcc
|
|
|
|
|IL.opLENGTHW:
|
|
PushAll(2);
|
|
CallRTL(IL._lengthw, 2);
|
|
GetAcc
|
|
|
|
|IL.opSAVES:
|
|
UnOp(r2);
|
|
REG.PushAll_1(R);
|
|
r1 := GetAnyReg();
|
|
StrAdr(r1, param2);
|
|
push(r1);
|
|
drop;
|
|
push(r2);
|
|
drop;
|
|
pushc(param1);
|
|
CallRTL(IL._move, 3)
|
|
|
|
|IL.opRSET:
|
|
PushAll(2);
|
|
CallRTL(IL._set, 2);
|
|
GetAcc
|
|
|
|
|IL.opRSETR:
|
|
PushAll(1);
|
|
pushc(param2);
|
|
CallRTL(IL._set, 2);
|
|
GetAcc
|
|
|
|
|IL.opRSETL:
|
|
UnOp(r1);
|
|
REG.PushAll_1(R);
|
|
pushc(param2);
|
|
push(r1);
|
|
drop;
|
|
CallRTL(IL._set, 2);
|
|
GetAcc
|
|
|
|
|IL.opRSET1:
|
|
PushAll(1);
|
|
CallRTL(IL._set1, 1);
|
|
GetAcc
|
|
|
|
|IL.opNEW:
|
|
PushAll(1);
|
|
INC(param2, 8);
|
|
ASSERT(UTILS.Align(param2, 32));
|
|
pushc(param2);
|
|
pushc(param1);
|
|
CallRTL(IL._new, 3)
|
|
|
|
|IL.opTYPEGP:
|
|
UnOp(r1);
|
|
PushAll(0);
|
|
push(r1);
|
|
pushc(param2);
|
|
CallRTL(IL._guard, 2);
|
|
GetAcc
|
|
|
|
|IL.opIS:
|
|
PushAll(1);
|
|
pushc(param2);
|
|
CallRTL(IL._is, 2);
|
|
GetAcc
|
|
|
|
|IL.opISREC:
|
|
PushAll(2);
|
|
pushc(param2);
|
|
CallRTL(IL._guardrec, 3);
|
|
GetAcc
|
|
|
|
|IL.opTYPEGR:
|
|
PushAll(1);
|
|
pushc(param2);
|
|
CallRTL(IL._guardrec, 2);
|
|
GetAcc
|
|
|
|
|IL.opTYPEGD:
|
|
UnOp(r1);
|
|
PushAll(0);
|
|
subrc(r1, 4);
|
|
ldr32(r1, r1);
|
|
push(r1);
|
|
pushc(param2);
|
|
CallRTL(IL._guardrec, 2);
|
|
GetAcc
|
|
|
|
|IL.opCASET:
|
|
push(R1);
|
|
push(R1);
|
|
pushc(param2);
|
|
CallRTL(IL._guardrec, 2);
|
|
pop(R1);
|
|
jnz(ACC, param1)
|
|
|
|
|IL.opCONSTF:
|
|
movrc(GetAnyReg(), UTILS.d2s(cmd.float))
|
|
|
|
|IL.opMULF:
|
|
PushAll(2);
|
|
CallRTL(IL._fmul, 2);
|
|
GetAcc
|
|
|
|
|IL.opDIVF:
|
|
PushAll(2);
|
|
CallRTL(IL._fdiv, 2);
|
|
GetAcc
|
|
|
|
|IL.opDIVFI:
|
|
PushAll(2);
|
|
CallRTL(IL._fdivi, 2);
|
|
GetAcc
|
|
|
|
|IL.opADDF:
|
|
PushAll(2);
|
|
CallRTL(IL._fadd, 2);
|
|
GetAcc
|
|
|
|
|IL.opSUBFI:
|
|
PushAll(2);
|
|
CallRTL(IL._fsubi, 2);
|
|
GetAcc
|
|
|
|
|IL.opSUBF:
|
|
PushAll(2);
|
|
CallRTL(IL._fsub, 2);
|
|
GetAcc
|
|
|
|
|IL.opEQF..IL.opGEF:
|
|
PushAll(2);
|
|
pushc(opcode - IL.opEQF);
|
|
CallRTL(IL._fcmp, 3);
|
|
GetAcc
|
|
|
|
|IL.opFLOOR:
|
|
PushAll(1);
|
|
CallRTL(IL._floor, 1);
|
|
GetAcc
|
|
|
|
|IL.opFLT:
|
|
PushAll(1);
|
|
CallRTL(IL._flt, 1);
|
|
GetAcc
|
|
|
|
|IL.opUMINF:
|
|
UnOp(r1);
|
|
Emit(opXORC, r1, ORD({31}))
|
|
|
|
|IL.opFABS:
|
|
UnOp(r1);
|
|
Emit(opANDC, r1, ORD({0..30}))
|
|
|
|
|IL.opINF:
|
|
movrc(GetAnyReg(), inf)
|
|
|
|
|IL.opPUSHF:
|
|
UnOp(r1);
|
|
push(r1);
|
|
drop
|
|
|
|
|IL.opPACK:
|
|
PushAll(2);
|
|
CallRTL(IL._pack, 2)
|
|
|
|
|IL.opPACKC:
|
|
PushAll(1);
|
|
pushc(param2);
|
|
CallRTL(IL._pack, 2)
|
|
|
|
|IL.opUNPK:
|
|
PushAll(2);
|
|
CallRTL(IL._unpk, 2)
|
|
|
|
|IL.opCODE:
|
|
OutInt(param2)
|
|
|
|
END;
|
|
|
|
cmd := cmd.next(IL.COMMAND)
|
|
END;
|
|
|
|
ASSERT(R.pushed = 0);
|
|
ASSERT(R.top = -1)
|
|
END translate;
|
|
|
|
|
|
PROCEDURE prolog;
|
|
BEGIN
|
|
Emit(opLEA, SP + LStack * 256, 0);
|
|
Emit(opLEA, ACC + LTypes * 256, 0);
|
|
push(ACC);
|
|
Emit(opLEA, ACC + LHeap * 256, 0);
|
|
push(ACC);
|
|
pushc(CHL.Length(IL.codes.types));
|
|
CallRTL(IL._init, 3)
|
|
END prolog;
|
|
|
|
|
|
PROCEDURE epilog (ram: INTEGER);
|
|
VAR
|
|
tcount, dcount, i, offTypes, offStrings, szData, szGlobal, szHeapStack: INTEGER;
|
|
|
|
BEGIN
|
|
Emit(opSTOP, 0, 0);
|
|
|
|
offTypes := count;
|
|
|
|
tcount := CHL.Length(IL.codes.types);
|
|
FOR i := 0 TO tcount - 1 DO
|
|
OutInt(CHL.GetInt(IL.codes.types, i))
|
|
END;
|
|
|
|
offStrings := count;
|
|
dcount := CHL.Length(IL.codes.data);
|
|
FOR i := 0 TO dcount - 1 DO
|
|
OutByte(CHL.GetByte(IL.codes.data, i))
|
|
END;
|
|
|
|
IF dcount MOD 4 # 0 THEN
|
|
i := 4 - dcount MOD 4;
|
|
WHILE i > 0 DO
|
|
OutByte(0);
|
|
DEC(i)
|
|
END
|
|
END;
|
|
|
|
szData := count - offTypes;
|
|
szGlobal := (IL.codes.bss DIV 4 + 1) * 4;
|
|
szHeapStack := ram - szData - szGlobal;
|
|
|
|
OutInt(offTypes);
|
|
OutInt(offStrings);
|
|
OutInt(szGlobal DIV 4);
|
|
OutInt(szHeapStack DIV 4);
|
|
FOR i := 1 TO 8 DO
|
|
OutInt(0)
|
|
END
|
|
END epilog;
|
|
|
|
|
|
PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
|
|
CONST
|
|
minRAM = 32*1024;
|
|
maxRAM = 256*1024;
|
|
|
|
VAR
|
|
szData, szRAM: INTEGER;
|
|
|
|
BEGIN
|
|
szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV 4 + IL.codes.bss DIV 4 + 2) * 4;
|
|
szRAM := MIN(MAX(options.ram, minRAM), maxRAM) * 1024;
|
|
|
|
IF szRAM - szData < 1024*1024 THEN
|
|
ERRORS.Error(208)
|
|
END;
|
|
|
|
count := 0;
|
|
WR.Create(outname);
|
|
|
|
REG.Init(R, push, pop, mov, xchg, NIL, NIL, GPRs, {});
|
|
|
|
prolog;
|
|
translate;
|
|
epilog(szRAM);
|
|
|
|
WR.Close
|
|
END CodeGen;
|
|
|
|
|
|
END RVM32I. |