RVMxI.ob07 30 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415
  1. (*
  2. BSD 2-Clause License
  3. Copyright (c) 2020-2022, Anton Krotov
  4. All rights reserved.
  5. *)
  6. MODULE RVMxI;
  7. IMPORT
  8. PROG, WR := WRITER, IL, CHL := CHUNKLISTS, REG, UTILS, STRINGS, ERRORS, TARGETS;
  9. CONST
  10. LTypes = 0;
  11. LStrings = 1;
  12. LGlobal = 2;
  13. LHeap = 3;
  14. LStack = 4;
  15. numGPRs = 3;
  16. R0 = 0; R1 = 1;
  17. BP = 3; SP = 4;
  18. ACC = R0;
  19. GPRs = {0 .. 2} + {5 .. numGPRs + 1};
  20. opSTOP = 0; opRET = 1; opENTER = 2; opNEG = 3; opNOT = 4; opNOP = 5;
  21. opXCHG = 6; opLDB = 7; opLDH = 8; opLDW = 9; opPUSH = 10; opPUSHC = 11;
  22. opPOP = 12; opLABEL = 13; opLEA = 14; opLLA = 15;
  23. opLDD = 16; (* 17, 18 *)
  24. opJMP = 19; opCALL = 20; opCALLI = 21;
  25. opMOV = 22; opMUL = 24; opADD = 26; opSUB = 28; opDIV = 30; opMOD = 32;
  26. opSTB = 34; opSTH = 36; opSTW = 38; opSTD = 40; (* 42, 44 *)
  27. opAND = 46; opOR = 48; opXOR = 50; opASR = 52; opLSR = 54;
  28. opLSL = 56; opROR = 58; (* 60, 62 *) opCMP = 64;
  29. opMOVC = 23; opMULC = 25; opADDC = 27; opSUBC = 29; opDIVC = 31; opMODC = 33;
  30. opSTBC = 35; opSTHC = 37; opSTWC = 39; opSTDC = 41; (* 43, 45 *)
  31. opANDC = 47; opORC = 49; opXORC = 51; opASRC = 53; opLSRC = 55;
  32. opLSLC = 57; opRORC = 59; (* 61, 63 *) opCMPC = 65;
  33. opBIT = 66; opSYSCALL = 67; opJBT = 68; opADDRC = 69;
  34. opJEQ = 70; opJNE = 71; opJLT = 72; opJGE = 73; opJGT = 74; opJLE = 75;
  35. opSEQ = 76; opSNE = 77; opSLT = 78; opSGE = 79; opSGT = 80; opSLE = 81;
  36. VAR
  37. R: REG.REGS; count, szWord: INTEGER;
  38. ldr, str: PROCEDURE (r1, r2: INTEGER);
  39. PROCEDURE OutByte (n: BYTE);
  40. BEGIN
  41. WR.WriteByte(n);
  42. INC(count)
  43. END OutByte;
  44. PROCEDURE OutInt (n: INTEGER);
  45. BEGIN
  46. IF szWord = 8 THEN
  47. WR.Write64LE(n);
  48. INC(count, 8)
  49. ELSE (* szWord = 4 *)
  50. WR.Write32LE(n);
  51. INC(count, 4)
  52. END
  53. END OutInt;
  54. PROCEDURE Emit (op, par1, par2: INTEGER);
  55. BEGIN
  56. OutInt(op);
  57. OutInt(par1);
  58. OutInt(par2)
  59. END Emit;
  60. PROCEDURE drop;
  61. BEGIN
  62. REG.Drop(R)
  63. END drop;
  64. PROCEDURE GetAnyReg (): INTEGER;
  65. RETURN REG.GetAnyReg(R)
  66. END GetAnyReg;
  67. PROCEDURE GetAcc;
  68. BEGIN
  69. ASSERT(REG.GetReg(R, ACC))
  70. END GetAcc;
  71. PROCEDURE UnOp (VAR r: INTEGER);
  72. BEGIN
  73. REG.UnOp(R, r)
  74. END UnOp;
  75. PROCEDURE BinOp (VAR r1, r2: INTEGER);
  76. BEGIN
  77. REG.BinOp(R, r1, r2)
  78. END BinOp;
  79. PROCEDURE PushAll (NumberOfParameters: INTEGER);
  80. BEGIN
  81. REG.PushAll(R);
  82. DEC(R.pushed, NumberOfParameters)
  83. END PushAll;
  84. PROCEDURE push (r: INTEGER);
  85. BEGIN
  86. Emit(opPUSH, r, 0)
  87. END push;
  88. PROCEDURE pop (r: INTEGER);
  89. BEGIN
  90. Emit(opPOP, r, 0)
  91. END pop;
  92. PROCEDURE mov (r1, r2: INTEGER);
  93. BEGIN
  94. Emit(opMOV, r1, r2)
  95. END mov;
  96. PROCEDURE xchg (r1, r2: INTEGER);
  97. BEGIN
  98. Emit(opXCHG, r1, r2)
  99. END xchg;
  100. PROCEDURE addrc (r, c: INTEGER);
  101. BEGIN
  102. Emit(opADDC, r, c)
  103. END addrc;
  104. PROCEDURE subrc (r, c: INTEGER);
  105. BEGIN
  106. Emit(opSUBC, r, c)
  107. END subrc;
  108. PROCEDURE movrc (r, c: INTEGER);
  109. BEGIN
  110. Emit(opMOVC, r, c)
  111. END movrc;
  112. PROCEDURE pushc (c: INTEGER);
  113. BEGIN
  114. Emit(opPUSHC, c, 0)
  115. END pushc;
  116. PROCEDURE add (r1, r2: INTEGER);
  117. BEGIN
  118. Emit(opADD, r1, r2)
  119. END add;
  120. PROCEDURE sub (r1, r2: INTEGER);
  121. BEGIN
  122. Emit(opSUB, r1, r2)
  123. END sub;
  124. PROCEDURE ldr64 (r1, r2: INTEGER);
  125. BEGIN
  126. Emit(opLDD, r2 * 256 + r1, 0)
  127. END ldr64;
  128. PROCEDURE ldr32 (r1, r2: INTEGER);
  129. BEGIN
  130. Emit(opLDW, r2 * 256 + r1, 0)
  131. END ldr32;
  132. PROCEDURE ldr16 (r1, r2: INTEGER);
  133. BEGIN
  134. Emit(opLDH, r2 * 256 + r1, 0)
  135. END ldr16;
  136. PROCEDURE ldr8 (r1, r2: INTEGER);
  137. BEGIN
  138. Emit(opLDB, r2 * 256 + r1, 0)
  139. END ldr8;
  140. PROCEDURE str64 (r1, r2: INTEGER);
  141. BEGIN
  142. Emit(opSTD, r1 * 256 + r2, 0)
  143. END str64;
  144. PROCEDURE str32 (r1, r2: INTEGER);
  145. BEGIN
  146. Emit(opSTW, r1 * 256 + r2, 0)
  147. END str32;
  148. PROCEDURE str16 (r1, r2: INTEGER);
  149. BEGIN
  150. Emit(opSTH, r1 * 256 + r2, 0)
  151. END str16;
  152. PROCEDURE str8 (r1, r2: INTEGER);
  153. BEGIN
  154. Emit(opSTB, r1 * 256 + r2, 0)
  155. END str8;
  156. PROCEDURE GlobalAdr (r, offset: INTEGER);
  157. BEGIN
  158. Emit(opLEA, r + 256 * LGlobal, offset)
  159. END GlobalAdr;
  160. PROCEDURE StrAdr (r, offset: INTEGER);
  161. BEGIN
  162. Emit(opLEA, r + 256 * LStrings, offset)
  163. END StrAdr;
  164. PROCEDURE ProcAdr (r, label: INTEGER);
  165. BEGIN
  166. Emit(opLLA, r, label)
  167. END ProcAdr;
  168. PROCEDURE jnz (r, label: INTEGER);
  169. BEGIN
  170. Emit(opCMPC, r, 0);
  171. Emit(opJNE, label, 0)
  172. END jnz;
  173. PROCEDURE CallRTL (proc, par: INTEGER);
  174. BEGIN
  175. Emit(opCALL, IL.codes.rtl[proc], 0);
  176. addrc(SP, par * szWord)
  177. END CallRTL;
  178. PROCEDURE jcc (cc: INTEGER): INTEGER;
  179. BEGIN
  180. CASE cc OF
  181. |IL.opEQ, IL.opEQC: cc := opJEQ
  182. |IL.opNE, IL.opNEC: cc := opJNE
  183. |IL.opLT, IL.opLTC: cc := opJLT
  184. |IL.opLE, IL.opLEC: cc := opJLE
  185. |IL.opGT, IL.opGTC: cc := opJGT
  186. |IL.opGE, IL.opGEC: cc := opJGE
  187. END
  188. RETURN cc
  189. END jcc;
  190. PROCEDURE shift1 (op, param: INTEGER);
  191. VAR
  192. r1, r2: INTEGER;
  193. BEGIN
  194. r2 := GetAnyReg();
  195. Emit(opMOVC, r2, param);
  196. BinOp(r1, r2);
  197. Emit(op, r2, r1);
  198. mov(r1, r2);
  199. drop
  200. END shift1;
  201. PROCEDURE shift (op: INTEGER);
  202. VAR
  203. r1, r2: INTEGER;
  204. BEGIN
  205. BinOp(r1, r2);
  206. Emit(op, r1, r2);
  207. drop
  208. END shift;
  209. PROCEDURE translate (szWord: INTEGER);
  210. VAR
  211. cmd, next: IL.COMMAND;
  212. opcode, param1, param2, r1, r2, r3,
  213. a, b, label, opLD, opST, opSTC: INTEGER;
  214. BEGIN
  215. IF szWord = 8 THEN
  216. opLD := opLDD;
  217. opST := opSTD;
  218. opSTC := opSTDC
  219. ELSE
  220. opLD := opLDW;
  221. opST := opSTW;
  222. opSTC := opSTWC
  223. END;
  224. cmd := IL.codes.commands.first(IL.COMMAND);
  225. WHILE cmd # NIL DO
  226. param1 := cmd.param1;
  227. param2 := cmd.param2;
  228. opcode := cmd.opcode;
  229. CASE opcode OF
  230. |IL.opJMP:
  231. Emit(opJMP, param1, 0)
  232. |IL.opLABEL:
  233. Emit(opLABEL, param1, 0)
  234. |IL.opCALL:
  235. Emit(opCALL, param1, 0)
  236. |IL.opCALLP:
  237. UnOp(r1);
  238. Emit(opCALLI, r1, 0);
  239. drop;
  240. ASSERT(R.top = -1)
  241. |IL.opPUSHC:
  242. pushc(param2)
  243. |IL.opCLEANUP:
  244. IF param2 # 0 THEN
  245. addrc(SP, param2 * szWord)
  246. END
  247. |IL.opNOP, IL.opAND, IL.opOR:
  248. |IL.opSADR:
  249. StrAdr(GetAnyReg(), param2)
  250. |IL.opGADR:
  251. GlobalAdr(GetAnyReg(), param2)
  252. |IL.opLADR:
  253. param2 := param2 * szWord;
  254. next := cmd.next(IL.COMMAND);
  255. IF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 8) OR (next.opcode = IL.opSAVE64) THEN
  256. UnOp(r1);
  257. Emit(opSTD, BP * 256 + r1, param2);
  258. drop;
  259. cmd := next
  260. ELSIF ((next.opcode = IL.opSAVE) OR (next.opcode = IL.opSAVEF)) & (szWord = 4) OR (next.opcode = IL.opSAVE32) THEN
  261. UnOp(r1);
  262. Emit(opSTW, BP * 256 + r1, param2);
  263. drop;
  264. cmd := next
  265. ELSIF next.opcode = IL.opSAVE16 THEN
  266. UnOp(r1);
  267. Emit(opSTH, BP * 256 + r1, param2);
  268. drop;
  269. cmd := next
  270. ELSIF next.opcode = IL.opSAVE8 THEN
  271. UnOp(r1);
  272. Emit(opSTB, BP * 256 + r1, param2);
  273. drop;
  274. cmd := next
  275. ELSE
  276. Emit(opADDRC, BP * 256 + GetAnyReg(), param2)
  277. END
  278. |IL.opPARAM:
  279. IF param2 = 1 THEN
  280. UnOp(r1);
  281. push(r1);
  282. drop
  283. ELSE
  284. ASSERT(R.top + 1 <= param2);
  285. PushAll(param2)
  286. END
  287. |IL.opONERR:
  288. pushc(param2);
  289. Emit(opJMP, param1, 0)
  290. |IL.opPRECALL:
  291. PushAll(0)
  292. |IL.opRES, IL.opRESF:
  293. ASSERT(R.top = -1);
  294. GetAcc
  295. |IL.opENTER:
  296. ASSERT(R.top = -1);
  297. Emit(opLABEL, param1, 0);
  298. Emit(opENTER, param2, 0)
  299. |IL.opLEAVE, IL.opLEAVER, IL.opLEAVEF:
  300. IF opcode # IL.opLEAVE THEN
  301. UnOp(r1);
  302. IF r1 # ACC THEN
  303. mov(ACC, r1)
  304. END;
  305. drop
  306. END;
  307. ASSERT(R.top = -1);
  308. IF param1 > 0 THEN
  309. mov(SP, BP)
  310. END;
  311. pop(BP);
  312. Emit(opRET, 0, 0)
  313. |IL.opLEAVEC:
  314. Emit(opRET, 0, 0)
  315. |IL.opCONST:
  316. next := cmd.next(IL.COMMAND);
  317. IF (next.opcode = IL.opPARAM) & (next.param2 = 1) THEN
  318. pushc(param2);
  319. cmd := next
  320. ELSE
  321. movrc(GetAnyReg(), param2)
  322. END
  323. |IL.opDROP:
  324. UnOp(r1);
  325. drop
  326. |IL.opSAVEC:
  327. UnOp(r1);
  328. Emit(opSTC, r1, param2);
  329. drop
  330. |IL.opSAVE8C:
  331. UnOp(r1);
  332. Emit(opSTBC, r1, param2 MOD 256);
  333. drop
  334. |IL.opSAVE16C:
  335. UnOp(r1);
  336. Emit(opSTHC, r1, param2 MOD 65536);
  337. drop
  338. |IL.opSAVE, IL.opSAVEF:
  339. BinOp(r2, r1);
  340. str(r1, r2);
  341. drop;
  342. drop
  343. |IL.opSAVE32:
  344. BinOp(r2, r1);
  345. str32(r1, r2);
  346. drop;
  347. drop
  348. |IL.opSAVE64:
  349. BinOp(r2, r1);
  350. str64(r1, r2);
  351. drop;
  352. drop
  353. |IL.opSAVEFI:
  354. BinOp(r2, r1);
  355. str(r2, r1);
  356. drop;
  357. drop
  358. |IL.opSAVE8:
  359. BinOp(r2, r1);
  360. str8(r1, r2);
  361. drop;
  362. drop
  363. |IL.opSAVE16:
  364. BinOp(r2, r1);
  365. str16(r1, r2);
  366. drop;
  367. drop
  368. |IL.opGLOAD32:
  369. r1 := GetAnyReg();
  370. GlobalAdr(r1, param2);
  371. ldr32(r1, r1)
  372. |IL.opGLOAD64:
  373. r1 := GetAnyReg();
  374. GlobalAdr(r1, param2);
  375. ldr64(r1, r1)
  376. |IL.opVADR:
  377. Emit(opLD, BP * 256 + GetAnyReg(), param2 * szWord)
  378. |IL.opLLOAD32:
  379. Emit(opLDW, BP * 256 + GetAnyReg(), param2 * szWord)
  380. |IL.opLLOAD64:
  381. Emit(opLDD, BP * 256 + GetAnyReg(), param2 * szWord)
  382. |IL.opVLOAD32:
  383. r1 := GetAnyReg();
  384. Emit(opLD, BP * 256 + r1, param2 * szWord);
  385. ldr32(r1, r1)
  386. |IL.opVLOAD64:
  387. r1 := GetAnyReg();
  388. Emit(opLDD, BP * 256 + r1, param2 * szWord);
  389. ldr64(r1, r1)
  390. |IL.opGLOAD16:
  391. r1 := GetAnyReg();
  392. GlobalAdr(r1, param2);
  393. ldr16(r1, r1)
  394. |IL.opLLOAD16:
  395. Emit(opLDH, BP * 256 + GetAnyReg(), param2 * szWord)
  396. |IL.opVLOAD16:
  397. r1 := GetAnyReg();
  398. Emit(opLD, BP * 256 + r1, param2 * szWord);
  399. ldr16(r1, r1)
  400. |IL.opGLOAD8:
  401. r1 := GetAnyReg();
  402. GlobalAdr(r1, param2);
  403. ldr8(r1, r1)
  404. |IL.opLLOAD8:
  405. Emit(opLDB, BP * 256 + GetAnyReg(), param2 * szWord)
  406. |IL.opVLOAD8:
  407. r1 := GetAnyReg();
  408. Emit(opLD, BP * 256 + r1, param2 * szWord);
  409. ldr8(r1, r1)
  410. |IL.opLOAD8:
  411. UnOp(r1);
  412. ldr8(r1, r1)
  413. |IL.opLOAD16:
  414. UnOp(r1);
  415. ldr16(r1, r1)
  416. |IL.opLOAD32:
  417. UnOp(r1);
  418. ldr32(r1, r1)
  419. |IL.opLOAD64:
  420. UnOp(r1);
  421. ldr64(r1, r1)
  422. |IL.opLOADF:
  423. UnOp(r1);
  424. ldr(r1, r1)
  425. |IL.opUMINUS:
  426. UnOp(r1);
  427. Emit(opNEG, r1, 0)
  428. |IL.opADD:
  429. BinOp(r1, r2);
  430. add(r1, r2);
  431. drop
  432. |IL.opSUB:
  433. BinOp(r1, r2);
  434. sub(r1, r2);
  435. drop
  436. |IL.opADDC:
  437. UnOp(r1);
  438. next := cmd.next(IL.COMMAND);
  439. CASE next.opcode OF
  440. |IL.opLOADF:
  441. Emit(opLD, r1 * 256 + r1, param2);
  442. cmd := next
  443. |IL.opLOAD64:
  444. Emit(opLDD, r1 * 256 + r1, param2);
  445. cmd := next
  446. |IL.opLOAD32:
  447. Emit(opLDW, r1 * 256 + r1, param2);
  448. cmd := next
  449. |IL.opLOAD16:
  450. Emit(opLDH, r1 * 256 + r1, param2);
  451. cmd := next
  452. |IL.opLOAD8:
  453. Emit(opLDB, r1 * 256 + r1, param2);
  454. cmd := next
  455. ELSE
  456. addrc(r1, param2)
  457. END
  458. |IL.opSUBR:
  459. UnOp(r1);
  460. subrc(r1, param2)
  461. |IL.opSUBL:
  462. UnOp(r1);
  463. subrc(r1, param2);
  464. Emit(opNEG, r1, 0)
  465. |IL.opMULC:
  466. UnOp(r1);
  467. Emit(opMULC, r1, param2)
  468. |IL.opMUL:
  469. BinOp(r1, r2);
  470. Emit(opMUL, r1, r2);
  471. drop
  472. |IL.opDIV:
  473. BinOp(r1, r2);
  474. Emit(opDIV, r1, r2);
  475. drop
  476. |IL.opMOD:
  477. BinOp(r1, r2);
  478. Emit(opMOD, r1, r2);
  479. drop
  480. |IL.opDIVR:
  481. UnOp(r1);
  482. Emit(opDIVC, r1, param2)
  483. |IL.opMODR:
  484. UnOp(r1);
  485. Emit(opMODC, r1, param2)
  486. |IL.opDIVL:
  487. UnOp(r1);
  488. r2 := GetAnyReg();
  489. movrc(r2, param2);
  490. Emit(opDIV, r2, r1);
  491. mov(r1, r2);
  492. drop
  493. |IL.opMODL:
  494. UnOp(r1);
  495. r2 := GetAnyReg();
  496. movrc(r2, param2);
  497. Emit(opMOD, r2, r1);
  498. mov(r1, r2);
  499. drop
  500. |IL.opEQ .. IL.opGE, IL.opEQC .. IL.opGEC:
  501. IF (IL.opEQ <= opcode) & (opcode <= IL.opGE) THEN
  502. BinOp(r1, r2);
  503. Emit(opCMP, r1, r2);
  504. drop
  505. ELSE
  506. UnOp(r1);
  507. Emit(opCMPC, r1, param2)
  508. END;
  509. next := cmd.next(IL.COMMAND);
  510. IF next.opcode = IL.opJZ THEN
  511. Emit(ORD(BITS(jcc(opcode)) / {0}), next.param1, 0);
  512. cmd := next;
  513. drop
  514. ELSIF next.opcode = IL.opJNZ THEN
  515. Emit(jcc(opcode), next.param1, 0);
  516. cmd := next;
  517. drop
  518. ELSE
  519. Emit(jcc(opcode) + 6, r1, 0)
  520. END
  521. |IL.opJNZ1:
  522. UnOp(r1);
  523. jnz(r1, param1)
  524. |IL.opJG:
  525. UnOp(r1);
  526. Emit(opCMPC, r1, 0);
  527. Emit(opJGT, param1, 0)
  528. |IL.opJNZ:
  529. UnOp(r1);
  530. jnz(r1, param1);
  531. drop
  532. |IL.opJZ:
  533. UnOp(r1);
  534. Emit(opCMPC, r1, 0);
  535. Emit(opJEQ, param1, 0);
  536. drop
  537. |IL.opMULS:
  538. BinOp(r1, r2);
  539. Emit(opAND, r1, r2);
  540. drop
  541. |IL.opMULSC:
  542. UnOp(r1);
  543. Emit(opANDC, r1, param2)
  544. |IL.opDIVS:
  545. BinOp(r1, r2);
  546. Emit(opXOR, r1, r2);
  547. drop
  548. |IL.opDIVSC:
  549. UnOp(r1);
  550. Emit(opXORC, r1, param2)
  551. |IL.opADDS:
  552. BinOp(r1, r2);
  553. Emit(opOR, r1, r2);
  554. drop
  555. |IL.opSUBS:
  556. BinOp(r1, r2);
  557. Emit(opNOT, r2, 0);
  558. Emit(opAND, r1, r2);
  559. drop
  560. |IL.opADDSC:
  561. UnOp(r1);
  562. Emit(opORC, r1, param2)
  563. |IL.opSUBSL:
  564. UnOp(r1);
  565. Emit(opNOT, r1, 0);
  566. Emit(opANDC, r1, param2)
  567. |IL.opSUBSR:
  568. UnOp(r1);
  569. Emit(opANDC, r1, ORD(-BITS(param2)))
  570. |IL.opUMINS:
  571. UnOp(r1);
  572. Emit(opNOT, r1, 0)
  573. |IL.opASR:
  574. shift(opASR)
  575. |IL.opLSL:
  576. shift(opLSL)
  577. |IL.opROR:
  578. shift(opROR)
  579. |IL.opLSR:
  580. shift(opLSR)
  581. |IL.opASR1:
  582. shift1(opASR, param2)
  583. |IL.opLSL1:
  584. shift1(opLSL, param2)
  585. |IL.opROR1:
  586. shift1(opROR, param2)
  587. |IL.opLSR1:
  588. shift1(opLSR, param2)
  589. |IL.opASR2:
  590. UnOp(r1);
  591. Emit(opASRC, r1, param2 MOD (szWord * 8))
  592. |IL.opLSL2:
  593. UnOp(r1);
  594. Emit(opLSLC, r1, param2 MOD (szWord * 8))
  595. |IL.opROR2:
  596. UnOp(r1);
  597. Emit(opRORC, r1, param2 MOD (szWord * 8))
  598. |IL.opLSR2:
  599. UnOp(r1);
  600. Emit(opLSRC, r1, param2 MOD (szWord * 8))
  601. |IL.opABS:
  602. UnOp(r1);
  603. Emit(opCMPC, r1, 0);
  604. label := IL.NewLabel();
  605. Emit(opJGE, label, 0);
  606. Emit(opNEG, r1, 0);
  607. Emit(opLABEL, label, 0)
  608. |IL.opLEN:
  609. UnOp(r1);
  610. drop;
  611. EXCL(R.regs, r1);
  612. WHILE param2 > 0 DO
  613. UnOp(r2);
  614. drop;
  615. DEC(param2)
  616. END;
  617. INCL(R.regs, r1);
  618. ASSERT(REG.GetReg(R, r1))
  619. |IL.opSWITCH:
  620. UnOp(r1);
  621. IF param2 = 0 THEN
  622. r2 := ACC
  623. ELSE
  624. r2 := R1
  625. END;
  626. IF r1 # r2 THEN
  627. ASSERT(REG.GetReg(R, r2));
  628. ASSERT(REG.Exchange(R, r1, r2));
  629. drop
  630. END;
  631. drop
  632. |IL.opENDSW:
  633. |IL.opCASEL:
  634. Emit(opCMPC, ACC, param1);
  635. Emit(opJLT, param2, 0)
  636. |IL.opCASER:
  637. Emit(opCMPC, ACC, param1);
  638. Emit(opJGT, param2, 0)
  639. |IL.opCASELR:
  640. Emit(opCMPC, ACC, param1);
  641. IF param2 = cmd.param3 THEN
  642. Emit(opJNE, param2, 0)
  643. ELSE
  644. Emit(opJLT, param2, 0);
  645. Emit(opJGT, cmd.param3, 0)
  646. END
  647. |IL.opSBOOL:
  648. BinOp(r2, r1);
  649. Emit(opCMPC, r2, 0);
  650. Emit(opSNE, r2, 0);
  651. str8(r1, r2);
  652. drop;
  653. drop
  654. |IL.opSBOOLC:
  655. UnOp(r1);
  656. Emit(opSTBC, r1, ORD(param2 # 0));
  657. drop
  658. |IL.opINCC:
  659. UnOp(r1);
  660. r2 := GetAnyReg();
  661. ldr(r2, r1);
  662. addrc(r2, param2);
  663. str(r1, r2);
  664. drop;
  665. drop
  666. |IL.opINCCB, IL.opDECCB:
  667. IF opcode = IL.opDECCB THEN
  668. param2 := -param2
  669. END;
  670. UnOp(r1);
  671. r2 := GetAnyReg();
  672. ldr8(r2, r1);
  673. addrc(r2, param2);
  674. str8(r1, r2);
  675. drop;
  676. drop
  677. |IL.opINCB, IL.opDECB:
  678. BinOp(r2, r1);
  679. r3 := GetAnyReg();
  680. ldr8(r3, r1);
  681. IF opcode = IL.opINCB THEN
  682. add(r3, r2)
  683. ELSE
  684. sub(r3, r2)
  685. END;
  686. str8(r1, r3);
  687. drop;
  688. drop;
  689. drop
  690. |IL.opINC, IL.opDEC:
  691. BinOp(r2, r1);
  692. r3 := GetAnyReg();
  693. ldr(r3, r1);
  694. IF opcode = IL.opINC THEN
  695. add(r3, r2)
  696. ELSE
  697. sub(r3, r2)
  698. END;
  699. str(r1, r3);
  700. drop;
  701. drop;
  702. drop
  703. |IL.opINCL, IL.opEXCL:
  704. BinOp(r2, r1);
  705. Emit(opBIT, r2, r2);
  706. r3 := GetAnyReg();
  707. ldr(r3, r1);
  708. IF opcode = IL.opINCL THEN
  709. Emit(opOR, r3, r2)
  710. ELSE
  711. Emit(opNOT, r2, 0);
  712. Emit(opAND, r3, r2)
  713. END;
  714. str(r1, r3);
  715. drop;
  716. drop;
  717. drop
  718. |IL.opINCLC, IL.opEXCLC:
  719. UnOp(r1);
  720. r2 := GetAnyReg();
  721. ldr(r2, r1);
  722. IF opcode = IL.opINCLC THEN
  723. Emit(opORC, r2, ORD({param2}))
  724. ELSE
  725. Emit(opANDC, r2, ORD(-{param2}))
  726. END;
  727. str(r1, r2);
  728. drop;
  729. drop
  730. |IL.opEQB, IL.opNEB:
  731. BinOp(r1, r2);
  732. Emit(opCMPC, r1, 0);
  733. Emit(opSNE, r1, 0);
  734. Emit(opCMPC, r2, 0);
  735. Emit(opSNE, r2, 0);
  736. Emit(opCMP, r1, r2);
  737. IF opcode = IL.opEQB THEN
  738. Emit(opSEQ, r1, 0)
  739. ELSE
  740. Emit(opSNE, r1, 0)
  741. END;
  742. drop
  743. |IL.opCHKIDX:
  744. UnOp(r1);
  745. Emit(opCMPC, r1, param2);
  746. Emit(opJBT, param1, 0)
  747. |IL.opCHKIDX2:
  748. BinOp(r1, r2);
  749. IF param2 # -1 THEN
  750. Emit(opCMP, r2, r1);
  751. Emit(opJBT, param1, 0)
  752. END;
  753. INCL(R.regs, r1);
  754. DEC(R.top);
  755. R.stk[R.top] := r2
  756. |IL.opEQP, IL.opNEP:
  757. ProcAdr(GetAnyReg(), param1);
  758. BinOp(r1, r2);
  759. Emit(opCMP, r1, r2);
  760. IF opcode = IL.opEQP THEN
  761. Emit(opSEQ, r1, 0)
  762. ELSE
  763. Emit(opSNE, r1, 0)
  764. END;
  765. drop
  766. |IL.opSAVEP:
  767. UnOp(r1);
  768. r2 := GetAnyReg();
  769. ProcAdr(r2, param2);
  770. str(r1, r2);
  771. drop;
  772. drop
  773. |IL.opPUSHP:
  774. ProcAdr(GetAnyReg(), param2)
  775. |IL.opPUSHT:
  776. UnOp(r1);
  777. Emit(opLD, r1 * 256 + GetAnyReg(), -szWord)
  778. |IL.opGET, IL.opGETC:
  779. IF opcode = IL.opGET THEN
  780. BinOp(r1, r2)
  781. ELSIF opcode = IL.opGETC THEN
  782. UnOp(r2);
  783. r1 := GetAnyReg();
  784. movrc(r1, param1)
  785. END;
  786. drop;
  787. drop;
  788. CASE param2 OF
  789. |1: ldr8(r1, r1); str8(r2, r1)
  790. |2: ldr16(r1, r1); str16(r2, r1)
  791. |4: ldr32(r1, r1); str32(r2, r1)
  792. |8: ldr64(r1, r1); str64(r2, r1)
  793. END
  794. |IL.opNOT:
  795. UnOp(r1);
  796. Emit(opCMPC, r1, 0);
  797. Emit(opSEQ, r1, 0)
  798. |IL.opORD:
  799. UnOp(r1);
  800. Emit(opCMPC, r1, 0);
  801. Emit(opSNE, r1, 0)
  802. |IL.opMIN, IL.opMAX:
  803. BinOp(r1, r2);
  804. Emit(opCMP, r1, r2);
  805. label := IL.NewLabel();
  806. IF opcode = IL.opMIN THEN
  807. Emit(opJLE, label, 0)
  808. ELSE
  809. Emit(opJGE, label, 0)
  810. END;
  811. Emit(opMOV, r1, r2);
  812. Emit(opLABEL, label, 0);
  813. drop
  814. |IL.opMINC, IL.opMAXC:
  815. UnOp(r1);
  816. Emit(opCMPC, r1, param2);
  817. label := IL.NewLabel();
  818. IF opcode = IL.opMINC THEN
  819. Emit(opJLE, label, 0)
  820. ELSE
  821. Emit(opJGE, label, 0)
  822. END;
  823. Emit(opMOVC, r1, param2);
  824. Emit(opLABEL, label, 0)
  825. |IL.opIN:
  826. BinOp(r1, r2);
  827. Emit(opBIT, r1, r1);
  828. Emit(opAND, r1, r2);
  829. Emit(opCMPC, r1, 0);
  830. Emit(opSNE, r1, 0);
  831. drop
  832. |IL.opINL:
  833. UnOp(r1);
  834. Emit(opANDC, r1, ORD({param2}));
  835. Emit(opCMPC, r1, 0);
  836. Emit(opSNE, r1, 0)
  837. |IL.opINR:
  838. UnOp(r1);
  839. Emit(opBIT, r1, r1);
  840. Emit(opANDC, r1, param2);
  841. Emit(opCMPC, r1, 0);
  842. Emit(opSNE, r1, 0)
  843. |IL.opERR:
  844. CallRTL(IL._error, 4)
  845. |IL.opEQS .. IL.opGES:
  846. PushAll(4);
  847. pushc(opcode - IL.opEQS);
  848. CallRTL(IL._strcmp, 5);
  849. GetAcc
  850. |IL.opEQSW .. IL.opGESW:
  851. PushAll(4);
  852. pushc(opcode - IL.opEQSW);
  853. CallRTL(IL._strcmpw, 5);
  854. GetAcc
  855. |IL.opCOPY:
  856. PushAll(2);
  857. pushc(param2);
  858. CallRTL(IL._move, 3)
  859. |IL.opMOVE:
  860. PushAll(3);
  861. CallRTL(IL._move, 3)
  862. |IL.opCOPYA:
  863. PushAll(4);
  864. pushc(param2);
  865. CallRTL(IL._arrcpy, 5);
  866. GetAcc
  867. |IL.opCOPYS:
  868. PushAll(4);
  869. pushc(param2);
  870. CallRTL(IL._strcpy, 5)
  871. |IL.opROT:
  872. PushAll(0);
  873. mov(ACC, SP);
  874. push(ACC);
  875. pushc(param2);
  876. CallRTL(IL._rot, 2)
  877. |IL.opLENGTH:
  878. PushAll(2);
  879. CallRTL(IL._length, 2);
  880. GetAcc
  881. |IL.opLENGTHW:
  882. PushAll(2);
  883. CallRTL(IL._lengthw, 2);
  884. GetAcc
  885. |IL.opSAVES:
  886. UnOp(r2);
  887. REG.PushAll_1(R);
  888. r1 := GetAnyReg();
  889. StrAdr(r1, param2);
  890. push(r1);
  891. drop;
  892. push(r2);
  893. drop;
  894. pushc(param1);
  895. CallRTL(IL._move, 3)
  896. |IL.opRSET:
  897. PushAll(2);
  898. CallRTL(IL._set, 2);
  899. GetAcc
  900. |IL.opRSETR:
  901. PushAll(1);
  902. pushc(param2);
  903. CallRTL(IL._set, 2);
  904. GetAcc
  905. |IL.opRSETL:
  906. UnOp(r1);
  907. REG.PushAll_1(R);
  908. pushc(param2);
  909. push(r1);
  910. drop;
  911. CallRTL(IL._set, 2);
  912. GetAcc
  913. |IL.opRSET1:
  914. PushAll(1);
  915. CallRTL(IL._set1, 1);
  916. GetAcc
  917. |IL.opNEW:
  918. PushAll(1);
  919. INC(param2, szWord);
  920. ASSERT(UTILS.Align(param2, szWord));
  921. pushc(param2);
  922. pushc(param1);
  923. CallRTL(IL._new, 3)
  924. |IL.opTYPEGP:
  925. UnOp(r1);
  926. PushAll(0);
  927. push(r1);
  928. pushc(param2);
  929. CallRTL(IL._guard, 2);
  930. GetAcc
  931. |IL.opIS:
  932. PushAll(1);
  933. pushc(param2);
  934. CallRTL(IL._is, 2);
  935. GetAcc
  936. |IL.opISREC:
  937. PushAll(2);
  938. pushc(param2);
  939. CallRTL(IL._guardrec, 3);
  940. GetAcc
  941. |IL.opTYPEGR:
  942. PushAll(1);
  943. pushc(param2);
  944. CallRTL(IL._guardrec, 2);
  945. GetAcc
  946. |IL.opTYPEGD:
  947. UnOp(r1);
  948. PushAll(0);
  949. subrc(r1, szWord);
  950. ldr(r1, r1);
  951. push(r1);
  952. pushc(param2);
  953. CallRTL(IL._guardrec, 2);
  954. GetAcc
  955. |IL.opCASET:
  956. push(R1);
  957. push(R1);
  958. pushc(param2);
  959. CallRTL(IL._guardrec, 2);
  960. pop(R1);
  961. jnz(ACC, param1)
  962. |IL.opCONSTF:
  963. IF szWord = 8 THEN
  964. movrc(GetAnyReg(), UTILS.splitf(cmd.float, a, b))
  965. ELSE (* szWord = 4 *)
  966. movrc(GetAnyReg(), UTILS.d2s(cmd.float))
  967. END
  968. |IL.opMULF:
  969. PushAll(2);
  970. CallRTL(IL._fmul, 2);
  971. GetAcc
  972. |IL.opDIVF:
  973. PushAll(2);
  974. CallRTL(IL._fdiv, 2);
  975. GetAcc
  976. |IL.opDIVFI:
  977. PushAll(2);
  978. CallRTL(IL._fdivi, 2);
  979. GetAcc
  980. |IL.opADDF:
  981. PushAll(2);
  982. CallRTL(IL._fadd, 2);
  983. GetAcc
  984. |IL.opSUBFI:
  985. PushAll(2);
  986. CallRTL(IL._fsubi, 2);
  987. GetAcc
  988. |IL.opSUBF:
  989. PushAll(2);
  990. CallRTL(IL._fsub, 2);
  991. GetAcc
  992. |IL.opEQF..IL.opGEF:
  993. PushAll(2);
  994. pushc(opcode - IL.opEQF);
  995. CallRTL(IL._fcmp, 3);
  996. GetAcc
  997. |IL.opFLOOR:
  998. PushAll(1);
  999. CallRTL(IL._floor, 1);
  1000. GetAcc
  1001. |IL.opFLT:
  1002. PushAll(1);
  1003. CallRTL(IL._flt, 1);
  1004. GetAcc
  1005. |IL.opUMINF:
  1006. UnOp(r1);
  1007. Emit(opRORC, r1, -1);
  1008. Emit(opXORC, r1, 1);
  1009. Emit(opRORC, r1, 1)
  1010. |IL.opFABS:
  1011. UnOp(r1);
  1012. Emit(opLSLC, r1, 1);
  1013. Emit(opLSRC, r1, 1)
  1014. |IL.opINF:
  1015. r1 := GetAnyReg();
  1016. Emit(opMOVC, r1, 1);
  1017. Emit(opRORC, r1, 1);
  1018. Emit(opASRC, r1, 7 + 3 * ORD(szWord = 8));
  1019. Emit(opLSRC, r1, 1)
  1020. |IL.opPUSHF:
  1021. UnOp(r1);
  1022. push(r1);
  1023. drop
  1024. |IL.opPACK:
  1025. PushAll(2);
  1026. CallRTL(IL._pack, 2)
  1027. |IL.opPACKC:
  1028. PushAll(1);
  1029. pushc(param2);
  1030. CallRTL(IL._pack, 2)
  1031. |IL.opUNPK:
  1032. PushAll(2);
  1033. CallRTL(IL._unpk, 2)
  1034. |IL.opCODE:
  1035. OutInt(param2)
  1036. |IL.opLADR_SAVE:
  1037. UnOp(r1);
  1038. Emit(opST, BP * 256 + r1, param2 * szWord);
  1039. drop
  1040. |IL.opLADR_INCC:
  1041. r1 := GetAnyReg();
  1042. Emit(opLD, BP * 256 + r1, param1 * szWord);
  1043. Emit(opADDC, r1, param2);
  1044. Emit(opST, BP * 256 + r1, param1 * szWord);
  1045. drop
  1046. END;
  1047. cmd := cmd.next(IL.COMMAND)
  1048. END;
  1049. ASSERT(R.pushed = 0);
  1050. ASSERT(R.top = -1)
  1051. END translate;
  1052. PROCEDURE prolog;
  1053. BEGIN
  1054. Emit(opLEA, SP + LStack * 256, 0);
  1055. Emit(opLEA, ACC + LTypes * 256, 0);
  1056. push(ACC);
  1057. Emit(opLEA, ACC + LHeap * 256, 0);
  1058. push(ACC);
  1059. pushc(CHL.Length(IL.codes.types));
  1060. CallRTL(IL._init, 3)
  1061. END prolog;
  1062. PROCEDURE epilog (ram, szWord: INTEGER);
  1063. VAR
  1064. tcount, dcount, i, offTypes, offStrings,
  1065. szData, szGlobal, szHeapStack: INTEGER;
  1066. BEGIN
  1067. Emit(opSTOP, 0, 0);
  1068. offTypes := count;
  1069. tcount := CHL.Length(IL.codes.types);
  1070. FOR i := 0 TO tcount - 1 DO
  1071. OutInt(CHL.GetInt(IL.codes.types, i))
  1072. END;
  1073. offStrings := count;
  1074. dcount := CHL.Length(IL.codes.data);
  1075. FOR i := 0 TO dcount - 1 DO
  1076. OutByte(CHL.GetByte(IL.codes.data, i))
  1077. END;
  1078. IF dcount MOD szWord # 0 THEN
  1079. i := szWord - dcount MOD szWord;
  1080. WHILE i > 0 DO
  1081. OutByte(0);
  1082. DEC(i)
  1083. END
  1084. END;
  1085. szData := count - offTypes;
  1086. szGlobal := (IL.codes.bss DIV szWord + 1) * szWord;
  1087. szHeapStack := ram - szData - szGlobal;
  1088. OutInt(offTypes);
  1089. OutInt(offStrings);
  1090. OutInt(szGlobal DIV szWord);
  1091. OutInt(szHeapStack DIV szWord);
  1092. FOR i := 1 TO 8 DO
  1093. OutInt(0)
  1094. END
  1095. END epilog;
  1096. PROCEDURE CodeGen* (outname: ARRAY OF CHAR; target: INTEGER; options: PROG.OPTIONS);
  1097. CONST
  1098. minRAM = 32*1024;
  1099. maxRAM = 256*1024;
  1100. VAR
  1101. szData, szRAM: INTEGER;
  1102. BEGIN
  1103. szWord := TARGETS.WordSize;
  1104. IF szWord = 8 THEN
  1105. ldr := ldr64;
  1106. str := str64
  1107. ELSE
  1108. ldr := ldr32;
  1109. str := str32
  1110. END;
  1111. szData := (CHL.Length(IL.codes.types) + CHL.Length(IL.codes.data) DIV szWord + IL.codes.bss DIV szWord + 2) * szWord;
  1112. szRAM := MIN(MAX(options.ram, minRAM), maxRAM) * 1024;
  1113. IF szRAM - szData < 1024*1024 THEN
  1114. ERRORS.Error(208)
  1115. END;
  1116. count := 0;
  1117. WR.Create(outname);
  1118. REG.Init(R, push, pop, mov, xchg, GPRs);
  1119. prolog;
  1120. translate(szWord);
  1121. epilog(szRAM, szWord);
  1122. WR.Close
  1123. END CodeGen;
  1124. END RVMxI.