kolibrios-fun/programs/develop/oberon07/source/RVMxI.ob07

1428 lines
32 KiB
Plaintext
Raw Normal View History

(*
BSD 2-Clause License
Copyright (c) 2020-2021, 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.opCHR:
UnOp(r1);
Emit(opANDC, r1, 255)
|IL.opWCHR:
UnOp(r1);
Emit(opANDC, r1, 65535)
|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.opCHKBYTE:
BinOp(r1, r2);
Emit(opCMPC, r1, 256);
Emit(opJBT, param1, 0)
|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.