DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / gpcp-linux.git / blob


23abf98e296a7ba270dc394cc203a4ef27ec135a
[gpcp-linux.git] / gpcp / JavaMaker.cp
1 (* ============================================================ *)
2 (* JavaMaker is the concrete class for emitting java *)
3 (* class files. *)
4 (* Diane Corney - September,2000. *)
5 (* ============================================================ *)
6
7 MODULE JavaMaker;
8
9 IMPORT
10 GPCPcopyright,
11 ASCII,
12 Error,
13 Console,
14 L := LitValue,
15 CPascalS,
16 FileNames,
17 ClassMaker,
18 JavaBase,
19 ClassUtil,
20 JsmnUtil,
21 Cst := CompState,
22 Jvm := JVMcodes,
23 Ju := JavaUtil,
24 Bi := Builtin,
25 Sy := Symbols,
26 Id := IdDesc,
27 Ty := TypeDesc,
28 Xp := ExprDesc,
29 St := StatDesc;
30
31 (* ------------------------------------ *)
32
33 TYPE JavaWorkList* =
34 POINTER TO
35 RECORD (JavaBase.ClassEmitter)
36 (* --------------------------- *
37 * mod* : Id.BlkId; *
38 * --------------------------- *)
39 tide : INTEGER;
40 high : INTEGER;
41 work : POINTER TO ARRAY OF JavaEmitter;
42 END;
43
44 (* ------------------------------------ *)
45
46 TYPE JavaEmitter* =
47 POINTER TO ABSTRACT
48 RECORD (JavaBase.ClassEmitter)
49 (* --------------------------- *
50 * mod* : Id.BlkId; *
51 * --------------------------- *)
52 outF : Ju.JavaFile;
53 END;
54
55 (* ------------------------------------ *)
56
57 TYPE JavaModEmitter* =
58 POINTER TO
59 RECORD (JavaEmitter);
60 (* --------------------------- *
61 * mod* : Id.BlkId; *
62 * outF : JavaBase.JavaFile; *
63 * --------------------------- *)
64 END;
65
66 (* ------------------------------------ *)
67
68 TYPE JavaRecEmitter* =
69 POINTER TO
70 RECORD (JavaEmitter)
71 (* --------------------------- *
72 * mod* : Id.BlkId; *
73 * outF : Ju.JavaFile; *
74 * --------------------------- *)
75 recT : Ty.Record;
76 END;
77
78 (* ------------------------------------ *)
79
80 TYPE JavaProcTypeEmitter* =
81 POINTER TO
82 RECORD (JavaEmitter)
83 (* --------------------------- *
84 * mod* : Id.BlkId; *
85 * outF : Ju.JavaFile; *
86 * --------------------------- *)
87 prcT : Ty.Procedure;
88 END;
89
90 (* ------------------------------------ *)
91
92 TYPE JavaAssembler* =
93 POINTER TO
94 RECORD (ClassMaker.Assembler)
95 END;
96
97
98 (* ------------------------------------ *)
99
100 VAR
101 asmList : L.CharOpenSeq;
102 currentLoopLabel : Ju.Label;
103
104 (* ============================================================ *)
105
106 PROCEDURE Append(list : JavaWorkList;
107 emit : JavaEmitter);
108 VAR temp : POINTER TO ARRAY OF JavaEmitter;
109 i : INTEGER;
110 BEGIN
111 IF list.tide > list.high THEN (* must expand *)
112 temp := list.work;
113 list.high := list.high * 2 + 1;
114 NEW(list.work, (list.high+1));
115 FOR i := 0 TO list.tide-1 DO list.work[i] := temp[i] END;
116 END;
117 list.work[list.tide] := emit; INC(list.tide);
118 END Append;
119
120 (* ============================================================ *)
121
122 PROCEDURE newJavaEmitter*(mod : Id.BlkId) : JavaWorkList;
123 VAR emitter : JavaWorkList;
124 modEmit : JavaModEmitter;
125 modName : L.CharOpen;
126 BEGIN
127 modName := Sy.getName.ChPtr(mod);
128 (*
129 * Allocate a new worklist object.
130 *)
131 NEW(emitter);
132 emitter.mod := mod;
133 NEW(emitter.work, 4);
134 emitter.tide := 0;
135 emitter.high := 3;
136 JavaBase.worklist := emitter;
137 (*
138 * Allocate a JavaModEmitter to be first item
139 * on the worklist. All later items will be of
140 * JavaRecEmitter type.
141 *)
142 NEW(modEmit);
143 modEmit.mod := mod;
144 (*
145 * Now append the mod-emitter to the worklist.
146 *)
147 Append(emitter, modEmit);
148 RETURN emitter;
149 END newJavaEmitter;
150
151 (* ============================================================ *)
152
153 PROCEDURE newJavaAsm*() : JavaAssembler;
154 VAR asm : JavaAssembler;
155 BEGIN
156 NEW(asm);
157 L.ResetCharOpenSeq(asmList);
158 RETURN asm;
159 END newJavaAsm;
160
161 (* ============================================================ *)
162
163 PROCEDURE (list : JavaWorkList)AddNewRecEmitter*(inTp : Ty.Record);
164 VAR emit : JavaRecEmitter;
165 BEGIN
166 NEW(emit);
167 emit.mod := list.mod;
168 (*
169 * Set the current record type for this class.
170 *)
171 emit.recT := inTp;
172 (*
173 * Now append the new RecEmitter to the worklist.
174 *)
175 Append(list, emit);
176 END AddNewRecEmitter;
177
178 (* ============================================================ *)
179
180 PROCEDURE (list : JavaWorkList)AddNewProcTypeEmitter*(inTp : Ty.Procedure);
181 VAR emit : JavaProcTypeEmitter;
182 BEGIN
183 NEW(emit);
184 emit.mod := list.mod;
185 (*
186 * Set the current record type for this class.
187 *)
188 emit.prcT := inTp;
189 (*
190 * Now append the new RecEmitter to the worklist.
191 *)
192 Append(list, emit);
193 END AddNewProcTypeEmitter;
194
195 (* ============================================================ *)
196 (* Mainline emitter, consumes worklist emitting assembler *)
197 (* files until the worklist is empty. *)
198 (* ============================================================ *)
199
200 PROCEDURE (this : JavaWorkList)Emit*();
201 VAR ix : INTEGER;
202 BEGIN
203 (*
204 * First construct the base class-name string in the BlkId.
205 *)
206 Ju.Init();
207 Ju.MkBlkName(this.mod);
208
209 ix := 0;
210 WHILE ix < this.tide DO
211 this.work[ix].Emit();
212 INC(ix);
213 END;
214 END Emit;
215
216 (* ============================================================ *)
217 (* Creates basic imports for java.lang, and inserts a few type *)
218 (* descriptors for Object, Exception, and String. *)
219 (* ============================================================ *)
220
221 PROCEDURE (this : JavaWorkList)Init*();
222 VAR tId : Id.TypId;
223 blk : Id.BlkId;
224 obj : Id.TypId;
225 cls : Id.TypId;
226 str : Id.TypId;
227 exc : Id.TypId;
228 xhr : Id.TypId;
229 BEGIN
230 (*
231 * Create import descriptor for java.lang
232 *)
233 Bi.MkDummyImport("java_lang", "java.lang", blk);
234 Cst.SetSysLib(blk);
235 (*
236 * Create various classes.
237 *)
238 Bi.MkDummyClass("Object", blk, Ty.isAbs, obj);
239 Cst.ntvObj := obj.type;
240 Bi.MkDummyClass("String", blk, Ty.noAtt, str);
241 Cst.ntvStr := str.type;
242 Bi.MkDummyClass("Exception", blk, Ty.extns, exc);
243 Cst.ntvExc := exc.type;
244 Bi.MkDummyClass("Class", blk, Ty.noAtt, cls);
245 Cst.ntvTyp := cls.type;
246 (*
247 * Create import descriptor for CP.RTS
248 *)
249 Bi.MkDummyImport("RTS", "", blk);
250 Bi.MkDummyAlias("NativeType", blk, cls.type, Cst.clsId);
251 Bi.MkDummyAlias("NativeObject", blk, obj.type, Cst.objId);
252 Bi.MkDummyAlias("NativeString", blk, str.type, Cst.strId);
253 Bi.MkDummyAlias("NativeException", blk, exc.type, Cst.excId);
254
255 Bi.MkDummyVar("dblPosInfinity",blk,Bi.realTp,Cst.dblInf);
256 Bi.MkDummyVar("dblNegInfinity",blk,Bi.realTp,Cst.dblNInf);
257 Bi.MkDummyVar("fltPosInfinity",blk,Bi.sReaTp,Cst.fltInf);
258 Bi.MkDummyVar("fltNegInfinity",blk,Bi.sReaTp,Cst.fltNInf);
259 INCL(blk.xAttr, Sy.need);
260 (*
261 * Uplevel addressing stuff.
262 *)
263 Bi.MkDummyImport("$CPJrts$", "CP.CPJrts", blk);
264 Bi.MkDummyClass("XHR", blk, Ty.isAbs, xhr);
265 Cst.rtsXHR := xhr.type;
266 Cst.xhrId.recTyp := Cst.rtsXHR;
267 Cst.xhrId.type := Cst.rtsXHR;
268 END Init;
269
270 (* ============================================================ *)
271
272 PROCEDURE (this : JavaWorkList)ObjectFeatures*();
273 VAR prcSig : Ty.Procedure;
274 thePar : Id.ParId;
275 BEGIN
276 NEW(prcSig);
277 prcSig.retType := Cst.strId.type;
278 Id.InitParSeq(prcSig.formals, 2);
279 Bi.MkDummyMethodAndInsert("toString", prcSig, Cst.ntvObj, Cst.sysLib, Sy.pubMode, Sy.var, Id.extns);
280
281 NEW(prcSig);
282 prcSig.retType := Bi.intTp;
283 Id.InitParSeq(prcSig.formals, 2);
284 Bi.MkDummyMethodAndInsert("hashCode", prcSig, Cst.ntvObj, Cst.sysLib, Sy.pubMode, Sy.var, Id.extns);
285
286 NEW(prcSig);
287 prcSig.retType := Cst.ntvObj;
288 Id.InitParSeq(prcSig.formals, 2);
289 Bi.MkDummyMethodAndInsert("clone", prcSig, Cst.ntvObj, Cst.sysLib, Sy.protect, Sy.var, Id.extns);
290
291 NEW(prcSig);
292 NEW(thePar);
293 prcSig.retType := Bi.boolTp;
294 Id.InitParSeq(prcSig.formals, 2);
295 thePar.parMod := Sy.val;
296 thePar.type := Cst.ntvObj;
297 thePar.varOrd := 1;
298 Id.AppendParam(prcSig.formals, thePar);
299 Bi.MkDummyMethodAndInsert("equals", prcSig, Cst.ntvObj, Cst.sysLib, Sy.pubMode, Sy.var, Id.extns);
300 END ObjectFeatures;
301
302 (* ============================================================ *)
303 PROCEDURE (this : JavaAssembler)Assemble*();
304 VAR ix : INTEGER;
305 BEGIN
306 IF asmList.tide > 0 THEN
307 Cst.Message("Jasmin Assmbler no longer supported");
308 Cst.Message("The following jasmin text files were created:");
309 FOR ix := 0 TO asmList.tide-1 DO
310 Console.Write(ASCII.HT);
311 Console.WriteString(asmList.a[ix]^);
312 Console.WriteLn;
313 END;
314 END;
315 END Assemble;
316
317 (* ============================================================ *)
318
319 PROCEDURE (t : JavaEmitter)EmitBody(f : Ju.JavaFile),NEW,ABSTRACT;
320 PROCEDURE^ (e : JavaEmitter)EmitProc(proc : Id.Procs),NEW;
321 PROCEDURE^ (e : JavaEmitter)EmitStat(stat : Sy.Stmt; OUT ok : BOOLEAN),NEW;
322 PROCEDURE^ (e : JavaEmitter)PushCall(callX : Xp.CallX),NEW;
323 PROCEDURE^ (e : JavaEmitter)PushValue(exp : Sy.Expr; typ : Sy.Type),NEW;
324 PROCEDURE^ (e : JavaEmitter)FallFalse(exp : Sy.Expr; tLb : Ju.Label),NEW;
325 PROCEDURE^ (e : JavaEmitter)ValueCopy(act : Sy.Expr; fmT : Sy.Type),NEW;
326 PROCEDURE^ (e : JavaEmitter)PushArg(act : Sy.Expr;
327 frm : Id.ParId;
328 VAR seq : Sy.ExprSeq),NEW;
329
330 (* ============================================================ *)
331
332 PROCEDURE (t : JavaRecEmitter)CopyProc(),NEW;
333 VAR out : Ju.JavaFile;
334 junk : INTEGER;
335 indx : INTEGER;
336 idnt : Sy.Idnt;
337 fTyp : Sy.Type;
338
339 BEGIN
340 (*
341 * Emit the copy procedure "__copy__()
342 *)
343 out := t.outF;
344 out.CopyProcHead(t.recT);
345 junk := out.newLocal(); (* create space for two locals *)
346 junk := out.newLocal();
347 (*
348 * Recurse to super class, if necessary.
349 *)
350 IF (t.recT.baseTp # NIL) &
351 (t.recT.baseTp IS Ty.Record) &
352 ~t.recT.baseTp.isNativeObj() THEN
353 out.Code(Jvm.opc_aload_0);
354 out.Code(Jvm.opc_aload_1);
355 out.ValRecCopy(t.recT.baseTp(Ty.Record));
356 END;
357 (*
358 * Emit field-by-field copy.
359 *)
360 FOR indx := 0 TO t.recT.fields.tide-1 DO
361 idnt := t.recT.fields.a[indx];
362 fTyp := idnt.type;
363 out.Code(Jvm.opc_aload_0);
364 IF (fTyp.kind = Ty.recTp) OR
365 (fTyp.kind = Ty.arrTp) THEN
366 out.PutGetF(Jvm.opc_getfield, t.recT, idnt(Id.FldId));
367 END;
368 out.Code(Jvm.opc_aload_1);
369 out.PutGetF(Jvm.opc_getfield, t.recT, idnt(Id.FldId));
370 WITH fTyp : Ty.Array DO
371 out.ValArrCopy(fTyp);
372 | fTyp : Ty.Record DO
373 out.ValRecCopy(fTyp);
374 ELSE
375 out.PutGetF(Jvm.opc_putfield, t.recT, idnt(Id.FldId));
376 END;
377 END;
378 out.VoidTail();
379 END CopyProc;
380
381 (* ============================================================ *)
382
383 PROCEDURE (this : JavaProcTypeEmitter)EmitBody(out : Ju.JavaFile);
384 (** Create the assembler for a class file for this proc-type wrapper. *)
385 VAR pType : Ty.Procedure; (* The procedure type that is being emitted *)
386 proxy : Ty.Record; (* The record that stands for the proc-type *)
387 invoke : Id.MthId; (* The abstract invoke method for this *)
388 BEGIN
389 pType := this.prcT;
390 proxy := pType.hostClass;
391 proxy.idnt := pType.idnt;
392 proxy.recAtt := Ty.isAbs;
393 out.StartRecClass(proxy);
394
395 (* Emit the no-arg constructor *)
396 out.RecMakeInit(proxy, NIL);
397 out.CallSuperCtor(proxy, NIL);
398 out.VoidTail();
399
400 (* Emit the abstract Invoke method *)
401 invoke := Ju.getProcVarInvoke(pType);
402 Ju.MkProcName(invoke);
403 Ju.RenumberLocals(invoke);
404 out.theP := invoke;
405 out.StartProc(invoke);
406 out.EndProc();
407 END EmitBody;
408
409 (* ============================================================ *)
410
411 PROCEDURE (this : JavaRecEmitter)EmitBody(out : Ju.JavaFile);
412 (** Create the assembler for a class file for this record. *)
413 VAR index : INTEGER;
414 parIx : INTEGER;
415 clsId : Sy.Idnt;
416 ident : Sy.Idnt;
417 ctorD : Id.PrcId;
418 sCtor : Id.PrcId;
419 sCtTy : Ty.Procedure;
420 baseT : Sy.Type;
421 field : Id.FldId;
422 method : Id.MthId;
423 record : Ty.Record;
424 impRec : Sy.Idnt;
425 attr : INTEGER;
426 form : Id.ParId;
427 expr : Sy.Expr;
428 live : BOOLEAN;
429 retn : Sy.Type;
430 BEGIN
431 record := this.recT;
432 out.StartRecClass(record);
433 (*
434 * Emit all the fields ...
435 *)
436 out.InitFields(record.fields.tide);
437 FOR index := 0 TO record.fields.tide-1 DO
438 out.EmitField(record.fields.a[index](Id.FldId));
439 END;
440 out.InitMethods(record.methods.tide+2);
441 (*
442 * Emit the no-arg constructor
443 *)
444 IF ~(Sy.noNew IN record.xAttr) &
445 ~(Sy.xCtor IN record.xAttr) THEN
446 out.RecMakeInit(record, NIL);
447 out.CallSuperCtor(record, NIL);
448 out.VoidTail();
449 END;
450 (*
451 * Emit constructors with args
452 *)
453 FOR index := 0 TO record.statics.tide-1 DO
454 sCtTy := NIL;
455 ctorD := record.statics.a[index](Id.PrcId);
456 out.RecMakeInit(record, ctorD);
457 (*
458 * Copy args for super constructors with args.
459 *)
460 IF ctorD # NIL THEN
461 sCtor := ctorD.basCll.sprCtor(Id.PrcId);
462 IF sCtor # NIL THEN
463 sCtTy := sCtor.type(Ty.Procedure);
464 IF sCtTy.xName = NIL THEN Ju.MkCallAttr(sCtor, sCtTy) END;
465 FOR parIx := 0 TO ctorD.basCll.actuals.tide-1 DO
466 form := sCtTy.formals.a[parIx];
467 expr := ctorD.basCll.actuals.a[parIx];
468 this.PushArg(expr, form, ctorD.basCll.actuals);
469 END;
470 END;
471 END;
472 (*
473 * Now call the super constructor
474 *)
475 out.CallSuperCtor(record, sCtTy);
476 IF (ctorD # NIL) & (ctorD.body # NIL) THEN
477 IF ctorD.rescue # NIL THEN out.Try END;
478 this.EmitStat(ctorD.body, live);
479 IF ctorD.rescue # NIL THEN
480 out.Catch(ctorD);
481 this.EmitStat(ctorD.rescue, live);
482 END;
483 END;
484 out.EndProc();
485 END;
486 IF ~(Sy.noCpy IN record.xAttr) THEN this.CopyProc() END;
487 (*
488 * Emit all the (non-forward) methods ...
489 *)
490 FOR index := 0 TO record.methods.tide-1 DO
491 ident := record.methods.a[index];
492 method := ident(Id.MthId);
493 IF method.kind = Id.conMth THEN
494 IF method.scopeNm = NIL THEN
495 Ju.MkProcName(method);
496 Ju.RenumberLocals(method);
497 END;
498 this.EmitProc(method)
499 END;
500 END;
501 END EmitBody;
502
503 (* ============================================================ *)
504
505 PROCEDURE (this : JavaModEmitter)EmitBody(out : Ju.JavaFile);
506 (** Create the assembler for a class file for this module. *)
507 VAR index : INTEGER;
508 objIx : INTEGER;
509 proc : Id.Procs;
510 type : Sy.Type;
511 varId : Id.VarId;
512 returned : BOOLEAN;
513 BEGIN
514 out.StartModClass(this.mod);
515 FOR index := 0 TO this.mod.procs.tide-1 DO
516 (*
517 * Create the mangled name for all non-forward procedures
518 *)
519 proc := this.mod.procs.a[index];
520 IF (proc.kind = Id.conPrc) OR
521 (proc.kind = Id.conMth) THEN
522 Ju.MkProcName(proc);
523 Ju.RenumberLocals(proc);
524 END;
525 END;
526 (*
527 * Do all the fields (ie. static vars)
528 *)
529 out.InitFields(this.mod.locals.tide);
530 FOR index := 0 TO this.mod.locals.tide-1 DO
531 varId := this.mod.locals.a[index](Id.VarId);
532 out.EmitField(varId);
533 END;
534 (*
535 FOR index := 0 TO this.mod.procs.tide-1 DO
536 (*
537 * Create the mangled name for all non-forward procedures
538 *)
539 proc := this.mod.procs.a[index];
540 IF (proc.kind = Id.conPrc) OR
541 (proc.kind = Id.conMth) THEN
542 Ju.MkProcName(proc);
543 Ju.RenumberLocals(proc);
544 END;
545 END;
546 *)
547 (*
548 * Do all the procs, including <init> and <clinit>
549 *)
550 out.InitMethods(this.mod.procs.tide+3);
551 out.ModNoArgInit();
552 out.ClinitHead();
553 out.InitVars(this.mod);
554 IF this.mod.main THEN
555 (*
556 * Emit <clinit>, and module body as main()
557 *)
558 out.VoidTail();
559 out.MainHead();
560 this.EmitStat(this.mod.modBody, returned);
561 IF returned THEN
562 this.EmitStat(this.mod.modClose, returned);
563 END;
564 out.VoidTail();
565 ELSE
566 (*
567 * Emit single <clinit> incorporating module body
568 *)
569 this.EmitStat(this.mod.modBody, returned);
570 out.VoidTail();
571 END;
572 (*
573 * Emit all of the static procedures
574 *)
575 FOR index := 0 TO this.mod.procs.tide-1 DO
576 proc := this.mod.procs.a[index];
577 IF (proc.kind = Id.conPrc) &
578 (proc.dfScp.kind = Id.modId) THEN this.EmitProc(proc) END;
579 END;
580 (*
581 * And now, just in case exported types have been missed ...
582 * For example, if they are unreferenced in this module.
583 *)
584 FOR index := 0 TO this.mod.expRecs.tide-1 DO
585 type := this.mod.expRecs.a[index];
586 IF type.xName = NIL THEN
587 WITH type : Ty.Record DO
588 Ju.MkRecName(type);
589 | type : Ty.Procedure DO
590 Ju.MkProcTypeName(type);
591 END;
592 END;
593 END;
594 END EmitBody;
595
596 (* ============================================================ *)
597
598 PROCEDURE (this : JavaEmitter)Emit*();
599 (** Create the assembler for a class file for this module. *)
600 VAR fileName : FileNames.NameString;
601 cf : ClassUtil.ClassFile;
602 jf : JsmnUtil.JsmnFile;
603 BEGIN
604 (*
605 * Create the classFile structure, and open the output file.
606 * The default for the JVM target is to write a class file
607 * directly. The -jasmin option writes a jasmin output file
608 * but does not call the (now unavailable) assembler.
609 *)
610 IF Cst.doCode & ~Cst.doJsmn THEN
611 WITH this : JavaModEmitter DO
612 L.ToStr(this.mod.xName, fileName);
613 | this : JavaRecEmitter DO
614 L.ToStr(this.recT.xName, fileName);
615 | this : JavaProcTypeEmitter DO
616 L.ToStr(this.prcT.xName, fileName);
617 END;
618 fileName := fileName + ".class";
619 cf := ClassUtil.newClassFile(fileName);
620 this.outF := cf;
621 ELSE
622 WITH this : JavaModEmitter DO
623 Sy.getName.Of(this.mod, fileName);
624 | this : JavaRecEmitter DO
625 FileNames.StripUpToLast("/", this.recT.xName, fileName);
626 | this : JavaProcTypeEmitter DO
627 FileNames.StripUpToLast("/", this.prcT.xName, fileName);
628 END;
629 fileName := fileName + ".j";
630 jf := JsmnUtil.newJsmnFile(fileName);
631 this.outF := jf;
632 (*
633 * Add this file to the list to assemble
634 *)
635 L.AppendCharOpen(asmList, L.strToCharOpen(fileName));
636 END;
637 IF this.outF = NIL THEN
638 CPascalS.SemError.Report(177, 0, 0);
639 Error.WriteString("Cannot create out-file <" + fileName + ">");
640 Error.WriteLn;
641 RETURN;
642 ELSE
643 IF Cst.verbose THEN Cst.Message("Created "+ fileName) END;
644 this.outF.Header(Cst.srcNam);
645 this.EmitBody(this.outF);
646 this.outF.Dump();
647 END;
648 END Emit;
649
650 (* ============================================================ *)
651 (* Shared code-emission methods *)
652 (* ============================================================ *)
653
654 PROCEDURE (e : JavaEmitter)EmitProc(proc : Id.Procs),NEW;
655 VAR out : Ju.JavaFile;
656 live : BOOLEAN;
657 retn : Sy.Type;
658 indx : INTEGER;
659 nest : Id.Procs;
660 procName : FileNames.NameString;
661 BEGIN
662 (*
663 * Recursively emit nested procedures first.
664 *)
665 FOR indx := 0 TO proc.nestPs.tide-1 DO
666 nest := proc.nestPs.a[indx];
667 IF nest.kind = Id.conPrc THEN e.EmitProc(nest) END;
668 END;
669 out := e.outF;
670 out.theP := proc;
671 out.StartProc(proc);
672 (*
673 * Output the body if not ABSTRACT
674 *)
675 IF ~out.isAbstract() THEN
676 (*
677 * Initialize any locals which need this.
678 *)
679 out.InitVars(proc);
680 IF proc.rescue # NIL THEN out.Try END;
681 (*
682 * Finally! Emit the method body.
683 *)
684 e.EmitStat(proc.body, live);
685 (*
686 * For proper procedure which reach the fall-
687 * through ending, copy OUT params and return.
688 *)
689 IF live & proc.type.isProperProcType() THEN
690 out.FixOutPars(proc, retn);
691 out.Return(retn);
692 END;
693 IF proc.rescue # NIL THEN
694 out.Catch(proc);
695 e.EmitStat(proc.rescue, live);
696 IF live & proc.type.isProperProcType() THEN
697 out.FixOutPars(proc, retn);
698 out.Return(retn);
699 END;
700 END;
701 END;
702 out.EndProc();
703 END EmitProc;
704
705 (* ============================================================ *)
706 (* Expression Handling Methods *)
707 (* ============================================================ *)
708
709 PROCEDURE longValue(lit : Sy.Expr) : LONGINT;
710 BEGIN
711 RETURN lit(Xp.LeafX).value.long();
712 END longValue;
713
714 PROCEDURE intValue(lit : Sy.Expr) : INTEGER;
715 BEGIN
716 RETURN lit(Xp.LeafX).value.int();
717 END intValue;
718
719 PROCEDURE isStrExp(exp : Sy.Expr) : BOOLEAN;
720 BEGIN
721 RETURN (exp.type = Bi.strTp) &
722 (exp.kind # Xp.mkStr) OR
723 exp.type.isNativeStr();
724 END isStrExp;
725
726 (* ============================================================ *)
727
728 PROCEDURE (e : JavaEmitter)UbyteClear(),NEW;
729 VAR out : Ju.JavaFile;
730 BEGIN
731 out := e.outF;
732 out.PushInt(255);
733 out.Code(Jvm.opc_iand);
734 END UbyteClear;
735
736 (* ============================================================ *)
737
738 PROCEDURE (e : JavaEmitter)newLeaf(rd : INTEGER; tp : Sy.Type) : Xp.IdLeaf,NEW;
739 VAR id : Id.LocId;
740 BEGIN
741 id := Id.newLocId();
742 id.varOrd := rd;
743 id.type := tp;
744 id.dfScp := e.outF.getScope();
745 RETURN Xp.mkIdLeaf(id);
746 END newLeaf;
747
748 (* ============================================================ *)
749
750 PROCEDURE RevTest(tst : INTEGER) : INTEGER;
751 BEGIN
752 CASE tst OF
753 | Xp.equal : RETURN Xp.notEq;
754 | Xp.notEq : RETURN Xp.equal;
755 | Xp.greT : RETURN Xp.lessEq;
756 | Xp.lessT : RETURN Xp.greEq;
757 | Xp.greEq : RETURN Xp.lessT;
758 | Xp.lessEq : RETURN Xp.greT;
759 END;
760 END RevTest;
761
762 (* ============================================================ *)
763
764 PROCEDURE (e : JavaEmitter)DoCmp(cmpE : INTEGER;
765 tLab : Ju.Label;
766 type : Sy.Type),NEW;
767 (** Compare two TOS elems and jump to tLab if true. *)
768 (* ------------------------------------------------- *)
769 VAR out : Ju.JavaFile;
770 code : INTEGER;
771 tNum : INTEGER;
772 (* ------------------------------------------------- *)
773 PROCEDURE test(t : INTEGER) : INTEGER;
774 BEGIN
775 CASE t OF
776 | Xp.greT : RETURN Jvm.opc_ifgt;
777 | Xp.greEq : RETURN Jvm.opc_ifge;
778 | Xp.notEq : RETURN Jvm.opc_ifne;
779 | Xp.lessEq : RETURN Jvm.opc_ifle;
780 | Xp.lessT : RETURN Jvm.opc_iflt;
781 | Xp.equal : RETURN Jvm.opc_ifeq;
782 END;
783 END test;
784 (* ------------------------------------------------- *)
785 BEGIN
786 out := e.outF;
787 code := test(cmpE); (* default code *)
788 WITH type : Ty.Base DO
789 tNum := type.tpOrd;
790 CASE tNum OF
791 | Ty.strN, Ty.sStrN : out.CallRTS(Ju.StrCmp,2,1);
792 | Ty.realN : out.Code(Jvm.opc_dcmpl);
793 | Ty.sReaN : out.Code(Jvm.opc_fcmpl);
794 | Ty.lIntN : out.Code(Jvm.opc_lcmp);
795 | Ty.anyRec, Ty.anyPtr :
796 CASE cmpE OF
797 | Xp.notEq : code := Jvm.opc_if_acmpne;
798 | Xp.equal : code := Jvm.opc_if_acmpeq;
799 END;
800 ELSE (* Ty.boolN,Ty.sChrN,Ty.charN,Ty.byteN,Ty.sIntN,Ty.intN,Ty.setN *)
801 CASE cmpE OF
802 | Xp.greT : code := Jvm.opc_if_icmpgt; (* override default code *)
803 | Xp.greEq : code := Jvm.opc_if_icmpge;
804 | Xp.notEq : code := Jvm.opc_if_icmpne;
805 | Xp.lessEq : code := Jvm.opc_if_icmple;
806 | Xp.lessT : code := Jvm.opc_if_icmplt;
807 | Xp.equal : code := Jvm.opc_if_icmpeq;
808 END;
809 END;
810 ELSE (* This must be a reference or string comparison *)
811 IF type.isCharArrayType() THEN out.CallRTS(Ju.StrCmp,2,1);
812 ELSIF cmpE = Xp.equal THEN code := Jvm.opc_if_acmpeq;
813 ELSIF cmpE = Xp.notEq THEN code := Jvm.opc_if_acmpne;
814 END;
815 END;
816 out.CodeLb(code, tLab);
817 END DoCmp;
818
819 (* ================= old code =========================== *
820 * IF type IS Ty.Base THEN
821 * tNum := type(Ty.Base).tpOrd;
822 * IF (tNum = Ty.strN) OR (tNum = Ty.sStrN) THEN
823 * out.CallRTS(Ju.StrCmp,2,1);
824 * ELSIF tNum = Ty.realN THEN
825 * out.Code(Jvm.opc_dcmpl);
826 * ELSIF tNum = Ty.sReaN THEN
827 * out.Code(Jvm.opc_fcmpl);
828 * ELSIF tNum = Ty.lIntN THEN
829 * out.Code(Jvm.opc_lcmp);
830 * ELSE (* Common, integer cases use separate instructions *)
831 * CASE cmpE OF
832 * | Xp.greT : code := Jvm.opc_if_icmpgt; (* override default *)
833 * | Xp.greEq : code := Jvm.opc_if_icmpge;
834 * | Xp.notEq : code := Jvm.opc_if_icmpne;
835 * | Xp.lessEq : code := Jvm.opc_if_icmple;
836 * | Xp.lessT : code := Jvm.opc_if_icmplt;
837 * | Xp.equal : code := Jvm.opc_if_icmpeq;
838 * END;
839 * END;
840 * ELSE (* This must be a reference or string comparison *)
841 * IF type.isCharArrayType() THEN
842 * out.CallRTS(Ju.StrCmp,2,1);
843 * ELSIF cmpE = Xp.equal THEN
844 * code := Jvm.opc_if_acmpeq;
845 * ELSIF cmpE = Xp.notEq THEN
846 * code := Jvm.opc_if_acmpne;
847 * END;
848 * END;
849 * out.CodeLb(code, tLab);
850 *END DoCmp;
851 * ================= old code =========================== *)
852
853 (* ---------------------------------------------------- *)
854
855 PROCEDURE (e : JavaEmitter)SetCmp(lOp,rOp : Sy.Expr;
856 theLabl : Ju.Label;
857 theTest : INTEGER),NEW;
858 VAR out : Ju.JavaFile;
859 l,r : INTEGER;
860 xit : Ju.Label;
861 BEGIN
862 out := e.outF;
863 e.PushValue(lOp, Bi.setTp);
864 CASE theTest OF
865 (* ---------------------------------- *)
866 | Xp.equal:
867 e.PushValue(rOp, Bi.setTp);
868 out.CodeLb(Jvm.opc_if_icmpeq, theLabl);
869 (* ---------------------------------- *)
870 | Xp.notEq :
871 e.PushValue(rOp, Bi.setTp);
872 out.CodeLb(Jvm.opc_if_icmpne, theLabl);
873 (* ---------------------------------- *)
874 | Xp.greEq, Xp.lessEq :
875 (*
876 * The semantics are implemented by the identities
877 *
878 * (L <= R) == (L AND R = L)
879 * (L >= R) == (L OR R = L)
880 *)
881 out.Code(Jvm.opc_dup);
882 e.PushValue(rOp, Bi.setTp);
883 IF theTest = Xp.greEq THEN
884 out.Code(Jvm.opc_ior);
885 ELSE
886 out.Code(Jvm.opc_iand);
887 END;
888 out.CodeLb(Jvm.opc_if_icmpeq, theLabl);
889 (* ---------------------------------- *)
890 | Xp.greT, Xp.lessT :
891 (*
892 * The semantics are implemented by the identities
893 *
894 * (L < R) == (L AND R = L) AND NOT (L = R)
895 * (L > R) == (L OR R = L) AND NOT (L = R)
896 *)
897 l := out.newLocal();
898 r := out.newLocal();
899 xit := out.newLabel();
900 out.Code(Jvm.opc_dup); (* ... L,L *)
901 out.Code(Jvm.opc_dup); (* ... L,L,L *)
902 out.StoreLocal(l, Bi.setTp); (* ... L,L, *)
903 e.PushValue(rOp, Bi.setTp); (* ... L,L,R *)
904 out.Code(Jvm.opc_dup); (* ... L,L,R,R *)
905 out.StoreLocal(r, Bi.setTp); (* ... L,L,R *)
906 IF theTest = Xp.greT THEN
907 out.Code(Jvm.opc_ior); (* ... L,LvR *)
908 ELSE
909 out.Code(Jvm.opc_iand); (* ... L,L^R *)
910 END;
911 out.CodeLb(Jvm.opc_if_icmpne, xit);
912 out.LoadLocal(l, Bi.setTp); (* ... L@R,l *)
913 out.LoadLocal(r, Bi.setTp); (* ... L@R,l,r *)
914 out.CodeLb(Jvm.opc_if_icmpne, theLabl);
915 out.ReleaseLocal(r);
916 out.ReleaseLocal(l);
917 out.DefLab(xit);
918 END;
919 END SetCmp;
920
921 (* ---------------------------------------------------- *)
922
923 PROCEDURE (e : JavaEmitter)BinCmp(exp : Sy.Expr;
924 tst : INTEGER;
925 rev : BOOLEAN; (* reverse sense *)
926 lab : Ju.Label),NEW;
927 VAR binOp : Xp.BinaryX;
928 lType : Sy.Type;
929 BEGIN
930 binOp := exp(Xp.BinaryX);
931 lType := binOp.lKid.type;
932 IF rev THEN tst := RevTest(tst) END;
933 IF lType = Bi.setTp THEN (* only partially ordered *)
934 e.SetCmp(binOp.lKid, binOp.rKid, lab, tst);
935 ELSE (* a totally ordered type *)
936 e.PushValue(binOp.lKid, lType);
937 IF isStrExp(binOp.lKid) THEN
938 e.outF.CallRTS(Ju.StrToChrOpen,1,1);
939 END;
940 e.PushValue(binOp.rKid, binOp.rKid.type);
941 IF isStrExp(binOp.rKid) THEN
942 e.outF.CallRTS(Ju.StrToChrOpen,1,1);
943 END;
944 e.DoCmp(tst, lab, lType);
945 END;
946 END BinCmp;
947
948 (* ---------------------------------------------------- *)
949
950 PROCEDURE (e : JavaEmitter)FallTrue(exp : Sy.Expr; fLb : Ju.Label),NEW;
951 (** Evaluate exp, fall through if true, jump to fLab otherwise *)
952 VAR binOp : Xp.BinaryX;
953 label : Ju.Label;
954 out : Ju.JavaFile;
955 BEGIN
956 out := e.outF;
957 CASE exp.kind OF
958 | Xp.tBool : (* just do nothing *)
959 | Xp.fBool :
960 out.CodeLb(Jvm.opc_goto, fLb);
961 | Xp.blNot :
962 e.FallFalse(exp(Xp.UnaryX).kid, fLb);
963 | Xp.greT, Xp.greEq, Xp.notEq, Xp.lessEq, Xp.lessT, Xp.equal :
964 e.BinCmp(exp, exp.kind, TRUE, fLb);
965 | Xp.blOr :
966 binOp := exp(Xp.BinaryX);
967 label := out.newLabel();
968 e.FallFalse(binOp.lKid, label);
969 e.FallTrue(binOp.rKid, fLb);
970 out.DefLab(label);
971 | Xp.blAnd :
972 binOp := exp(Xp.BinaryX);
973 e.FallTrue(binOp.lKid, fLb);
974 e.FallTrue(binOp.rKid, fLb);
975 | Xp.isOp :
976 binOp := exp(Xp.BinaryX);
977 e.PushValue(binOp.lKid, binOp.lKid.type);
978 out.CodeT(Jvm.opc_instanceof, binOp.rKid(Xp.IdLeaf).ident.type);
979 out.CodeLb(Jvm.opc_ifeq, fLb);
980 | Xp.inOp :
981 binOp := exp(Xp.BinaryX);
982 out.Code(Jvm.opc_iconst_1);
983 e.PushValue(binOp.lKid, binOp.lKid.type);
984 out.Code(Jvm.opc_ishl);
985 out.Code(Jvm.opc_dup);
986 e.PushValue(binOp.rKid, binOp.rKid.type);
987 out.Code(Jvm.opc_iand);
988 out.CodeLb(Jvm.opc_if_icmpne, fLb);
989 ELSE (* Xp.fnCll, Xp.qualId, Xp.index, Xp.selct *)
990 e.PushValue(exp, exp.type); (* boolean variable *)
991 out.CodeLb(Jvm.opc_ifeq, fLb);
992 END;
993 END FallTrue;
994
995 (* ---------------------------------------------------- *)
996
997 PROCEDURE (e : JavaEmitter)FallFalse(exp : Sy.Expr; tLb : Ju.Label),NEW;
998 (** Evaluate exp, fall through if false, jump to tLb otherwise *)
999 VAR binOp : Xp.BinaryX;
1000 label : Ju.Label;
1001 out : Ju.JavaFile;
1002 BEGIN
1003 out := e.outF;
1004 CASE exp.kind OF
1005 | Xp.fBool : (* just do nothing *)
1006 | Xp.tBool :
1007 out.CodeLb(Jvm.opc_goto, tLb);
1008 | Xp.blNot :
1009 e.FallTrue(exp(Xp.UnaryX).kid, tLb);
1010 | Xp.greT, Xp.greEq, Xp.notEq, Xp.lessEq, Xp.lessT, Xp.equal :
1011 e.BinCmp(exp, exp.kind, FALSE, tLb);
1012 | Xp.blOr :
1013 binOp := exp(Xp.BinaryX);
1014 e.FallFalse(binOp.lKid, tLb);
1015 e.FallFalse(binOp.rKid, tLb);
1016 | Xp.blAnd :
1017 label := out.newLabel();
1018 binOp := exp(Xp.BinaryX);
1019 e.FallTrue(binOp.lKid, label);
1020 e.FallFalse(binOp.rKid, tLb);
1021 out.DefLab(label);
1022 | Xp.isOp :
1023 binOp := exp(Xp.BinaryX);
1024 e.PushValue(binOp.lKid, binOp.lKid.type);
1025 out.CodeT(Jvm.opc_instanceof, binOp.rKid(Xp.IdLeaf).ident.type);
1026 out.CodeLb(Jvm.opc_ifne, tLb);
1027 | Xp.inOp :
1028 binOp := exp(Xp.BinaryX);
1029 out.Code(Jvm.opc_iconst_1);
1030 e.PushValue(binOp.lKid, binOp.lKid.type);
1031 out.Code(Jvm.opc_ishl);
1032 out.Code(Jvm.opc_dup);
1033 e.PushValue(binOp.rKid, binOp.rKid.type);
1034 out.Code(Jvm.opc_iand);
1035 out.CodeLb(Jvm.opc_if_icmpeq, tLb);
1036 ELSE (* Xp.fnCll, Xp.qualId, Xp.index, Xp.selct *)
1037 e.PushValue(exp, exp.type); (* boolean variable *)
1038 out.CodeLb(Jvm.opc_ifne, tLb);
1039 END;
1040 END FallFalse;
1041
1042 (* ============================================================ *)
1043
1044 PROCEDURE (e : JavaEmitter)PushUnary(exp : Xp.UnaryX; dst : Sy.Type),NEW;
1045 VAR dNum : INTEGER;
1046 code : INTEGER;
1047 labl : Ju.Label;
1048 out : Ju.JavaFile;
1049 (* ------------------------------------- *)
1050 PROCEDURE MkBox(emt : JavaEmitter; exp : Xp.UnaryX);
1051 VAR dst : Sy.Type;
1052 src : Sy.Type;
1053 out : Ju.JavaFile;
1054 BEGIN
1055 out := emt.outF;
1056 src := exp.kid.type;
1057 dst := exp.type(Ty.Pointer).boundTp;
1058 IF isStrExp(exp.kid) THEN
1059 emt.PushValue(exp.kid, src);
1060 out.CallRTS(Ju.StrToChrOpen,1,1);
1061 ELSE
1062 emt.ValueCopy(exp.kid, dst);
1063 END;
1064 END MkBox;
1065 (* ------------------------------------- *)
1066 BEGIN
1067 IF exp.kind = Xp.mkBox THEN MkBox(e,exp); RETURN END; (* PRE-EMPTIVE RET *)
1068 e.PushValue(exp.kid, exp.kid.type);
1069 out := e.outF;
1070 CASE exp.kind OF
1071 | Xp.mkStr, Xp.deref : (* skip *)
1072 | Xp.tCheck :
1073 out.CodeT(Jvm.opc_checkcast, exp.type.boundRecTp()(Ty.Record));
1074 | Xp.mkNStr :
1075 IF ~isStrExp(exp.kid) THEN
1076 out.CallRTS(Ju.ChrsToStr,1,1);
1077 END;
1078 | Xp.strChk : (* Some range checks required *)
1079 out.Code(Jvm.opc_dup);
1080 out.CallRTS(Ju.StrCheck,1,0);
1081 | Xp.compl :
1082 out.Code(Jvm.opc_iconst_m1);
1083 out.Code(Jvm.opc_ixor);
1084 | Xp.neg :
1085 dNum := dst(Ty.Base).tpOrd;
1086 IF dNum = Ty.realN THEN
1087 code := Jvm.opc_dneg;
1088 ELSIF dNum = Ty.sReaN THEN
1089 code := Jvm.opc_fneg;
1090 ELSIF dNum = Ty.lIntN THEN
1091 code := Jvm.opc_lneg;
1092 ELSE (* all INTEGER cases *)
1093 code := Jvm.opc_ineg;
1094 END;
1095 out.Code(code);
1096 | Xp.absVl :
1097 dNum := dst(Ty.Base).tpOrd;
1098 IF dNum = Ty.realN THEN
1099 out.Code(Jvm.opc_dup2);
1100 out.Code(Jvm.opc_dconst_0);
1101 out.Code(Jvm.opc_dcmpg);
1102 code := Jvm.opc_dneg;
1103 ELSIF dNum = Ty.sReaN THEN
1104 out.Code(Jvm.opc_dup);
1105 out.Code(Jvm.opc_fconst_0);
1106 out.Code(Jvm.opc_fcmpg);
1107 code := Jvm.opc_fneg;
1108 ELSIF dNum = Ty.lIntN THEN
1109 out.Code(Jvm.opc_dup2);
1110 out.Code(Jvm.opc_lconst_0);
1111 out.Code(Jvm.opc_lcmp);
1112 code := Jvm.opc_lneg;
1113 ELSE (* all INTEGER cases *)
1114 out.Code(Jvm.opc_dup);
1115 code := Jvm.opc_ineg;
1116 END;
1117 labl := out.newLabel();
1118 out.CodeLb(Jvm.opc_ifge, labl); (* NOT ifle, Aug2001 *)
1119 out.Code(code);
1120 out.DefLab(labl);
1121 | Xp.entVl :
1122 dNum := dst(Ty.Base).tpOrd;
1123 IF dNum = Ty.sReaN THEN out.Code(Jvm.opc_f2d) END;
1124 (*
1125 // We _could_ check if the value is >= 0.0, and
1126 // skip the call in that case, falling through
1127 // into the round-to-zero mode opc_d2l.
1128 *)
1129 out.CallRTS(Ju.DFloor,1,1);
1130 out.Code(Jvm.opc_d2l);
1131 | Xp.capCh :
1132 out.CallRTS(Ju.ToUpper,1,1);
1133 | Xp.blNot :
1134 out.Code(Jvm.opc_iconst_1);
1135 out.Code(Jvm.opc_ixor);
1136 | Xp.strLen :
1137 out.CallRTS(Ju.StrLen,1,1);
1138 | Xp.oddTst :
1139 IF exp.kid.type.isLongType() THEN out.Code(Jvm.opc_l2i) END;
1140 out.Code(Jvm.opc_iconst_1);
1141 out.Code(Jvm.opc_iand);
1142 | Xp.getTp :
1143 out.CallGetClass();
1144 END;
1145 END PushUnary;
1146
1147 (* ============================================================ *)
1148
1149 PROCEDURE (e : JavaEmitter)PushVecElemHandle(lOp,rOp : Sy.Expr),NEW;
1150 VAR vTp : Ty.Vector;
1151 eTp : Sy.Type;
1152 tde : INTEGER;
1153 out : Ju.JavaFile;
1154 xLb : Ju.Label;
1155 BEGIN
1156 out := e.outF;
1157 vTp := lOp.type(Ty.Vector);
1158 eTp := vTp.elemTp;
1159 tde := out.newLocal();
1160 xLb := out.newLabel();
1161
1162 e.PushValue(lOp, eTp); (* vRef ... *)
1163 out.Code(Jvm.opc_dup); (* vRef, vRef ... *)
1164 out.GetVecLen(); (* tide, vRef ... *)
1165 out.StoreLocal(tde, Bi.intTp); (* vRef ... *)
1166
1167 e.outF.GetVecArr(eTp); (* arr ... *)
1168 e.PushValue(rOp, Bi.intTp); (* idx, arr ... *)
1169 out.Code(Jvm.opc_dup); (* idx, idx, arr ... *)
1170 out.LoadLocal(tde, Bi.intTp); (* tide, idx, idx, arr ... *)
1171
1172 out.CodeLb(Jvm.opc_if_icmplt, xLb);
1173 out.Trap("Vector index out of bounds");
1174
1175 out.DefLab(xLb); (* idx, arr ... *)
1176 out.ReleaseLocal(tde);
1177 END PushVecElemHandle;
1178
1179 (* ============================================================ *)
1180
1181 (* Assert: lOp is already pushed. *)
1182 PROCEDURE ShiftInt(kind : INTEGER; e : JavaEmitter; lOp : Sy.Expr; rOp : Sy.Expr);
1183 VAR indx : INTEGER;
1184 out : Ju.JavaFile;
1185 shrLab, fixLab, s31Lab, exitLb : Ju.Label;
1186 BEGIN
1187 out := e.outF;
1188 IF rOp.kind = Xp.numLt THEN
1189 indx := intValue(rOp);
1190 IF indx = 0 THEN (* skip *)
1191 ELSIF indx < -31 THEN (* right shift out *)
1192 IF kind = Xp.ashInt THEN
1193 out.PushInt(31);
1194 out.Code(Jvm.opc_ishr);
1195 ELSE
1196 out.Code(Jvm.opc_pop);
1197 out.PushInt(0);
1198 END;
1199 ELSIF indx < 0 THEN (* right shift *)
1200 out.PushInt(-indx);
1201 IF kind = Xp.ashInt THEN (* arith shift *)
1202 out.Code(Jvm.opc_ishr);
1203 ELSE (* logical shift *)
1204 out.Code(Jvm.opc_iushr);
1205 END;
1206 ELSIF indx > 31 THEN (* result is zero *)
1207 out.Code(Jvm.opc_pop);
1208 out.PushInt(0);
1209 ELSE (* a left shift *)
1210 out.PushInt(indx);
1211 out.Code(Jvm.opc_ishl);
1212 END;
1213 ELSE (* variable sized shift *)
1214 shrLab := out.newLabel();
1215 fixLab := out.newLabel();
1216 s31Lab := out.newLabel();
1217 exitLb := out.newLabel();
1218 (*
1219 * This is a variable shift. Do it the hard way.
1220 * First, check the sign of the right hand op.
1221 *)
1222 e.PushValue(rOp, Bi.intTp); (* TOS: rOp, lOp, ... *)
1223 out.Code(Jvm.opc_dup); (* TOS: rOp, rOp, lOp, ... *)
1224 out.CodeLb(Jvm.opc_iflt, shrLab); (* TOS: rOp, lOp, ... *)
1225 (*
1226 * Positive selector ==> shift left;
1227 * But first: a range check ...
1228 *)
1229 out.Code(Jvm.opc_dup); (* TOS: rOp, rOp, lOp, ... *)
1230 out.PushInt(31); (* TOS: 31, rOp, rOp, lOp, ... *)
1231 out.CodeLb(Jvm.opc_if_icmpgt, fixLab); (* TOS: rOp, lOp, ... *)
1232 out.Code(Jvm.opc_ishl); (* TOS: rslt, ... *)
1233 out.CodeLb(Jvm.opc_goto, exitLb);
1234 (*
1235 * Out of range shift, set result to zero.
1236 *)
1237 out.DefLab(fixLab); (* TOS: rOp, lOp, ... *)
1238 out.Code(Jvm.opc_pop2); (* TOS: ... *)
1239 out.PushInt(0); (* TOS: 0, ... *)
1240 out.CodeLb(Jvm.opc_goto, exitLb);
1241 (*
1242 * Out of range, rslt = rOp >> 31.
1243 *)
1244 out.DefLab(s31Lab); (* TOS: rOp, lOp, ... *)
1245 out.Code(Jvm.opc_pop); (* TOS: lOp, ... *)
1246 out.PushInt(31); (* TOS: 31, lOp, ... *)
1247 out.Code(Jvm.opc_ishr);
1248 out.CodeLb(Jvm.opc_goto, exitLb);
1249 (*
1250 * Negative selector ==> shift right;
1251 *)
1252 out.DefLab(shrLab); (* TOS: rOp, lOp, ... *)
1253 out.Code(Jvm.opc_ineg); (* TOS: -rOp, lOp, ... *)
1254 out.Code(Jvm.opc_dup); (* TOS: -rOp, -rOp, lOp, ... *)
1255 out.PushInt(31); (* TOS: 31, -rOp, -rOp, lOp, ...*)
1256 IF kind = Xp.lshInt THEN (* LSH *)
1257 out.CodeLb(Jvm.opc_if_icmpgt, fixLab); (* TOS: -rOp, lOp, ... *)
1258 out.Code(Jvm.opc_iushr); (* TOS: rslt, ... *)
1259 ELSE (* ASH *) (* TOS: 31, rOp, rOp, lOp, ... *)
1260 out.CodeLb(Jvm.opc_if_icmpgt, s31Lab); (* TOS: rOp, lOp, ... *)
1261 out.Code(Jvm.opc_ishr); (* TOS: rslt, ... *)
1262 END;
1263 out.DefLab(exitLb);
1264 END;
1265 END ShiftInt;
1266
1267 (* ============================================================ *)
1268
1269 (* Assert: lOp is already pushed. *)
1270 PROCEDURE ShiftLong(kind : INTEGER; e : JavaEmitter; lOp : Sy.Expr; rOp : Sy.Expr);
1271 VAR indx : INTEGER;
1272 out : Ju.JavaFile;
1273 shrLab, fixLab, s63Lab, exitLb : Ju.Label;
1274 BEGIN
1275 out := e.outF;
1276 IF rOp.kind = Xp.numLt THEN
1277 indx := intValue(rOp);
1278 IF indx = 0 THEN (* skip *)
1279 ELSIF indx < -63 THEN (* right shift out *)
1280 IF kind = Xp.ashInt THEN
1281 out.PushInt(63);
1282 out.Code(Jvm.opc_lshr);
1283 ELSE
1284 out.Code(Jvm.opc_pop2);
1285 out.PushLong(0);
1286 END;
1287 ELSIF indx < 0 THEN (* right shift *)
1288 out.PushInt(-indx);
1289 IF kind = Xp.ashInt THEN (* arith shift *)
1290 out.Code(Jvm.opc_lshr);
1291 ELSE (* logical shift *)
1292 out.Code(Jvm.opc_lushr);
1293 END;
1294 ELSIF indx > 63 THEN (* result is zero *)
1295 out.Code(Jvm.opc_pop2);
1296 out.PushLong(0);
1297 ELSE (* a left shift *)
1298 out.PushInt(indx);
1299 out.Code(Jvm.opc_lshl);
1300 END;
1301 ELSE (* variable sized shift *)
1302 shrLab := out.newLabel();
1303 fixLab := out.newLabel();
1304 s63Lab := out.newLabel();
1305 exitLb := out.newLabel();
1306 (*
1307 * This is a variable shift. Do it the hard way.
1308 * First, check the sign of the right hand op.
1309 *)
1310 e.PushValue(rOp, Bi.intTp); (* TOS: rOp, lOp, ... *)
1311 out.Code(Jvm.opc_dup); (* TOS: rOp, rOp, lOp, ... *)
1312 out.CodeLb(Jvm.opc_iflt, shrLab); (* TOS: rOp, lOp, ... *)
1313 (*
1314 * Positive selector ==> shift left;
1315 * But first: a range check ...
1316 *)
1317 out.Code(Jvm.opc_dup); (* TOS: rOp, rOp, lOp, ... *)
1318 out.PushInt(63); (* TOS: 63, rOp, rOp, lOp, ... *)
1319 out.CodeLb(Jvm.opc_if_icmpgt, fixLab); (* TOS: rOp, lOp, ... *)
1320 out.Code(Jvm.opc_lshl); (* TOS: rslt, ... *)
1321 out.CodeLb(Jvm.opc_goto, exitLb);
1322 (*
1323 * Out of range shift, set result to zero.
1324 *)
1325 out.DefLab(fixLab); (* TOS: rOp, lOp, ... *)
1326 out.Code(Jvm.opc_pop); (* TOS: lOp, ... *)
1327 out.Code(Jvm.opc_pop2); (* TOS: ... *)
1328 out.PushLong(0); (* TOS: 0, ... *)
1329 out.CodeLb(Jvm.opc_goto, exitLb);
1330 (*
1331 * Out of range, rslt = rOp >> 63.
1332 *)
1333 out.DefLab(s63Lab); (* TOS: rOp, lOp, ... *)
1334 out.Code(Jvm.opc_pop); (* TOS: lOp, ... *)
1335 out.PushInt(63); (* TOS: 63, lOp, ... *)
1336 out.Code(Jvm.opc_lshr);
1337 out.CodeLb(Jvm.opc_goto, exitLb);
1338 (*
1339 * Negative selector ==> shift right;
1340 *)
1341 out.DefLab(shrLab); (* TOS: rOp, lOp, ... *)
1342 out.Code(Jvm.opc_ineg); (* TOS: -rOp, lOp, ... *)
1343 out.Code(Jvm.opc_dup); (* TOS: -rOp, -rOp, lOp, ... *)
1344 out.PushInt(63); (* TOS: 63, -rOp, -rOp, lOp, ...*)
1345 IF kind = Xp.lshInt THEN (* LSH *)
1346 out.CodeLb(Jvm.opc_if_icmpgt, fixLab); (* TOS: -rOp, lOp, ... *)
1347 out.Code(Jvm.opc_lushr); (* TOS: rslt, ... *)
1348 ELSE (* ASH *) (* TOS: 31, rOp, rOp, lOp, ... *)
1349 out.CodeLb(Jvm.opc_if_icmpgt, s63Lab); (* TOS: rOp, lOp, ... *)
1350 out.Code(Jvm.opc_lshr); (* TOS: rslt, ... *)
1351 END;
1352 out.DefLab(exitLb);
1353 END;
1354 END ShiftLong;
1355
1356 (* ============================================================ *)
1357 (* Assert: lOp is already pushed. *)
1358 PROCEDURE RotateInt(e : JavaEmitter; lOp : Sy.Expr; rOp : Sy.Expr);
1359 VAR
1360 temp, ixSv : INTEGER; (* local vars *)
1361 indx : INTEGER; (* literal index *)
1362 rtSz : INTEGER;
1363 out : Ju.JavaFile;
1364 BEGIN
1365 out := e.outF;
1366 IF lOp.type = Bi.sIntTp THEN
1367 rtSz := 16;
1368 out.ConvertDn(Bi.intTp, Bi.charTp);
1369 ELSIF (lOp.type = Bi.byteTp) OR (lOp.type = Bi.uBytTp) THEN
1370 rtSz := 8;
1371 out.ConvertDn(Bi.intTp, Bi.uBytTp);
1372 ELSE
1373 rtSz := 32;
1374 END;
1375 temp := out.newLocal();
1376 IF rOp.kind = Xp.numLt THEN
1377 indx := intValue(rOp) MOD rtSz;
1378 IF indx = 0 THEN (* skip *)
1379 ELSE (*
1380 * Rotation is achieved by means of the identity
1381 * Forall 0 <= n < rtSz:
1382 * ROT(a, n) = LSH(a,n) bitwiseOR LSH(a,n-rtSz);
1383 *)
1384 out.Code(Jvm.opc_dup);
1385 out.StoreLocal(temp, Bi.intTp);
1386 out.PushInt(indx);
1387 out.Code(Jvm.opc_ishl);
1388 out.LoadLocal(temp, Bi.intTp);
1389 out.PushInt(rtSz - indx);
1390 out.Code(Jvm.opc_iushr);
1391 out.Code(Jvm.opc_ior);
1392 out.ConvertDn(Bi.intTp, lOp.type);
1393 END;
1394 ELSE
1395 ixSv := out.newLocal();
1396 out.Code(Jvm.opc_dup); (* TOS: lOp, lOp, ... *)
1397 out.StoreLocal(temp, Bi.intTp); (* TOS: lOp, ... *)
1398 e.PushValue(rOp, rOp.type); (* TOS: rOp, lOp, ... *)
1399 out.PushInt(rtSz-1); (* TOS: 31, rOp, lOp, ... *)
1400 out.Code(Jvm.opc_iand); (* TOS: rOp', lOp, ... *)
1401 out.Code(Jvm.opc_dup); (* TOS: rOp', rOp', lOp, ... *)
1402 out.StoreLocal(ixSv, Bi.intTp); (* TOS: rOp', lOp, ... *)
1403 out.Code(Jvm.opc_ishl); (* TOS: lRz, ... *)
1404 out.LoadLocal(temp, Bi.intTp); (* TOS: lOp, lRz, ... *)
1405 out.PushInt(rtSz); (* TOS: 32, lOp, lRz, ... *)
1406 out.LoadLocal(ixSv, Bi.intTp); (* TOS: rOp',32, lOp, lRz, ... *)
1407 out.Code(Jvm.opc_isub); (* TOS: rOp'', lOp, lRz, ... *)
1408 out.Code(Jvm.opc_iushr); (* TOS: rRz, lRz, ... *)
1409 out.Code(Jvm.opc_ior); (* TOS: ROT(lOp, rOp), ... *)
1410 out.ReleaseLocal(ixSv);
1411 out.ConvertDn(Bi.intTp, lOp.type);
1412 END;
1413 out.ReleaseLocal(temp);
1414 END RotateInt;
1415
1416 (* ============================================================ *)
1417
1418 (* Assert: lOp is already pushed. *)
1419 PROCEDURE RotateLong(e : JavaEmitter; lOp : Sy.Expr; rOp : Sy.Expr);
1420 VAR
1421 tmp1,tmp2, ixSv : INTEGER; (* local vars *)
1422 indx : INTEGER; (* literal index *)
1423 out : Ju.JavaFile;
1424 BEGIN
1425 out := e.outF;
1426 tmp1 := out.newLocal(); (* Pair of locals *)
1427 tmp2 := out.newLocal();
1428 IF rOp.kind = Xp.numLt THEN
1429 indx := intValue(rOp) MOD 64;
1430 IF indx = 0 THEN (* skip *)
1431 ELSE (*
1432 * Rotation is achieved by means of the identity
1433 * Forall 0 <= n < rtSz:
1434 * ROT(a, n) = LSH(a,n) bitwiseOR LSH(a,n-rtSz);
1435 *)
1436 out.Code(Jvm.opc_dup2);
1437 out.StoreLocal(tmp1, Bi.lIntTp);
1438 out.PushInt(indx);
1439 out.Code(Jvm.opc_lshl);
1440 out.LoadLocal(tmp1, Bi.lIntTp);
1441 out.PushInt(64 - indx);
1442 out.Code(Jvm.opc_lushr);
1443 out.Code(Jvm.opc_lor);
1444 END;
1445 ELSE
1446 ixSv := out.newLocal();
1447 out.Code(Jvm.opc_dup2); (* TOS: lOp, lOp, ... *)
1448 out.StoreLocal(tmp1, Bi.lIntTp); (* TOS: lOp, ... *)
1449 e.PushValue(rOp, rOp.type); (* TOS: rOp, lOp, ... *)
1450 out.PushInt(63); (* TOS: 31, rOp, lOp, ... *)
1451 out.Code(Jvm.opc_iand); (* TOS: rOp', lOp, ... *)
1452 out.Code(Jvm.opc_dup); (* TOS: rOp', rOp', lOp, ... *)
1453 out.StoreLocal(ixSv, Bi.intTp); (* TOS: rOp', lOp, ... *)
1454 out.Code(Jvm.opc_lshl); (* TOS: lRz, ... *)
1455 out.LoadLocal(tmp1, Bi.lIntTp); (* TOS: lOp, lRz, ... *)
1456 out.PushInt(64); (* TOS: 32, lOp, lRz, ... *)
1457 out.LoadLocal(ixSv, Bi.intTp); (* TOS: rOp',32, lOp, lRz, ... *)
1458 out.Code(Jvm.opc_isub); (* TOS: rOp'', lOp, lRz, ... *)
1459 out.Code(Jvm.opc_lushr); (* TOS: rRz, lRz, ... *)
1460 out.Code(Jvm.opc_lor); (* TOS: ROT(lOp, rOp), ... *)
1461 out.ReleaseLocal(ixSv);
1462 END;
1463 out.ReleaseLocal(tmp2);
1464 out.ReleaseLocal(tmp1);
1465 END RotateLong;
1466
1467 (* ============================================================ *)
1468
1469 PROCEDURE (e : JavaEmitter)PushBinary(exp : Xp.BinaryX; dst : Sy.Type),NEW;
1470 VAR out : Ju.JavaFile;
1471 lOp : Sy.Expr;
1472 rOp : Sy.Expr;
1473
1474 dNum : INTEGER;
1475 sNum : INTEGER;
1476 code : INTEGER;
1477 indx : INTEGER;
1478 rLit : LONGINT;
1479 exLb : Ju.Label;
1480 tpLb : Ju.Label;
1481 long : BOOLEAN;
1482 (* -------------------------------- *)
1483 PROCEDURE plusCode(tNnm : INTEGER) : INTEGER;
1484 BEGIN
1485 CASE tNnm OF
1486 | Ty.realN : RETURN Jvm.opc_dadd;
1487 | Ty.sReaN : RETURN Jvm.opc_fadd;
1488 | Ty.lIntN : RETURN Jvm.opc_ladd;
1489 ELSE RETURN Jvm.opc_iadd;
1490 END;
1491 END plusCode;
1492 (* -------------------------------- *)
1493 PROCEDURE minusCode(tNnm : INTEGER) : INTEGER;
1494 BEGIN
1495 CASE tNnm OF
1496 | Ty.realN : RETURN Jvm.opc_dsub;
1497 | Ty.sReaN : RETURN Jvm.opc_fsub;
1498 | Ty.lIntN : RETURN Jvm.opc_lsub;
1499 ELSE RETURN Jvm.opc_isub;
1500 END;
1501 END minusCode;
1502 (* -------------------------------- *)
1503 PROCEDURE multCode(tNnm : INTEGER) : INTEGER;
1504 BEGIN
1505 CASE tNnm OF
1506 | Ty.realN : RETURN Jvm.opc_dmul;
1507 | Ty.sReaN : RETURN Jvm.opc_fmul;
1508 | Ty.lIntN : RETURN Jvm.opc_lmul;
1509 ELSE RETURN Jvm.opc_imul;
1510 END;
1511 END multCode;
1512 (* -------------------------------- *)
1513 BEGIN (* PushBinary *)
1514 out := e.outF;
1515 lOp := exp.lKid;
1516 rOp := exp.rKid;
1517 CASE exp.kind OF
1518 (* -------------------------------- *)
1519 | Xp.index :
1520 IF exp.lKid.type IS Ty.Vector THEN
1521 e.PushVecElemHandle(lOp, rOp);
1522 out.GetVecElement(dst); (* load the element *)
1523 ELSE
1524 IF rOp.type = NIL THEN rOp.type := Bi.intTp END;
1525 e.PushValue(lOp, lOp.type); (* push arr. desig. *)
1526 e.PushValue(rOp, rOp.type); (* push index value *)
1527 out.GetElement(lOp.type(Ty.Array).elemTp); (* load the element *)
1528 IF dst = Bi.uBytTp THEN e.UbyteClear() END;
1529 END;
1530 (* -------------------------------- *)
1531 | Xp.range : (* set i..j range ... *)
1532 (* We want to create an integer with bits-- *)
1533 (* [0...01...10...0] *)
1534 (* MSB==31 j i 0==LSB *)
1535 (* One method is A *)
1536 (* 1) [0..010........0] 1 << (j+1) *)
1537 (* 2) [1..110........0] negate(1) *)
1538 (* 3) [0.......010...0] 1 << i *)
1539 (* 4) [1.......110...0] negate(3) *)
1540 (* 5) [0...01...10...0] (2)xor(4) *)
1541 (* Another method is B *)
1542 (* 1) [1.............1] -1 *)
1543 (* 2) [0...01........1] (1) >>> (31-j) *)
1544 (* 3) [0........01...1] (2) >> i *)
1545 (* 4) [0...01...10...0] (3) << i *)
1546 (* --------------------------------------------- *
1547 * (* *
1548 * * Method A *
1549 * *) *
1550 * out.Code(Jvm.opc_iconst_1); *
1551 * out.Code(Jvm.opc_iconst_1); *
1552 * e.PushValue(rOp, Bi.intTp); *
1553 * (* Do unsigned less than 32 test here *) *
1554 * out.Code(Jvm.opc_iadd); *
1555 * out.Code(Jvm.opc_ishl); *
1556 * out.Code(Jvm.opc_ineg); *
1557 * out.Code(Jvm.opc_iconst_1); *
1558 * e.PushValue(lOp, Bi.intTp); *
1559 * (* Do unsigned less than 32 test here *) *
1560 * out.Code(Jvm.opc_ishl); *
1561 * out.Code(Jvm.opc_ineg); *
1562 * out.Code(Jvm.opc_ixor); *
1563 * -------------------------------------------- *)
1564 (*
1565 * Method B
1566 *)
1567 IF rOp.kind = Xp.numLt THEN
1568 (* out.PushInt(-1 >>> (31 - intValue(rOp))); *)
1569 out.PushInt(ORD({0 .. intValue(rOp)}));
1570 ELSE
1571 out.Code(Jvm.opc_iconst_m1);
1572 out.PushInt(31);
1573 e.PushValue(rOp, Bi.intTp);
1574 (* Do unsigned less than 32 test here ...*)
1575 out.Code(Jvm.opc_isub);
1576 out.Code(Jvm.opc_iushr);
1577 END;
1578 IF lOp.kind = Xp.numLt THEN
1579 (* out.PushInt(-1 << intValue(lOp)); *)
1580 out.PushInt(ORD({intValue(lOp) .. 31}));
1581 out.Code(Jvm.opc_iand);
1582 ELSE
1583 e.PushValue(lOp, Bi.intTp);
1584 (* Do unsigned less than 32 test here ...*)
1585 out.Code(Jvm.opc_dup_x1);
1586 out.Code(Jvm.opc_ishr);
1587 out.Code(Jvm.opc_swap);
1588 out.Code(Jvm.opc_ishl);
1589 END;
1590 (* -------------------------------- *)
1591 | Xp.lenOf :
1592 e.PushValue(lOp, lOp.type);
1593 IF lOp.type IS Ty.Vector THEN
1594 out.GetVecLen();
1595 ELSE
1596 FOR indx := 0 TO intValue(rOp) - 1 DO
1597 out.Code(Jvm.opc_iconst_0);
1598 out.Code(Jvm.opc_aaload);
1599 END;
1600 out.Code(Jvm.opc_arraylength);
1601 END;
1602 (* -------------------------------- *)
1603 | Xp.maxOf, Xp.minOf :
1604 long := dst.isLongType();
1605 tpLb := out.newLabel();
1606 exLb := out.newLabel();
1607 (*
1608 * Push left operand, duplicate
1609 * stack is (top) lOp lOp ...
1610 *)
1611 e.PushValue(lOp, dst);
1612 IF long THEN
1613 out.Code(Jvm.opc_dup2);
1614 ELSE
1615 out.Code(Jvm.opc_dup);
1616 END;
1617 (*
1618 * Push right operand
1619 * stack is (top) rOp lOp lOp ...
1620 *)
1621 e.PushValue(rOp, dst);
1622 (*
1623 * Duplicate and stow
1624 * stack is (top) rOp lOp rOp lOp ...
1625 *)
1626 IF long THEN
1627 out.Code(Jvm.opc_dup2_x2);
1628 ELSE
1629 out.Code(Jvm.opc_dup_x1);
1630 END;
1631 (*
1632 * Compare two top items and jump
1633 * stack is (top) rOp lOp ...
1634 *)
1635 IF exp.kind = Xp.maxOf THEN
1636 e.DoCmp(Xp.lessT, tpLb, dst);
1637 ELSE
1638 e.DoCmp(Xp.greT, tpLb, dst);
1639 END;
1640 indx := out.getDepth();
1641 (*
1642 * Discard top item
1643 * stack is (top) lOp ...
1644 *)
1645 IF long THEN
1646 out.Code(Jvm.opc_pop2);
1647 ELSE
1648 out.Code(Jvm.opc_pop);
1649 END;
1650 out.CodeLb(Jvm.opc_goto, exLb);
1651 out.DefLab(tpLb);
1652 out.setDepth(indx);
1653 (*
1654 * Swap top two items and discard top
1655 * stack is (top) rOp ...
1656 *)
1657 IF long THEN
1658 out.Code(Jvm.opc_dup2_x2);
1659 out.Code(Jvm.opc_pop2);
1660 out.Code(Jvm.opc_pop2);
1661 ELSE
1662 out.Code(Jvm.opc_swap);
1663 out.Code(Jvm.opc_pop);
1664 END;
1665 out.DefLab(exLb);
1666 (* -------------------------------- *)
1667 | Xp.bitAnd :
1668 e.PushValue(lOp, dst);
1669 e.PushValue(rOp, dst);
1670 (*
1671 * A literal bitAnd might be a long
1672 * operation, from a folded MOD.
1673 *)
1674 IF dst.isLongType() THEN
1675 out.Code(Jvm.opc_land);
1676 ELSE
1677 out.Code(Jvm.opc_iand);
1678 END;
1679 (* -------------------------------- *)
1680 | Xp.bitOr :
1681 e.PushValue(lOp, dst);
1682 e.PushValue(rOp, dst);
1683 out.Code(Jvm.opc_ior);
1684 (* -------------------------------- *)
1685 | Xp.bitXor :
1686 e.PushValue(lOp, dst);
1687 e.PushValue(rOp, dst);
1688 out.Code(Jvm.opc_ixor);
1689 (* -------------------------------- *)
1690 | Xp.plus :
1691 dNum := dst(Ty.Base).tpOrd;
1692 e.PushValue(lOp, dst);
1693 e.PushValue(rOp, dst);
1694 out.Code(plusCode(dNum));
1695 (* -------------------------------- *)
1696 | Xp.minus :
1697 dNum := dst(Ty.Base).tpOrd;
1698 e.PushValue(lOp, dst);
1699 e.PushValue(rOp, dst);
1700 out.Code(minusCode(dNum));
1701 (* -------------------------------- *)
1702 | Xp.mult :
1703 dNum := dst(Ty.Base).tpOrd;
1704 e.PushValue(lOp, dst);
1705 e.PushValue(rOp, dst);
1706 out.Code(multCode(dNum));
1707 (* -------------------------------- *)
1708 | Xp.slash :
1709 e.PushValue(lOp, dst);
1710 e.PushValue(rOp, dst);
1711 out.Code(Jvm.opc_ddiv);
1712 (* -------------------------------- *)
1713 | Xp.modOp :
1714 dNum := dst(Ty.Base).tpOrd;
1715 e.PushValue(lOp, dst);
1716 e.PushValue(rOp, dst);
1717 IF dNum = Ty.lIntN THEN
1718 out.CallRTS(Ju.ModL,4,2);
1719 ELSE
1720 out.CallRTS(Ju.ModI,2,1);
1721 END;
1722 (* -------------------------------- *)
1723 | Xp.divOp :
1724 (*
1725 * dNum := dst(Ty.Base).tpOrd;
1726 * e.PushValue(lOp, dst);
1727 * e.PushValue(rOp, dst);
1728 * IF dNum = Ty.lIntN THEN
1729 * out.CallRTS(Ju.DivL,4,2);
1730 * ELSE
1731 * out.CallRTS(Ju.DivI,2,1);
1732 * END;
1733 *
1734 * Alternative, inline code ...
1735 *)
1736 e.PushValue(lOp, dst);
1737 long := dst(Ty.Base).tpOrd = Ty.lIntN;
1738 IF (rOp.kind = Xp.numLt) & (longValue(rOp) > 0) THEN
1739 tpLb := out.newLabel();
1740 IF long THEN
1741 rLit := longValue(rOp);
1742 out.Code(Jvm.opc_dup2);
1743 out.PushLong(0);
1744 out.Code(Jvm.opc_lcmp);
1745 out.CodeLb(Jvm.opc_ifge, tpLb);
1746 out.PushLong(rLit-1);
1747 out.Code(Jvm.opc_lsub);
1748 out.DefLab(tpLb);
1749 out.PushLong(rLit);
1750 out.Code(Jvm.opc_ldiv);
1751 ELSE
1752 indx := intValue(rOp);
1753 out.Code(Jvm.opc_dup);
1754 out.CodeLb(Jvm.opc_ifge, tpLb);
1755 out.PushInt(indx-1);
1756 out.Code(Jvm.opc_isub);
1757 out.DefLab(tpLb);
1758 out.PushInt(indx);
1759 out.Code(Jvm.opc_idiv);
1760 END;
1761 ELSE
1762 e.PushValue(rOp, dst);
1763 IF long THEN
1764 out.CallRTS(Ju.DivL,4,2);
1765 ELSE
1766 out.CallRTS(Ju.DivI,2,1);
1767 END;
1768 END;
1769 (* -------------------------------- *)
1770 | Xp.rem0op :
1771 dNum := dst(Ty.Base).tpOrd;
1772 e.PushValue(lOp, dst);
1773 e.PushValue(rOp, dst);
1774 IF dNum = Ty.lIntN THEN
1775 out.Code(Jvm.opc_lrem);
1776 ELSE
1777 out.Code(Jvm.opc_irem);
1778 END;
1779 (* -------------------------------- *)
1780 | Xp.div0op :
1781 dNum := dst(Ty.Base).tpOrd;
1782 e.PushValue(lOp, dst);
1783 e.PushValue(rOp, dst);
1784 IF dNum = Ty.lIntN THEN
1785 out.Code(Jvm.opc_ldiv);
1786 ELSE
1787 out.Code(Jvm.opc_idiv);
1788 END;
1789 (* -------------------------------- *)
1790 | Xp.blOr, Xp.blAnd, Xp.greT, Xp.greEq,
1791 Xp.notEq, Xp.lessEq, Xp.lessT, Xp.equal, Xp.inOp :
1792 tpLb := out.newLabel();
1793 exLb := out.newLabel();
1794 (*
1795 * Jumping code is mandated for blOr and blAnd...
1796 *
1797 * For the Relational Ops this next seems crude, but
1798 * appears to be the only way that the JVM allows
1799 * construction of boolean values.
1800 *)
1801 e.FallTrue(exp, tpLb);
1802 out.Code(Jvm.opc_iconst_1);
1803 out.CodeLb(Jvm.opc_goto, exLb);
1804 out.DefLab(tpLb);
1805 out.Code(Jvm.opc_iconst_0);
1806 out.DefLab(exLb);
1807 (* -------------------------------- *)
1808 | Xp.isOp :
1809 e.PushValue(lOp, lOp.type);
1810 out.CodeT(Jvm.opc_instanceof, rOp(Xp.IdLeaf).ident.type);
1811 (* -------------------------------- *)
1812 | Xp.rotInt :
1813 e.PushValue(lOp, lOp.type);
1814 IF lOp.type = Bi.lIntTp THEN
1815 RotateLong(e, lOp, rOp);
1816 ELSE
1817 RotateInt(e, lOp, rOp);
1818 END;
1819 (* -------------------------------- *)
1820 | Xp.ashInt, Xp.lshInt :
1821 long := dst.isLongType();
1822 e.PushValue(lOp, lOp.type);
1823 IF long THEN
1824 ShiftLong(exp.kind, e, lOp, rOp);
1825 ELSE
1826 ShiftInt(exp.kind, e, lOp, rOp);
1827 END;
1828 (* -------------------------------- *)
1829 | Xp.strCat :
1830 e.PushValue(lOp, lOp.type);
1831 e.PushValue(rOp, rOp.type);
1832 IF (lOp.type = Bi.strTp) &
1833 (lOp.kind # Xp.mkStr) OR
1834 lOp.type.isNativeStr() THEN
1835 IF (rOp.type = Bi.strTp) &
1836 (rOp.kind # Xp.mkStr) OR
1837 rOp.type.isNativeStr() THEN
1838 out.CallRTS(Ju.StrCatSS,2,1);
1839 ELSE
1840 out.CallRTS(Ju.StrCatSA, 2, 1);
1841 END;
1842 ELSE
1843 IF (rOp.type = Bi.strTp) &
1844 (rOp.kind # Xp.mkStr) OR
1845 rOp.type.isNativeStr() THEN
1846 out.CallRTS(Ju.StrCatAS, 2, 1);
1847 ELSE
1848 out.CallRTS(Ju.StrCatAA, 2, 1);
1849 END;
1850 END;
1851 (* -------------------------------- *)
1852 END;
1853 END PushBinary;
1854
1855 (* ============================================================ *)
1856
1857 PROCEDURE (e : JavaEmitter)PushValue(exp : Sy.Expr; typ : Sy.Type),NEW;
1858 VAR out : Ju.JavaFile;
1859 rec : Ty.Record;
1860 ix : INTEGER;
1861 elm : Sy.Expr;
1862 emt : BOOLEAN; (* ==> more than one set element expr *)
1863 BEGIN
1864 out := e.outF;
1865 WITH exp : Xp.IdLeaf DO
1866 IF exp.isProcLit() THEN
1867 out.MakeAndPushProcLitValue(exp, typ(Ty.Procedure));
1868 ELSIF exp.kind = Xp.typOf THEN
1869 out.LoadType(exp.ident);
1870 ELSE
1871 out.GetVar(exp.ident);
1872 IF typ = Bi.uBytTp THEN e.UbyteClear() END;
1873 END;
1874 | exp : Xp.SetExp DO
1875 emt := TRUE;
1876 (*
1877 * Write out the constant part, if there is one.
1878 *)
1879 IF exp.value # NIL THEN
1880 out.PushInt(exp.value.int()); (* const part *)
1881 emt := FALSE;
1882 END;
1883 (*
1884 * Write out the element expressions.
1885 * taking the union with any part emitted already.
1886 *)
1887 FOR ix := 0 TO exp.varSeq.tide-1 DO
1888 elm := exp.varSeq.a[ix];
1889 IF elm.kind = Xp.range THEN
1890 e.PushValue(elm, Bi.intTp);
1891 ELSE
1892 out.PushInt(1);
1893 e.PushValue(exp.varSeq.a[ix], Bi.intTp);
1894 out.Code(Jvm.opc_ishl);
1895 END;
1896 IF ~emt THEN out.Code(Jvm.opc_ior) END;
1897 emt := FALSE;
1898 END;
1899 (*
1900 * If neither of the above emitted anything, emit zero!
1901 *)
1902 IF emt THEN out.Code(Jvm.opc_iconst_0) END;
1903 | exp : Xp.LeafX DO
1904 CASE exp.kind OF
1905 | Xp.tBool : out.Code(Jvm.opc_iconst_1);
1906 | Xp.fBool : out.Code(Jvm.opc_iconst_0);
1907 | Xp.nilLt : out.Code(Jvm.opc_aconst_null);
1908 | Xp.charLt : out.PushInt(ORD(exp.value.char()));
1909 | Xp.setLt : out.PushInt(exp.value.int());
1910 | Xp.numLt :
1911 IF typ = Bi.lIntTp THEN
1912 out.PushLong(exp.value.long());
1913 ELSE
1914 out.PushInt(exp.value.int());
1915 END;
1916 | Xp.realLt :
1917 IF typ = Bi.realTp THEN
1918 out.PushReal(exp.value.real());
1919 ELSE
1920 out.PushSReal(exp.value.real());
1921 END;
1922 | Xp.strLt :
1923 IF (typ = Bi.charTp) OR (typ = Bi.sChrTp) THEN
1924 out.PushInt(ORD(exp.value.chr0()));
1925 ELSE
1926 out.PushStr(exp.value.chOpen());
1927 END;
1928 | Xp.infLt :
1929 IF typ = Bi.realTp THEN
1930 out.GetVar(Cst.dblInf);
1931 ELSE
1932 out.GetVar(Cst.fltInf);
1933 END;
1934 | Xp.nInfLt :
1935 IF typ = Bi.realTp THEN
1936 out.GetVar(Cst.dblNInf);
1937 ELSE
1938 out.GetVar(Cst.fltNInf);
1939 END;
1940 END;
1941 | exp : Xp.CallX DO
1942 e.PushCall(exp);
1943 | exp : Xp.IdentX DO
1944 e.PushValue(exp.kid, exp.kid.type);
1945 IF exp.kind = Xp.selct THEN
1946 rec := exp.kid.type(Ty.Record);
1947 out.PutGetF(Jvm.opc_getfield, rec, exp.ident(Id.FldId));
1948 IF typ = Bi.uBytTp THEN e.UbyteClear() END;
1949 ELSIF exp.kind = Xp.cvrtUp THEN
1950 out.ConvertUp(exp.kid.type, typ);
1951 ELSIF exp.kind = Xp.cvrtDn THEN
1952 out.ConvertDn(exp.kid.type, typ);
1953 END;
1954 | exp : Xp.UnaryX DO
1955 e.PushUnary(exp, typ);
1956 | exp : Xp.BinaryX DO
1957 e.PushBinary(exp, typ);
1958 END;
1959 END PushValue;
1960
1961 (* ---------------------------------------------------- *)
1962
1963 PROCEDURE SwapHandle(out : Ju.JavaFile; exp : Sy.Expr; long : BOOLEAN);
1964 (* Precondition: exp must be a variable designator *)
1965 (* A value is below a handle of 0,1,2 words. Swap val to top *)
1966 VAR hSiz : INTEGER;
1967 idnt : Sy.Idnt;
1968 type : Sy.Type;
1969 BEGIN
1970 type := exp.type;
1971 IF (type IS Ty.Record) OR
1972 ((type IS Ty.Array) & (type.kind # Ty.vecTp)) THEN
1973 hSiz := 1;
1974 ELSE
1975 WITH exp : Xp.IdLeaf DO
1976 idnt := exp.ident;
1977 WITH idnt : Id.LocId DO
1978 IF Id.uplevA IN idnt.locAtt THEN hSiz := 1 ELSE hSiz := 0 END;
1979 ELSE
1980 hSiz := 0;
1981 END;
1982 | exp : Xp.BinaryX DO
1983 hSiz := 2;
1984 ELSE
1985 hSiz := 1;
1986 END; (* -------------------- *)
1987 END; (* -------------------- *)
1988 (* Before ==> After *)
1989 IF hSiz = 1 THEN (* -------------------- *)
1990 IF ~long THEN (* [hndl] ==> [valu] *)
1991 out.Code(Jvm.opc_swap); (* [valu] [hndl] *)
1992 (* -------------------- *)
1993 ELSE (* [hndl] ==> [val2] *)
1994 out.Code(Jvm.opc_dup_x2); (* [val2] [val1] *)
1995 out.Code(Jvm.opc_pop); (* [val1] [hndl] *)
1996 END; (* -------------------- *)
1997 ELSIF hSiz = 2 THEN (* -------------------- *)
1998 IF ~long THEN (* [indx] ==> [valu] *)
1999 out.Code(Jvm.opc_dup2_x1); (* [hndl] [indx] *)
2000 out.Code(Jvm.opc_pop2); (* [valu] [hndl] *)
2001 (* -------------------- *)
2002 ELSE (* [indx] ==> [val2] *)
2003 out.Code(Jvm.opc_dup2_x2); (* [hdnl] [val1] *)
2004 out.Code(Jvm.opc_pop2); (* [val2] [indx] *)
2005 END; (* [val1] [hndl] *)
2006 (* ELSE nothing to do *) (* -------------------- *)
2007 END;
2008 END SwapHandle;
2009
2010 (* -------------------------------------------- *)
2011
2012 PROCEDURE (e : JavaEmitter)PushHandle(exp : Sy.Expr; typ : Sy.Type),NEW;
2013 (* Precondition: exp must be a variable designator *)
2014 VAR idnt : Sy.Idnt;
2015 BEGIN
2016 ASSERT(exp.isVarDesig());
2017 IF (typ IS Ty.Record) OR ((typ IS Ty.Array) & (typ.kind # Ty.vecTp)) THEN
2018 e.PushValue(exp, typ);
2019 ELSE
2020 WITH exp : Xp.IdentX DO
2021 e.PushValue(exp.kid, exp.kid.type);
2022 | exp : Xp.BinaryX DO
2023 IF exp.lKid.type IS Ty.Vector THEN
2024 e.PushVecElemHandle(exp.lKid, exp.rKid);
2025 (*
2026 * e.PushValue(exp.lKid, exp.lKid.type);
2027 * e.outF.GetVecArr(exp.lKid.type(Ty.Vector).elemTp);
2028 * e.PushValue(exp.rKid, Bi.intTp);
2029 *)
2030 ELSE
2031 e.PushValue(exp.lKid, exp.lKid.type);
2032 e.PushValue(exp.rKid, Bi.intTp);
2033 END;
2034 | exp : Xp.IdLeaf DO
2035 idnt := exp.ident;
2036 WITH idnt : Id.LocId DO (* check if implemented inside XHR *)
2037 IF Id.uplevA IN idnt.locAtt THEN e.outF.XhrHandle(idnt) END;
2038 ELSE (* skip *)
2039 END;
2040 END;
2041 END;
2042 END PushHandle;
2043
2044 (* ---------------------------------------------------- *)
2045
2046 PROCEDURE (e : JavaEmitter)ScalarAssign(exp : Sy.Expr),NEW;
2047 VAR out : Ju.JavaFile;
2048 rec : Ty.Record;
2049 BEGIN
2050 out := e.outF;
2051 WITH exp : Xp.IdLeaf DO
2052 (* stack has ... value, (top) *)
2053 out.PutVar(exp.ident);
2054 | exp : Xp.IdentX DO
2055 (* stack has ... obj-ref, value, (top) *)
2056 rec := exp.kid.type(Ty.Record);
2057 out.PutGetF(Jvm.opc_putfield, rec, exp.ident(Id.FldId));
2058 | exp : Xp.BinaryX DO
2059 (* stack has ... arr-ref, index, value, (top) *)
2060 IF exp.lKid.type IS Ty.Vector THEN
2061 out.PutVecElement(exp.type);
2062 ELSE
2063 out.PutElement(exp.type);
2064 END;
2065 ELSE
2066 Console.WriteString("BAD SCALAR ASSIGN"); Console.WriteLn;
2067 exp.Diagnose(0);
2068 ASSERT(FALSE);
2069 END;
2070 END ScalarAssign;
2071
2072 (* ---------------------------------------------------- *)
2073
2074 PROCEDURE (e : JavaEmitter)ValueCopy(act : Sy.Expr; fmT : Sy.Type),NEW;
2075 VAR out : Ju.JavaFile;
2076 BEGIN
2077 (*
2078 * Copy this actual, where fmT is either an array or record.
2079 *)
2080 out := e.outF;
2081 WITH fmT : Ty.Record DO
2082 out.MkNewRecord(fmT); (* (top) dst... *)
2083 out.Code(Jvm.opc_dup); (* (top) dst,dst... *)
2084 e.PushValue(act, fmT); (* (top) src,dst,dst... *)
2085 out.ValRecCopy(fmT); (* (top) dst... *)
2086 | fmT : Ty.Array DO
2087 (*
2088 * Array case: ordinary value copy
2089 *)
2090 IF fmT.length = 0 THEN (* open array case *)
2091 e.PushValue(act, fmT); (* (top) src... *)
2092 out.Code(Jvm.opc_dup); (* (top) src,src... *)
2093 IF act.kind = Xp.mkStr THEN
2094 out.CallRTS(Ju.StrLP1,1,1); (* (top) len,src... *)
2095 out.Alloc1d(Bi.charTp); (* (top) dst,src... *)
2096 ELSE
2097 out.MkArrayCopy(fmT); (* (top) dst,src... *)
2098 END;
2099 out.Code(Jvm.opc_dup_x1); (* dst,src,dst... *)
2100 out.Code(Jvm.opc_swap); (* (top) src,dst,dst... *)
2101 ELSE (* fixed array case *)
2102 out.MkNewFixedArray(fmT.elemTp, fmT.length);
2103 out.Code(Jvm.opc_dup); (* (top) dst,dst... *)
2104 e.PushValue(act, fmT); (* (top) src,dst,dst... *)
2105 END;
2106 IF act.kind = Xp.mkStr THEN
2107 out.CallRTS(Ju.StrVal, 2, 0); (* (top) dst... *)
2108 ELSE
2109 out.ValArrCopy(fmT); (* (top) dst... *)
2110 END;
2111 ELSE
2112 e.PushValue(act, fmT);
2113 END;
2114 END ValueCopy;
2115
2116 (* ---------------------------------------------------- *)
2117
2118 PROCEDURE (e : JavaEmitter)StringCopy(act : Sy.Expr; fmT : Ty.Array),NEW;
2119 VAR out : Ju.JavaFile;
2120 BEGIN
2121 out := e.outF;
2122 IF act.kind = Xp.mkStr THEN
2123 e.ValueCopy(act, fmT);
2124 ELSIF fmT.length = 0 THEN (* str passed to open array *)
2125 e.PushValue(act, fmT);
2126 out.CallRTS(Ju.StrToChrOpen,1,1);
2127 ELSE (* str passed to fixed array *)
2128 out.MkNewFixedArray(Bi.charTp, fmT.length);
2129 out.Code(Jvm.opc_dup);
2130 e.PushValue(act, fmT);
2131 out.CallRTS(Ju.StrToChrs,2,0);
2132 END;
2133 END StringCopy;
2134
2135 (* ============================================================ *)
2136
2137 PROCEDURE (e : JavaEmitter)Invoke(exp : Sy.Expr; typ : Ty.Procedure),NEW;
2138 VAR code : INTEGER;
2139 prcI : Id.PrcId;
2140 mthI : Id.MthId;
2141 BEGIN
2142 IF exp.isProcVar() THEN
2143 mthI := Ju.getProcVarInvoke(exp.type(Ty.Procedure));
2144 code := Jvm.opc_invokevirtual;
2145 e.outF.CallIT(code, mthI, typ);
2146 ELSE
2147 WITH exp : Xp.IdLeaf DO (* qualid *)
2148 prcI := exp.ident(Id.PrcId);
2149 IF prcI.kind = Id.ctorP THEN
2150 code := Jvm.opc_invokespecial;
2151 ELSE
2152 code := Jvm.opc_invokestatic;
2153 END;
2154 e.outF.CallIT(code, prcI, typ);
2155 | exp : Xp.IdentX DO (* selct *)
2156 mthI := exp.ident(Id.MthId);
2157 IF exp.kind = Xp.sprMrk THEN
2158 code := Jvm.opc_invokespecial;
2159 ELSIF mthI.bndType.isInterfaceType() THEN
2160 code := Jvm.opc_invokeinterface;
2161 ELSE
2162 code := Jvm.opc_invokevirtual;
2163 END;
2164 e.outF.CallIT(code, mthI, typ);
2165 IF Id.covar IN mthI.mthAtt THEN
2166 e.outF.CodeT(Jvm.opc_checkcast, typ.retType);
2167 END;
2168 END;
2169 END;
2170 END Invoke;
2171
2172 (* ---------------------------------------------------- *)
2173
2174 PROCEDURE (e : JavaEmitter)PushAndGetReturn(act : Sy.Expr;
2175 typ : Sy.Type;
2176 OUT ret : Sy.Expr),NEW;
2177 (* ----------------------------------------- *)
2178 VAR out : Ju.JavaFile;
2179 local : INTEGER;
2180 recXp : Sy.Expr;
2181 array : Sy.Expr;
2182 index : Sy.Expr;
2183 (* ----------------------------------------- *)
2184 PROCEDURE simple(x : Sy.Expr) : BOOLEAN;
2185 BEGIN
2186 IF x.kind = Xp.deref THEN x := x(Xp.UnaryX).kid END;
2187 RETURN x IS Xp.LeafX; (* IdLeaf or LeafX *)
2188 END simple;
2189 (* ----------------------------------------- *)
2190 BEGIN
2191 (*
2192 * Assert: the expression is a (possibly complex)
2193 * variable designator. Is some part of the handle
2194 * worth saving? Note saving is mandatory for calls.
2195 *)
2196 out := e.outF;
2197 ret := act;
2198 WITH act : Xp.IdLeaf DO
2199 (*
2200 * This is a simple variable. Result will be
2201 * stored directly using the same expression.
2202 *)
2203 e.PushValue(act, typ);
2204 | act : Xp.IdentX DO
2205 ASSERT(act.kind = Xp.selct);
2206 (*
2207 * This is a field select. If the handle is
2208 * sufficiently complicated it will be saved.
2209 *)
2210 recXp := act.kid;
2211 e.PushValue(recXp, recXp.type);
2212 IF ~simple(recXp) THEN
2213 local := out.newLocal();
2214 out.Code(Jvm.opc_dup);
2215 out.StoreLocal(local, NIL);
2216 (*
2217 * The restore expression is a mutated
2218 * version of the original expression.
2219 *)
2220 act.kid := e.newLeaf(local, recXp.type);
2221 act.kid.type := recXp.type;
2222 END;
2223 out.PutGetF(Jvm.opc_getfield,
2224 recXp.type(Ty.Record), act.ident(Id.FldId));
2225 | act : Xp.BinaryX DO
2226 ASSERT(act.kind = Xp.index);
2227 (*
2228 * This is an index select. If the handle, or
2229 * index (or both) are complicated they are saved.
2230 *)
2231 array := act.lKid;
2232 index := act.rKid;
2233 e.PushValue(array, array.type);
2234 IF simple(array) THEN (* don't save handle *)
2235 e.PushValue(index, Bi.intTp);
2236 IF ~simple(index) THEN (* must save index *)
2237 local := out.newLocal();
2238 out.Code(Jvm.opc_dup);
2239 out.StoreLocal(local, Bi.intTp); (* #### *)
2240 act.rKid := e.newLeaf(local, Bi.intTp);
2241 act.rKid.type := Bi.intTp;
2242 END;
2243 ELSE (* must save handle *)
2244 local := out.newLocal();
2245 out.Code(Jvm.opc_dup);
2246 out.StoreLocal(local, NIL);
2247 act.lKid := e.newLeaf(local, array.type);
2248 act.lKid.type := array.type;
2249 e.PushValue(index, Bi.intTp);
2250 IF ~simple(index) THEN (* save index as well *)
2251 local := out.newLocal();
2252 out.Code(Jvm.opc_dup);
2253 out.StoreLocal(local, Bi.intTp); (* #### *)
2254 act.rKid := e.newLeaf(local, Bi.intTp);
2255 act.rKid.type := Bi.intTp;
2256 END;
2257 END;
2258 out.GetElement(typ);
2259 ELSE
2260 act.Diagnose(0); THROW("Bad PushAndGetReturn");
2261 END;
2262 END PushAndGetReturn;
2263
2264 (* ---------------------------------------------------- *)
2265
2266 PROCEDURE (e : JavaEmitter)PushArg(act : Sy.Expr;
2267 frm : Id.ParId;
2268 VAR seq : Sy.ExprSeq),NEW;
2269 (* ------------------------- *)
2270 VAR idExp : Xp.IdentX;
2271 out : Ju.JavaFile;
2272 local : INTEGER;
2273 (* ----------------------------------------- *)
2274 PROCEDURE boxNumber(exp : Sy.Expr) : INTEGER;
2275 BEGIN
2276 RETURN exp(Xp.IdLeaf).ident(Id.ParId).boxOrd;
2277 END boxNumber;
2278 (* ----------------------------------------- *)
2279 PROCEDURE boxedPar(exp : Sy.Expr) : BOOLEAN;
2280 VAR idnt : Sy.Idnt;
2281 BEGIN
2282 WITH exp : Xp.IdLeaf DO
2283 idnt := exp.ident;
2284 WITH idnt : Id.ParId DO
2285 RETURN (idnt.boxOrd # Ju.retMarker) & Ju.needsBox(idnt);
2286 ELSE
2287 RETURN FALSE;
2288 END;
2289 ELSE
2290 RETURN FALSE;
2291 END;
2292 END boxedPar;
2293 (* ----------------------------------------- *)
2294 BEGIN
2295 out := e.outF;
2296 IF Ju.needsBox(frm) THEN (* value is returned *)
2297 NEW(idExp);
2298 idExp.ident := frm;
2299 IF frm.parMod = Sy.out THEN (* no value push *)
2300 idExp.kid := act;
2301 ELSE
2302 e.PushAndGetReturn(act, frm.type, idExp.kid);
2303 END;
2304 IF frm.boxOrd # Ju.retMarker THEN
2305 (* ==> out value but not in return slot *)
2306 frm.rtsTmp := out.newLocal();
2307 IF boxedPar(act) THEN
2308 out.LoadLocal(boxNumber(act), NIL);
2309 ELSE
2310 out.MkNewFixedArray(frm.type, 1);
2311 END;
2312 out.Code(Jvm.opc_dup);
2313 out.StoreLocal(frm.rtsTmp, NIL);
2314 END;
2315 Sy.AppendExpr(seq, idExp);
2316 ELSIF (frm.type IS Ty.Array) &
2317 ((act.type = Bi.strTp) OR act.type.isNativeStr()) THEN
2318 e.StringCopy(act, frm.type(Ty.Array)); (* special string case *)
2319 ELSIF (frm.parMod = Sy.val) &
2320 ((frm.type IS Ty.Record) OR
2321 (* #### *)
2322 ((frm.type IS Ty.Array) & (frm.type.kind # Ty.vecTp))) THEN
2323 (* #### *)
2324 e.ValueCopy(act, frm.type);
2325 ELSE
2326 e.PushValue(act, frm.type);
2327 END;
2328 END PushArg;
2329
2330 (* ---------------------------------------------------- *)
2331
2332 PROCEDURE (e : JavaEmitter)CopyOut(exp : Sy.Expr; idD : Sy.Idnt),NEW;
2333 VAR out : Ju.JavaFile;
2334 par : Id.ParId;
2335 BEGIN
2336 (* Assert : this is an unboxed type *)
2337 out := e.outF;
2338 par := idD(Id.ParId);
2339 e.PushHandle(exp, par.type);
2340 IF par.boxOrd # Ju.retMarker THEN
2341 out.LoadLocal(par.rtsTmp, NIL);
2342 out.Code(Jvm.opc_iconst_0);
2343 out.GetElement(par.type);
2344 ELSE (* result is below handle *)
2345 SwapHandle(out, exp, par.type.isLongType());
2346 END;
2347 e.ScalarAssign(exp);
2348 END CopyOut;
2349
2350 (* ============================================================ *)
2351 (* Possible structures of procedure call expressions are: *)
2352 (* ============================================================ *)
2353 (* o o *)
2354 (* / / *)
2355 (* [CallX] [CallX] *)
2356 (* / +--- actuals --> ... / +--- actuals *)
2357 (* / / *)
2358 (* [IdentX] [IdLeaf] *)
2359 (* / +--- ident ---> [Procs] +--- ident ---> [Procs] *)
2360 (* / *)
2361 (* kid expr *)
2362 (* *)
2363 (* ============================================================ *)
2364 (* only the right hand case can be a standard proc or function *)
2365 (* ============================================================ *)
2366
2367 PROCEDURE (e : JavaEmitter)PushCall(callX : Xp.CallX),NEW;
2368 VAR jFile : Ju.JavaFile;
2369 mark0 : INTEGER; (* local ord limit on entry *)
2370 tide0 : INTEGER; (* parameter tide on entry *)
2371 index : INTEGER; (* just a counter for loops *)
2372 prVar : BOOLEAN; (* Procedure variable call *)
2373 formT : Ty.Procedure; (* formal type of procedure *)
2374 formP : Id.ParId; (* current formal parameter *)
2375 prExp : Sy.Expr;
2376 idExp : Xp.IdentX;
2377 (* ---------------------------------------------------- *)
2378 PROCEDURE CheckCall(expr : Sy.Expr; pTyp : Ty.Procedure);
2379 VAR prcI : Id.PrcId;
2380 mthI : Id.MthId;
2381 idnt : Sy.Idnt;
2382 BEGIN
2383 WITH expr : Xp.IdLeaf DO (* qualid *)
2384 idnt := expr.ident;
2385 WITH idnt : Id.PrcId DO
2386 (* prcI := expr.ident(Id.PrcId); *)
2387 IF pTyp.xName = NIL THEN Ju.MkCallAttr(idnt, pTyp) END;
2388 | idnt : Id.AbVar DO
2389 mthI := Ju.getProcVarInvoke(pTyp);
2390 IF mthI.type.xName = NIL THEN Ju.MkCallAttr(mthI, mthI.type(Ty.Procedure)) END;
2391 END;
2392 | expr : Xp.IdentX DO (* selct *)
2393 idnt := expr.ident;
2394 WITH idnt : Id.MthId DO
2395 IF pTyp.xName = NIL THEN Ju.MkCallAttr(idnt, pTyp) END;
2396 | idnt : Id.FldId DO
2397 mthI := Ju.getProcVarInvoke(pTyp);
2398 IF mthI.type.xName = NIL THEN Ju.MkCallAttr(mthI, mthI.type(Ty.Procedure)) END;
2399 END;
2400 END;
2401 END CheckCall;
2402 (* ---------------------------------------------------- *)
2403 PROCEDURE isNested(exp : Xp.IdLeaf) : BOOLEAN;
2404 BEGIN
2405 RETURN exp.ident(Id.PrcId).lxDepth > 0;
2406 END isNested;
2407 (* ---------------------------------------------------- *)
2408 BEGIN
2409 jFile := e.outF;
2410 mark0 := jFile.markTop();
2411 tide0 := callX.actuals.tide;
2412 prExp := callX.kid;
2413 formT := prExp.type(Ty.Procedure);
2414 (*
2415 * Before we push any arguments, we must ensure that
2416 * the formal-type name is computed, and the first
2417 * out-value is moved to the return-slot, if possible.
2418 *)
2419 prVar := prExp.isProcVar();
2420 CheckCall(prExp, formT);
2421 (*
2422 * We must first deal with the receiver if this is a method.
2423 *)
2424 IF prVar THEN
2425 e.PushValue(prExp, prExp.type);
2426 formT := Ju.getProcVarInvoke(formT).type(Ty.Procedure);
2427 ELSIF formT.receiver # NIL THEN
2428 idExp := prExp(Xp.IdentX);
2429 formP := idExp.ident(Id.MthId).rcvFrm;
2430 e.PushArg(idExp.kid, formP, callX.actuals);
2431 ELSE
2432 WITH prExp : Xp.IdLeaf DO
2433 IF prExp.ident.kind = Id.ctorP THEN
2434 jFile.CodeT(Jvm.opc_new, callX.type);
2435 jFile.Code(Jvm.opc_dup);
2436 ELSIF isNested(prExp) THEN
2437 jFile.PushStaticLink(prExp.ident(Id.Procs));
2438 END;
2439 ELSE (* skip *)
2440 END;
2441 END;
2442 (*
2443 * We push the arguments from left to right.
2444 * New IdentX expressions are appended to the argument
2445 * list to describe how to save any returned values.
2446 *)
2447 FOR index := 0 TO tide0-1 DO
2448 formP := formT.formals.a[index];
2449 e.PushArg(callX.actuals.a[index], formP, callX.actuals);
2450 END;
2451 (*
2452 * Now emit the actual call instruction(s)
2453 *)
2454 e.Invoke(prExp, formT);
2455 (*
2456 * Now we save any out arguments from the appended exprs.
2457 *)
2458 FOR index := tide0 TO callX.actuals.tide-1 DO
2459 prExp := callX.actuals.a[index];
2460 idExp := prExp(Xp.IdentX);
2461 e.CopyOut(idExp.kid, idExp.ident);
2462 END;
2463 jFile.ReleaseAll(mark0);
2464 (*
2465 * Normally an CallX expression can only be evaluated once,
2466 * so it does not matter if PushCall() is not idempotent.
2467 * However, there is a pathological case if a predicate in a
2468 * while loop has a function call with OUT formals. Since the
2469 * GPCP method of laying out while loops evaluates the test
2470 * twice, the actual list must be reset to its original length.
2471 *)
2472 callX.actuals.ResetTo(tide0);
2473 END PushCall;
2474
2475 (* ---------------------------------------------------- *)
2476
2477 PROCEDURE IncByLit(out : Ju.JavaFile; ord : INTEGER; inc : INTEGER);
2478 BEGIN
2479 IF (ord < 256) & (inc >= -128) & (inc <= 127) THEN
2480 out.CodeInc(ord, inc);
2481 ELSE
2482 out.LoadLocal(ord, Bi.intTp);
2483 out.PushInt(inc);
2484 out.Code(Jvm.opc_iadd);
2485 out.StoreLocal(ord, Bi.intTp);
2486 END;
2487 END IncByLit;
2488
2489 PROCEDURE LitIncLocal(out : Ju.JavaFile; proc, vOrd, incr : INTEGER);
2490 BEGIN
2491 IF proc = Bi.decP THEN incr := -incr END;
2492 IncByLit(out, vOrd, incr);
2493 END LitIncLocal;
2494
2495 (* ------------------------------------------ *)
2496
2497 PROCEDURE (e : JavaEmitter)EmitStdProc(callX : Xp.CallX),NEW;
2498 CONST fMsg = "Assertion failure ";
2499 VAR out : Ju.JavaFile;
2500 prId : Id.PrcId;
2501 flId : Id.FldId;
2502 pOrd : INTEGER;
2503 arg0 : Sy.Expr;
2504 argX : Sy.Expr;
2505 dstT : Sy.Type;
2506 idX0 : Sy.Idnt;
2507 argN : INTEGER;
2508 numL : INTEGER;
2509 incr : INTEGER;
2510 vRef : INTEGER;
2511 tide : INTEGER;
2512 okLb : Ju.Label;
2513 long : BOOLEAN;
2514 c : INTEGER;
2515 BEGIN
2516 out := e.outF;
2517 prId := callX.kid(Xp.IdLeaf).ident(Id.PrcId);
2518 arg0 := callX.actuals.a[0]; (* Always need at least one arg *)
2519 argN := callX.actuals.tide;
2520
2521 pOrd := prId.stdOrd;
2522 CASE pOrd OF
2523 (* --------------------------- *)
2524 | Bi.asrtP :
2525 okLb := out.newLabel();
2526 e.FallFalse(arg0, okLb);
2527 (*
2528 * If expression evaluates to false, fall
2529 * into the error code, else skip to okLb.
2530 *)
2531 IF argN > 1 THEN
2532 numL := intValue(callX.actuals.a[1]);
2533 out.Trap(fMsg + L.intToCharOpen(numL)^);
2534 ELSE
2535 numL := callX.token.lin;
2536 out.Trap(fMsg + Cst.srcNam +":"+ L.intToCharOpen(numL)^);
2537 END;
2538 out.DefLab(okLb);
2539 (* --------------------------- *)
2540 | Bi.incP, Bi.decP :
2541 argX := callX.actuals.a[1];
2542 dstT := arg0.type;
2543 long := dstT.isLongType();
2544 (*
2545 * Is this a local variable?
2546 * There is a special instruction for incrementing
2547 * word-sized local variables, provided the increment is
2548 * by a literal 8-bit amount, and local index is 8-bit.
2549 *)
2550 e.PushHandle(arg0, dstT);
2551 WITH arg0 : Xp.IdLeaf DO
2552
2553 idX0 := arg0.ident;
2554 WITH idX0 : Id.LocId DO
2555 IF Id.uplevA IN idX0.locAtt THEN (* uplevel addressing case *)
2556 out.Code(Jvm.opc_dup); (* handle is one slot only *)
2557 out.PutGetX(Jvm.opc_getfield, idX0);
2558 ELSIF (argX.kind = Xp.numLt) & ~long THEN (* PREMATURE EXIT *)
2559 LitIncLocal(out, pOrd, idX0.varOrd, intValue(argX)); RETURN;
2560 ELSE
2561 out.LoadLocal(idX0.varOrd, dstT);
2562 END;
2563 ELSE
2564 e.PushValue(arg0, dstT);
2565 END;
2566 | arg0 : Xp.IdentX DO
2567 flId := arg0.ident(Id.FldId);
2568 out.Code(Jvm.opc_dup); (* handle is one slot only *)
2569 out.PutGetF(Jvm.opc_getfield, arg0.kid.type(Ty.Record), flId);
2570 | arg0 : Xp.BinaryX DO
2571 out.Code(Jvm.opc_dup2); (* handle is two slots here *)
2572 out.GetElement(dstT);
2573 END;
2574 e.PushValue(argX, dstT);
2575 IF long THEN
2576 IF pOrd = Bi.incP THEN c := Jvm.opc_ladd ELSE c := Jvm.opc_lsub END;
2577 ELSE
2578 IF pOrd = Bi.incP THEN c := Jvm.opc_iadd ELSE c := Jvm.opc_isub END;
2579 END;
2580 out.Code(c);
2581 e.ScalarAssign(arg0);
2582 (* --------------------------- *)
2583 | Bi.cutP :
2584 (* ------------------------------------- *
2585 * Emit the code ...
2586 * <push vector ref>
2587 * dup
2588 * getfield CP/CPJvec/VecBase/tide I // tide, vRef ...
2589 * <push arg1> // arg1, tide, vRef ...
2590 * dup_x1 // arg1, tide, arg1, vRef ...
2591 * if_icmpge okLb // arg1, vRef ...
2592 * <throw index trap>
2593 * okLb: // arg1, vRef ...
2594 * putfield CP/CPJvec/VecBase/tide I // (empty)
2595 * ------------------------------------- *)
2596 argX := callX.actuals.a[1];
2597 okLb := out.newLabel();
2598 e.PushValue(arg0, arg0.type);
2599 out.Code(Jvm.opc_dup);
2600 out.GetVecLen();
2601 e.PushValue(argX, Bi.intTp);
2602 out.Code(Jvm.opc_dup_x1);
2603
2604 out.Code(Jvm.opc_iconst_1); (* Chop the sign bit *)
2605 out.Code(Jvm.opc_ishl); (* asserting, for *)
2606 out.Code(Jvm.opc_iconst_1); (* correctness, that *)
2607 out.Code(Jvm.opc_iushr); (* argX >> minInt. *)
2608
2609 out.CodeLb(Jvm.opc_if_icmpge, okLb);
2610 out.Trap("Vector index out of bounds");
2611 out.DefLab(okLb);
2612 out.PutVecLen();
2613 (* --------------------------- *)
2614 | Bi.apndP :
2615 (* -------------------------------------- *
2616 * Emit the code ...
2617 * <push vector ref>
2618 * dup
2619 * astore R // vRef ...
2620 * getfield CP/CPJvec/VecBase/tide I // tide ...
2621 * istore T
2622 * aload R // vRef ...
2623 * getfield CP/CPJvec/VecXXX/elems [X // elems ...
2624 * arraylength // aLen ...
2625 * iload T // tide, aLen ...
2626 * if_icmpgt okLb
2627 * aload R // vRef
2628 * <call expand()>
2629 * okLb:
2630 * aload R // vRef
2631 * getfield CP/CPJvec/VecXXX/elems [X // elems ...
2632 * iload T // tide, elems ...
2633 * <push arg1> // arg1, tide, elems ...
2634 * Xastore
2635 * aload R // vRef ...
2636 * iload T // tide, vRef ...
2637 * iconst_1 // 1, tide, vRef ...
2638 * iadd // tide', vRef ...
2639 * putfield CP/CPJvec/VecBase/tide I // (empty)
2640 * -------------------------------------- *)
2641 argX := callX.actuals.a[1];
2642 dstT := arg0.type(Ty.Vector).elemTp;
2643 vRef := out.newLocal();
2644 tide := out.newLocal();
2645 okLb := out.newLabel();
2646 e.PushValue(arg0, arg0.type);
2647 out.Code(Jvm.opc_dup);
2648 out.StoreLocal(vRef, NIL);
2649 out.GetVecLen();
2650 out.StoreLocal(tide, Bi.intTp);
2651 out.LoadLocal(vRef, NIL);
2652 out.GetVecArr(dstT);
2653 out.Code(Jvm.opc_arraylength);
2654 out.LoadLocal(tide, Bi.intTp);
2655 out.CodeLb(Jvm.opc_if_icmpgt, okLb);
2656 out.LoadLocal(vRef, NIL);
2657 out.InvokeExpand(dstT);
2658 out.DefLab(okLb);
2659 out.LoadLocal(vRef, NIL);
2660 out.GetVecArr(dstT);
2661 out.LoadLocal(tide, Bi.intTp);
2662 e.ValueCopy(argX, dstT);
2663 out.PutVecElement(dstT);
2664 out.LoadLocal(vRef, NIL);
2665 out.LoadLocal(tide, Bi.intTp);
2666 out.Code(Jvm.opc_iconst_1);
2667 out.Code(Jvm.opc_iadd);
2668 out.PutVecLen();
2669 out.ReleaseLocal(tide);
2670 out.ReleaseLocal(vRef);
2671 (* --------------------------- *)
2672 | Bi.exclP, Bi.inclP :
2673 dstT := arg0.type;
2674 argX := callX.actuals.a[1];
2675
2676 e.PushHandle(arg0, dstT);
2677 WITH arg0 : Xp.IdLeaf DO
2678 idX0 := arg0.ident;
2679 WITH idX0 : Id.LocId DO
2680 IF Id.uplevA IN idX0.locAtt THEN (* uplevel addressing case *)
2681 out.Code(Jvm.opc_dup); (* handle is one slot only *)
2682 out.PutGetX(Jvm.opc_getfield, idX0);
2683 ELSE
2684 out.LoadLocal(idX0.varOrd, dstT);
2685 END;
2686 ELSE
2687 e.PushValue(arg0, dstT);
2688 END;
2689 | arg0 : Xp.BinaryX DO
2690 ASSERT(arg0.kind = Xp.index);
2691 out.Code(Jvm.opc_dup2);
2692 out.GetElement(dstT);
2693 | arg0 : Xp.IdentX DO
2694 ASSERT(arg0.kind = Xp.selct);
2695 out.Code(Jvm.opc_dup);
2696 out.PutGetF(Jvm.opc_getfield,
2697 arg0.kid.type(Ty.Record), arg0.ident(Id.FldId));
2698 END;
2699 IF argX.kind = Xp.numLt THEN
2700 out.PushInt(ORD({intValue(argX)}));
2701 ELSE
2702 out.Code(Jvm.opc_iconst_1);
2703 e.PushValue(argX, Bi.intTp);
2704 out.Code(Jvm.opc_ishl);
2705 END;
2706 IF pOrd = Bi.inclP THEN
2707 out.Code(Jvm.opc_ior);
2708 ELSE
2709 out.Code(Jvm.opc_iconst_m1);
2710 out.Code(Jvm.opc_ixor);
2711 out.Code(Jvm.opc_iand);
2712 END;
2713 e.ScalarAssign(arg0);
2714 (* --------------------------- *)
2715 | Bi.haltP :
2716 out.PushInt(intValue(arg0));
2717 out.CallRTS(Ju.SysExit,1,0);
2718 out.PushJunkAndReturn();
2719 (* --------------------------- *)
2720 | Bi.throwP :
2721 IF Cst.ntvExc.assignCompat(arg0) THEN
2722 e.PushValue(arg0, Cst.ntvExc);
2723 out.Code(Jvm.opc_athrow);
2724 ELSE
2725 out.MkNewException();
2726 out.Code(Jvm.opc_dup);
2727 e.PushValue(arg0, Cst.ntvStr);
2728 out.InitException();
2729 out.Code(Jvm.opc_athrow);
2730 END;
2731 (* --------------------------- *)
2732 | Bi.newP :
2733 (*
2734 * arg0 is a pointer to a Record or Array, or else a vector type.
2735 *)
2736 e.PushHandle(arg0, arg0.type);
2737 IF argN = 1 THEN
2738 (*
2739 * No LEN argument implies either:
2740 * pointer to record, OR
2741 * pointer to a fixed array.
2742 *)
2743 dstT := arg0.type(Ty.Pointer).boundTp;
2744 WITH dstT : Ty.Record DO
2745 out.MkNewRecord(dstT);
2746 | dstT : Ty.Array DO
2747 out.MkNewFixedArray(dstT.elemTp, dstT.length);
2748 END;
2749 ELSIF arg0.type.kind = Ty.ptrTp THEN
2750 FOR numL := 1 TO argN-1 DO
2751 argX := callX.actuals.a[numL];
2752 e.PushValue(argX, Bi.intTp);
2753 END;
2754 dstT := arg0.type(Ty.Pointer).boundTp;
2755 out.MkNewOpenArray(dstT(Ty.Array), argN-1);
2756 ELSE (* must be a vector type *)
2757 dstT := arg0.type(Ty.Vector).elemTp;
2758 out.MkVecRec(dstT);
2759 out.Code(Jvm.opc_dup);
2760 e.PushValue(callX.actuals.a[1], Bi.intTp);
2761 out.MkVecArr(dstT);
2762 END;
2763 e.ScalarAssign(arg0);
2764 (* --------------------------- *)
2765 END;
2766 END EmitStdProc;
2767
2768 (* ============================================================ *)
2769 (* Statement Handling Methods *)
2770 (* ============================================================ *)
2771
2772 PROCEDURE (e : JavaEmitter)EmitAssign(stat : St.Assign),NEW;
2773 VAR lhTyp : Sy.Type;
2774 BEGIN
2775 (*
2776 * This is a value assign in CP.
2777 *)
2778 lhTyp := stat.lhsX.type;
2779 e.PushHandle(stat.lhsX, lhTyp);
2780 e.PushValue(stat.rhsX, lhTyp);
2781 WITH lhTyp : Ty.Vector DO
2782 e.ScalarAssign(stat.lhsX);
2783 | lhTyp : Ty.Array DO
2784 IF stat.rhsX.kind = Xp.mkStr THEN
2785 e.outF.CallRTS(Ju.StrVal, 2, 0);
2786 ELSIF stat.rhsX.type = Bi.strTp THEN
2787 e.outF.CallRTS(Ju.StrToChrs,2, 0);
2788 ELSE
2789 e.outF.ValArrCopy(lhTyp);
2790 END;
2791 | lhTyp : Ty.Record DO
2792 e.outF.ValRecCopy(lhTyp);
2793 ELSE
2794 e.ScalarAssign(stat.lhsX);
2795 END;
2796 END EmitAssign;
2797
2798 (* ---------------------------------------------------- *)
2799
2800 PROCEDURE (e : JavaEmitter)EmitCall(stat : St.ProcCall),NEW;
2801 VAR expr : Xp.CallX; (* the stat call expression *)
2802 BEGIN
2803 expr := stat.expr(Xp.CallX);
2804 IF (expr.kind = Xp.prCall) & expr.kid.isStdProc() THEN
2805 e.EmitStdProc(expr);
2806 ELSE
2807 e.PushCall(expr);
2808 END;
2809 END EmitCall;
2810
2811 (* ---------------------------------------------------- *)
2812
2813 PROCEDURE (e : JavaEmitter)EmitIf(stat : St.Choice; OUT ok : BOOLEAN),NEW;
2814 VAR out : Ju.JavaFile;
2815 high : INTEGER; (* Branch count. *)
2816 exLb : Ju.Label; (* Exit label *)
2817 nxtP : Ju.Label; (* Next predicate *)
2818 indx : INTEGER;
2819 live : BOOLEAN; (* then is live *)
2820 else : BOOLEAN; (* else not seen *)
2821 then : Sy.Stmt;
2822 pred : Sy.Expr;
2823 BEGIN
2824 ok := FALSE;
2825 out := e.outF;
2826 exLb := out.newLabel();
2827 else := FALSE;
2828 high := stat.preds.tide - 1;
2829 FOR indx := 0 TO high DO
2830 live := TRUE;
2831 pred := stat.preds.a[indx];
2832 then := stat.blocks.a[indx];
2833 nxtP := out.newLabel();
2834 IF pred = NIL THEN else := TRUE ELSE e.FallTrue(pred, nxtP) END;
2835 IF then # NIL THEN e.EmitStat(then, live) END;
2836 IF live THEN
2837 ok := TRUE;
2838 IF indx < high THEN out.CodeLb(Jvm.opc_goto, exLb) END;
2839 END;
2840 out.DefLab(nxtP);
2841 END;
2842 (*
2843 * If not ELSE has been seen, then control flow is still live!
2844 *)
2845 IF ~else THEN ok := TRUE END;
2846 out.DefLab(exLb);
2847 END EmitIf;
2848
2849 (* ---------------------------------------------------- *)
2850
2851 PROCEDURE (e : JavaEmitter)EmitRanges
2852 (locV : INTEGER; (* select Var *)
2853 stat : St.CaseSt; (* case stat *)
2854 minR : INTEGER; (* min rng-ix *)
2855 maxR : INTEGER; (* max rng-ix *)
2856 minI : INTEGER; (* min index *)
2857 maxI : INTEGER; (* max index *)
2858 labs : ARRAY OF Ju.Label),NEW;
2859 (* --------------------------------------------------------- *
2860 * This procedure emits the code for a single,
2861 * dense range of selector values in the label-list.
2862 * --------------------------------------------------------- *)
2863 VAR out : Ju.JavaFile;
2864 loIx : INTEGER; (* low selector value for dense range *)
2865 hiIx : INTEGER; (* high selector value for dense range *)
2866 rNum : INTEGER; (* total number of ranges in the group *)
2867 peel : INTEGER; (* max index of range to be peeled off *)
2868 indx : INTEGER;
2869 pos : INTEGER;
2870 rnge : St.Triple;
2871 dfLb : Ju.Label;
2872 lab : Ju.Label;
2873 BEGIN
2874 out := e.outF;
2875 dfLb := labs[0];
2876 rNum := maxR - minR + 1;
2877 rnge := stat.labels.a[minR];
2878 IF rNum = 1 THEN (* single range only *)
2879 lab := labs[rnge.ord+1];
2880 out.EmitOneRange(locV, rnge.loC, rnge.hiC, minI, maxI, dfLb, lab);
2881 ELSIF rNum < 4 THEN
2882 (*
2883 * Two or three ranges only.
2884 * Peel off the lowest of the ranges, and recurse.
2885 *)
2886 loIx := rnge.loC;
2887 peel := rnge.hiC;
2888 out.LoadLocal(locV, Bi.intTp);
2889 (*
2890 * There are a number of special cases
2891 * that can benefit from special code.
2892 *)
2893 IF loIx = peel THEN
2894 (*
2895 * A singleton. Leave minI unchanged, unless peel = minI.
2896 *)
2897 out.PushInt(peel);
2898 out.CodeLb(Jvm.opc_if_icmpeq, labs[rnge.ord + 1]);
2899 IF minI = peel THEN minI := peel+1 END;
2900 INC(minR);
2901 ELSIF loIx = minI THEN
2902 (*
2903 * A range starting at the minimum selector value.
2904 *)
2905 out.PushInt(peel);
2906 out.CodeLb(Jvm.opc_if_icmple, labs[rnge.ord + 1]);
2907 minI := peel+1;
2908 INC(minR);
2909 ELSE
2910 (*
2911 * We must peel the default range from minI to loIx.
2912 *)
2913 out.PushInt(loIx);
2914 out.CodeLb(Jvm.opc_if_icmplt, dfLb);
2915 minI := loIx; (* and minR is unchanged! *)
2916 END;
2917 e.EmitRanges(locV, stat, minR, maxR, minI, maxI, labs);
2918 ELSE
2919 (*
2920 * Four or more ranges. Emit a dispatch table.
2921 *)
2922 loIx := rnge.loC; (* low of min-range *)
2923 hiIx := stat.labels.a[maxR].hiC; (* high of max-range *)
2924 out.LoadLocal(locV, Bi.intTp);
2925 out.CodeSwitch(loIx, hiIx, dfLb);
2926 pos := 0;
2927 FOR indx := minR TO maxR DO
2928 rnge := stat.labels.a[indx];
2929 WHILE loIx < rnge.loC DO
2930 out.AddSwitchLab(labs[0],pos); INC(pos); INC(loIx);
2931 END;
2932 WHILE loIx <= rnge.hiC DO
2933 out.AddSwitchLab(labs[rnge.ord+1],pos); INC(pos); INC(loIx);
2934 END;
2935 END;
2936 out.LstDef(labs[0]);
2937 END;
2938 END EmitRanges;
2939
2940 (* ---------------------------------------------------- *)
2941
2942 PROCEDURE (e : JavaEmitter)EmitGroups
2943 (locV : INTEGER; (* select vOrd *)
2944 stat : St.CaseSt; (* case stat *)
2945 minG : INTEGER; (* min grp-indx *)
2946 maxG : INTEGER; (* max grp-indx *)
2947 minI : INTEGER; (* min index *)
2948 maxI : INTEGER; (* max index *)
2949 labs : ARRAY OF Ju.Label),NEW;
2950 (* --------------------------------------------------------- *
2951 * This function emits the branching code which sits on top
2952 * of the selection code for each dense range of case values.
2953 * --------------------------------------------------------- *)
2954 VAR out : Ju.JavaFile;
2955 newLb : Ju.Label;
2956 midPt : INTEGER;
2957 group : St.Triple;
2958 range : St.Triple;
2959 BEGIN
2960 IF maxG = -1 THEN RETURN; (* Empty case statment *)
2961 ELSIF minG = maxG THEN (* only one remaining dense group *)
2962 group := stat.groups.a[minG];
2963 e.EmitRanges(locV, stat, group.loC, group.hiC, minI, maxI, labs);
2964 ELSE
2965 (*
2966 * We must bifurcate the group range, and recurse.
2967 * We will split the value range at the lower limit
2968 * of the low-range of the upper half-group.
2969 *)
2970 midPt := (minG + maxG + 1) DIV 2;
2971 group := stat.groups.a[midPt];
2972 range := stat.labels.a[group.loC];
2973 (*
2974 * Test and branch at range.loC
2975 *)
2976 out := e.outF;
2977 newLb := out.newLabel();
2978 out.LoadLocal(locV, Bi.intTp);
2979 out.PushInt(range.loC);
2980 out.CodeLb(Jvm.opc_if_icmpge, newLb);
2981 (*
2982 * Recurse!
2983 *)
2984 e.EmitGroups(locV, stat, minG, midPt-1, minI, range.loC-1, labs);
2985 out.DefLab(newLb);
2986 e.EmitGroups(locV, stat, midPt, maxG, range.loC, maxI, labs);
2987 END;
2988 END EmitGroups;
2989
2990 (* ---------------------------------------------------- *)
2991
2992 PROCEDURE (e : JavaEmitter)EmitCase(stat : St.CaseSt; OUT ok : BOOLEAN),NEW;
2993 VAR out : Ju.JavaFile;
2994 indx : INTEGER;
2995 dfLb : Ju.Label;
2996 exLb : Ju.Label;
2997 selV : INTEGER;
2998 live : BOOLEAN;
2999 minI : INTEGER;
3000 maxI : INTEGER;
3001 labs : POINTER TO ARRAY OF Ju.Label;
3002 BEGIN
3003 (* ---------------------------------------------------------- *
3004 * CaseSt* = POINTER TO RECORD (Sy.Stmt)
3005 * (* ----------------------------------------- *
3006 * * kind- : INTEGER; (* tag for unions *)
3007 * * token* : S.Token; (* stmt first tok *)
3008 * * ----------------------------------------- *)
3009 * select* : Sy.Expr; (* case selector *)
3010 * chrSel* : BOOLEAN; (* ==> use chars *)
3011 * blocks* : Sy.StmtSeq; (* case bodies *)
3012 * elsBlk* : Sy.Stmt; (* elseCase | NIL *)
3013 * labels* : TripleSeq; (* label seqence *)
3014 * groups- : TripleSeq; (* dense groups *)
3015 * END;
3016 * --------------------------------------------------------- *
3017 * Notes on the semantics of this structure. "blocks" holds *
3018 * an ordered list of case statement code blocks. "labels" *
3019 * is a list of ranges, intially in textual order,with flds *
3020 * loC, hiC and ord corresponding to the range min, max and *
3021 * the selected block ordinal number. This list is later *
3022 * sorted on the loC value, and adjacent values merged if *
3023 * they select the same block. The "groups" list of triples *
3024 * groups ranges into dense subranges in the selector space *
3025 * The fields loC, hiC, and ord to hold the lower and upper *
3026 * indices into the labels list, and the number of non- *
3027 * default values in the group. Groups are guaranteed to *
3028 * have density (nonDefN / (max-min+1)) > DENSITY *
3029 * --------------------------------------------------------- *)
3030 ok := FALSE;
3031 out := e.outF;
3032 exLb := out.newLabel();
3033 NEW(labs,stat.blocks.tide+1);
3034 out.getLabelRange(labs);
3035 selV := out.newLocal();
3036
3037 IF stat.chrSel THEN
3038 minI := 0; maxI := ORD(MAX(CHAR));
3039 ELSE
3040 minI := MIN(INTEGER);
3041 maxI := MAX(INTEGER);
3042 END;
3043
3044 (*
3045 * Push the selector value, and save in local variable;
3046 *)
3047 e.PushValue(stat.select, stat.select.type);
3048 out.StoreLocal(selV, Bi.intTp);
3049 e.EmitGroups(selV, stat, 0, stat.groups.tide-1, minI, maxI, labs);
3050 (*
3051 * Now we emit the code for the cases.
3052 * If any branch returns, then exLb is reachable.
3053 *)
3054 FOR indx := 0 TO stat.blocks.tide-1 DO
3055 out.DefLab(labs[indx + 1]);
3056 e.EmitStat(stat.blocks.a[indx], live);
3057 IF live THEN
3058 ok := TRUE;
3059 out.CodeLb(Jvm.opc_goto, exLb);
3060 END;
3061 END;
3062 (*
3063 * Now we emit the code for the elespart.
3064 * If the elsepart returns then exLb is reachable.
3065 *)
3066 out.DefLabC(labs[0], "Default case");
3067 IF stat.elsBlk # NIL THEN
3068 e.EmitStat(stat.elsBlk, live);
3069 IF live THEN ok := TRUE END;
3070 ELSE
3071 out.CaseTrap(selV);
3072 END;
3073 out.ReleaseLocal(selV);
3074 IF ok THEN out.DefLabC(exLb, "Case exit label") END;
3075 END EmitCase;
3076
3077 (* ---------------------------------------------------- *)
3078
3079 PROCEDURE (e : JavaEmitter)
3080 EmitWhile(stat : St.TestLoop; OUT ok : BOOLEAN),NEW;
3081 VAR out : Ju.JavaFile;
3082 lpLb : Ju.Label;
3083 exLb : Ju.Label;
3084 BEGIN
3085 out := e.outF;
3086 lpLb := out.newLabel();
3087 exLb := out.newLabel();
3088 e.FallTrue(stat.test, exLb); (* goto exLb if eval false *)
3089 out.DefLabC(lpLb, "Loop header");
3090 e.EmitStat(stat.body, ok);
3091 IF ok THEN e.FallFalse(stat.test, lpLb) END;
3092 out.DefLabC(exLb, "Loop exit");
3093 END EmitWhile;
3094
3095 (* ---------------------------------------------------- *)
3096
3097 PROCEDURE (e : JavaEmitter)
3098 EmitRepeat(stat : St.TestLoop; OUT ok : BOOLEAN),NEW;
3099 VAR out : Ju.JavaFile;
3100 lpLb : Ju.Label;
3101 BEGIN
3102 out := e.outF;
3103 lpLb := out.newLabel();
3104 out.DefLabC(lpLb, "Loop header");
3105 e.EmitStat(stat.body, ok);
3106 IF ok THEN e.FallTrue(stat.test, lpLb) END; (* exit on eval true *)
3107 END EmitRepeat;
3108
3109 (* ---------------------------------------------------- *)
3110
3111 PROCEDURE (e : JavaEmitter)EmitFor(stat : St.ForLoop; OUT ok : BOOLEAN),NEW;
3112 (* ----------------------------------------------------------- *
3113 * This code has been split into the four cases:
3114 * - long control variable, counting up;
3115 * - long control variable, counting down;
3116 * - int control variable, counting up;
3117 * - int control variable, counting down;
3118 * Of course, it is possible to fold all of this, and have
3119 * tests everywhere, but the following is cleaner, and easier
3120 * to enhance in the future.
3121 *
3122 * Note carefully the use of ForLoop::isSimple(). It is
3123 * essential to use exactly the same function here as is
3124 * used by ForLoop::flowAttr() for initialization analysis.
3125 * If this were not the case, the verifier could barf.
3126 * ----------------------------------------------------------- *)
3127 PROCEDURE SetVar(cv : Id.AbVar; ln : BOOLEAN; ou : Ju.JavaFile);
3128 BEGIN
3129 WITH cv : Id.LocId DO (* check if implemented inside XHR *)
3130 IF Id.uplevA IN cv.locAtt THEN
3131 ou.XhrHandle(cv);
3132 IF ~ln THEN
3133 ou.Code(Jvm.opc_swap);
3134 ELSE
3135 ou.Code(Jvm.opc_dup_x2);
3136 ou.Code(Jvm.opc_pop);
3137 END;
3138 END;
3139 ELSE (* skip *)
3140 END;
3141 ou.PutVar(cv);
3142 END SetVar;
3143 (* ----------------------------------------------------------- *)
3144 PROCEDURE LongForUp(e: JavaEmitter; stat: St.ForLoop; OUT ok: BOOLEAN);
3145 VAR out : Ju.JavaFile;
3146 cVar : Id.AbVar;
3147 top1 : INTEGER;
3148 top2 : INTEGER;
3149 exLb : Ju.Label;
3150 lpLb : Ju.Label;
3151 step : LONGINT;
3152 smpl : BOOLEAN;
3153 BEGIN
3154 out := e.outF;
3155 lpLb := out.newLabel();
3156 exLb := out.newLabel();
3157 cVar := stat.cVar(Id.AbVar);
3158 step := longValue(stat.byXp);
3159 smpl := stat.isSimple();
3160 IF smpl THEN
3161 out.PushLong(longValue(stat.loXp));
3162 SetVar(cVar, TRUE, out);
3163 top1 := -1; (* keep the verifier happy! *)
3164 top2 := -1; (* keep the verifier happy! *)
3165 ELSE
3166 top1 := out.newLocal(); (* actually a pair of locals *)
3167 top2 := out.newLocal();
3168 e.PushValue(stat.hiXp, Bi.lIntTp);
3169 out.Code(Jvm.opc_dup2);
3170 out.StoreLocal(top1, Bi.lIntTp);
3171 e.PushValue(stat.loXp, Bi.lIntTp);
3172 out.Code(Jvm.opc_dup2);
3173 SetVar(cVar, TRUE, out);
3174 (*
3175 * The top test is NEVER inside the loop.
3176 *)
3177 e.DoCmp(Xp.lessT, exLb, Bi.lIntTp);
3178 END;
3179 out.DefLabC(lpLb, "Loop header");
3180 (*
3181 * Emit the code body.
3182 * Stack contents are (top) hi, ...
3183 * and exactly the same on the backedge.
3184 *)
3185 e.EmitStat(stat.body, ok);
3186 (*
3187 * If the body returns ... do an exit test.
3188 *)
3189 IF ok THEN
3190 IF smpl THEN
3191 out.PushLong(longValue(stat.hiXp));
3192 ELSE
3193 out.LoadLocal(top1, Bi.lIntTp);
3194 END;
3195 out.GetVar(cVar); (* (top) cv,hi *)
3196 out.PushLong(step);
3197 out.Code(Jvm.opc_ladd); (* (top) cv',hi *)
3198 out.Code(Jvm.opc_dup2); (* (top) cv',cv',hi *)
3199 SetVar(cVar, TRUE, out);
3200 e.DoCmp(Xp.greEq, lpLb, Bi.lIntTp);
3201 END;
3202 (*
3203 * The exit label.
3204 *)
3205 out.DefLabC(exLb, "Loop trailer");
3206 END LongForUp;
3207
3208 (* ----------------------------------------- *)
3209
3210 PROCEDURE LongForDn(e: JavaEmitter; stat: St.ForLoop; OUT ok: BOOLEAN);
3211 VAR out : Ju.JavaFile;
3212 cVar : Id.AbVar;
3213 top1 : INTEGER;
3214 top2 : INTEGER;
3215 exLb : Ju.Label;
3216 lpLb : Ju.Label;
3217 step : LONGINT;
3218 smpl : BOOLEAN;
3219 BEGIN
3220 out := e.outF;
3221 lpLb := out.newLabel();
3222 exLb := out.newLabel();
3223 cVar := stat.cVar(Id.AbVar);
3224 step := longValue(stat.byXp);
3225 smpl := stat.isSimple();
3226 IF smpl THEN
3227 out.PushLong(longValue(stat.loXp));
3228 SetVar(cVar, TRUE, out);
3229 top1 := -1; (* keep the verifier happy! *)
3230 top2 := -1; (* keep the verifier happy! *)
3231 ELSE
3232 top1 := out.newLocal(); (* actually a pair of locals *)
3233 top2 := out.newLocal();
3234 e.PushValue(stat.hiXp, Bi.lIntTp);
3235 out.Code(Jvm.opc_dup2);
3236 out.StoreLocal(top1, Bi.lIntTp);
3237 e.PushValue(stat.loXp, Bi.lIntTp);
3238 out.Code(Jvm.opc_dup2);
3239 SetVar(cVar, TRUE, out);
3240 (*
3241 * The top test is NEVER inside the loop.
3242 *)
3243 e.DoCmp(Xp.greT, exLb, Bi.lIntTp);
3244 END;
3245 out.DefLabC(lpLb, "Loop header");
3246 (*
3247 * Emit the code body.
3248 * Stack contents are (top) hi, ...
3249 * and exactly the same on the backedge.
3250 *)
3251 e.EmitStat(stat.body, ok);
3252 (*
3253 * If the body returns ... do an exit test.
3254 *)
3255 IF ok THEN
3256 IF smpl THEN
3257 out.PushLong(longValue(stat.hiXp));
3258 ELSE
3259 out.LoadLocal(top1, Bi.lIntTp);
3260 END;
3261 out.GetVar(cVar); (* (top) cv,hi *)
3262 out.PushLong(step);
3263 out.Code(Jvm.opc_ladd); (* (top) cv',hi *)
3264 out.Code(Jvm.opc_dup2); (* (top) cv',cv',hi *)
3265 SetVar(cVar, TRUE, out);
3266 e.DoCmp(Xp.lessEq, lpLb, Bi.lIntTp);
3267 END;
3268 (*
3269 * The exit label.
3270 *)
3271 out.DefLabC(exLb, "Loop trailer");
3272 END LongForDn;
3273
3274 (* ----------------------------------------- *)
3275
3276 PROCEDURE IntForUp(e: JavaEmitter; stat: St.ForLoop; OUT ok: BOOLEAN);
3277 VAR out : Ju.JavaFile;
3278 cVar : Id.AbVar;
3279 topV : INTEGER;
3280 exLb : Ju.Label;
3281 lpLb : Ju.Label;
3282 step : INTEGER;
3283 smpl : BOOLEAN;
3284 BEGIN
3285 (*
3286 * This is the common case, so we work a bit harder.
3287 *)
3288 out := e.outF;
3289 lpLb := out.newLabel();
3290 exLb := out.newLabel();
3291 cVar := stat.cVar(Id.AbVar);
3292 step := intValue(stat.byXp);
3293 smpl := stat.isSimple();
3294 IF smpl THEN
3295 out.PushInt(intValue(stat.loXp));
3296 SetVar(cVar, FALSE, out);
3297 topV := -1; (* keep the verifier happy! *)
3298 ELSE
3299 topV := out.newLocal();
3300 e.PushValue(stat.hiXp, Bi.intTp);
3301 out.Code(Jvm.opc_dup);
3302 out.StoreLocal(topV, Bi.intTp);
3303 e.PushValue(stat.loXp, Bi.intTp);
3304 out.Code(Jvm.opc_dup);
3305 SetVar(cVar, FALSE, out);
3306 (*
3307 * The top test is NEVER inside the loop.
3308 *)
3309 e.DoCmp(Xp.lessT, exLb, Bi.intTp);
3310 END;
3311 out.DefLabC(lpLb, "Loop header");
3312 (*
3313 * Emit the code body.
3314 *)
3315 e.EmitStat(stat.body, ok);
3316 (*
3317 * If the body returns ... do an exit test.
3318 *)
3319 IF ok THEN
3320 IF smpl THEN
3321 out.PushInt(intValue(stat.hiXp));
3322 ELSE
3323 out.LoadLocal(topV, Bi.intTp);
3324 END;
3325 out.GetVar(cVar); (* (top) cv,hi *)
3326 out.PushInt(step);
3327 out.Code(Jvm.opc_iadd); (* (top) cv',hi *)
3328 out.Code(Jvm.opc_dup); (* (top) cv',cv',hi *)
3329 SetVar(cVar, FALSE, out);
3330 e.DoCmp(Xp.greEq, lpLb, Bi.intTp);
3331 END;
3332 (*
3333 * The exit label.
3334 *)
3335 out.DefLabC(exLb, "Loop trailer");
3336 END IntForUp;
3337
3338 (* ----------------------------------------- *)
3339
3340 PROCEDURE IntForDn(e: JavaEmitter; stat: St.ForLoop; OUT ok: BOOLEAN);
3341 VAR out : Ju.JavaFile;
3342 cVar : Id.AbVar;
3343 topV : INTEGER;
3344 exLb : Ju.Label;
3345 lpLb : Ju.Label;
3346 step : INTEGER;
3347 smpl : BOOLEAN;
3348 BEGIN
3349 out := e.outF;
3350 lpLb := out.newLabel();
3351 exLb := out.newLabel();
3352 cVar := stat.cVar(Id.AbVar);
3353 step := intValue(stat.byXp);
3354 topV := out.newLocal();
3355 smpl := stat.isSimple();
3356 IF smpl THEN
3357 out.PushInt(intValue(stat.loXp));
3358 SetVar(cVar, FALSE, out);
3359 topV := -1; (* keep the verifier happy! *)
3360 ELSE
3361 e.PushValue(stat.hiXp, Bi.intTp);
3362 out.Code(Jvm.opc_dup);
3363 out.StoreLocal(topV, Bi.intTp);
3364 e.PushValue(stat.loXp, Bi.intTp);
3365 out.Code(Jvm.opc_dup);
3366 SetVar(cVar, FALSE, out);
3367 (*
3368 * The top test is NEVER inside the loop.
3369 *)
3370 e.DoCmp(Xp.greT, exLb, Bi.intTp);
3371 END;
3372 out.DefLabC(lpLb, "Loop header");
3373 (*
3374 * Emit the code body.
3375 *)
3376 e.EmitStat(stat.body, ok);
3377 (*
3378 * If the body returns ... do an exit test.
3379 *)
3380 IF ok THEN
3381 IF smpl THEN
3382 out.PushInt(intValue(stat.hiXp));
3383 ELSE
3384 out.LoadLocal(topV, Bi.intTp);
3385 END;
3386 out.GetVar(cVar); (* (top) cv,hi *)
3387 out.PushInt(step);
3388 out.Code(Jvm.opc_iadd); (* (top) cv',hi *)
3389 out.Code(Jvm.opc_dup); (* (top) cv',cv',hi *)
3390 SetVar(cVar, FALSE, out);
3391 e.DoCmp(Xp.lessEq, lpLb, Bi.intTp);
3392 END;
3393 (*
3394 * The exit label.
3395 *)
3396 out.DefLabC(exLb, "Loop trailer");
3397 END IntForDn;
3398
3399 (* ----------------------------------------- *)
3400 BEGIN (* body of EmitFor *)
3401 IF stat.cVar.type.isLongType() THEN
3402 IF longValue(stat.byXp) > 0 THEN LongForUp(e, stat, ok);
3403 ELSE LongForDn(e, stat, ok);
3404 END;
3405 ELSE
3406 IF longValue(stat.byXp) > 0 THEN IntForUp(e, stat, ok);
3407 ELSE IntForDn(e, stat, ok);
3408 END;
3409 END;
3410 END EmitFor;
3411
3412 (* ---------------------------------------------------- *)
3413
3414 PROCEDURE (e : JavaEmitter)
3415 EmitLoop(stat : St.TestLoop; OUT ok : BOOLEAN),NEW;
3416 VAR out : Ju.JavaFile;
3417 lpLb : Ju.Label;
3418 tmpLb : Ju.Label;
3419 BEGIN
3420 out := e.outF;
3421 lpLb := out.newLabel();
3422 tmpLb := currentLoopLabel;
3423 currentLoopLabel := out.newLabel();
3424 out.DefLabC(lpLb, "Loop header");
3425 e.EmitStat(stat.body, ok);
3426 IF ok THEN out.CodeLb(Jvm.opc_goto, lpLb) END;
3427 out.DefLabC(currentLoopLabel, "Loop exit");
3428 currentLoopLabel := tmpLb;
3429 END EmitLoop;
3430
3431 (* ---------------------------------------------------- *)
3432
3433 PROCEDURE (e : JavaEmitter)EmitWith(stat : St.Choice; OUT ok : BOOLEAN),NEW;
3434 VAR out : Ju.JavaFile;
3435 high : INTEGER; (* Branch count. *)
3436 exLb : Ju.Label; (* Exit label *)
3437 nxtP : Ju.Label; (* Next predicate *)
3438 indx : INTEGER;
3439 live : BOOLEAN;
3440 then : Sy.Stmt;
3441 pred : Sy.Expr;
3442 tVar : Id.LocId;
3443 (* --------------------------- *)
3444 PROCEDURE WithTest(je : JavaEmitter;
3445 os : Ju.JavaFile;
3446 pr : Sy.Expr;
3447 nx : Ju.Label;
3448 tm : INTEGER);
3449 VAR bX : Xp.BinaryX;
3450 ty : Sy.Type;
3451 BEGIN
3452 bX := pr(Xp.BinaryX);
3453 ty := bX.rKid(Xp.IdLeaf).ident.type;
3454 je.PushValue(bX.lKid, bX.lKid.type);
3455 os.CodeT(Jvm.opc_instanceof, ty);
3456 os.CodeLb(Jvm.opc_ifeq, nx);
3457 (*
3458 * We must also generate a checkcast, because the verifier
3459 * seems to understand the typeflow consequences of the
3460 * checkcast bytecode, but not instanceof.
3461 *)
3462 je.PushValue(bX.lKid, bX.lKid.type);
3463 os.CodeT(Jvm.opc_checkcast, ty);
3464 os.StoreLocal(tm, ty);
3465 END WithTest;
3466 (* --------------------------- *)
3467 BEGIN
3468 tVar := NIL;
3469 pred := NIL;
3470 ok := FALSE;
3471 out := e.outF;
3472 exLb := out.newLabel();
3473 high := stat.preds.tide - 1;
3474 FOR indx := 0 TO high DO
3475 live := TRUE;
3476 pred := stat.preds.a[indx];
3477 then := stat.blocks.a[indx];
3478 tVar := stat.temps.a[indx](Id.LocId);
3479 nxtP := out.newLabel();
3480 IF pred # NIL THEN
3481 tVar.varOrd := out.newLocal();
3482 WithTest(e, out, pred, nxtP, tVar.varOrd);
3483 END;
3484 IF then # NIL THEN e.EmitStat(then, live) END;
3485 IF live THEN
3486 ok := TRUE;
3487 (*
3488 * If this is not the else case, skip over the
3489 * later cases, or jump over the WITH ELSE trap.
3490 *)
3491 IF pred # NIL THEN out.CodeLb(Jvm.opc_goto, exLb) END;
3492 END;
3493 IF tVar # NIL THEN out.ReleaseLocal(tVar.varOrd) END;
3494 out.DefLab(nxtP);
3495 END;
3496 IF pred # NIL THEN out.WithTrap(pred(Xp.BinaryX).lKid(Xp.IdLeaf).ident) END;
3497 out.DefLab(exLb);
3498 END EmitWith;
3499
3500 (* ---------------------------------------------------- *)
3501
3502 PROCEDURE (e : JavaEmitter)EmitExit(stat : St.ExitSt),NEW;
3503 BEGIN
3504 e.outF.CodeLb(Jvm.opc_goto, currentLoopLabel);
3505 END EmitExit;
3506
3507 (* ---------------------------------------------------- *)
3508
3509 PROCEDURE (e : JavaEmitter)EmitReturn(stat : St.Return),NEW;
3510 VAR out : Ju.JavaFile;
3511 pId : Id.Procs;
3512 ret : Sy.Type;
3513 BEGIN
3514 out := e.outF;
3515 pId := out.getScope()(Id.Procs);
3516 (*
3517 * Because the return slot may be used for the first
3518 * OUT or VAR parameter, the real return type might
3519 * be different to that shown in the formal type.
3520 * FixOutPars() returns this real return type.
3521 *)
3522 IF (stat.retX # NIL) &
3523 (pId.kind # Id.ctorP) THEN e.PushValue(stat.retX, stat.retX.type) END;
3524 out.FixOutPars(pId, ret);
3525 out.Return(ret);
3526 END EmitReturn;
3527
3528 (* ---------------------------------------------------- *)
3529
3530 PROCEDURE (e : JavaEmitter)EmitBlock(stat : St.Block; OUT ok : BOOLEAN),NEW;
3531 VAR index, limit : INTEGER;
3532 BEGIN
3533 ok := TRUE;
3534 index := 0;
3535 limit := stat.sequ.tide;
3536 WHILE ok & (index < limit) DO
3537 e.EmitStat(stat.sequ.a[index], ok);
3538 INC(index);
3539 END;
3540 END EmitBlock;
3541
3542 (* ---------------------------------------------------- *)
3543 (* ---------------------------------------------------- *)
3544
3545 PROCEDURE (e : JavaEmitter)EmitStat(stat : Sy.Stmt; OUT ok : BOOLEAN),NEW;
3546 VAR depth : INTEGER;
3547 BEGIN
3548 IF (stat = NIL) OR (stat.kind = St.emptyS) THEN ok := TRUE; RETURN END;
3549 IF stat.kind # St.blockS THEN
3550 e.outF.Line(stat.token.lin);
3551 END;
3552 depth := e.outF.getDepth();
3553 CASE stat.kind OF
3554 | St.assignS : e.EmitAssign(stat(St.Assign)); ok := TRUE;
3555 | St.procCall : e.EmitCall(stat(St.ProcCall)); ok := TRUE;
3556 | St.ifStat : e.EmitIf(stat(St.Choice), ok);
3557 | St.caseS : e.EmitCase(stat(St.CaseSt), ok);
3558 | St.whileS : e.EmitWhile(stat(St.TestLoop), ok);
3559 | St.repeatS : e.EmitRepeat(stat(St.TestLoop), ok);
3560 | St.forStat : e.EmitFor(stat(St.ForLoop), ok);
3561 | St.loopS : e.EmitLoop(stat(St.TestLoop), ok);
3562 | St.withS : e.EmitWith(stat(St.Choice), ok);
3563 | St.exitS : e.EmitExit(stat(St.ExitSt)); ok := TRUE;
3564 | St.returnS : e.EmitReturn(stat(St.Return)); ok := FALSE;
3565 | St.blockS : e.EmitBlock(stat(St.Block), ok);
3566 END;
3567 e.outF.setDepth(depth);
3568 END EmitStat;
3569
3570
3571 (* ============================================================ *)
3572 (* ============================================================ *)
3573 END JavaMaker.
3574 (* ============================================================ *)
3575 (* ============================================================ *)
[FORK] Old GPCP with patches
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024