(* 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.