1415 lines
31 KiB
Plaintext
1415 lines
31 KiB
Plaintext
(*
|
|
BSD 2-Clause License
|
|
|
|
Copyright (c) 2020-2022, Anton Krotov
|
|
All rights reserved.
|
|
*)
|
|
|
|
MODULE RVMxI;
|
|
|
|
IMPORT
|
|
|
|
PROG, WR := WRITER, IL, CHL := CHUNKLISTS, REG, UTILS, STRINGS, ERRORS, TARGETS;
|
|
|
|
|
|
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; opNOP = 5;
|
|
opXCHG = 6; opLDB = 7; opLDH = 8; opLDW = 9; opPUSH = 10; opPUSHC = 11;
|
|
opPOP = 12; opLABEL = 13; opLEA = 14; opLLA = 15;
|
|
opLDD = 16; (* 17, 18 *)
|
|
opJMP = 19; opCALL = 20; opCALLI = 21;
|
|
|
|
opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32;
|
|
opSTB = 34; opSTH = 36; opSTW = 38; opSTD = 40; (* 42, 44 *)
|
|
opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54;
|
|
opLSL = 56; opROR = 58; (* 60, 62 *) opCMP = 64;
|
|
|
|
opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33;
|
|
opSTBC = 35; opSTHC = 37; opSTWC = 39; opSTDC = 41; (* 43, 45 *)
|
|
opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55;
|
|
opLSLC = 57; opRORC = 59; (* 61, 63 *) opCMPC = 65;
|
|
|
|
opBIT = 66; opSYSCALL = 67; opJBT = 68; opADDRC = 69;
|
|
|
|
opJEQ = 70; opJNE = 71; opJLT = 72; opJGE = 73; opJGT = 74; opJLE = 75;
|
|
opSEQ = 76; opSNE = 77; opSLT = 78; opSGE = 79; opSGT = 80; opSLE = 81;
|
|
|
|
|
|
VAR
|
|
|
|
R: REG.REGS; count, szWord: INTEGER;
|
|
|
|
ldr, str: PROCEDURE (r1, r2: INTEGER);
|
|
|
|
|
|
PROCEDURE OutByte (n: BYTE);
|
|
BEGIN
|
|
WR.WriteByte(n);
|
|
INC(count)
|
|
END OutByte;
|
|
|
|
|
|
PROCEDURE OutInt (n: INTEGER);
|
|
BEGIN
|
|
IF szWord = 8 THEN
|
|
WR.Write64LE(n);
|
|
INC(count, 8)
|
|
ELSE (* szWord = 4 *)
|
|
WR.Write32LE(n);
|
|
INC(count, 4)
|
|
END
|
|
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 ldr64 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opLDD, r2 * 256 + r1, 0)
|
|
END ldr64;
|
|
|
|
|
|
PROCEDURE ldr32 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opLDW, r2 * 256 + r1, 0)
|
|
END ldr32;
|
|
|
|
|
|
PROCEDURE ldr16 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opLDH, r2 * 256 + r1, 0)
|
|
END ldr16;
|
|
|
|
|
|
PROCEDURE ldr8 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opLDB, r2 * 256 + r1, 0)
|
|
END ldr8;
|
|
|
|
|
|
PROCEDURE str64 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opSTD, r1 * 256 + r2, 0)
|
|
END str64;
|
|
|
|
|
|
PROCEDURE str32 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opSTW, r1 * 256 + r2, 0)
|
|
END str32;
|
|
|
|
|
|
PROCEDURE str16 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opSTH, r1 * 256 + r2, 0)
|
|
END str16;
|
|
|
|
|
|
PROCEDURE str8 (r1, r2: INTEGER);
|
|
BEGIN
|
|
Emit(opSTB, r1 * 256 + r2, 0)
|
|
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(opCMPC, r, 0);
|
|
Emit(opJNE, label, 0)
|
|
END jnz;
|
|
|
|
|
|
PROCEDURE CallRTL (proc, par: INTEGER);
|
|
BEGIN
|
|
Emit(opCALL, IL.codes.rtl[proc], 0);
|
|
addrc(SP, par * szWord)
|
|
END CallRTL;
|
|
|
|
|
|
PROCEDURE jcc (cc: INTEGER): INTEGER;
|
|
BEGIN
|
|
CASE cc OF
|
|
|IL.opEQ, IL.opEQC: cc := opJEQ
|
|
|IL.opNE, IL.opNEC: cc := opJNE
|
|
|IL.opLT, IL.opLTC: cc := opJLT
|
|
|IL.opLE, IL.opLEC: cc := opJLE
|
|
|IL.opGT, IL.opGTC: cc := opJGT
|
|
|IL.opGE, IL.opGEC: cc := opJGE
|
|
END
|
|
RETURN cc
|
|
END jcc;
|
|
|
|
|
|
PROCEDURE shift1 (op, param: INTEGER);
|
|
VAR
|
|
r1, r2: INTEGER;
|
|
|
|
BEGIN
|
|
r2 := GetAnyReg();
|
|
Emit(opMOVC, r2, param);
|
|
BinOp(r1, r2);
|
|
Emit(op, r2, r1);
|
|
mov(r1, r2);
|
|
drop
|
|
END shift1;
|
|
|
|
|
|
PROCEDURE shift (op: INTEGER);
|
|
VAR
|
|
r1, r2: INTEGER;
|
|
|
|
BEGIN
|
|
BinOp(r1, r2);
|
|
Emit(op, r1, r2);
|
|
drop
|
|
END shift;
|
|
|
|
|
|
PROCEDURE translate (szWord: INTEGER);
|
|
VAR
|
|
cmd, next: IL.COMMAND;
|
|
|
|
opcode, param1, param2, r1, r2, r3,
|
|
a, b, label, opLD, opST, opSTC: INTEGER;
|
|
|
|
BEGIN
|
|
IF szWord = 8 THEN
|
|
opLD := opLDD;
|
|
opST := opSTD;
|
|
opSTC := opSTDC
|
|
ELSE
|
|
opLD := opLDW;
|
|
opST := opSTW;
|
|
opSTC := opSTWC
|
|
END;
|
|
|
|
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 * szWord)
|
|
END
|
|
|
|
|IL.opNOP, IL.opAND, IL.opOR:
|
|
|
|
|IL.opSADR:
|
|
StrAdr(GetAnyReg(), param2)
|
|
|
|
|IL.opGADR:
|
|
GlobalAdr(GetAnyReg(), param2)
|
|
|
|
|IL.opLADR:
|
|
param2 := param2 * szWord;
|
|
next := cmd.next(IL.COMMAND);
|
|
IF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 8) OR (next.opcode = IL.opSAVE64) THEN
|
|
UnOp(r1);
|
|
Emit(opSTD, BP * 256 + r1, param2);
|
|
drop;
|
|
cmd := next
|
|
ELSIF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 4) OR (next.opcode = IL.opSAVE32) THEN
|
|
UnOp(r1);
|
|
Emit(opSTW, BP * 256 + r1, param2);
|
|
drop;
|
|
cmd := next
|
|
ELSIF next.opcode = IL.opSAVE16 THEN
|
|
UnOp(r1);
|
|
Emit(opSTH, BP * 256 + r1, param2);
|
|
drop;
|
|
cmd := next
|
|
ELSIF next.opcode = IL.opSAVE8 THEN
|
|
UnOp(r1);
|
|
Emit(opSTB, BP * 256 + r1, param2);
|
|
drop;
|
|
cmd := next
|
|
ELSE
|
|
Emit(opADDRC, BP * 256 + GetAnyReg(), param2)
|
|
END
|
|
|
|
|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
|
|
mov(ACC, r1)
|
|
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:
|
|
next := cmd.next(IL.COMMAND);
|
|
IF (next.opcode = IL.opPARAM) & (next.param2 = 1) THEN
|
|
pushc(param2);
|
|
cmd := next
|
|
ELSE
|
|
movrc(GetAnyReg(), param2)
|
|
END
|
|
|
|
|IL.opDROP:
|
|
UnOp(r1);
|
|
drop
|
|
|
|
|IL.opSAVEC:
|
|
UnOp(r1);
|
|
Emit(opSTC, r1, param2);
|
|
drop
|
|
|
|
|IL.opSAVE8C:
|
|
UnOp(r1);
|
|
Emit(opSTBC, r1, param2 MOD 256);
|
|
drop
|
|
|
|
|IL.opSAVE16C:
|
|
UnOp(r1);
|
|
Emit(opSTHC, r1, param2 MOD 65536);
|
|
drop
|
|
|
|
|IL.opSAVE, IL.opSAVEF:
|
|
BinOp(r2, r1);
|
|
str(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opSAVE32:
|
|
BinOp(r2, r1);
|
|
str32(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opSAVE64:
|
|
BinOp(r2, r1);
|
|
str64(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opSAVEFI:
|
|
BinOp(r2, r1);
|
|
str(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.opGLOAD64:
|
|
r1 := GetAnyReg();
|
|
GlobalAdr(r1, param2);
|
|
ldr64(r1, r1)
|
|
|
|
|IL.opVADR:
|
|
Emit(opLD, BP * 256 + GetAnyReg(), param2 * szWord)
|
|
|
|
|IL.opLLOAD32:
|
|
Emit(opLDW, BP * 256 + GetAnyReg(), param2 * szWord)
|
|
|
|
|IL.opLLOAD64:
|
|
Emit(opLDD, BP * 256 + GetAnyReg(), param2 * szWord)
|
|
|
|
|IL.opVLOAD32:
|
|
r1 := GetAnyReg();
|
|
Emit(opLD, BP * 256 + r1, param2 * szWord);
|
|
ldr32(r1, r1)
|
|
|
|
|IL.opVLOAD64:
|
|
r1 := GetAnyReg();
|
|
Emit(opLDD, BP * 256 + r1, param2 * szWord);
|
|
ldr64(r1, r1)
|
|
|
|
|IL.opGLOAD16:
|
|
r1 := GetAnyReg();
|
|
GlobalAdr(r1, param2);
|
|
ldr16(r1, r1)
|
|
|
|
|IL.opLLOAD16:
|
|
Emit(opLDH, BP * 256 + GetAnyReg(), param2 * szWord)
|
|
|
|
|IL.opVLOAD16:
|
|
r1 := GetAnyReg();
|
|
Emit(opLD, BP * 256 + r1, param2 * szWord);
|
|
ldr16(r1, r1)
|
|
|
|
|IL.opGLOAD8:
|
|
r1 := GetAnyReg();
|
|
GlobalAdr(r1, param2);
|
|
ldr8(r1, r1)
|
|
|
|
|IL.opLLOAD8:
|
|
Emit(opLDB, BP * 256 + GetAnyReg(), param2 * szWord)
|
|
|
|
|IL.opVLOAD8:
|
|
r1 := GetAnyReg();
|
|
Emit(opLD, BP * 256 + r1, param2 * szWord);
|
|
ldr8(r1, r1)
|
|
|
|
|IL.opLOAD8:
|
|
UnOp(r1);
|
|
ldr8(r1, r1)
|
|
|
|
|IL.opLOAD16:
|
|
UnOp(r1);
|
|
ldr16(r1, r1)
|
|
|
|
|IL.opLOAD32:
|
|
UnOp(r1);
|
|
ldr32(r1, r1)
|
|
|
|
|IL.opLOAD64:
|
|
UnOp(r1);
|
|
ldr64(r1, r1)
|
|
|
|
|IL.opLOADF:
|
|
UnOp(r1);
|
|
ldr(r1, r1)
|
|
|
|
|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);
|
|
next := cmd.next(IL.COMMAND);
|
|
CASE next.opcode OF
|
|
|IL.opLOADF:
|
|
Emit(opLD, r1 * 256 + r1, param2);
|
|
cmd := next
|
|
|IL.opLOAD64:
|
|
Emit(opLDD, r1 * 256 + r1, param2);
|
|
cmd := next
|
|
|IL.opLOAD32:
|
|
Emit(opLDW, r1 * 256 + r1, param2);
|
|
cmd := next
|
|
|IL.opLOAD16:
|
|
Emit(opLDH, r1 * 256 + r1, param2);
|
|
cmd := next
|
|
|IL.opLOAD8:
|
|
Emit(opLDB, r1 * 256 + r1, param2);
|
|
cmd := next
|
|
ELSE
|
|
addrc(r1, param2)
|
|
END
|
|
|
|
|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 .. IL.opGE, IL.opEQC .. IL.opGEC:
|
|
IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN
|
|
BinOp(r1, r2);
|
|
Emit(opCMP, r1, r2);
|
|
drop
|
|
ELSE
|
|
UnOp(r1);
|
|
Emit(opCMPC, r1, param2)
|
|
END;
|
|
next := cmd.next(IL.COMMAND);
|
|
IF next.opcode = IL.opJZ THEN
|
|
Emit(ORD(BITS(jcc(opcode)) / {0}), next.param1, 0);
|
|
cmd := next;
|
|
drop
|
|
ELSIF next.opcode = IL.opJNZ THEN
|
|
Emit(jcc(opcode), next.param1, 0);
|
|
cmd := next;
|
|
drop
|
|
ELSE
|
|
Emit(jcc(opcode) + 6, r1, 0)
|
|
END
|
|
|
|
|IL.opJNZ1:
|
|
UnOp(r1);
|
|
jnz(r1, param1)
|
|
|
|
|IL.opJG:
|
|
UnOp(r1);
|
|
Emit(opCMPC, r1, 0);
|
|
Emit(opJGT, param1, 0)
|
|
|
|
|IL.opJNZ:
|
|
UnOp(r1);
|
|
jnz(r1, param1);
|
|
drop
|
|
|
|
|IL.opJZ:
|
|
UnOp(r1);
|
|
Emit(opCMPC, r1, 0);
|
|
Emit(opJEQ, param1, 0);
|
|
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:
|
|
shift(opASR)
|
|
|
|
|IL.opLSL:
|
|
shift(opLSL)
|
|
|
|
|IL.opROR:
|
|
shift(opROR)
|
|
|
|
|IL.opLSR:
|
|
shift(opLSR)
|
|
|
|
|IL.opASR1:
|
|
shift1(opASR, param2)
|
|
|
|
|IL.opLSL1:
|
|
shift1(opLSL, param2)
|
|
|
|
|IL.opROR1:
|
|
shift1(opROR, param2)
|
|
|
|
|IL.opLSR1:
|
|
shift1(opLSR, param2)
|
|
|
|
|IL.opASR2:
|
|
UnOp(r1);
|
|
Emit(opASRC, r1, param2 MOD (szWord * 8))
|
|
|
|
|IL.opLSL2:
|
|
UnOp(r1);
|
|
Emit(opLSLC, r1, param2 MOD (szWord * 8))
|
|
|
|
|IL.opROR2:
|
|
UnOp(r1);
|
|
Emit(opRORC, r1, param2 MOD (szWord * 8))
|
|
|
|
|IL.opLSR2:
|
|
UnOp(r1);
|
|
Emit(opLSRC, r1, param2 MOD (szWord * 8))
|
|
|
|
|IL.opABS:
|
|
UnOp(r1);
|
|
Emit(opCMPC, r1, 0);
|
|
label := IL.NewLabel();
|
|
Emit(opJGE, label, 0);
|
|
Emit(opNEG, r1, 0);
|
|
Emit(opLABEL, label, 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:
|
|
Emit(opCMPC, ACC, param1);
|
|
Emit(opJLT, param2, 0)
|
|
|
|
|IL.opCASER:
|
|
Emit(opCMPC, ACC, param1);
|
|
Emit(opJGT, param2, 0)
|
|
|
|
|IL.opCASELR:
|
|
Emit(opCMPC, ACC, param1);
|
|
IF param2 = cmd.param3 THEN
|
|
Emit(opJNE, param2, 0)
|
|
ELSE
|
|
Emit(opJLT, param2, 0);
|
|
Emit(opJGT, cmd.param3, 0)
|
|
END
|
|
|
|
|IL.opSBOOL:
|
|
BinOp(r2, r1);
|
|
Emit(opCMPC, r2, 0);
|
|
Emit(opSNE, r2, 0);
|
|
str8(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opSBOOLC:
|
|
UnOp(r1);
|
|
Emit(opSTBC, r1, ORD(param2 # 0));
|
|
drop
|
|
|
|
|IL.opINCC:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
ldr(r2, r1);
|
|
addrc(r2, param2);
|
|
str(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();
|
|
ldr(r3, r1);
|
|
IF opcode = IL.opINC THEN
|
|
add(r3, r2)
|
|
ELSE
|
|
sub(r3, r2)
|
|
END;
|
|
str(r1, r3);
|
|
drop;
|
|
drop;
|
|
drop
|
|
|
|
|IL.opINCL, IL.opEXCL:
|
|
BinOp(r2, r1);
|
|
Emit(opBIT, r2, r2);
|
|
r3 := GetAnyReg();
|
|
ldr(r3, r1);
|
|
IF opcode = IL.opINCL THEN
|
|
Emit(opOR, r3, r2)
|
|
ELSE
|
|
Emit(opNOT, r2, 0);
|
|
Emit(opAND, r3, r2)
|
|
END;
|
|
str(r1, r3);
|
|
drop;
|
|
drop;
|
|
drop
|
|
|
|
|IL.opINCLC, IL.opEXCLC:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
ldr(r2, r1);
|
|
IF opcode = IL.opINCLC THEN
|
|
Emit(opORC, r2, ORD({param2}))
|
|
ELSE
|
|
Emit(opANDC, r2, ORD(-{param2}))
|
|
END;
|
|
str(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opEQB, IL.opNEB:
|
|
BinOp(r1, r2);
|
|
Emit(opCMPC, r1, 0);
|
|
Emit(opSNE, r1, 0);
|
|
Emit(opCMPC, r2, 0);
|
|
Emit(opSNE, r2, 0);
|
|
Emit(opCMP, r1, r2);
|
|
IF opcode = IL.opEQB THEN
|
|
Emit(opSEQ, r1, 0)
|
|
ELSE
|
|
Emit(opSNE, r1, 0)
|
|
END;
|
|
drop
|
|
|
|
|IL.opCHKIDX:
|
|
UnOp(r1);
|
|
Emit(opCMPC, r1, param2);
|
|
Emit(opJBT, param1, 0)
|
|
|
|
|IL.opCHKIDX2:
|
|
BinOp(r1, r2);
|
|
IF param2 # -1 THEN
|
|
Emit(opCMP, r2, r1);
|
|
Emit(opJBT, param1, 0)
|
|
END;
|
|
INCL(R.regs, r1);
|
|
DEC(R.top);
|
|
R.stk[R.top] := r2
|
|
|
|
|IL.opEQP, IL.opNEP:
|
|
ProcAdr(GetAnyReg(), param1);
|
|
BinOp(r1, r2);
|
|
Emit(opCMP, r1, r2);
|
|
IF opcode = IL.opEQP THEN
|
|
Emit(opSEQ, r1, 0)
|
|
ELSE
|
|
Emit(opSNE, r1, 0)
|
|
END;
|
|
drop
|
|
|
|
|IL.opSAVEP:
|
|
UnOp(r1);
|
|
r2 := GetAnyReg();
|
|
ProcAdr(r2, param2);
|
|
str(r1, r2);
|
|
drop;
|
|
drop
|
|
|
|
|IL.opPUSHP:
|
|
ProcAdr(GetAnyReg(), param2)
|
|
|
|
|IL.opPUSHT:
|
|
UnOp(r1);
|
|
Emit(opLD, r1 * 256 + GetAnyReg(), -szWord)
|
|
|
|
|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)
|
|
|8: ldr64(r1, r1); str64(r2, r1)
|
|
END
|
|
|
|
|IL.opNOT:
|
|
UnOp(r1);
|
|
Emit(opCMPC, r1, 0);
|
|
Emit(opSEQ, r1, 0)
|
|
|
|
|IL.opORD:
|
|
UnOp(r1);
|
|
Emit(opCMPC, r1, 0);
|
|
Emit(opSNE, r1, 0)
|
|
|
|
|IL.opMIN, IL.opMAX:
|
|
BinOp(r1, r2);
|
|
Emit(opCMP, r1, r2);
|
|
label := IL.NewLabel();
|
|
IF opcode = IL.opMIN THEN
|
|
Emit(opJLE, label, 0)
|
|
ELSE
|
|
Emit(opJGE, label, 0)
|
|
END;
|
|
Emit(opMOV, r1, r2);
|
|
Emit(opLABEL, label, 0);
|
|
drop
|
|
|
|
|IL.opMINC, IL.opMAXC:
|
|
UnOp(r1);
|
|
Emit(opCMPC, r1, param2);
|
|
label := IL.NewLabel();
|
|
IF opcode = IL.opMINC THEN
|
|
Emit(opJLE, label, 0)
|
|
ELSE
|
|
Emit(opJGE, label, 0)
|
|
END;
|
|
Emit(opMOVC, r1, param2);
|
|
Emit(opLABEL, label, 0)
|
|
|
|
|IL.opIN:
|
|
BinOp(r1, r2);
|
|
Emit(opBIT, r1, r1);
|
|
Emit(opAND, r1, r2);
|
|
Emit(opCMPC, r1, 0);
|
|
Emit(opSNE, r1, 0);
|
|
drop
|
|
|
|
|IL.opINL:
|
|
UnOp(r1);
|
|
Emit(opANDC, r1, ORD({param2}));
|
|
Emit(opCMPC, r1, 0);
|
|
Emit(opSNE, r1, 0)
|
|
|
|
|IL.opINR:
|
|
UnOp(r1);
|
|
Emit(opBIT, r1, r1);
|
|
Emit(opANDC, r1, param2);
|
|
Emit(opCMPC, r1, 0);
|
|
Emit(opSNE, r1, 0)
|
|
|
|
|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, szWord);
|
|
ASSERT(UTILS.Align(param2, szWord));
|
|
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, szWord);
|
|
ldr(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:
|
|
IF szWord = 8 THEN
|
|
movrc(GetAnyReg(), UTILS.splitf(cmd.float, a, b))
|
|
ELSE (* szWord = 4 *)
|
|
movrc(GetAnyReg(), UTILS.d2s(cmd.float))
|
|
END
|
|
|
|
|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(opRORC, r1, -1);
|
|
Emit(opXORC, r1, 1);
|
|
Emit(opRORC, r1, 1)
|
|
|
|
|IL.opFABS:
|
|
UnOp(r1);
|
|
Emit(opLSLC, r1, 1);
|
|
Emit(opLSRC, r1, 1)
|
|
|
|
|IL.opINF:
|
|
r1 := GetAnyReg();
|
|
Emit(opMOVC, r1, 1);
|
|
Emit(opRORC, r1, 1);
|
|
Emit(opASRC, r1, 7 + 3 * ORD(szWord = 8));
|
|
Emit(opLSRC, r1, 1)
|
|
|
|
|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)
|
|
|
|
|IL.opLADR_SAVE:
|
|
UnOp(r1);
|
|
Emit(opST, BP * 256 + r1, param2 * szWord);
|
|
drop
|
|
|
|
|IL.opLADR_INCC:
|
|
r1 := GetAnyReg();
|
|
Emit(opLD, BP * 256 + r1, param1 * szWord);
|
|
Emit(opADDC, r1, param2);
|
|
Emit(opST, BP * 256 + r1, param1 * szWord);
|
|
drop
|
|
|
|
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, szWord: 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 szWord # 0 THEN
|
|
i := szWord - dcount MOD szWord;
|
|
WHILE i > 0 DO
|
|
OutByte(0);
|
|
DEC(i)
|
|
END
|
|
END;
|
|
|
|
szData := count - offTypes;
|
|
szGlobal := (IL.codes.bss DIV szWord + 1) * szWord;
|
|
szHeapStack := ram - szData - szGlobal;
|
|
|
|
OutInt(offTypes);
|
|
OutInt(offStrings);
|
|
OutInt(szGlobal DIV szWord);
|
|
OutInt(szHeapStack DIV szWord);
|
|
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
|
|
szWord := TARGETS.WordSize;
|
|
IF szWord = 8 THEN
|
|
ldr := ldr64;
|
|
str := str64
|
|
ELSE
|
|
ldr := ldr32;
|
|
str := str32
|
|
END;
|
|
szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV szWord + IL.codes.bss DIV szWord + 2) * szWord;
|
|
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, GPRs);
|
|
|
|
prolog;
|
|
translate(szWord);
|
|
epilog(szRAM, szWord);
|
|
|
|
WR.Close
|
|
END CodeGen;
|
|
|
|
|
|
END RVMxI. |