kolibrios-fun/programs/develop/oberon07/Source/RVM32I.ob07
maxcodehack 2f54c7de00 Update oberon07 from akron1's github
git-svn-id: svn://kolibrios.org@8097 a494cfbc-eb01-0410-851d-a64ba20cac60
2020-10-13 07:58:51 +00:00

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.