DEADSOFTWARE

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