CPL486.txt 34 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070
  1. MODULE Dev0CPL486;
  2. (* THIS IS TEXT COPY OF CPL486.odc *)
  3. (* DO NOT EDIT *)
  4. (**
  5. project = "BlackBox"
  6. organization = "www.oberon.ch"
  7. contributors = "Oberon microsystems"
  8. version = "System/Rsrc/AboutBB"
  9. copyright = "System/Rsrc/AboutBB"
  10. license = "Docu/BB-License"
  11. references = "ftp://ftp.inf.ethz.ch/pub/software/Oberon/OberonV4/Docu/OP2.Paper.ps"
  12. changes = ""
  13. issues = ""
  14. **)
  15. IMPORT DevCPM := Dev0CPM, DevCPT := Dev0CPT, DevCPE := Dev0CPE;
  16. TYPE
  17. Item* = RECORD
  18. mode*, tmode*, form*: BYTE;
  19. offset*, index*, reg*, scale*: INTEGER; (* adr = offset + index * scale *)
  20. typ*: DevCPT.Struct;
  21. obj*: DevCPT.Object
  22. END ;
  23. (* Items:
  24. mode | offset index scale reg obj
  25. ------------------------------------------------
  26. 1 Var | adr xreg scale obj (ea = FP + adr + xreg * scale)
  27. 2 VarPar| off xreg scale obj (ea = [FP + obj.adr] + off + xreg * scale)
  28. 3 Con | val (val2) NIL
  29. Con | off obj (val = adr(obj) + off)
  30. Con | id NIL (for predefined reals)
  31. 6 LProc | obj
  32. 7 XProc | obj
  33. 9 CProc | obj
  34. 10 IProc | obj
  35. 13 TProc | mthno 0/1 obj (0 = normal / 1 = super call)
  36. 14 Ind | off xreg scale Reg (ea = Reg + off + xreg * scale)
  37. 15 Abs | adr xreg scale NIL (ea = adr + xreg * scale)
  38. Abs | off xreg scale obj (ea = adr(obj) + off + xreg * scale)
  39. Abs | off len 0 obj (for constant strings and reals)
  40. 16 Stk | (ea = ESP)
  41. 17 Cond | CC
  42. 18 Reg | (Reg2) Reg
  43. 19 DInd | off xreg scale Reg (ea = [Reg + off + xreg * scale])
  44. tmode | record tag array desc
  45. -------------------------------------
  46. VarPar | [FP + obj.adr + 4] [FP + obj.adr]
  47. Ind | [Reg - 4] [Reg + 8]
  48. Con | Adr(typ.strobj)
  49. *)
  50. CONST
  51. processor* = 10; (* for i386 *)
  52. NewLbl* = 0;
  53. TYPE
  54. Label* = INTEGER; (* 0: unassigned, > 0: address, < 0: - (linkadr + linktype * 2^24) *)
  55. VAR
  56. level*: BYTE;
  57. one*: DevCPT.Const;
  58. CONST
  59. (* item base modes (=object modes) *)
  60. Var = 1; VarPar = 2; Con = 3; LProc = 6; XProc = 7; CProc = 9; IProc = 10; TProc = 13;
  61. (* item modes for i386 (must not overlap item basemodes, > 13) *)
  62. Ind = 14; Abs = 15; Stk = 16; Cond = 17; Reg = 18; DInd = 19;
  63. (* structure forms *)
  64. Undef = 0; Byte = 1; Bool = 2; Char8 = 3; Int8 = 4; Int16 = 5; Int32 = 6;
  65. Real32 = 7; Real64 = 8; Set = 9; String8 = 10; NilTyp = 11; NoTyp = 12;
  66. Pointer = 13; ProcTyp = 14; Comp = 15;
  67. Char16 = 16; String16 = 17; Int64 = 18; Guid = 23;
  68. (* composite structure forms *)
  69. Basic = 1; Array = 2; DynArr = 3; Record = 4;
  70. (* condition codes *)
  71. ccB = 2; ccAE = 3; ccBE = 6; ccA = 7; (* unsigned *)
  72. ccL = 12; ccGE = 13; ccLE = 14; ccG = 15; (* signed *)
  73. ccE = 4; ccNE = 5; ccS = 8; ccNS = 9; ccO = 0; ccNO = 1;
  74. ccAlways = -1; ccNever = -2; ccCall = -3;
  75. (* registers *)
  76. AX = 0; CX = 1; DX = 2; BX = 3; SP = 4; BP = 5; SI = 6; DI = 7; AH = 4; CH = 5; DH = 6; BH = 7;
  77. (* fixup types *)
  78. absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104; short = 105;
  79. (* system trap numbers *)
  80. withTrap = -1; caseTrap = -2; funcTrap = -3; typTrap = -4;
  81. recTrap = -5; ranTrap = -6; inxTrap = -7; copyTrap = -8;
  82. VAR
  83. Size: ARRAY 32 OF INTEGER; (* Size[typ.form] == +/- typ.size *)
  84. a1, a2: Item;
  85. PROCEDURE MakeReg* (VAR x: Item; reg: INTEGER; form: BYTE);
  86. BEGIN
  87. ASSERT((reg >= 0) & (reg < 8));
  88. x.mode := Reg; x.reg := reg; x.form := form
  89. END MakeReg;
  90. PROCEDURE MakeConst* (VAR x: Item; val: INTEGER; form: BYTE);
  91. BEGIN
  92. x.mode := Con; x.offset := val; x.form := form; x.obj := NIL;
  93. END MakeConst;
  94. PROCEDURE AllocConst* (VAR x: Item; con: DevCPT.Const; form: BYTE);
  95. VAR r: REAL; short: SHORTREAL; c: DevCPT.Const; i: INTEGER;
  96. BEGIN
  97. IF form IN {Real32, Real64} THEN
  98. r := con.realval;
  99. IF ABS(r) <= MAX(SHORTREAL) THEN
  100. short := SHORT(r);
  101. IF short = r THEN form := Real32 (* a shortreal can represent the exact value *)
  102. ELSE form := Real64 (* use a real *)
  103. END
  104. ELSE form := Real64 (* use a real *)
  105. END
  106. ELSIF form IN {String8, String16, Guid} THEN
  107. x.index := con.intval2 (* string length *)
  108. END;
  109. DevCPE.AllocConst(con, form, x.obj, x.offset);
  110. x.form := form; x.mode := Abs; x.scale := 0
  111. END AllocConst;
  112. (*******************************************************)
  113. PROCEDURE BegStat*; (* general-purpose procedure which is called before each statement *)
  114. BEGIN
  115. END BegStat;
  116. PROCEDURE EndStat*; (* general-purpose procedure which is called after each statement *)
  117. BEGIN
  118. END EndStat;
  119. (*******************************************************)
  120. PROCEDURE SetLabel* (VAR L: Label);
  121. VAR link, typ, disp, x: INTEGER; c: SHORTCHAR;
  122. BEGIN
  123. ASSERT(L <= 0); link := -L;
  124. WHILE link # 0 DO
  125. typ := link DIV 1000000H; link := link MOD 1000000H;
  126. IF typ = short THEN
  127. disp := DevCPE.pc - link - 1; ASSERT(disp < 128);
  128. DevCPE.PutByte(link, disp); link := 0
  129. ELSIF typ = relative THEN
  130. x := DevCPE.ThisWord(link); DevCPE.PutWord(link, DevCPE.pc - link - 4); link := x
  131. ELSE
  132. x := DevCPE.ThisWord(link); DevCPE.PutWord(link, DevCPE.pc + typ * 1000000H); link := x
  133. END
  134. END;
  135. L := DevCPE.pc;
  136. a1.mode := 0; a2.mode := 0
  137. END SetLabel;
  138. (*******************************************************)
  139. PROCEDURE GenWord (x: INTEGER);
  140. BEGIN
  141. DevCPE.GenByte(x); DevCPE.GenByte(x DIV 256)
  142. END GenWord;
  143. PROCEDURE GenDbl (x: INTEGER);
  144. BEGIN
  145. DevCPE.GenByte(x); DevCPE.GenByte(x DIV 256); DevCPE.GenByte(x DIV 10000H); DevCPE.GenByte(x DIV 1000000H)
  146. END GenDbl;
  147. PROCEDURE CaseEntry* (tab, from, to: INTEGER);
  148. VAR a, e: INTEGER;
  149. BEGIN
  150. a := tab + 4 * from; e := tab + 4 * to;
  151. WHILE a <= e DO
  152. DevCPE.PutByte(a, DevCPE.pc);
  153. DevCPE.PutByte(a + 1, DevCPE.pc DIV 256);
  154. DevCPE.PutByte(a + 2, DevCPE.pc DIV 65536);
  155. INC(a, 4)
  156. END;
  157. a1.mode := 0; a2.mode := 0
  158. END CaseEntry;
  159. PROCEDURE GenLinked (VAR x: Item; type: BYTE);
  160. VAR link: DevCPT.LinkList;
  161. BEGIN
  162. IF x.obj = NIL THEN GenDbl(x.offset)
  163. ELSE
  164. link := DevCPE.OffsetLink(x.obj, x.offset);
  165. IF link # NIL THEN
  166. GenDbl(type * 1000000H + link.linkadr MOD 1000000H);
  167. link.linkadr := DevCPE.pc - 4
  168. ELSE GenDbl(0)
  169. END
  170. END
  171. END GenLinked;
  172. PROCEDURE CheckSize (form: BYTE; VAR w: INTEGER);
  173. BEGIN
  174. IF form IN {Int16, Char16} THEN DevCPE.GenByte(66H); w := 1
  175. ELSIF form >= Int32 THEN ASSERT(form IN {Int32, Set, NilTyp, Pointer, ProcTyp}); w := 1
  176. ELSE w := 0
  177. END
  178. END CheckSize;
  179. PROCEDURE CheckForm (form: BYTE; VAR mf: INTEGER);
  180. BEGIN
  181. IF form = Real32 THEN mf := 0
  182. ELSIF form = Real64 THEN mf := 4
  183. ELSIF form = Int32 THEN mf := 2
  184. ELSE ASSERT(form = Int16); mf := 6
  185. END
  186. END CheckForm;
  187. PROCEDURE CheckConst (VAR x: Item; VAR s: INTEGER);
  188. BEGIN
  189. IF (x.form > Int8) & (x.offset >= -128) & (x.offset < 128) & (x.obj = NIL) THEN s := 2
  190. ELSE s := 0
  191. END
  192. END CheckConst;
  193. PROCEDURE GenConst (VAR x: Item; short: BOOLEAN);
  194. BEGIN
  195. IF x.obj # NIL THEN GenLinked(x, absolute)
  196. ELSIF x.form <= Int8 THEN DevCPE.GenByte(x.offset)
  197. ELSIF short & (x.offset >= -128) & (x.offset < 128) THEN DevCPE.GenByte(x.offset)
  198. ELSIF x.form IN {Int16, Char16} THEN GenWord(x.offset)
  199. ELSE GenDbl(x.offset)
  200. END
  201. END GenConst;
  202. PROCEDURE GenCExt (code: INTEGER; VAR x: Item);
  203. VAR disp, mod, base, scale: INTEGER;
  204. BEGIN
  205. ASSERT(x.mode IN {Reg, Ind, Abs, Stk});
  206. ASSERT((code MOD 8 = 0) & (code < 64));
  207. disp := x.offset; base := x.reg; scale := x.scale;
  208. IF x.mode = Reg THEN mod := 0C0H; scale := 0
  209. ELSIF x.mode = Stk THEN base := SP; mod := 0; disp := 0; scale := 0
  210. ELSIF x.mode = Abs THEN
  211. IF scale = 1 THEN base := x.index; mod := 80H; scale := 0
  212. ELSE base := BP; mod := 0
  213. END
  214. ELSIF (disp = 0) & (base # BP) THEN mod := 0
  215. ELSIF (disp >= -128) & (disp < 128) THEN mod := 40H
  216. ELSE mod := 80H
  217. END;
  218. IF scale # 0 THEN
  219. DevCPE.GenByte(mod + code + 4); base := base + x.index * 8;
  220. IF scale = 8 THEN DevCPE.GenByte(0C0H + base);
  221. ELSIF scale = 4 THEN DevCPE.GenByte(80H + base);
  222. ELSIF scale = 2 THEN DevCPE.GenByte(40H + base);
  223. ELSE ASSERT(scale = 1); DevCPE.GenByte(base);
  224. END;
  225. ELSE
  226. DevCPE.GenByte(mod + code + base);
  227. IF (base = SP) & (mod <= 80H) THEN DevCPE.GenByte(24H) END
  228. END;
  229. IF x.mode = Abs THEN GenLinked(x, absolute)
  230. ELSIF mod = 80H THEN GenDbl(disp)
  231. ELSIF mod = 40H THEN DevCPE.GenByte(disp)
  232. END
  233. END GenCExt;
  234. PROCEDURE GenDExt (VAR r, x: Item);
  235. BEGIN
  236. ASSERT(r.mode = Reg);
  237. GenCExt(r.reg * 8, x)
  238. END GenDExt;
  239. (*******************************************************)
  240. PROCEDURE GenMove* (VAR from, to: Item);
  241. VAR w: INTEGER;
  242. BEGIN
  243. ASSERT(Size[from.form] = Size[to.form]);
  244. IF to.mode = Reg THEN
  245. IF from.mode = Con THEN
  246. IF to.reg = AX THEN
  247. IF (a1.mode = Con) & (from.offset = a1.offset) & (from.obj = a1.obj) & (from.form = a1.form) THEN
  248. RETURN
  249. END;
  250. a1 := from; a2.mode := 0
  251. END;
  252. CheckSize(from.form, w);
  253. IF (from.offset = 0) & (from.obj = NIL) THEN
  254. DevCPE.GenByte(30H + w); DevCPE.GenByte(0C0H + 9 * to.reg) (* XOR r,r *)
  255. ELSE
  256. DevCPE.GenByte(0B0H + w * 8 + to.reg); GenConst(from, FALSE)
  257. END;
  258. ELSIF (to.reg = AX) & (from.mode = Abs) & (from.scale = 0) THEN
  259. IF (a1.mode = Abs) & (from.offset = a1.offset) & (from.obj = a1.obj) & (from.form = a1.form)
  260. OR (a2.mode = Abs) & (from.offset = a2.offset) & (from.obj = a2.obj) & (from.form = a2.form) THEN
  261. RETURN
  262. END;
  263. a1 := from; a2.mode := 0;
  264. CheckSize(from.form, w);
  265. DevCPE.GenByte(0A0H + w); GenLinked(from, absolute);
  266. ELSIF (from.mode # Reg) OR (from.reg # to.reg) THEN
  267. IF to.reg = AX THEN
  268. IF (from.mode = Ind) & (from.scale = 0) & ((from.reg = BP) OR (from.reg = BX)) THEN
  269. IF (a1.mode = Ind) & (from.offset = a1.offset) & (from.reg = a1.reg) & (from.form = a1.form)
  270. OR (a2.mode = Ind) & (from.offset = a2.offset) & (from.reg = a2.reg) & (from.form = a2.form) THEN
  271. RETURN
  272. END;
  273. a1 := from
  274. ELSE a1.mode := 0
  275. END;
  276. a2.mode := 0
  277. END;
  278. CheckSize(from.form, w);
  279. DevCPE.GenByte(8AH + w); GenDExt(to, from)
  280. END
  281. ELSE
  282. CheckSize(from.form, w);
  283. IF from.mode = Con THEN
  284. DevCPE.GenByte(0C6H + w); GenCExt(0, to); GenConst(from, FALSE);
  285. a1.mode := 0; a2.mode := 0
  286. ELSIF (from.reg = AX) & (to.mode = Abs) & (to.scale = 0) THEN
  287. DevCPE.GenByte(0A2H + w); GenLinked(to, absolute);
  288. a2 := to
  289. ELSE
  290. DevCPE.GenByte(88H + w); GenDExt(from, to);
  291. IF from.reg = AX THEN
  292. IF (to.mode = Ind) & (to.scale = 0) & ((to.reg = BP) OR (to.reg = BX)) THEN a2 := to END
  293. ELSE a1.mode := 0; a2.mode := 0
  294. END
  295. END
  296. END
  297. END GenMove;
  298. PROCEDURE GenExtMove* (VAR from, to: Item);
  299. VAR w, op: INTEGER;
  300. BEGIN
  301. ASSERT(from.mode # Con);
  302. IF from.form IN {Byte, Char8, Char16} THEN op := 0B6H (* MOVZX *)
  303. ELSE op := 0BEH (* MOVSX *)
  304. END;
  305. IF from.form IN {Int16, Char16} THEN INC(op) END;
  306. DevCPE.GenByte(0FH); DevCPE.GenByte(op); GenDExt(to, from);
  307. IF to.reg = AX THEN a1.mode := 0; a2.mode := 0 END
  308. END GenExtMove;
  309. PROCEDURE GenSignExt* (VAR from, to: Item);
  310. BEGIN
  311. ASSERT(to.mode = Reg);
  312. IF (from.mode = Reg) & (from.reg = AX) & (to.reg = DX) THEN
  313. DevCPE.GenByte(99H) (* cdq *)
  314. ELSE
  315. GenMove(from, to); (* mov to, from *)
  316. DevCPE.GenByte(0C1H); GenCExt(38H, to); DevCPE.GenByte(31) (* sar to, 31 *)
  317. END
  318. END GenSignExt;
  319. PROCEDURE GenLoadAdr* (VAR from, to: Item);
  320. BEGIN
  321. ASSERT(to.form IN {Int32, Pointer, ProcTyp});
  322. IF (from.mode = Abs) & (from.scale = 0) THEN
  323. DevCPE.GenByte(0B8H + to.reg); GenLinked(from, absolute)
  324. ELSIF from.mode = Stk THEN
  325. DevCPE.GenByte(89H); GenCExt(SP * 8, to)
  326. ELSIF (from.mode # Ind) OR (from.offset # 0) OR (from.scale # 0) THEN
  327. DevCPE.GenByte(8DH); GenDExt(to, from)
  328. ELSIF from.reg # to.reg THEN
  329. DevCPE.GenByte(89H); GenCExt(from.reg * 8, to)
  330. ELSE RETURN
  331. END;
  332. IF to.reg = AX THEN a1.mode := 0; a2.mode := 0 END
  333. END GenLoadAdr;
  334. PROCEDURE GenPush* (VAR src: Item);
  335. VAR s: INTEGER;
  336. BEGIN
  337. IF src.mode = Con THEN
  338. ASSERT(src.form >= Int32);
  339. CheckConst(src, s); DevCPE.GenByte(68H + s); GenConst(src, TRUE)
  340. ELSIF src.mode = Reg THEN
  341. ASSERT((src.form >= Int16) OR (src.reg < 4));
  342. DevCPE.GenByte(50H + src.reg)
  343. ELSE
  344. ASSERT(src.form >= Int32);
  345. DevCPE.GenByte(0FFH); GenCExt(30H, src)
  346. END
  347. END GenPush;
  348. PROCEDURE GenPop* (VAR dst: Item);
  349. BEGIN
  350. IF dst.mode = Reg THEN
  351. ASSERT((dst.form >= Int16) OR (dst.reg < 4));
  352. DevCPE.GenByte(58H + dst.reg);
  353. IF dst.reg = AX THEN a1.mode := 0; a2.mode := 0 END
  354. ELSE
  355. DevCPE.GenByte(08FH); GenCExt(0, dst)
  356. END
  357. END GenPop;
  358. PROCEDURE GenConOp (op: INTEGER; VAR src, dst: Item);
  359. VAR w, s: INTEGER;
  360. BEGIN
  361. ASSERT(Size[src.form] = Size[dst.form]);
  362. CheckSize(src.form, w);
  363. CheckConst(src, s);
  364. IF (dst.mode = Reg) & (dst.reg = AX) & (s = 0) THEN
  365. DevCPE.GenByte(op + 4 + w); GenConst(src, FALSE)
  366. ELSE
  367. DevCPE.GenByte(80H + s + w); GenCExt(op, dst); GenConst(src, TRUE)
  368. END
  369. END GenConOp;
  370. PROCEDURE GenDirOp (op: INTEGER; VAR src, dst: Item);
  371. VAR w: INTEGER;
  372. BEGIN
  373. ASSERT(Size[src.form] = Size[dst.form]);
  374. CheckSize(src.form, w);
  375. IF dst.mode = Reg THEN
  376. DevCPE.GenByte(op + 2 + w); GenDExt(dst, src)
  377. ELSE
  378. DevCPE.GenByte(op + w); GenDExt(src, dst)
  379. END
  380. END GenDirOp;
  381. PROCEDURE GenAdd* (VAR src, dst: Item; ovflchk: BOOLEAN);
  382. VAR w: INTEGER;
  383. BEGIN
  384. ASSERT(Size[src.form] = Size[dst.form]);
  385. IF src.mode = Con THEN
  386. IF src.obj = NIL THEN
  387. IF src.offset = 1 THEN
  388. IF (dst.mode = Reg) & (dst.form >= Int32) THEN DevCPE.GenByte(40H + dst.reg) (* inc *)
  389. ELSE CheckSize(dst.form, w); DevCPE.GenByte(0FEH + w); GenCExt(0, dst)
  390. END
  391. ELSIF src.offset = -1 THEN
  392. IF (dst.mode = Reg) & (dst.form >= Int32) THEN DevCPE.GenByte(48H + dst.reg) (* dec *)
  393. ELSE CheckSize(dst.form, w); DevCPE.GenByte(0FEH + w); GenCExt(8, dst)
  394. END
  395. ELSIF src.offset # 0 THEN
  396. GenConOp(0, src, dst)
  397. ELSE RETURN
  398. END
  399. ELSE
  400. GenConOp(0, src, dst)
  401. END
  402. ELSE
  403. GenDirOp(0, src, dst)
  404. END;
  405. IF ovflchk THEN DevCPE.GenByte(0CEH) END;
  406. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  407. END GenAdd;
  408. PROCEDURE GenAddC* (VAR src, dst: Item; first, ovflchk: BOOLEAN);
  409. VAR op: INTEGER;
  410. BEGIN
  411. ASSERT(Size[src.form] = Size[dst.form]);
  412. IF first THEN op := 0 ELSE op := 10H END;
  413. IF src.mode = Con THEN GenConOp(op, src, dst)
  414. ELSE GenDirOp(op, src, dst)
  415. END;
  416. IF ovflchk THEN DevCPE.GenByte(0CEH) END;
  417. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  418. END GenAddC;
  419. PROCEDURE GenSub* (VAR src, dst: Item; ovflchk: BOOLEAN);
  420. VAR w: INTEGER;
  421. BEGIN
  422. ASSERT(Size[src.form] = Size[dst.form]);
  423. IF src.mode = Con THEN
  424. IF src.obj = NIL THEN
  425. IF src.offset = 1 THEN
  426. IF (dst.mode = Reg) & (dst.form >= Int32) THEN DevCPE.GenByte(48H + dst.reg) (* dec *)
  427. ELSE CheckSize(dst.form, w); DevCPE.GenByte(0FEH + w); GenCExt(8, dst)
  428. END
  429. ELSIF src.offset = -1 THEN
  430. IF (dst.mode = Reg) & (dst.form >= Int32) THEN DevCPE.GenByte(40H + dst.reg) (* inc *)
  431. ELSE CheckSize(dst.form, w); DevCPE.GenByte(0FEH + w); GenCExt(0, dst)
  432. END
  433. ELSIF src.offset # 0 THEN
  434. GenConOp(28H, src, dst)
  435. ELSE RETURN
  436. END
  437. ELSE
  438. GenConOp(28H, src, dst)
  439. END
  440. ELSE
  441. GenDirOp(28H, src, dst)
  442. END;
  443. IF ovflchk THEN DevCPE.GenByte(0CEH) END;
  444. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  445. END GenSub;
  446. PROCEDURE GenSubC* (VAR src, dst: Item; first, ovflchk: BOOLEAN);
  447. VAR op: INTEGER;
  448. BEGIN
  449. ASSERT(Size[src.form] = Size[dst.form]);
  450. IF first THEN op := 28H ELSE op := 18H END;
  451. IF src.mode = Con THEN GenConOp(op, src, dst)
  452. ELSE GenDirOp(op, src, dst)
  453. END;
  454. IF ovflchk THEN DevCPE.GenByte(0CEH) END;
  455. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  456. END GenSubC;
  457. PROCEDURE GenComp* (VAR src, dst: Item);
  458. VAR w: INTEGER;
  459. BEGIN
  460. IF src.mode = Con THEN
  461. IF (src.offset = 0) & (src.obj = NIL) & (dst.mode = Reg) THEN
  462. CheckSize(dst.form, w); DevCPE.GenByte(8 + w); DevCPE.GenByte(0C0H + 9 * dst.reg) (* or r,r *)
  463. ELSE GenConOp(38H, src, dst)
  464. END
  465. ELSE
  466. GenDirOp(38H, src, dst)
  467. END
  468. END GenComp;
  469. PROCEDURE GenAnd* (VAR src, dst: Item);
  470. BEGIN
  471. IF src.mode = Con THEN
  472. IF (src.obj # NIL) OR (src.offset # -1) THEN GenConOp(20H, src, dst) END
  473. ELSE GenDirOp(20H, src, dst)
  474. END;
  475. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  476. END GenAnd;
  477. PROCEDURE GenOr* (VAR src, dst: Item);
  478. BEGIN
  479. IF src.mode = Con THEN
  480. IF (src.obj # NIL) OR (src.offset # 0) THEN GenConOp(8H, src, dst) END
  481. ELSE GenDirOp(8H, src, dst)
  482. END;
  483. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  484. END GenOr;
  485. PROCEDURE GenXor* (VAR src, dst: Item);
  486. BEGIN
  487. IF src.mode = Con THEN
  488. IF (src.obj # NIL) OR (src.offset # 0) THEN GenConOp(30H, src, dst) END
  489. ELSE GenDirOp(30H, src, dst)
  490. END;
  491. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  492. END GenXor;
  493. PROCEDURE GenTest* (VAR x, y: Item);
  494. VAR w: INTEGER;
  495. BEGIN
  496. ASSERT(Size[x.form] = Size[y.form]);
  497. CheckSize(x.form, w);
  498. IF x.mode = Con THEN
  499. IF (x.mode = Reg) & (x.reg = AX) THEN
  500. DevCPE.GenByte(0A8H + w); GenConst(x, FALSE)
  501. ELSE
  502. DevCPE.GenByte(0F6H + w); GenCExt(0, y); GenConst(x, FALSE)
  503. END
  504. ELSE
  505. DevCPE.GenByte(84H + w);
  506. IF y.mode = Reg THEN GenDExt(y, x) ELSE GenDExt(x, y) END
  507. END
  508. END GenTest;
  509. PROCEDURE GenNeg* (VAR dst: Item; ovflchk: BOOLEAN);
  510. VAR w: INTEGER;
  511. BEGIN
  512. CheckSize(dst.form, w); DevCPE.GenByte(0F6H + w); GenCExt(18H, dst);
  513. IF ovflchk THEN DevCPE.GenByte(0CEH) END;
  514. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  515. END GenNeg;
  516. PROCEDURE GenNot* (VAR dst: Item);
  517. VAR w: INTEGER;
  518. BEGIN
  519. CheckSize(dst.form, w); DevCPE.GenByte(0F6H + w); GenCExt(10H, dst);
  520. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  521. END GenNot;
  522. PROCEDURE GenMul* (VAR src, dst: Item; ovflchk: BOOLEAN);
  523. VAR w, s, val, f2, f5, f9: INTEGER;
  524. BEGIN
  525. ASSERT((dst.mode = Reg) & (Size[src.form] = Size[dst.form]));
  526. IF (src.mode = Con) & (src.offset = 1) THEN RETURN END;
  527. IF src.form <= Int8 THEN
  528. ASSERT(dst.reg = 0);
  529. DevCPE.GenByte(0F6H); GenCExt(28H, src)
  530. ELSIF src.mode = Con THEN
  531. val := src.offset;
  532. IF (src.obj = NIL) & (val # 0) & ~ovflchk THEN
  533. f2 := 0; f5 := 0; f9 := 0;
  534. WHILE ~ODD(val) DO val := val DIV 2; INC(f2) END;
  535. WHILE val MOD 9 = 0 DO val := val DIV 9; INC(f9) END;
  536. WHILE val MOD 5 = 0 DO val := val DIV 5; INC(f5) END;
  537. IF ABS(val) <= 3 THEN
  538. WHILE f9 > 0 DO
  539. DevCPE.GenByte(8DH);
  540. DevCPE.GenByte(dst.reg * 8 + 4);
  541. DevCPE.GenByte(0C0H + dst.reg * 9);
  542. DEC(f9)
  543. END;
  544. WHILE f5 > 0 DO
  545. DevCPE.GenByte(8DH);
  546. DevCPE.GenByte(dst.reg * 8 + 4);
  547. DevCPE.GenByte(80H + dst.reg * 9);
  548. DEC(f5)
  549. END;
  550. IF ABS(val) = 3 THEN
  551. DevCPE.GenByte(8DH); DevCPE.GenByte(dst.reg * 8 + 4); DevCPE.GenByte(40H + dst.reg * 9)
  552. END;
  553. IF f2 > 1 THEN DevCPE.GenByte(0C1H); DevCPE.GenByte(0E0H + dst.reg); DevCPE.GenByte(f2)
  554. ELSIF f2 = 1 THEN DevCPE.GenByte(1); DevCPE.GenByte(0C0H + dst.reg * 9)
  555. END;
  556. IF val < 0 THEN DevCPE.GenByte(0F7H); GenCExt(18H, dst) END;
  557. IF dst.reg = AX THEN a1.mode := 0; a2.mode := 0 END;
  558. RETURN
  559. END
  560. END;
  561. CheckSize(src.form, w); CheckConst(src, s);
  562. DevCPE.GenByte(69H + s); GenDExt(dst, dst); GenConst(src, TRUE)
  563. ELSE
  564. CheckSize(src.form, w);
  565. DevCPE.GenByte(0FH); DevCPE.GenByte(0AFH); GenDExt(dst, src)
  566. END;
  567. IF ovflchk THEN DevCPE.GenByte(0CEH) END;
  568. IF dst.reg = AX THEN a1.mode := 0; a2.mode := 0 END
  569. END GenMul;
  570. PROCEDURE GenDiv* (VAR src: Item; mod, pos: BOOLEAN);
  571. VAR w, rem: INTEGER;
  572. BEGIN
  573. ASSERT(src.mode = Reg);
  574. IF src.form >= Int32 THEN DevCPE.GenByte(99H) (* cdq *)
  575. ELSIF src.form = Int16 THEN DevCPE.GenByte(66H); DevCPE.GenByte(99H) (* cwd *)
  576. ELSE DevCPE.GenByte(66H); DevCPE.GenByte(98H) (* cbw *)
  577. END;
  578. CheckSize(src.form, w); DevCPE.GenByte(0F6H + w); GenCExt(38H, src); (* idiv src *)
  579. IF src.form > Int8 THEN rem := 2 (* edx *) ELSE rem := 4 (* ah *) END;
  580. IF pos THEN (* src > 0 *)
  581. CheckSize(src.form, w); DevCPE.GenByte(8 + w); DevCPE.GenByte(0C0H + 9 * rem); (* or rem,rem *)
  582. IF mod THEN
  583. DevCPE.GenByte(79H); DevCPE.GenByte(2); (* jns end *)
  584. DevCPE.GenByte(2 + w); GenCExt(8 * rem, src); (* add rem,src *)
  585. ELSE
  586. DevCPE.GenByte(79H); DevCPE.GenByte(1); (* jns end *)
  587. DevCPE.GenByte(48H); (* dec eax *)
  588. END
  589. ELSE
  590. CheckSize(src.form, w); DevCPE.GenByte(30H + w); GenCExt(8 * rem, src); (* xor src,rem *)
  591. IF mod THEN
  592. DevCPE.GenByte(79H); (* jns end *)
  593. IF src.form = Int16 THEN DevCPE.GenByte(9); DevCPE.GenByte(66H) ELSE DevCPE.GenByte(8) END;
  594. DevCPE.GenByte(8 + w); DevCPE.GenByte(0C0H + 9 * rem); (* or rem,rem *)
  595. DevCPE.GenByte(74H); DevCPE.GenByte(4); (* je end *)
  596. DevCPE.GenByte(30H + w); GenCExt(8 * rem, src); (* xor src,rem *)
  597. DevCPE.GenByte(2 + w); GenCExt(8 * rem, src); (* add rem,src *)
  598. ELSE
  599. DevCPE.GenByte(79H); (* jns end *)
  600. IF src.form = Int16 THEN DevCPE.GenByte(6); DevCPE.GenByte(66H) ELSE DevCPE.GenByte(5) END;
  601. DevCPE.GenByte(8 + w); DevCPE.GenByte(0C0H + 9 * rem); (* or rem,rem *)
  602. DevCPE.GenByte(74H); DevCPE.GenByte(1); (* je end *)
  603. DevCPE.GenByte(48H); (* dec eax *)
  604. END
  605. (*
  606. CheckSize(src.form, w); DevCPE.GenByte(3AH + w); GenCExt(8 * rem, src); (* cmp rem,src *)
  607. IF mod THEN
  608. DevCPE.GenByte(72H); DevCPE.GenByte(4); (* jb end *)
  609. DevCPE.GenByte(7FH); DevCPE.GenByte(2); (* jg end *)
  610. DevCPE.GenByte(2 + w); GenCExt(8 * rem, src); (* add rem,src *)
  611. ELSE
  612. DevCPE.GenByte(72H); DevCPE.GenByte(3); (* jb end *)
  613. DevCPE.GenByte(7FH); DevCPE.GenByte(1); (* jg end *)
  614. DevCPE.GenByte(48H); (* dec eax *)
  615. END
  616. *)
  617. END;
  618. a1.mode := 0; a2.mode := 0
  619. END GenDiv;
  620. PROCEDURE GenShiftOp* (op: INTEGER; VAR cnt, dst: Item);
  621. VAR w: INTEGER;
  622. BEGIN
  623. CheckSize(dst.form, w);
  624. IF cnt.mode = Con THEN
  625. ASSERT(cnt.offset >= 0); ASSERT(cnt.obj = NIL);
  626. IF cnt.offset = 1 THEN
  627. IF (op = 10H) & (dst.mode = Reg) THEN (* shl r *)
  628. DevCPE.GenByte(w); GenDExt(dst, dst) (* add r, r *)
  629. ELSE
  630. DevCPE.GenByte(0D0H + w); GenCExt(op, dst)
  631. END
  632. ELSIF cnt.offset > 1 THEN
  633. DevCPE.GenByte(0C0H + w); GenCExt(op, dst); DevCPE.GenByte(cnt.offset)
  634. END
  635. ELSE
  636. ASSERT((cnt.mode = Reg) & (cnt.reg = CX));
  637. DevCPE.GenByte(0D2H + w); GenCExt(op, dst)
  638. END;
  639. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  640. END GenShiftOp;
  641. PROCEDURE GenBitOp* (op: INTEGER; VAR num, dst: Item);
  642. BEGIN
  643. DevCPE.GenByte(0FH);
  644. IF num.mode = Con THEN
  645. ASSERT(num.obj = NIL);
  646. DevCPE.GenByte(0BAH); GenCExt(op, dst); DevCPE.GenByte(num.offset)
  647. ELSE
  648. ASSERT((num.mode = Reg) & (num.form = Int32));
  649. DevCPE.GenByte(83H + op); GenDExt(num, dst)
  650. END;
  651. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  652. END GenBitOp;
  653. PROCEDURE GenSetCC* (cc: INTEGER; VAR dst: Item);
  654. BEGIN
  655. ASSERT((dst.form = Bool) & (cc >= 0));
  656. DevCPE.GenByte(0FH); DevCPE.GenByte(90H + cc); GenCExt(0, dst);
  657. IF (dst.mode # Reg) OR (dst.reg = AX) THEN a1.mode := 0; a2.mode := 0 END
  658. END GenSetCC;
  659. PROCEDURE GenFLoad* (VAR src: Item);
  660. VAR mf: INTEGER;
  661. BEGIN
  662. IF src.mode = Con THEN (* predefined constants *)
  663. DevCPE.GenByte(0D9H); DevCPE.GenByte(0E8H + src.offset)
  664. ELSIF src.form = Int64 THEN
  665. DevCPE.GenByte(0DFH); GenCExt(28H, src)
  666. ELSE
  667. CheckForm(src.form, mf);
  668. DevCPE.GenByte(0D9H + mf); GenCExt(0, src)
  669. END
  670. END GenFLoad;
  671. PROCEDURE GenFStore* (VAR dst: Item; pop: BOOLEAN);
  672. VAR mf: INTEGER;
  673. BEGIN
  674. IF dst.form = Int64 THEN ASSERT(pop);
  675. DevCPE.GenByte(0DFH); GenCExt(38H, dst); DevCPE.GenByte(9BH) (* wait *)
  676. ELSE
  677. CheckForm(dst.form, mf); DevCPE.GenByte(0D9H + mf);
  678. IF pop THEN GenCExt(18H, dst); DevCPE.GenByte(9BH) (* wait *)
  679. ELSE GenCExt(10H, dst)
  680. END
  681. END;
  682. a1.mode := 0; a2.mode := 0
  683. END GenFStore;
  684. PROCEDURE GenFDOp* (op: INTEGER; VAR src: Item);
  685. VAR mf: INTEGER;
  686. BEGIN
  687. IF src.mode = Reg THEN
  688. DevCPE.GenByte(0DEH); DevCPE.GenByte(0C1H + op)
  689. ELSE
  690. CheckForm(src.form, mf);
  691. DevCPE.GenByte(0D8H + mf); GenCExt(op, src)
  692. END
  693. END GenFDOp;
  694. PROCEDURE GenFMOp* (op: INTEGER);
  695. BEGIN
  696. DevCPE.GenByte(0D8H + op DIV 256);
  697. DevCPE.GenByte(op MOD 256);
  698. IF op = 07E0H THEN a1.mode := 0; a2.mode := 0 END (* FSTSW AX *)
  699. END GenFMOp;
  700. PROCEDURE GenJump* (cc: INTEGER; VAR L: Label; shortjmp: BOOLEAN);
  701. BEGIN
  702. IF cc # ccNever THEN
  703. IF shortjmp OR (L > 0) & (DevCPE.pc + 2 - L <= 128) & (cc # ccCall) THEN
  704. IF cc = ccAlways THEN DevCPE.GenByte(0EBH)
  705. ELSE DevCPE.GenByte(70H + cc)
  706. END;
  707. IF L > 0 THEN DevCPE.GenByte(L - DevCPE.pc - 1)
  708. ELSE ASSERT(L = 0); L := -(DevCPE.pc + short * 1000000H); DevCPE.GenByte(0)
  709. END
  710. ELSE
  711. IF cc = ccAlways THEN DevCPE.GenByte(0E9H)
  712. ELSIF cc = ccCall THEN DevCPE.GenByte(0E8H)
  713. ELSE DevCPE.GenByte(0FH); DevCPE.GenByte(80H + cc)
  714. END;
  715. IF L > 0 THEN GenDbl(L - DevCPE.pc - 4)
  716. ELSE GenDbl(-L); L := -(DevCPE.pc - 4 + relative * 1000000H)
  717. END
  718. END
  719. END
  720. END GenJump;
  721. PROCEDURE GenExtJump* (cc: INTEGER; VAR dst: Item);
  722. BEGIN
  723. IF cc = ccAlways THEN DevCPE.GenByte(0E9H)
  724. ELSE DevCPE.GenByte(0FH); DevCPE.GenByte(80H + cc)
  725. END;
  726. dst.offset := 0; GenLinked(dst, relative)
  727. END GenExtJump;
  728. PROCEDURE GenIndJump* (VAR dst: Item);
  729. BEGIN
  730. DevCPE.GenByte(0FFH); GenCExt(20H, dst)
  731. END GenIndJump;
  732. PROCEDURE GenCaseJump* (VAR src: Item);
  733. VAR link: DevCPT.LinkList; tab: INTEGER;
  734. BEGIN
  735. ASSERT((src.form = Int32) & (src.mode = Reg));
  736. DevCPE.GenByte(0FFH); DevCPE.GenByte(24H); DevCPE.GenByte(85H + 8 * src.reg);
  737. tab := (DevCPE.pc + 7) DIV 4 * 4;
  738. NEW(link); link.offset := tab; link.linkadr := DevCPE.pc;
  739. link.next := DevCPE.CaseLinks; DevCPE.CaseLinks := link;
  740. GenDbl(absolute * 1000000H + tab);
  741. WHILE DevCPE.pc < tab DO DevCPE.GenByte(90H) END;
  742. END GenCaseJump;
  743. (*
  744. PROCEDURE GenCaseJump* (VAR src: Item; num: LONGINT; VAR tab: LONGINT);
  745. VAR link: DevCPT.LinkList; else, last: LONGINT;
  746. BEGIN
  747. ASSERT((src.form = Int32) & (src.mode = Reg));
  748. DevCPE.GenByte(0FFH); DevCPE.GenByte(24H); DevCPE.GenByte(85H + 8 * src.reg);
  749. tab := (DevCPE.pc + 7) DIV 4 * 4;
  750. else := tab + num * 4; last := else - 4;
  751. NEW(link); link.offset := tab; link.linkadr := DevCPE.pc;
  752. link.next := CaseLinks; CaseLinks := link;
  753. GenDbl(absolute * 1000000H + tab);
  754. WHILE DevCPE.pc < tab DO DevCPE.GenByte(90H) END;
  755. WHILE DevCPE.pc < last DO GenDbl(table * 1000000H + else) END;
  756. GenDbl(tableend * 1000000H + else)
  757. END GenCaseJump;
  758. *)
  759. PROCEDURE GenCaseEntry* (VAR L: Label; last: BOOLEAN);
  760. VAR typ: INTEGER;
  761. BEGIN
  762. IF last THEN typ := tableend * 1000000H ELSE typ := table * 1000000H END;
  763. IF L > 0 THEN GenDbl(L + typ) ELSE GenDbl(-L); L := -(DevCPE.pc - 4 + typ) END
  764. END GenCaseEntry;
  765. PROCEDURE GenCall* (VAR dst: Item);
  766. BEGIN
  767. IF dst.mode IN {LProc, XProc, IProc} THEN
  768. DevCPE.GenByte(0E8H);
  769. IF dst.obj.mnolev >= 0 THEN (* local *)
  770. IF dst.obj.adr > 0 THEN GenDbl(dst.obj.adr - DevCPE.pc - 4)
  771. ELSE GenDbl(-dst.obj.adr); dst.obj.adr := -(DevCPE.pc - 4 + relative * 1000000H)
  772. END
  773. ELSE (* imported *)
  774. dst.offset := 0; GenLinked(dst, relative)
  775. END
  776. ELSE DevCPE.GenByte(0FFH); GenCExt(10H, dst)
  777. END;
  778. a1.mode := 0; a2.mode := 0
  779. END GenCall;
  780. PROCEDURE GenAssert* (cc, no: INTEGER);
  781. BEGIN
  782. IF cc # ccAlways THEN
  783. IF cc >= 0 THEN
  784. DevCPE.GenByte(70H + cc); (* jcc end *)
  785. IF no < 0 THEN DevCPE.GenByte(2) ELSE DevCPE.GenByte(3) END
  786. END;
  787. IF no < 0 THEN
  788. DevCPE.GenByte(8DH); DevCPE.GenByte(0E0H - no)
  789. ELSE
  790. DevCPE.GenByte(8DH); DevCPE.GenByte(0F0H); DevCPE.GenByte(no)
  791. END
  792. END
  793. END GenAssert;
  794. PROCEDURE GenReturn* (val: INTEGER);
  795. BEGIN
  796. IF val = 0 THEN DevCPE.GenByte(0C3H)
  797. ELSE DevCPE.GenByte(0C2H); GenWord(val)
  798. END;
  799. a1.mode := 0; a2.mode := 0
  800. END GenReturn;
  801. PROCEDURE LoadStr (size: INTEGER);
  802. BEGIN
  803. IF size = 2 THEN DevCPE.GenByte(66H) END;
  804. IF size <= 1 THEN DevCPE.GenByte(0ACH) ELSE DevCPE.GenByte(0ADH) END (* lods *)
  805. END LoadStr;
  806. PROCEDURE StoreStr (size: INTEGER);
  807. BEGIN
  808. IF size = 2 THEN DevCPE.GenByte(66H) END;
  809. IF size <= 1 THEN DevCPE.GenByte(0AAH) ELSE DevCPE.GenByte(0ABH) END (* stos *)
  810. END StoreStr;
  811. PROCEDURE ScanStr (size: INTEGER; rep: BOOLEAN);
  812. BEGIN
  813. IF size = 2 THEN DevCPE.GenByte(66H) END;
  814. IF rep THEN DevCPE.GenByte(0F2H) END;
  815. IF size <= 1 THEN DevCPE.GenByte(0AEH) ELSE DevCPE.GenByte(0AFH) END (* scas *)
  816. END ScanStr;
  817. PROCEDURE TestNull (size: INTEGER);
  818. BEGIN
  819. IF size = 2 THEN DevCPE.GenByte(66H) END;
  820. IF size <= 1 THEN DevCPE.GenByte(8); DevCPE.GenByte(0C0H); (* or al,al *)
  821. ELSE DevCPE.GenByte(9); DevCPE.GenByte(0C0H); (* or ax,ax *)
  822. END
  823. END TestNull;
  824. PROCEDURE GenBlockMove* (wsize, len: INTEGER); (* len = 0: len in ECX *)
  825. VAR w: INTEGER;
  826. BEGIN
  827. IF len = 0 THEN (* variable size move *)
  828. IF wsize = 4 THEN w := 1 ELSIF wsize = 2 THEN w := 1; DevCPE.GenByte(66H) ELSE w := 0 END;
  829. DevCPE.GenByte(0F3H); DevCPE.GenByte(0A4H + w); (* rep:movs *)
  830. ELSE (* fixed size move *)
  831. len := len * wsize;
  832. IF len >= 16 THEN
  833. DevCPE.GenByte(0B9H); GenDbl(len DIV 4); (* ld ecx,len/4 *)
  834. DevCPE.GenByte(0F3H); DevCPE.GenByte(0A5H); (* rep:movs long*)
  835. len := len MOD 4
  836. END;
  837. WHILE len >= 4 DO DevCPE.GenByte(0A5H); DEC(len, 4) END; (* movs long *);
  838. IF len >= 2 THEN DevCPE.GenByte(66H); DevCPE.GenByte(0A5H) END; (* movs word *);
  839. IF ODD(len) THEN DevCPE.GenByte(0A4H) END; (* movs byte *)
  840. END
  841. END GenBlockMove;
  842. PROCEDURE GenBlockStore* (wsize, len: INTEGER); (* len = 0: len in ECX *)
  843. VAR w: INTEGER;
  844. BEGIN
  845. IF len = 0 THEN (* variable size move *)
  846. IF wsize = 4 THEN w := 1 ELSIF wsize = 2 THEN w := 1; DevCPE.GenByte(66H) ELSE w := 0 END;
  847. DevCPE.GenByte(0F3H); DevCPE.GenByte(0AAH + w); (* rep:stos *)
  848. ELSE (* fixed size move *)
  849. len := len * wsize;
  850. IF len >= 16 THEN
  851. DevCPE.GenByte(0B9H); GenDbl(len DIV 4); (* ld ecx,len/4 *)
  852. DevCPE.GenByte(0F3H); DevCPE.GenByte(0ABH); (* rep:stos long*)
  853. len := len MOD 4
  854. END;
  855. WHILE len >= 4 DO DevCPE.GenByte(0ABH); DEC(len, 4) END; (* stos long *);
  856. IF len >= 2 THEN DevCPE.GenByte(66H); DevCPE.GenByte(0ABH) END; (* stos word *);
  857. IF ODD(len) THEN DevCPE.GenByte(0ABH) END; (* stos byte *)
  858. END
  859. END GenBlockStore;
  860. PROCEDURE GenBlockComp* (wsize, len: INTEGER); (* len = 0: len in ECX *)
  861. VAR w: INTEGER;
  862. BEGIN
  863. ASSERT(len >= 0);
  864. IF len > 0 THEN DevCPE.GenByte(0B9H); GenDbl(len) END; (* ld ecx,len *)
  865. IF wsize = 4 THEN w := 1 ELSIF wsize = 2 THEN w := 1; DevCPE.GenByte(66H) ELSE w := 0 END;
  866. DevCPE.GenByte(0F3H); DevCPE.GenByte(0A6H + w) (* repe:cmps *)
  867. END GenBlockComp;
  868. PROCEDURE GenStringMove* (excl: BOOLEAN; wsize, dsize, len: INTEGER);
  869. (*
  870. len = 0: len in ECX, len = -1: len undefined; wsize # dsize -> convert; size = 0: opsize = 1, incsize = 2; excl: don't move 0X
  871. *)
  872. VAR loop, end: Label;
  873. BEGIN
  874. IF len > 0 THEN DevCPE.GenByte(0B9H); GenDbl(len) END; (* ld ecx,len *)
  875. (* len >= 0: len IN ECX *)
  876. IF (dsize = 2) & (wsize < 2) THEN DevCPE.GenByte(31H); DevCPE.GenByte(0C0H) END; (* xor eax,eax *)
  877. loop := NewLbl; end := NewLbl;
  878. SetLabel(loop); LoadStr(wsize);
  879. IF wsize = 0 THEN DevCPE.GenByte(46H) END; (* inc esi *)
  880. IF len < 0 THEN (* no limit *)
  881. StoreStr(dsize); TestNull(wsize); GenJump(ccNE, loop, TRUE);
  882. IF excl THEN (* dec edi *)
  883. DevCPE.GenByte(4FH);
  884. IF dsize # 1 THEN DevCPE.GenByte(4FH) END
  885. END;
  886. ELSE (* cx limit *)
  887. IF excl THEN TestNull(wsize); GenJump(ccE, end, TRUE); StoreStr(dsize)
  888. ELSE StoreStr(dsize); TestNull(wsize); GenJump(ccE, end, TRUE)
  889. END;
  890. DevCPE.GenByte(49H); (* dec ecx *)
  891. GenJump(ccNE, loop, TRUE);
  892. GenAssert(ccNever, copyTrap); (* trap *)
  893. SetLabel(end)
  894. END;
  895. a1.mode := 0; a2.mode := 0
  896. END GenStringMove;
  897. PROCEDURE GenStringComp* (wsize, dsize: INTEGER);
  898. (* wsize # dsize -> convert; size = 0: opsize = 1, incsize = 2; *)
  899. VAR loop, end: Label;
  900. BEGIN
  901. IF (dsize = 2) & (wsize < 2) THEN DevCPE.GenByte(31H); DevCPE.GenByte(0C0H); (* xor eax,eax *) END;
  902. loop := NewLbl; end := NewLbl;
  903. SetLabel(loop); LoadStr(wsize);
  904. IF wsize = 0 THEN DevCPE.GenByte(46H) END; (* inc esi *)
  905. ScanStr(dsize, FALSE); GenJump(ccNE, end, TRUE);
  906. IF dsize = 0 THEN DevCPE.GenByte(47H) END; (* inc edi *)
  907. TestNull(wsize); GenJump(ccNE, loop, TRUE);
  908. SetLabel(end);
  909. a1.mode := 0; a2.mode := 0
  910. END GenStringComp;
  911. PROCEDURE GenStringLength* (wsize, len: INTEGER); (* len = 0: len in ECX, len = -1: len undefined *)
  912. BEGIN
  913. DevCPE.GenByte(31H); DevCPE.GenByte(0C0H); (* xor eax,eax *)
  914. IF len # 0 THEN DevCPE.GenByte(0B9H); GenDbl(len) END; (* ld ecx,len *)
  915. ScanStr(wsize, TRUE);
  916. a1.mode := 0; a2.mode := 0
  917. END GenStringLength;
  918. PROCEDURE GenStrStore* (size: INTEGER);
  919. VAR w: INTEGER;
  920. BEGIN
  921. IF size # 0 THEN
  922. IF size MOD 4 = 0 THEN w := 1; size := size DIV 4
  923. ELSIF size MOD 2 = 0 THEN w := 2; size := size DIV 2
  924. ELSE w := 0
  925. END;
  926. DevCPE.GenByte(0B9H); GenDbl(size); (* ld ecx,size *)
  927. IF w = 2 THEN DevCPE.GenByte(66H); w := 1 END
  928. ELSE w := 0
  929. END;
  930. DevCPE.GenByte(0F3H); DevCPE.GenByte(0AAH + w); (* rep:stos *)
  931. a1.mode := 0; a2.mode := 0
  932. END GenStrStore;
  933. PROCEDURE GenCode* (op: INTEGER);
  934. BEGIN
  935. DevCPE.GenByte(op);
  936. a1.mode := 0; a2.mode := 0
  937. END GenCode;
  938. PROCEDURE Init*(opt: SET);
  939. BEGIN
  940. DevCPE.Init(processor, opt);
  941. level := 0;
  942. NEW(one); one.realval := 1.0; one.intval := DevCPM.ConstNotAlloc;
  943. END Init;
  944. PROCEDURE Close*;
  945. BEGIN
  946. a1.obj := NIL; a1.typ := NIL; a2.obj := NIL; a2.typ := NIL; one := NIL;
  947. DevCPE.Close
  948. END Close;
  949. BEGIN
  950. Size[Undef] := 0;
  951. Size[Byte] := 1;
  952. Size[Bool] := 1;
  953. Size[Char8] := 1;
  954. Size[Int8] := 1;
  955. Size[Int16] := 2;
  956. Size[Int32] := 4;
  957. Size[Real32] := -4;
  958. Size[Real64] := -8;
  959. Size[Set] := 4;
  960. Size[String8] := 0;
  961. Size[NilTyp] := 4;
  962. Size[NoTyp] := 0;
  963. Size[Pointer] := 4;
  964. Size[ProcTyp] := 4;
  965. Size[Comp] := 0;
  966. Size[Char16] := 2;
  967. Size[Int64] := 8;
  968. Size[String16] := 0
  969. END Dev0CPL486.