1 /*
2 * Copyright © 1988-2004 Keith Packard and Bart Massey.
3 * All Rights Reserved. See the file COPYING in this directory
4 * for licensing information.
5 */
6
7 #include "nickle.h"
8 #include "gram.h"
9
10 #undef DEBUG
11
12 SymbolPtr CompileNamespace (ExprPtr);
13
14 static void
ObjMark(void * object)15 ObjMark (void *object)
16 {
17 ObjPtr obj = object;
18 InstPtr inst;
19 int i;
20
21 MemReference (obj->nonLocal);
22 inst = ObjCode (obj, 0);
23 for (i = 0; i < obj->used; i++, inst++)
24 {
25 switch (inst->base.opCode) {
26 case OpGlobal:
27 case OpGlobalRef:
28 case OpGlobalRefStore:
29 case OpTagGlobal:
30 MemReference (inst->box.box);
31 break;
32 case OpBuildStruct:
33 MemReference (inst->structs.structs);
34 break;
35 case OpBuildArrayInd:
36 case OpBuildArray:
37 MemReference (inst->array.type);
38 break;
39 case OpBuildHash:
40 MemReference (inst->hash.type);
41 break;
42 case OpConst:
43 MemReference (inst->constant.constant);
44 break;
45 case OpObj:
46 MemReference (inst->code.code);
47 break;
48 case OpFork:
49 MemReference (inst->obj.obj);
50 break;
51 case OpCatch:
52 MemReference (inst->catch.exception);
53 break;
54 case OpRaise:
55 MemReference (inst->raise.exception);
56 break;
57 case OpFarJump:
58 MemReference (inst->farJump.farJump);
59 break;
60 default:
61 break;
62 }
63 }
64 if (!profiling)
65 obj->ticks = obj->sub_ticks = 0;
66 for (i = 0; i < obj->used_stat; i++)
67 MemReference (ObjStat (obj, i)->stat);
68 }
69
70 DataType ObjType = { ObjMark, 0, "ObjType" };
71
72 static ObjPtr
NewObj(int size,int size_stat)73 NewObj (int size, int size_stat)
74 {
75 ENTER ();
76 ObjPtr obj;
77
78 obj = ALLOCATE (&ObjType,
79 sizeof (Obj) +
80 size * sizeof (Inst) +
81 size_stat * sizeof (Stat));
82 obj->size = size;
83 obj->used = 0;
84 obj->size_stat = size_stat;
85 obj->used_stat = 0;
86 obj->error = False;
87 obj->nonLocal = 0;
88 obj->ticks = 0;
89 obj->sub_ticks = 0;
90 RETURN (obj);
91 }
92
93 #define OBJ_INCR 32
94 #define OBJ_STAT_INCR 16
95
96 static ObjPtr
AddInst(ObjPtr obj,ExprPtr stat)97 AddInst (ObjPtr obj, ExprPtr stat)
98 {
99 ENTER ();
100 ObjPtr nobj;
101 int need_stat = 1;
102
103 if (obj->used_stat && ObjStat(obj, obj->used_stat - 1)->stat == stat)
104 need_stat = 0;
105 if (obj->used == obj->size || obj->used_stat + need_stat > obj->size_stat)
106 {
107 int nsize = obj->size, nsize_stat = obj->size_stat;
108 if (obj->used == obj->size)
109 nsize = obj->size + OBJ_INCR;
110 if (obj->used_stat + need_stat > obj->size_stat)
111 nsize_stat = obj->size_stat + OBJ_STAT_INCR;
112 nobj = NewObj (nsize, nsize_stat);
113 memcpy (ObjCode (nobj, 0), ObjCode (obj, 0), obj->used * sizeof (Inst));
114 memcpy (ObjStat (nobj, 0), ObjStat (obj, 0), obj->used_stat * sizeof (Stat));
115 nobj->used = obj->used;
116 nobj->used_stat = obj->used_stat;
117 nobj->error = obj->error;
118 nobj->nonLocal = obj->nonLocal;
119 obj = nobj;
120 }
121 if (need_stat)
122 {
123 StatPtr s = ObjStat (obj, obj->used_stat);
124 s->inst = obj->used;
125 s->stat = stat;
126 obj->used_stat++;
127 }
128 obj->used++;
129 RETURN (obj);
130 }
131
132 static ObjPtr
AppendObj(ObjPtr first,ObjPtr last)133 AppendObj (ObjPtr first, ObjPtr last)
134 {
135 int i;
136 InstPtr firsti, lasti;
137
138 for (i = 0; i < last->used; i++)
139 {
140 lasti = ObjCode (last, i);
141 first = AddInst (first, ObjStatement (last, lasti));
142 firsti = ObjCode (first, ObjLast (first));
143 *firsti = *lasti;
144 }
145 if (last->error)
146 first->error = True;
147 return first;
148 }
149
150 ExprPtr
ObjStatement(ObjPtr obj,InstPtr inst)151 ObjStatement (ObjPtr obj, InstPtr inst)
152 {
153 int i = inst - ObjCode(obj, 0);
154 int low = 0, high = obj->used_stat - 1;
155
156 while (low < high - 1)
157 {
158 int mid = (low + high) >> 1;
159 if (ObjStat(obj,mid)->inst <= i)
160 low = mid;
161 else
162 high = mid - 1;
163 }
164 while (low <= high)
165 {
166 StatPtr s = ObjStat(obj, high);
167 if (s->inst <= i)
168 return s->stat;
169 high--;
170 }
171 return 0;
172 }
173
174 static void
ResetInst(ObjPtr obj,int i)175 ResetInst (ObjPtr obj, int i)
176 {
177 obj->used = i;
178 while (obj->used_stat && ObjStat(obj, obj->used_stat - 1)->inst > i)
179 obj->used_stat--;
180 }
181
182 /*
183 * Set branch offsets to zero so that CompileIsReachable can
184 * use them before the real values get filled in. This is correct
185 * because the reachability targets are always in nested blocks which
186 * can never be the target for this instruction
187 */
188 #define NewInst(_o,_op,_i,_stat) \
189 {\
190 InstPtr __inst__; \
191 (_o) = AddInst(_o, _stat); \
192 (_i) = ObjLast(_o); \
193 __inst__ = ObjCode (_o, _i); \
194 __inst__->base.opCode = (_op); \
195 __inst__->base.flags = 0; \
196 __inst__->branch.offset = 0; \
197 }
198
199 #define BuildInst(_o,_op,_inst,_stat) \
200 {\
201 (_o) = AddInst (_o, _stat); \
202 (_inst) = ObjCode(_o, ObjLast(_o)); \
203 (_inst)->base.opCode = (_op); \
204 (_inst)->base.flags = 0; \
205 (_inst)->branch.offset = 0; \
206 }
207
208 #define SetFlag(_o,_f) ((_o)->used ? (ObjCode((_o), \
209 ObjLast(_o))->base.flags |= (_f)) \
210 : 0)
211 #define SetPush(_o) SetFlag(_o,InstPush)
212 #define SetAInit(_o) SetFlag(_o,InstAInit)
213
214
215 /*
216 * Select the correct code body depending on whether
217 * we're compiling a static initializer
218 */
219 #define CodeBody(c) ((c)->func.inStaticInit ? &(c)->func.staticInit : &(c)->func.body)
220
221 typedef enum _tail { TailNever, TailVoid, TailAlways } Tail;
222
223 ObjPtr CompileLvalue (ObjPtr obj, ExprPtr expr, ExprPtr stat, CodePtr code, Bool createIfNecessary, Bool assign, Bool initialize, Bool amper, Bool auto_reference);
224 ObjPtr CompileBinOp (ObjPtr obj, ExprPtr expr, BinaryOp op, ExprPtr stat, CodePtr code);
225 ObjPtr CompileBinFunc (ObjPtr obj, ExprPtr expr, BinaryFunc func, ExprPtr stat, CodePtr code, char *name);
226 ObjPtr CompileUnOp (ObjPtr obj, ExprPtr expr, UnaryOp op, ExprPtr stat, CodePtr code);
227 ObjPtr CompileUnFunc (ObjPtr obj, ExprPtr expr, UnaryFunc func, ExprPtr stat, CodePtr code, char *name);
228 ObjPtr CompileAssign (ObjPtr obj, ExprPtr expr, Bool initialize, ExprPtr stat, CodePtr code);
229 ObjPtr CompileAssignOp (ObjPtr obj, ExprPtr expr, BinaryOp op, ExprPtr stat, CodePtr code);
230 ObjPtr CompileAssignFunc (ObjPtr obj, ExprPtr expr, BinaryFunc func, ExprPtr stat, CodePtr code, char *name);
231 ObjPtr CompileArrayIndex (ObjPtr obj, ExprPtr expr, TypePtr indexType, ExprPtr stat, CodePtr code, int *ndimp);
232 ObjPtr CompileCall (ObjPtr obj, ExprPtr expr, Tail tail, ExprPtr stat, CodePtr code, Bool auto_reference);
233 ObjPtr _CompileExpr (ObjPtr obj, ExprPtr expr, Bool evaluate, ExprPtr stat, CodePtr code);
234 ObjPtr _CompileBoolExpr (ObjPtr obj, ExprPtr expr, Bool evaluate, ExprPtr stat, CodePtr code);
235 void CompilePatchLoop (ObjPtr obj, int start,
236 int continue_offset,
237 int break_offset,
238 int catch_offset);
239 ObjPtr _CompileStat (ObjPtr obj, ExprPtr expr, Bool last, CodePtr code);
240 ObjPtr CompileFunc (ObjPtr obj, CodePtr code, ExprPtr stat, CodePtr previous, NonLocalPtr nonLocal);
241 ObjPtr CompileDecl (ObjPtr obj, ExprPtr decls, Bool evaluate, ExprPtr stat, CodePtr code);
242 ObjPtr CompileFuncCode (CodePtr code,
243 ExprPtr stat,
244 CodePtr previous,
245 NonLocalPtr nonLocal);
246 void CompileError (ObjPtr obj, ExprPtr stat, char *s, ...);
247 static Bool CompileIsReachable (ObjPtr obj, int i, int frame);
248 static ObjPtr
249 CompileArrayDimValue (ObjPtr obj, TypePtr type, Bool lvalue, ExprPtr stat, CodePtr code);
250 static ObjPtr
251 CompileType (ObjPtr obj, ExprPtr decls, TypePtr type, ExprPtr stat, CodePtr code);
252
253 /*
254 * Set storage information for new symbols
255 */
256 static void
CompileStorage(ObjPtr obj,ExprPtr stat,SymbolPtr symbol,CodePtr code)257 CompileStorage (ObjPtr obj, ExprPtr stat, SymbolPtr symbol, CodePtr code)
258 {
259 ENTER ();
260
261 if (!symbol)
262 obj->error = True;
263 /*
264 * For symbols hanging from a frame (statics, locals and args),
265 * locate the frame and set their element value
266 */
267 else if (ClassFrame(symbol->symbol.class))
268 {
269 switch (symbol->symbol.class) {
270 case class_static:
271 symbol->local.element = AddBoxType (&code->func.statics,
272 symbol->symbol.type);
273 symbol->local.staticScope = True;
274 symbol->local.code = code;
275 break;
276 case class_arg:
277 case class_auto:
278 symbol->local.element = AddBoxType (&CodeBody (code)->dynamics,
279 symbol->symbol.type);
280 symbol->local.staticScope = code->func.inStaticInit;
281 symbol->local.code = code;
282 break;
283 default:
284 break;
285 }
286 }
287 EXIT ();
288 }
289
290 /*
291 * Set storage information for array dimensions
292 */
293 static void
CompileDimensionStorage(ObjPtr obj,Class class,TypePtr type,CodePtr code)294 CompileDimensionStorage (ObjPtr obj, Class class, TypePtr type, CodePtr code)
295 {
296 ENTER ();
297 if (class == class_typedef)
298 class = code ? class_auto : class_global;
299
300 switch (class) {
301 case class_global:
302 case class_const:
303 type->array.storage = DimStorageGlobal;
304 type->array.u.global = NewBox (True, False, 1, typeArrayInt);
305 break;
306 case class_static:
307 type->array.storage = DimStorageStatic;
308 type->array.u.frame.element = AddBoxType (&code->func.statics,
309 typeArrayInt);
310 type->array.u.frame.staticScope = True;
311 type->array.u.frame.code = code;
312 break;
313 case class_arg:
314 case class_auto:
315 type->array.storage = DimStorageAuto;
316 type->array.u.frame.element = AddBoxType (&CodeBody (code)->dynamics,
317 typeArrayInt);
318 type->array.u.frame.staticScope = code->func.inStaticInit;
319 type->array.u.frame.code = code;
320 break;
321 default:
322 break;
323 }
324 EXIT ();
325 }
326
327 /*
328 * Make sure a symbol is valid
329 */
330 static SymbolPtr
CompileCheckSymbol(ObjPtr obj,ExprPtr stat,ExprPtr name,CodePtr code,int * depth,Bool createIfNecessary)331 CompileCheckSymbol (ObjPtr obj, ExprPtr stat, ExprPtr name, CodePtr code,
332 int *depth, Bool createIfNecessary)
333 {
334 ENTER ();
335 SymbolPtr s;
336 int d;
337 CodePtr c;
338
339 s = name->atom.symbol;
340 if (!s)
341 {
342 if (name->atom.atom == AtomId ("[]"))
343 CompileError (obj, stat, "Using [] outside of comprehension scope");
344 else
345 CompileError (obj, stat, "No visible symbol \"%A\" in scope%s",
346 name->atom.atom,
347 name->atom.privateFound ? " (found non-public symbol)" : "");
348 RETURN (0);
349 }
350 /*
351 * For args and autos, make sure we're not compiling a static
352 * initializer, in that case, the locals will not be in dynamic
353 * namespace
354 */
355 d = 0;
356 switch (s->symbol.class) {
357 case class_static:
358 case class_arg:
359 case class_auto:
360 /*
361 * See if the name is above a global init scope
362 */
363 for (c = code; c; c = c->base.previous)
364 if (c->func.inGlobalInit)
365 break;
366 for (; c; c = c->base.previous)
367 if (c == s->local.code)
368 break;
369 if (c)
370 {
371 CompileError (obj, stat, "\"%A\" not in global initializer scope",
372 name->atom.atom);
373 break;
374 }
375
376 c = s->local.code;
377 if (!c)
378 {
379 CompileError (obj, stat, "Class %C invalid at global scope",
380 s->symbol.class);
381 break;
382 }
383 /*
384 * Ensure the dynamic scope will exist
385 */
386 if (c->func.inStaticInit && !s->local.staticScope)
387 {
388 CompileError (obj, stat, "\"%A\" not in static initializer scope",
389 name->atom.atom);
390 break;
391 }
392
393 /*
394 * Compute the static link offset
395 */
396 d = 0;
397 for (c = code; c && c != s->local.code; c = c->base.previous)
398 d++;
399 break;
400 default:
401 break;
402 }
403 *depth = d;
404 RETURN (s);
405 }
406
407 void
CompileError(ObjPtr obj,ExprPtr stat,char * s,...)408 CompileError (ObjPtr obj, ExprPtr stat, char *s, ...)
409 {
410 va_list args;
411
412 FilePrintf (FileStderr, "-> ");
413 PrettyStat (FileStderr, stat, False);
414 if (stat->base.file)
415 FilePrintf (FileStderr, "%A:%d: ", stat->base.file, stat->base.line);
416 va_start (args, s);
417 FileVPrintf (FileStderr, s, args);
418 va_end (args);
419 FilePrintf (FileStderr, "\n");
420 obj->error = True;
421 }
422
423 static TypePtr
CompileRefType(ObjPtr obj,ExprPtr expr,TypePtr t)424 CompileRefType (ObjPtr obj, ExprPtr expr, TypePtr t)
425 {
426 t = TypeCanon (t);
427 if (!t) {
428 CompileError(obj, expr, "reference to incomplete type");
429 return 0;
430 }
431
432 if (t->base.tag == type_ref && !t->ref.pointer)
433 return t->ref.ref;
434 return 0;
435 }
436
437 static TypePtr
CompileIndexType(ExprPtr expr)438 CompileIndexType (ExprPtr expr)
439 {
440 TypePtr type = expr->base.type, indexType = typePoly;
441
442 if (type)
443 {
444 switch (type->base.tag) {
445 case type_array:
446 indexType = typePrim[rep_integer];
447 break;
448 case type_hash:
449 indexType = type->hash.keyType;
450 break;
451 default:
452 break;
453 }
454 }
455 return indexType;
456 }
457
458 /*
459 * Compile the left side of an assignment statement.
460 * The result is a 'ref' left in the value register
461 * The type is the type of the refered value, not a reference
462 * to that type.
463 */
464 ObjPtr
CompileLvalue(ObjPtr obj,ExprPtr expr,ExprPtr stat,CodePtr code,Bool createIfNecessary,Bool assign,Bool initialize,Bool amper,Bool auto_reference)465 CompileLvalue (ObjPtr obj, ExprPtr expr, ExprPtr stat, CodePtr code,
466 Bool createIfNecessary, Bool assign, Bool initialize,
467 Bool amper, Bool auto_reference)
468 {
469 ENTER ();
470 InstPtr inst = 0;
471 SymbolPtr s;
472 int depth;
473 int ndim;
474 TypePtr t;
475 Bool flipTypes = False;
476
477 switch (expr->base.tag) {
478 case VAR:
479 obj = CompileDecl (obj, expr, False, stat, code);
480 {
481 DeclListPtr decl;
482 s = 0;
483 for (decl = expr->decl.decl; decl; decl = decl->next)
484 s = decl->symbol;
485 }
486 /* the symbol was compiled in this frame */
487 depth = 0;
488 goto isName;
489 case NAME:
490 s = CompileCheckSymbol (obj, stat, expr, code,
491 &depth, createIfNecessary);
492 isName:
493 if (!s)
494 {
495 expr->base.type = typePoly;
496 break;
497 }
498 inst = 0;
499 switch (s->symbol.class) {
500 case class_const:
501 if (!initialize) {
502 CompileError (obj, stat, "Attempt to assign to static variable \"%A\"",
503 expr->atom.atom);
504 expr->base.type = typePoly;
505 break;
506 }
507 /* fall through ... */
508 case class_global:
509 BuildInst (obj, OpGlobalRef, inst, stat);
510 inst->box.box = s->global.value;
511 break;
512 case class_static:
513 BuildInst (obj, OpStaticRef, inst, stat);
514 inst->frame.staticLink = depth;
515 inst->frame.element = s->local.element;
516 break;
517 case class_arg:
518 case class_auto:
519 BuildInst (obj, OpLocalRef, inst, stat);
520 inst->frame.staticLink = depth;
521 inst->frame.element = s->local.element;
522 break;
523 default:
524 CompileError (obj, stat, "Invalid use of %C \"%A\"",
525 s->symbol.class, expr->atom.atom);
526 expr->base.type = typePoly;
527 break;
528 }
529 if (!inst)
530 break;
531 expr->base.type = s->symbol.type;
532 flipTypes = True;
533 break;
534 case AMPER:
535 obj = CompileLvalue (obj, expr->tree.left, stat, code,
536 createIfNecessary, assign, initialize,
537 True, auto_reference);
538 expr->base.type = expr->tree.left->base.type;
539 break;
540 case COLONCOLON:
541 obj = CompileLvalue (obj, expr->tree.right, stat, code, False, assign, initialize,
542 amper, auto_reference);
543 expr->base.type = expr->tree.right->base.type;
544 amper = False; /* has been dealt with in nested call */
545 break;
546 case DOT:
547 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
548 expr->base.type = TypeCombineStruct (expr->tree.left->base.type,
549 expr->base.tag,
550 expr->tree.right->atom.atom);
551 if (!expr->base.type)
552 {
553 CompileError (obj, stat, "Object left of '.' is not a struct or union containing \"%A\"",
554 expr->tree.right->atom.atom);
555 expr->base.type = typePoly;
556 break;
557 }
558 BuildInst (obj, OpDotRef, inst, stat);
559 inst->atom.atom = expr->tree.right->atom.atom;
560 flipTypes = True;
561 break;
562 case ARROW:
563 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
564 expr->base.type = TypeCombineStruct (expr->tree.left->base.type,
565 expr->base.tag,
566 expr->tree.right->atom.atom);
567 if (!expr->base.type)
568 {
569 CompileError (obj, stat, "Object left of '->' is not a struct or union containing \"%A\"",
570 expr->tree.right->atom.atom);
571 expr->base.type = typePoly;
572 break;
573 }
574 BuildInst (obj, OpArrowRef, inst, stat);
575 inst->atom.atom = expr->tree.right->atom.atom;
576 flipTypes = True;
577 break;
578 case OS:
579 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
580
581 obj = CompileArrayIndex (obj, expr->tree.right,
582 CompileIndexType (expr->tree.left),
583 stat, code, &ndim);
584
585 if (!ndim)
586 {
587 expr->base.type = typePoly;
588 break;
589 }
590
591 expr->base.type = TypeCombineArray (expr->tree.left->base.type,
592 ndim,
593 True);
594 if (!expr->base.type)
595 {
596 CompileError (obj, stat, "Incompatible type '%T', for %d dimension operation",
597 expr->tree.left->base.type, ndim);
598 expr->base.type = typePoly;
599 break;
600 }
601 BuildInst (obj, OpArrayRef, inst, stat);
602 inst->ints.value = ndim;
603 flipTypes = True;
604 break;
605 case STAR:
606 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
607 expr->base.type = TypeCombineUnary (expr->tree.left->base.type, expr->base.tag);
608 if (!expr->base.type)
609 {
610 CompileError (obj, stat, "Incompatible type, value '%T', for * operation",
611 expr->tree.left->base.type);
612 expr->base.type = typePoly;
613 break;
614 }
615 break;
616 case OP:
617 if (auto_reference)
618 {
619 obj = CompileCall (obj, expr, TailNever, stat, code, True);
620 break;
621 }
622 default:
623 if (auto_reference)
624 {
625 obj = _CompileExpr (obj, expr, True, stat, code);
626 BuildInst (obj, OpUnFunc, inst, stat);
627 inst->unfunc.func = do_reference;
628 }
629 else
630 {
631 CompileError (obj, stat, "Invalid lvalue");
632 expr->base.type = typePoly;
633 }
634 break;
635 }
636 if (flipTypes)
637 {
638 t = CompileRefType (obj, expr, expr->base.type);
639 if (amper)
640 {
641 if (t)
642 {
643 /*
644 * reference to a reference type; that
645 * means just reference the variable itself, but
646 * switch the expression type to '*foo' instead of
647 * '&foo'
648 */
649 expr->base.type = NewTypeRef (t, True);
650 if (assign)
651 inst->base.opCode++;
652 amper = False;
653 }
654 }
655 else
656 {
657 if (t)
658 {
659 /*
660 * access to a reference type; that means
661 * fetch the value of the reference
662 */
663 inst->base.opCode--;
664 expr->base.type = t;
665 }
666 else
667 {
668 /*
669 * access to a non-reference type; that
670 * means just reference the variable itself and
671 * leave the type alone
672 */
673 if (assign)
674 inst->base.opCode++;
675 }
676 }
677 }
678 /*
679 * Handle any remaining & from above
680 */
681 if (amper)
682 {
683 if (auto_reference)
684 {
685 BuildInst (obj, OpUnFunc, inst, stat);
686 inst->unfunc.func = do_reference;
687 expr->base.type = NewTypeRef (expr->base.type, True);
688 }
689 else
690 {
691 /*
692 * reference to a non-reference type. Error
693 */
694 CompileError (obj, stat, "Object right of '&' is not of ref type");
695 expr->base.type = typePoly;
696 }
697 }
698
699 assert (expr->base.type);
700 RETURN (obj);
701 }
702
703 static void
_CompileCheckException(ObjPtr obj,ExprPtr stat)704 _CompileCheckException (ObjPtr obj, ExprPtr stat)
705 {
706 SymbolPtr except = CheckStandardException ();
707
708 if (except)
709 CompileError (obj, stat, "Exception \"%A\" raised during compilation",
710 except->symbol.name);
711 }
712
713 /*
714 * Compile a binary operator --
715 * compile the left side, push, compile the right and then
716 * add the operator
717 */
718
719 ObjPtr
CompileBinOp(ObjPtr obj,ExprPtr expr,BinaryOp op,ExprPtr stat,CodePtr code)720 CompileBinOp (ObjPtr obj, ExprPtr expr, BinaryOp op, ExprPtr stat, CodePtr code)
721 {
722 ENTER ();
723 InstPtr inst;
724 int left, right;
725
726 left = obj->used;
727 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
728 SetPush (obj);
729 right = obj->used;
730 obj = _CompileExpr (obj, expr->tree.right, True, stat, code);
731 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
732 expr->base.tag,
733 expr->tree.right->base.type);
734 if (!expr->base.type)
735 {
736 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for %O operation",
737 expr->tree.left->base.type,
738 expr->tree.right->base.type,
739 op);
740 expr->base.type = typePoly;
741 }
742 else if (obj->used == left + 2 &&
743 ObjCode (obj, left)->base.opCode == OpConst &&
744 ObjCode (obj, right)->base.opCode == OpConst &&
745 !signalException)
746 {
747 inst = ObjCode (obj, left);
748 inst->constant.constant = BinaryOperate (ObjCode(obj, left)->constant.constant,
749 ObjCode(obj, right)->constant.constant,
750 op);
751 _CompileCheckException (obj, stat);
752 inst->base.flags &= ~InstPush;
753 obj->used = left + 1;
754 }
755 else
756 {
757 BuildInst (obj, OpBinOp, inst, stat);
758 inst->binop.op = op;
759 }
760 RETURN (obj);
761 }
762
763 ObjPtr
CompileBinFunc(ObjPtr obj,ExprPtr expr,BinaryFunc func,ExprPtr stat,CodePtr code,char * name)764 CompileBinFunc (ObjPtr obj, ExprPtr expr, BinaryFunc func, ExprPtr stat, CodePtr code, char *name)
765 {
766 ENTER ();
767 InstPtr inst;
768 int left, right;
769
770 left = obj->used;
771 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
772 SetPush (obj);
773 right = obj->used;
774 obj = _CompileExpr (obj, expr->tree.right, True, stat, code);
775 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
776 expr->base.tag,
777 expr->tree.right->base.type);
778 if (!expr->base.type)
779 {
780 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for %s operation",
781 expr->tree.left->base.type,
782 expr->tree.right->base.type,
783 name);
784 expr->base.type = typePoly;
785 }
786 else if (obj->used == left + 2 &&
787 ObjCode (obj, left)->base.opCode == OpConst &&
788 ObjCode (obj, right)->base.opCode == OpConst &&
789 !signalException)
790 {
791 inst = ObjCode (obj, left);
792 inst->constant.constant = (*func) (ObjCode(obj, left)->constant.constant,
793 ObjCode(obj, right)->constant.constant);
794 _CompileCheckException (obj, stat);
795 inst->base.flags &= ~InstPush;
796 obj->used = left + 1;
797 }
798 else
799 {
800 BuildInst (obj, OpBinFunc, inst, stat);
801 inst->binfunc.func = func;
802 }
803 RETURN (obj);
804 }
805
806 /*
807 * Unaries are easy --
808 * compile the operand and add the operator
809 */
810
811 ObjPtr
CompileUnOp(ObjPtr obj,ExprPtr expr,UnaryOp op,ExprPtr stat,CodePtr code)812 CompileUnOp (ObjPtr obj, ExprPtr expr, UnaryOp op, ExprPtr stat, CodePtr code)
813 {
814 ENTER ();
815 InstPtr inst;
816 ExprPtr down;
817 int d;
818
819 if (expr->tree.right)
820 down = expr->tree.right;
821 else
822 down = expr->tree.left;
823 d = obj->used;
824 obj = _CompileExpr (obj, down, True, stat, code);
825 expr->base.type = TypeCombineUnary (down->base.type, expr->base.tag);
826 if (!expr->base.type)
827 {
828 CompileError (obj, stat, "Incompatible type, value '%T', for %U operation",
829 down->base.type, op);
830 expr->base.type = typePoly;
831 }
832 else if (obj->used == d + 1 &&
833 ObjCode (obj, d)->base.opCode == OpConst &&
834 !signalException)
835 {
836 inst = ObjCode (obj, d);
837 inst->constant.constant = UnaryOperate (ObjCode(obj, d)->constant.constant,
838 op);
839 _CompileCheckException (obj, stat);
840 inst->base.flags &= ~InstPush;
841 obj->used = d + 1;
842 }
843 else
844 {
845 BuildInst (obj, OpUnOp, inst, stat);
846 inst->unop.op = op;
847 }
848 RETURN (obj);
849 }
850
851 ObjPtr
CompileUnFunc(ObjPtr obj,ExprPtr expr,UnaryFunc func,ExprPtr stat,CodePtr code,char * name)852 CompileUnFunc (ObjPtr obj, ExprPtr expr, UnaryFunc func, ExprPtr stat, CodePtr code, char *name)
853 {
854 ENTER ();
855 InstPtr inst;
856 ExprPtr down;
857 int d;
858
859 if (expr->tree.right)
860 down = expr->tree.right;
861 else
862 down = expr->tree.left;
863 d = obj->used;
864 obj = _CompileExpr (obj, down, True, stat, code);
865 expr->base.type = TypeCombineUnary (down->base.type, expr->base.tag);
866 if (!expr->base.type)
867 {
868 CompileError (obj, stat, "Incompatible type, value '%T', for %s operation",
869 down->base.type, name);
870 expr->base.type = typePoly;
871 }
872 else if (obj->used == d + 1 &&
873 ObjCode (obj, d)->base.opCode == OpConst &&
874 !signalException)
875 {
876 inst = ObjCode (obj, d);
877 inst->constant.constant = (*func) (ObjCode(obj, d)->constant.constant);
878 _CompileCheckException (obj, stat);
879 inst->base.flags &= ~InstPush;
880 obj->used = d + 1;
881 }
882 else
883 {
884 BuildInst (obj, OpUnFunc, inst, stat);
885 inst->unfunc.func = func;
886 }
887 RETURN (obj);
888 }
889
890 /*
891 * Assignement --
892 * compile the value, build a ref for the LHS and add the operator
893 */
894 ObjPtr
CompileAssign(ObjPtr obj,ExprPtr expr,Bool initialize,ExprPtr stat,CodePtr code)895 CompileAssign (ObjPtr obj, ExprPtr expr, Bool initialize, ExprPtr stat, CodePtr code)
896 {
897 ENTER ();
898 InstPtr inst;
899
900 obj = CompileLvalue (obj, expr->tree.left, stat, code, True, True, initialize,
901 False, False);
902 SetPush (obj);
903 obj = _CompileExpr (obj, expr->tree.right, True, stat, code);
904 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
905 expr->base.tag,
906 expr->tree.right->base.type);
907 if (!expr->base.type)
908 {
909 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for = operation",
910 expr->tree.left->base.type,
911 expr->tree.right->base.type);
912 expr->base.type = typePoly;
913 }
914 BuildInst (obj, OpAssign, inst, stat);
915 inst->assign.initialize = initialize;
916 RETURN (obj);
917 }
918
919 ObjPtr
CompileAssignOp(ObjPtr obj,ExprPtr expr,BinaryOp op,ExprPtr stat,CodePtr code)920 CompileAssignOp (ObjPtr obj, ExprPtr expr, BinaryOp op, ExprPtr stat, CodePtr code)
921 {
922 ENTER ();
923 InstPtr inst;
924
925 obj = CompileLvalue (obj, expr->tree.left, stat, code, False, False, False,
926 False, False);
927 SetPush (obj);
928 BuildInst (obj, OpFetch, inst, stat);
929 SetPush (obj);
930 obj = _CompileExpr (obj, expr->tree.right, True, stat, code);
931 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
932 expr->base.tag,
933 expr->tree.right->base.type);
934 if (!expr->base.type)
935 {
936 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for %O= operation",
937 expr->tree.left->base.type,
938 expr->tree.right->base.type,
939 op);
940 expr->base.type = typePoly;
941 }
942 BuildInst (obj, OpAssignOp, inst, stat);
943 inst->binop.op = op;
944 RETURN (obj);
945 }
946
947 ObjPtr
CompileAssignFunc(ObjPtr obj,ExprPtr expr,BinaryFunc func,ExprPtr stat,CodePtr code,char * name)948 CompileAssignFunc (ObjPtr obj, ExprPtr expr, BinaryFunc func, ExprPtr stat, CodePtr code, char *name)
949 {
950 ENTER ();
951 InstPtr inst;
952
953 obj = CompileLvalue (obj, expr->tree.left, stat, code, False, False, False,
954 False, False);
955 SetPush (obj);
956 BuildInst (obj, OpFetch, inst, stat);
957 SetPush (obj);
958 obj = _CompileExpr (obj, expr->tree.right, True, stat, code);
959 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
960 expr->base.tag,
961 expr->tree.right->base.type);
962 if (!expr->base.type)
963 {
964 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for %s= operation",
965 expr->tree.left->base.type,
966 expr->tree.right->base.type,
967 name);
968 expr->base.type = typePoly;
969 }
970 BuildInst (obj, OpAssignFunc, inst, stat);
971 inst->binfunc.func = func;
972 RETURN (obj);
973 }
974
975 static ObjPtr
CompileArgs(ObjPtr obj,int * argcp,Bool * varactualp,ExprPtr arg,Bool pushValue,ExprPtr stat,CodePtr code)976 CompileArgs (ObjPtr obj, int *argcp, Bool *varactualp, ExprPtr arg, Bool pushValue, ExprPtr stat, CodePtr code)
977 {
978 ENTER ();
979 int argc;
980
981 argc = 0;
982 *varactualp = False;
983 while (arg)
984 {
985 if (pushValue)
986 SetPush (obj);
987 if (arg->tree.left->base.tag == DOTDOTDOT)
988 {
989 InstPtr inst;
990 obj = _CompileExpr (obj, arg->tree.left->tree.left, True, stat, code);
991 BuildInst (obj, OpVarActual, inst, stat);
992 *varactualp = True;
993 }
994 else
995 {
996 obj = _CompileExpr (obj, arg->tree.left, True, stat, code);
997 }
998 arg = arg->tree.right;
999 pushValue = True;
1000 argc++;
1001 }
1002 *argcp = argc;
1003 RETURN(obj);
1004 }
1005
1006 /*
1007 * Typecheck function object and arguments
1008 */
1009 static Bool
CompileTypecheckArgs(ObjPtr obj,Type * type,ExprPtr args,int argc,ExprPtr stat)1010 CompileTypecheckArgs (ObjPtr obj,
1011 Type *type,
1012 ExprPtr args,
1013 int argc,
1014 ExprPtr stat)
1015 {
1016 ENTER ();
1017 Bool ret = True;
1018 ArgType *argt;
1019 ExprPtr arg;
1020 Type *func_type;
1021 Type *actual_type;
1022 int i;
1023 Bool varactual;
1024
1025 func_type = TypeCombineFunction (type);
1026 if (!func_type)
1027 {
1028 CompileError (obj, stat, "Incompatible type, value '%T', for call",
1029 type);
1030 EXIT ();
1031 return False;
1032 }
1033
1034 if (func_type->base.tag == type_func)
1035 {
1036 argt = func_type->func.args;
1037 arg = args;
1038 i = 0;
1039 varactual = False;
1040 while ((arg && !varactual) || (argt && !argt->varargs))
1041 {
1042 if (!argt)
1043 {
1044 CompileError (obj, stat, "Too many parameters for function type '%T'", func_type);
1045 ret = False;
1046 break;
1047 }
1048 if (!arg)
1049 {
1050 CompileError (obj, stat, "Too few parameters for function type '%T'", func_type);
1051 ret = False;
1052 break;
1053 }
1054 varactual = arg->tree.left->base.tag == DOTDOTDOT;
1055 if (varactual)
1056 actual_type = TypeCombineArray (arg->tree.left->tree.left->base.type, 1, False);
1057 else
1058 actual_type = arg->tree.left->base.type;
1059 if (!TypeIsOrdered (argt->type, actual_type))
1060 {
1061 CompileError (obj, stat, "Incompatible types, formal '%T', actual '%T', for argument %d",
1062 argt->type, arg->tree.left->base.type, i);
1063 ret = False;
1064 }
1065 i++;
1066 if (!argt->varargs)
1067 argt = argt->next;
1068 if (arg && (!varactual || !argt))
1069 arg = arg->tree.right;
1070 }
1071 }
1072 EXIT ();
1073 return ret;
1074 }
1075
1076
1077 static void
MarkNonLocal(void * object)1078 MarkNonLocal (void *object)
1079 {
1080 NonLocal *nl = object;
1081
1082 MemReference (nl->prev);
1083 }
1084
1085 DataType NonLocalType = { MarkNonLocal, 0, "NonLocalType" };
1086
1087 static NonLocal *
NewNonLocal(NonLocal * prev,NonLocalKind kind,int target)1088 NewNonLocal (NonLocal *prev, NonLocalKind kind, int target)
1089 {
1090 ENTER();
1091 NonLocal *nl;
1092
1093 nl = ALLOCATE (&NonLocalType, sizeof (NonLocal));
1094 nl->prev = prev;
1095 nl->kind = kind;
1096 nl->target = target;
1097 RETURN (nl);
1098 }
1099
1100 /*
1101 * Compile a function call --
1102 *
1103 * + compile the code that generates a function object
1104 * + compile the args, pushing value on the stack
1105 * + Typecheck the arguments. Must be done here so that
1106 * the type of the function is available
1107 * + Add the OpCall
1108 * + Add an OpNoop in case the result must be pushed; otherwise there's
1109 * no place to hang a push bit
1110 */
1111
1112 ObjPtr
CompileCall(ObjPtr obj,ExprPtr expr,Tail tail,ExprPtr stat,CodePtr code,Bool auto_reference)1113 CompileCall (ObjPtr obj, ExprPtr expr, Tail tail, ExprPtr stat, CodePtr code, Bool auto_reference)
1114 {
1115 ENTER ();
1116 InstPtr inst;
1117 int argc;
1118 Bool varactual;
1119 TypePtr t;
1120
1121 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
1122 obj = CompileArgs (obj, &argc, &varactual, expr->tree.right, True, stat, code);
1123 if (!CompileTypecheckArgs (obj, expr->tree.left->base.type,
1124 expr->tree.right, argc, stat))
1125 {
1126 expr->base.type = typePoly;
1127 RETURN (obj);
1128 }
1129 expr->base.type = TypeCombineReturn (expr->tree.left->base.type);
1130 t = CompileRefType (obj, expr, expr->base.type);
1131 if ((t && !auto_reference) || (!t && auto_reference))
1132 tail = TailNever;
1133 if (!code)
1134 tail = TailNever;
1135 if ((tail == TailAlways &&
1136 !TypePoly (expr->base.type) &&
1137 TypeIsSupertype (code->base.type, expr->base.type)) ||
1138 (tail == TailVoid &&
1139 TypeCanon (expr->base.type) == typePrim[rep_void]))
1140 {
1141 BuildInst (obj, OpTailCall, inst, stat);
1142 inst->ints.value = varactual ? -argc : argc;
1143 }
1144 else
1145 {
1146 BuildInst (obj, OpCall, inst, stat);
1147 inst->ints.value = varactual ? -argc : argc;
1148 if (t && !auto_reference)
1149 {
1150 BuildInst (obj, OpUnFunc, inst, stat);
1151 inst->unfunc.func = Dereference;
1152 expr->base.type = t;
1153 }
1154 else if (!t && auto_reference)
1155 {
1156 BuildInst (obj, OpUnFunc, inst, stat);
1157 inst->unfunc.func = do_reference;
1158 /*
1159 * this is called from CompileLvalue which
1160 * must return a value of the type pointed to, not the
1161 * type of the object itself, so don't create a pointer
1162 * type here. Someday we'll figure all of this out...
1163 */
1164 /* expr->base.type = NewTypeRef (expr->base.type, True); */
1165 }
1166 else
1167 BuildInst (obj, OpNoop, inst, stat);
1168 }
1169 RETURN (obj);
1170 }
1171
1172 /*
1173 * Compile an exception --
1174 *
1175 * + lookup the name
1176 * + compile the args, pushing
1177 * + typecheck the args
1178 * + Add the OpRaise
1179 */
1180 static ObjPtr
CompileRaise(ObjPtr obj,ExprPtr expr,ExprPtr stat,CodePtr code)1181 CompileRaise (ObjPtr obj, ExprPtr expr, ExprPtr stat, CodePtr code)
1182 {
1183 ENTER();
1184 int argc;
1185 ExprPtr name;
1186 SymbolPtr sym;
1187 InstPtr inst;
1188 Bool varactual;
1189
1190 if (expr->tree.left->base.tag == COLONCOLON)
1191 name = expr->tree.left->tree.right;
1192 else
1193 name = expr->tree.left;
1194
1195 sym = name->atom.symbol;
1196
1197 if (!sym)
1198 {
1199 CompileError (obj, stat, "No exception '%A' in scope",
1200 name->atom.atom);
1201 RETURN (obj);
1202 }
1203 if (sym->symbol.class != class_exception)
1204 {
1205 CompileError (obj, stat, "'%A' is not an exception",
1206 name->atom.atom);
1207 RETURN (obj);
1208 }
1209 obj = CompileArgs (obj, &argc, &varactual, expr->tree.right, False, stat, code);
1210 if (!CompileTypecheckArgs (obj, sym->symbol.type, expr->tree.right, argc, stat))
1211 RETURN(obj);
1212 expr->base.type = typePoly;
1213 BuildInst (obj, OpRaise, inst, stat);
1214 inst->raise.argc = varactual ? -argc : argc;
1215 inst->raise.exception = sym;
1216 RETURN (obj);
1217 }
1218
1219
1220 /*
1221 * Compile a twixt --
1222 *
1223 * twixt (enter; leave) body
1224 *
1225 * enter:
1226 * enter
1227 * OpEnterDone
1228 * OpTwixt enter: leave:
1229 * body
1230 * OpTwixtDone
1231 * leave:
1232 * leave
1233 * OpLeaveDone
1234 *
1235 */
1236
1237 static ObjPtr
CompileTwixt(ObjPtr obj,ExprPtr expr,ExprPtr stat,CodePtr code)1238 CompileTwixt (ObjPtr obj, ExprPtr expr, ExprPtr stat, CodePtr code)
1239 {
1240 ENTER ();
1241 int enter_inst, twixt_inst;
1242 InstPtr inst;
1243
1244 enter_inst = obj->used;
1245
1246 /* Compile enter expression */
1247 if (expr->tree.left->tree.left)
1248 obj = _CompileExpr (obj, expr->tree.left->tree.left, True, stat, code);
1249 BuildInst (obj, OpEnterDone, inst, stat);
1250
1251 /* here's where the twixt instruction goes */
1252 NewInst (obj, OpTwixt, twixt_inst, stat);
1253
1254 obj->nonLocal = NewNonLocal (obj->nonLocal, NonLocalTwixt, 0);
1255
1256 /* Compile the body */
1257 obj = _CompileStat (obj, expr->tree.right->tree.left, False, code);
1258
1259 obj->nonLocal = obj->nonLocal->prev;
1260
1261 BuildInst (obj, OpTwixtDone, inst, stat);
1262
1263 /* finish the twixt instruction */
1264 inst = ObjCode (obj, twixt_inst);
1265 inst->twixt.enter = enter_inst - twixt_inst;
1266 inst->twixt.leave = obj->used - twixt_inst;
1267
1268 /* Compile leave expression */
1269 if (expr->tree.left->tree.right)
1270 obj = _CompileExpr (obj, expr->tree.left->tree.right, False, stat, code);
1271 BuildInst (obj, OpLeaveDone, inst, stat);
1272
1273 RETURN (obj);
1274 }
1275
1276 /*
1277 * Compile an array index expression tree
1278 */
1279
1280 ObjPtr
CompileArrayIndex(ObjPtr obj,ExprPtr expr,TypePtr indexType,ExprPtr stat,CodePtr code,int * ndimp)1281 CompileArrayIndex (ObjPtr obj, ExprPtr expr, TypePtr indexType,
1282 ExprPtr stat, CodePtr code, int *ndimp)
1283 {
1284 ENTER ();
1285 int ndim;
1286
1287 ndim = 0;
1288 while (expr)
1289 {
1290 SetPush (obj);
1291 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
1292 if (!TypeIsOrdered (indexType,
1293 expr->tree.left->base.type))
1294 {
1295 CompileError (obj, stat, "Incompatible expression type '%T', for index %d type '%T'",
1296 expr->tree.left->base.type, ndim, indexType);
1297 break;
1298 }
1299 expr = expr->tree.right;
1300 ndim++;
1301 }
1302 *ndimp = ndim;
1303 RETURN (obj);
1304 }
1305
1306 /*
1307 * Return an expression that will build an
1308 * initializer for a fully specified composite
1309 * type
1310 */
1311
1312 /*
1313 * Calculate the number of dimensions in an array by looking at
1314 * the initializers
1315 */
1316 static int
CompileCountInitDimensions(TypePtr type,ExprPtr expr)1317 CompileCountInitDimensions (TypePtr type, ExprPtr expr)
1318 {
1319 int ndimMax, ndimSub, ndim;
1320
1321 switch (expr->base.tag) {
1322 case ANONINIT:
1323 type = TypeCanon (type);
1324 if (type->base.tag == type_struct)
1325 ndim = 0;
1326 else
1327 ndim = 1;
1328 break;
1329 case ARRAY:
1330 expr = expr->tree.left;
1331 ndimMax = 0;
1332 while (expr)
1333 {
1334 if (expr->tree.left && expr->tree.left->base.tag != DOTDOTDOT)
1335 {
1336 ndimSub = CompileCountInitDimensions (type, expr->tree.left);
1337 if (ndimSub < 0)
1338 return ndimSub;
1339 if (ndimMax && ndimSub != ndimMax)
1340 return -1;
1341 ndimMax = ndimSub;
1342 }
1343 expr = expr->tree.right;
1344 }
1345 ndim = ndimMax + 1;
1346 break;
1347 default:
1348 ndim = 0;
1349 break;
1350 }
1351 return ndim;
1352 }
1353
1354 static int
CompileCountDeclDimensions(ExprPtr expr)1355 CompileCountDeclDimensions (ExprPtr expr)
1356 {
1357 int ndim;
1358
1359 ndim = 0;
1360 while (expr)
1361 {
1362 expr = expr->tree.right;
1363 ndim++;
1364 }
1365 return ndim;
1366 }
1367
1368 static int
CompileCountImplicitDimensions(ExprPtr expr)1369 CompileCountImplicitDimensions (ExprPtr expr)
1370 {
1371 switch (expr->base.tag) {
1372 case ARRAY:
1373 return 1 + CompileCountImplicitDimensions (expr->tree.left);
1374 case ANONINIT:
1375 return 0;
1376 case COMMA:
1377 return CompileCountImplicitDimensions (expr->tree.left);
1378 default:
1379 return 0;
1380 }
1381 }
1382
1383 static ObjPtr
CompileBuildArray(ObjPtr obj,ExprPtr expr,TypePtr type,ExprPtr dim,int ndim,ExprPtr stat,CodePtr code)1384 CompileBuildArray (ObjPtr obj, ExprPtr expr, TypePtr type,
1385 ExprPtr dim, int ndim,
1386 ExprPtr stat, CodePtr code)
1387 {
1388 ENTER ();
1389 InstPtr inst;
1390
1391 if (dim)
1392 {
1393 while (dim)
1394 {
1395 obj = _CompileExpr (obj, dim->tree.left, True, stat, code);
1396 SetPush (obj);
1397 dim = dim->tree.right;
1398 }
1399 BuildInst (obj, OpBuildArray, inst, stat);
1400 }
1401 else
1402 {
1403 obj = CompileArrayDimValue (obj, type, False, stat, code);
1404 BuildInst (obj, OpBuildArrayInd, inst, stat);
1405 }
1406 inst->array.ndim = ndim;
1407 inst->array.type = type->array.type;
1408 inst->array.resizable = type->array.resizable;
1409 RETURN (obj);
1410 }
1411
1412 static void
CompileSizeDimensions(ExprPtr expr,int * dims,int ndims)1413 CompileSizeDimensions (ExprPtr expr, int *dims, int ndims)
1414 {
1415 int dim;
1416
1417 if (!expr)
1418 dim = 0;
1419 else switch (expr->base.tag) {
1420 case ARRAY:
1421 dim = 0;
1422 expr = expr->tree.left;
1423 while (expr)
1424 {
1425 if (expr->tree.left->base.tag == DOTDOTDOT) {
1426 dim = -dim;
1427 break;
1428 }
1429 if (ndims != 1)
1430 {
1431 CompileSizeDimensions (expr->tree.left, dims + 1, ndims - 1);
1432 if (dims[1])
1433 dim++;
1434 }
1435 else
1436 dim++;
1437 expr = expr->tree.right;
1438 }
1439 break;
1440 case COMP:
1441 dim = -1;
1442 break;
1443 case ANONINIT:
1444 dim = 0;
1445 break;
1446 default:
1447 dim = 1;
1448 break;
1449 }
1450 if (abs(dim) > *dims || dim > *dims)
1451 *dims = dim;
1452 }
1453
1454 static ExprPtr
CompileImplicitArray(ObjPtr obj,ExprPtr stat,ExprPtr inits,int ndim)1455 CompileImplicitArray (ObjPtr obj, ExprPtr stat, ExprPtr inits, int ndim)
1456 {
1457 ENTER ();
1458 ExprPtr sub;
1459 int *dims;
1460 int n;
1461
1462 dims = AllocateTemp (ndim * sizeof (int));
1463 memset (dims, '\0', ndim * sizeof (int));
1464 CompileSizeDimensions (inits, dims, ndim);
1465 for (n = 0; n < ndim; n++) {
1466 if (dims[n] < 0) {
1467 CompileError (obj, stat, "Implicit dimensioned array with variable initializers");
1468 RETURN (0);
1469 }
1470 }
1471 sub = 0;
1472 for (n = ndim - 1; n >= 0; n--)
1473 {
1474 sub = NewExprTree (COMMA,
1475 NewExprConst (TEN_NUM, NewInt (dims[n])),
1476 sub);
1477 }
1478 RETURN(sub);
1479 }
1480
1481 static ObjPtr
1482 CompileArrayInit (ObjPtr obj, ExprPtr expr, Type *type,
1483 ExprPtr stat, CodePtr code);
1484
1485 static ObjPtr
1486 CompileHashInit (ObjPtr obj, ExprPtr expr, Type *type,
1487 ExprPtr stat, CodePtr code);
1488
1489 static ObjPtr
1490 CompileStructUnionInit (ObjPtr obj, ExprPtr expr, Type *type,
1491 ExprPtr stat, CodePtr code);
1492
1493 static ExprPtr
1494 CompileImplicitInit (Type *type);
1495
1496 static ObjPtr
CompileInit(ObjPtr obj,ExprPtr expr,Type * type,ExprPtr stat,CodePtr code)1497 CompileInit (ObjPtr obj, ExprPtr expr, Type *type,
1498 ExprPtr stat, CodePtr code)
1499 {
1500 ENTER ();
1501 Type *canon_type;
1502
1503 canon_type = TypeCanon (type);
1504 if (!canon_type) {
1505 CompileError(obj, stat, "Initializer with undefined type '%T'", type);
1506 RETURN(obj);
1507 }
1508 type = canon_type;
1509
1510 if (!expr || expr->base.tag == ANONINIT)
1511 {
1512 switch (type->base.tag) {
1513 case type_array:
1514 obj = CompileArrayInit (obj, 0, type, stat, code);
1515 break;
1516 case type_hash:
1517 obj = CompileHashInit (obj, 0, type, stat, code);
1518 break;
1519 case type_struct:
1520 obj = CompileStructUnionInit (obj, 0, type, stat, code);
1521 break;
1522 case type_union:
1523 default:
1524 CompileError (obj, stat, "Invalid empty initializer , type '%T'", type);
1525 break;
1526 }
1527 }
1528 else switch (expr->base.tag) {
1529 case ARRAY:
1530 case COMP:
1531 if (type->base.tag != type_array)
1532 CompileError (obj, stat, "Array initializer type mismatch, type '%T'",
1533 type);
1534 else
1535 obj = CompileArrayInit (obj, expr, type, stat, code);
1536 break;
1537 case HASH:
1538 if (type->base.tag != type_hash)
1539 CompileError (obj, stat, "Hash initializer type mismatch, type '%T'",
1540 type);
1541 else
1542 obj = CompileHashInit (obj, expr, type, stat, code);
1543 break;
1544 case STRUCT:
1545 if (type->base.tag != type_struct && type->base.tag != type_union)
1546 CompileError (obj, stat, "Struct/union initializer type mismatch, type '%T'",
1547 type);
1548 else
1549 obj = CompileStructUnionInit (obj, expr, type, stat, code);
1550 break;
1551 default:
1552 obj = _CompileExpr (obj, expr, True, stat, code);
1553 if (!TypeCombineBinary (type, ASSIGN, expr->base.type))
1554 CompileError (obj, stat, "Incompatible types, storage '%T', value '%T', for initializer",
1555 type, expr->base.type);
1556 }
1557 RETURN (obj);
1558 }
1559
1560 static ObjPtr
CompileArrayInits(ObjPtr obj,ExprPtr expr,TypePtr type,int ndim,ExprPtr stat,CodePtr code,AInitMode mode)1561 CompileArrayInits (ObjPtr obj, ExprPtr expr, TypePtr type,
1562 int ndim, ExprPtr stat, CodePtr code,
1563 AInitMode mode)
1564 {
1565 ENTER ();
1566 InstPtr inst;
1567 ExprPtr e;
1568
1569 if (ndim == 0)
1570 {
1571 obj = CompileInit (obj, expr, type, stat, code);
1572 }
1573 else
1574 {
1575 ExprPtr next;
1576
1577 switch (expr->base.tag) {
1578 case ARRAY:
1579 for (e = expr->tree.left; e; e = next)
1580 {
1581 AInitMode subMode = AInitModeElement;
1582
1583 next = e->tree.right;
1584 if (next && next->tree.left->base.tag == DOTDOTDOT)
1585 {
1586 subMode = AInitModeRepeat;
1587 next = next->tree.right;
1588 }
1589 obj = CompileArrayInits (obj, e->tree.left, type,
1590 ndim-1, stat, code, subMode);
1591 }
1592 break;
1593 case ANONINIT:
1594 break;
1595 case COMP:
1596 CompileError (obj, stat, "Comprehension not valid for nested array initializer");
1597 break;
1598 default:
1599 CompileError (obj, stat, "Not enough initializer dimensions");
1600 break;
1601 }
1602 }
1603 BuildInst (obj, OpInitArray, inst, stat);
1604 inst->ainit.dim = ndim;
1605 inst->ainit.mode = mode;
1606 RETURN (obj);
1607 }
1608
1609 static ExprPtr
CompileArrayInitArgs(int ndim)1610 CompileArrayInitArgs (int ndim)
1611 {
1612 ExprPtr a = NewExprConst (TEN_NUM, One);
1613
1614 a->base.type = typePrim[rep_integer];
1615 if (!ndim)
1616 return 0;
1617 return NewExprTree (COMMA, a, CompileArrayInitArgs (ndim - 1));
1618 }
1619
1620 static ArgType *
CompileComprehensionArgs(ExprPtr e)1621 CompileComprehensionArgs (ExprPtr e)
1622 {
1623 ArgType *down = 0;
1624 if (e->base.tag == COMMA)
1625 {
1626 down = CompileComprehensionArgs (e->tree.right);
1627 e = e->tree.left;
1628 }
1629 down = NewArgType (typePrim[rep_integer],
1630 False, e->atom.atom,
1631 e->atom.symbol, down);
1632 return down;
1633 }
1634
1635 static ObjPtr
CompileComprehension(ObjPtr obj,TypePtr type,ExprPtr expr,ExprPtr stat,CodePtr code)1636 CompileComprehension (ObjPtr obj,
1637 TypePtr type,
1638 ExprPtr expr,
1639 ExprPtr stat,
1640 CodePtr code)
1641 {
1642 ENTER ();
1643 ExprPtr body = expr->tree.right;
1644 ExprPtr lambda;
1645 ArgType *args;
1646
1647 /*
1648 * Convert a single expression into a block containing a
1649 * return statement
1650 */
1651 switch (body->base.tag) {
1652 case STRUCT:
1653 case COMP:
1654 case ARRAY:
1655 case ANONINIT:
1656 body = NewExprTree (NEW, body, 0);
1657 body->base.type = type;
1658 }
1659 if (body->base.tag != OC)
1660 body = NewExprTree (OC,
1661 NewExprTree (RETURNTOK, 0, body),
1662 NewExprTree (OC, 0, 0));
1663 /*
1664 * Convert the args
1665 */
1666 args = CompileComprehensionArgs (expr->tree.left->tree.left);
1667 /*
1668 * Compile [] symbol
1669 */
1670 CompileStorage (obj, stat, expr->tree.left->tree.right->atom.symbol,
1671 code);
1672 /*
1673 * Build a func expression
1674 */
1675 lambda = NewExprCode (NewFuncCode (type,
1676 args,
1677 body,
1678 Void),
1679 0);
1680 obj = _CompileExpr (obj, lambda, True, stat, code);
1681 expr->tree.left->base.type = lambda->base.type;
1682 RETURN(obj);
1683 }
1684
1685 /*
1686 * typedef struct { int x; } foo;
1687 * typedef struct { foo[2,2] q; } bar;
1688 * bar y = { q = { { { x = 1 } ... } ... } };
1689 *
1690 *
1691 * ARRAY
1692 * / \
1693 * COMMA 0
1694 * / \
1695 * ARRAY COMMA
1696 * / \ | \
1697 * COMMA 0 DOTDOTDOT 0
1698 * / \
1699 * STRUCT COMMA
1700 * / \ | \
1701 * COMMA 0 DOTDOTDOT 0
1702 * / \
1703 * ASSIGN 0
1704 * | \
1705 * NAME TEN_NUM
1706 * "x" 1
1707 */
1708
1709 static ObjPtr
CompileArrayInit(ObjPtr obj,ExprPtr expr,Type * type,ExprPtr stat,CodePtr code)1710 CompileArrayInit (ObjPtr obj, ExprPtr expr, Type *type, ExprPtr stat, CodePtr code)
1711 {
1712 ENTER ();
1713 int ndim;
1714 Type *sub = type->array.type;
1715 Expr *dimensions;
1716
1717 ndim = CompileCountDeclDimensions (type->array.dimensions);
1718 if (!ndim)
1719 {
1720 if (expr)
1721 ndim = CompileCountImplicitDimensions (expr);
1722 if (!ndim)
1723 {
1724 CompileError (obj, stat, "Cannot compute number of array dimensions");
1725 RETURN (obj);
1726 }
1727 }
1728 if (type->array.dimensions && type->array.dimensions->tree.left)
1729 dimensions = 0;
1730 else
1731 {
1732 dimensions = CompileImplicitArray (obj, stat, expr, ndim);
1733 if (!dimensions)
1734 RETURN (obj);
1735 }
1736 if (expr && expr->base.tag == COMP)
1737 {
1738 ExprPtr args = CompileArrayInitArgs (ndim);
1739 Type *retType;
1740
1741 obj = CompileComprehension (obj, sub, expr, stat, code);
1742 if (!CompileTypecheckArgs (obj, expr->tree.left->base.type,
1743 args, ndim, stat))
1744 {
1745 RETURN(obj);
1746 }
1747 retType = TypeCombineReturn (expr->tree.left->base.type);
1748 if (!TypeCombineBinary (sub, ASSIGN, retType))
1749 {
1750 CompileError (obj, stat, "Incompatible types, array '%T', return '%T', for initializer",
1751 sub, expr->base.type);
1752 RETURN(obj);
1753 }
1754 SetPush (obj);
1755 obj = CompileLvalue (obj,
1756 expr->tree.left->tree.right,
1757 stat, code, False, True, True, False, False);
1758 SetPush (obj);
1759 }
1760 obj = CompileBuildArray (obj, expr, type, dimensions, ndim, stat, code);
1761 if (expr)
1762 {
1763 InstPtr inst;
1764
1765 if (expr->base.tag == COMP)
1766 {
1767 int start_inst;
1768 int top_inst;
1769
1770 /*
1771 * Comprehension:
1772 *
1773 * Obj ^ (obj)
1774 * InitArray ndim (Start)
1775 * Branch L1
1776 * L2: InitArray ndim (Func)
1777 * Call
1778 * InitArray 0 (Element)
1779 * L1: InitArray n (Test)
1780 * BranchFalse L2
1781 * InitArray n (Element)
1782 */
1783 BuildInst (obj, OpAssign, inst, stat);
1784 inst->assign.initialize = True;
1785 BuildInst (obj, OpInitArray, inst, stat);
1786 inst->ainit.mode = AInitModeStart;
1787 inst->ainit.dim = ndim;
1788
1789 /* Branch L1 */
1790 NewInst (obj, OpBranch, start_inst, stat);
1791
1792 top_inst = obj->used;
1793 BuildInst (obj, OpInitArray, inst, stat);
1794 inst->ainit.dim = ndim;
1795 inst->ainit.mode = AInitModeFunc;
1796
1797 BuildInst (obj, OpCall, inst, stat);
1798 inst->ints.value = ndim;
1799 BuildInst (obj, OpInitArray, inst, stat);
1800 inst->ainit.dim = 0;
1801 inst->ainit.mode = AInitModeElement;
1802
1803 /* Patch Branch L1 */
1804 inst = ObjCode (obj, start_inst);
1805 inst->branch.offset = obj->used - start_inst;
1806 inst->branch.mod = BranchModNone;
1807
1808 BuildInst (obj, OpInitArray, inst, stat);
1809 inst->ainit.dim = 0;
1810 inst->ainit.mode = AInitModeTest;
1811
1812 /* Branch L2 */
1813 BuildInst (obj, OpBranchFalse, inst, stat);
1814 inst->branch.offset = top_inst - ObjLast(obj);
1815 inst->branch.mod = BranchModNone;
1816
1817 /* Finish up */
1818 BuildInst (obj, OpInitArray, inst, stat);
1819 inst->ainit.dim = ndim;
1820 inst->ainit.mode = AInitModeFuncDone;
1821 }
1822 else
1823 {
1824 int ninitdim;
1825 if (expr->base.tag != ARRAY && expr->base.tag != ANONINIT)
1826 {
1827 CompileError (obj, stat, "Non array initializer");
1828 RETURN (obj);
1829 }
1830 ninitdim = CompileCountInitDimensions (sub, expr);
1831 if (ninitdim < 0)
1832 {
1833 CompileError (obj, stat, "Inconsistent array initializer dimensionality");
1834 RETURN (obj);
1835 }
1836 if (ndim > ninitdim ||
1837 (ndim < ninitdim && TypeCanon(sub)->base.tag != type_array))
1838 {
1839 CompileError (obj, stat, "Array dimension mismatch %d != %d",
1840 ndim, ninitdim);
1841 RETURN (obj);
1842 }
1843 BuildInst (obj, OpInitArray, inst, stat);
1844 inst->ainit.mode = AInitModeStart;
1845 inst->ainit.dim = ndim;
1846 obj = CompileArrayInits (obj, expr, sub, ndim, stat, code,
1847 AInitModeElement);
1848 }
1849 }
1850 RETURN (obj);
1851 }
1852
1853 static ObjPtr
CompileHashInit(ObjPtr obj,ExprPtr expr,Type * type,ExprPtr stat,CodePtr code)1854 CompileHashInit (ObjPtr obj, ExprPtr expr, Type *type,
1855 ExprPtr stat, CodePtr code)
1856 {
1857 ENTER ();
1858 InstPtr inst;
1859 ExprPtr inits = expr ? expr->tree.left : 0;
1860 ExprPtr init;
1861
1862 if (type->base.tag == type_hash)
1863 {
1864 BuildInst (obj, OpBuildHash, inst, stat);
1865 inst->hash.type = type;
1866 if (expr)
1867 expr->base.type = type;
1868
1869 /*
1870 * Initialize any elements given values
1871 */
1872 for (init = inits; init; init = init->tree.right)
1873 {
1874 ExprPtr key = init->tree.left->tree.left;
1875 ExprPtr value = init->tree.left->tree.right;
1876
1877 SetPush (obj); /* push the hash */
1878
1879 if (key)
1880 {
1881 /*
1882 * Compute the key
1883 */
1884 obj = CompileInit (obj, key, type->hash.keyType, stat, code);
1885
1886 if (!TypeIsOrdered (type->hash.keyType, key->base.type))
1887 {
1888 CompileError (obj, stat, "Incompatible expression type '%T', for hash index type '%T'",
1889 key->base.type, type->hash.keyType);
1890 RETURN (obj);
1891 }
1892
1893 SetPush (obj); /* push the key */
1894 }
1895
1896 /*
1897 * Compute the value
1898 */
1899 obj = CompileInit (obj, value, type->hash.type, stat, code);
1900
1901 /*
1902 * Store the pair
1903 */
1904 BuildInst (obj, key ? OpInitHash : OpInitHashDef, inst, stat);
1905 }
1906 }
1907 RETURN (obj);
1908 }
1909
1910
1911 /*
1912 * Construct an implicit initializer expression for the specified type
1913 */
1914 static ExprPtr
CompileImplicitInit(Type * type)1915 CompileImplicitInit (Type *type)
1916 {
1917 ENTER ();
1918 ExprPtr init = 0;
1919 Type *sub;
1920 int dim;
1921 StructTypePtr structs;
1922 TypePtr *types;
1923 Atom *atoms;
1924 int i;
1925
1926 type = TypeCanon (type);
1927
1928 switch (type->base.tag) {
1929 case type_array:
1930 if (type->array.dimensions)
1931 {
1932 if (type->array.resizable)
1933 {
1934 init = NewExprTree (ANONINIT, 0, 0);
1935 }
1936 else if (type->array.dimensions->tree.left)
1937 {
1938 sub = type->array.type;
1939 init = CompileImplicitInit (sub);
1940 if (init)
1941 {
1942 dim = CompileCountDeclDimensions (type->array.dimensions);
1943 while (--dim >= 0)
1944 {
1945 init = NewExprTree (ARRAY,
1946 NewExprTree (COMMA,
1947 init,
1948 NewExprTree (COMMA,
1949 NewExprTree (DOTDOTDOT, 0, 0),
1950 0)),
1951 0);
1952 }
1953 }
1954 else
1955 init = NewExprTree (ANONINIT, 0, 0);
1956 }
1957 }
1958 break;
1959 case type_hash:
1960 init = NewExprTree (HASH, 0, 0);
1961 break;
1962 case type_struct:
1963 structs = type->structs.structs;
1964 types = BoxTypesElements (structs->types);
1965 atoms = StructTypeAtoms (structs);
1966 init = 0;
1967 for (i = 0; i < structs->nelements; i++)
1968 {
1969 ExprPtr member;
1970
1971 sub = types[i];
1972
1973 member = CompileImplicitInit (sub);
1974 if (member)
1975 {
1976 init = NewExprTree (COMMA,
1977 NewExprTree (ASSIGN,
1978 NewExprAtom (atoms[i], 0, False),
1979 member),
1980 init);
1981 }
1982 }
1983 if (init)
1984 init = NewExprTree (STRUCT, init, 0);
1985 else
1986 init = NewExprTree (ANONINIT, 0, 0);
1987 break;
1988 default:
1989 break;
1990 }
1991 RETURN (init);
1992 }
1993
1994 static Bool
CompileStructInitElementIncluded(ExprPtr expr,Atom atom)1995 CompileStructInitElementIncluded (ExprPtr expr, Atom atom)
1996 {
1997 while (expr)
1998 {
1999 if (atom == expr->tree.left->tree.left->atom.atom)
2000 return True;
2001 expr = expr->tree.right;
2002 }
2003 return False;
2004 }
2005
2006 static ObjPtr
CompileStructUnionInit(ObjPtr obj,ExprPtr expr,Type * type,ExprPtr stat,CodePtr code)2007 CompileStructUnionInit (ObjPtr obj, ExprPtr expr, Type *type,
2008 ExprPtr stat, CodePtr code)
2009 {
2010 ENTER ();
2011 StructType *structs = type->structs.structs;
2012 InstPtr inst;
2013 ExprPtr inits = expr ? expr->tree.left : 0;
2014 ExprPtr init;
2015 Type *mem_type;
2016 int i;
2017 TypePtr *types = BoxTypesElements (structs->types);
2018 Atom *atoms = StructTypeAtoms (structs);
2019
2020 if (type->base.tag == type_struct)
2021 {
2022 BuildInst (obj, OpBuildStruct, inst, stat);
2023 inst->structs.structs = structs;
2024 /*
2025 * Initialize any elements which were given explicit values
2026 */
2027 for (init = inits; init; init = init->tree.right)
2028 {
2029 mem_type = StructMemType (structs, init->tree.left->tree.left->atom.atom);
2030 if (!mem_type)
2031 {
2032 CompileError (obj, stat, "Type '%T' is not a struct or union containing \"%A\"",
2033 type, init->tree.left->tree.left->atom.atom);
2034 continue;
2035 }
2036
2037 SetPush (obj); /* push the struct */
2038
2039 /*
2040 * Compute the initializer value
2041 */
2042 obj = CompileInit (obj, init->tree.left->tree.right, mem_type, stat, code);
2043
2044 /*
2045 * Assign to the member
2046 */
2047 BuildInst (obj, OpInitStruct, inst, stat);
2048 inst->atom.atom = init->tree.left->tree.left->atom.atom;
2049 }
2050
2051 /*
2052 * Implicitly initialize any remaining elements
2053 */
2054 for (i = 0; i < structs->nelements; i++)
2055 {
2056 TypePtr type = TypeCanon (types[i]);
2057
2058 if (!inits || !CompileStructInitElementIncluded (inits, atoms[i]))
2059 {
2060 ExprPtr init = CompileImplicitInit (type);
2061
2062 if (init)
2063 {
2064 SetPush (obj);
2065 obj = CompileInit (obj, init, type, stat, code);
2066 BuildInst (obj, OpInitStruct, inst, stat);
2067 inst->atom.atom = atoms[i];
2068 }
2069 }
2070 }
2071 }
2072 else
2073 {
2074 init = inits;
2075 if (!init)
2076 {
2077 CompileError (obj, stat, "Empty initializer for union '%T'",
2078 type);
2079 RETURN (obj);
2080 }
2081 if (init->tree.right)
2082 {
2083 CompileError (obj, stat, "Multiple initializers for union '%T'",
2084 type);
2085 RETURN (obj);
2086 }
2087
2088 mem_type = StructMemType (structs, init->tree.left->tree.left->atom.atom);
2089 if (!mem_type)
2090 {
2091 CompileError (obj, stat, "Type '%T' is not a struct or union containing \"%A\"",
2092 type, init->tree.left->tree.left->atom.atom);
2093 RETURN (obj);
2094 }
2095 /*
2096 * Compute the initializer value
2097 */
2098 obj = CompileInit (obj, init->tree.left->tree.right, mem_type, stat, code);
2099
2100 SetPush (obj); /* push the initializer value */
2101
2102 BuildInst (obj, OpBuildUnion, inst, stat);
2103 inst->structs.structs = structs;
2104
2105 BuildInst (obj, OpInitUnion, inst, stat);
2106 inst->atom.atom = init->tree.left->tree.left->atom.atom;
2107 }
2108 RETURN (obj);
2109 }
2110
2111 static int
CompileCountCatches(ExprPtr catches)2112 CompileCountCatches (ExprPtr catches)
2113 {
2114 int c = 0;
2115
2116 while (catches)
2117 {
2118 c++;
2119 catches = catches->tree.left;
2120 }
2121 return c;
2122 }
2123
2124 static ObjPtr
CompileCatch(ObjPtr obj,ExprPtr catches,ExprPtr body,ExprPtr stat,CodePtr code,int nest)2125 CompileCatch (ObjPtr obj, ExprPtr catches, ExprPtr body,
2126 ExprPtr stat, CodePtr code, int nest)
2127 {
2128 ENTER ();
2129 int catch_inst, exception_inst;
2130 InstPtr inst;
2131 ExprPtr catch;
2132 ExprPtr name;
2133 SymbolPtr exception;
2134 Type *catch_type;
2135 NonLocal *nonLocal;
2136 int nest_tmp;
2137
2138 if (catches)
2139 {
2140 catch = catches->tree.right;
2141 /*
2142 * try a catch b
2143 *
2144 * CATCH b OpCall EXCEPTION a ENDCATCH
2145 * +----------------------+
2146 * +-----------------+
2147 */
2148
2149 if (catch->code.code->base.name->base.tag == COLONCOLON)
2150 name = catch->code.code->base.name->tree.right;
2151 else
2152 name = catch->code.code->base.name;
2153
2154 exception = name->atom.symbol;
2155
2156 if (!exception)
2157 {
2158 CompileError (obj, stat, "No exception '%A' in scope",
2159 name->atom.atom);
2160 RETURN(obj);
2161 }
2162 if (exception->symbol.class != class_exception)
2163 {
2164 CompileError (obj, stat, "Invalid use of %C \"%A\" as exception",
2165 exception->symbol.class, catch->code.code->base.name->atom);
2166 RETURN (obj);
2167 }
2168
2169 catch_type = NewTypeFunc (typePoly, catch->code.code->base.args);
2170 if (!TypeIsOrdered (exception->symbol.type, catch_type))
2171 {
2172 CompileError (obj, stat, "Incompatible types, formal '%T', actual '%T', for catch",
2173 exception->symbol.type, catch_type);
2174 RETURN (obj);
2175 }
2176 NewInst (obj, OpCatch, catch_inst, stat);
2177
2178 /*
2179 * Pop peer catch blocks from non local list while
2180 * compiling exception handler
2181 */
2182 nonLocal = obj->nonLocal;
2183 if (nest)
2184 {
2185 REFERENCE (nonLocal);
2186 nest_tmp = nest;
2187 while (nest_tmp-- > 0)
2188 obj->nonLocal = obj->nonLocal->prev;
2189 }
2190
2191 /*
2192 * Exception arguments are sitting in value, push
2193 * them on the stack
2194 */
2195 BuildInst (obj, OpNoop, inst, stat);
2196 SetPush (obj);
2197
2198 /*
2199 * Compile the exception handler and the
2200 * call to get to it.
2201 */
2202 catch->code.code->base.func = code ? code->base.func : 0;
2203 obj = CompileFunc (obj, catch->code.code, stat, code,
2204 NewNonLocal (obj->nonLocal,
2205 NonLocalCatch,
2206 NON_LOCAL_RETURN));
2207 /*
2208 * Patch non local returns inside
2209 */
2210 CompilePatchLoop (obj, catch_inst, -1, -1, -1);
2211
2212 /*
2213 * Unwind any peer catch blocks while executing catch
2214 */
2215 if (nest)
2216 {
2217 BuildInst (obj, OpUnwind, inst, stat);
2218 inst->unwind.twixt = 0;
2219 inst->unwind.catch = nest;
2220 /* replace peer catch blocks */
2221 obj->nonLocal = nonLocal;
2222 }
2223
2224 BuildInst (obj, OpExceptionCall, inst, stat);
2225
2226 exception_inst = obj->used;
2227
2228 BuildInst (obj, OpBranch, inst, stat);
2229 inst->branch.offset = 0;
2230 inst->branch.mod = BranchModCatch;
2231
2232 inst = ObjCode (obj, catch_inst);
2233 inst->catch.offset = obj->used - catch_inst;
2234 inst->catch.exception = exception;
2235
2236 obj->nonLocal = NewNonLocal (obj->nonLocal, NonLocalTry, 0);
2237
2238 obj = CompileCatch (obj, catches->tree.left, body, stat, code, nest+1);
2239
2240 obj->nonLocal = obj->nonLocal->prev;
2241
2242 if (!nest)
2243 {
2244 BuildInst (obj, OpEndCatch, inst, stat);
2245 inst->ints.value = CompileCountCatches (catches);
2246 /*
2247 * Patch Catch branches inside
2248 */
2249 CompilePatchLoop (obj, exception_inst, -1, -1, obj->used);
2250 }
2251 }
2252 else
2253 obj = _CompileStat (obj, body, False, code);
2254 RETURN (obj);
2255 }
2256
2257 ObjPtr
_CompileExpr(ObjPtr obj,ExprPtr expr,Bool evaluate,ExprPtr stat,CodePtr code)2258 _CompileExpr (ObjPtr obj, ExprPtr expr, Bool evaluate, ExprPtr stat, CodePtr code)
2259 {
2260 ENTER ();
2261 int ndim;
2262 int top_inst, test_inst, middle_inst;
2263 InstPtr inst;
2264 SymbolPtr s;
2265 Type *t;
2266 int staticLink;
2267 Bool bool_const;
2268
2269 switch (expr->base.tag) {
2270 case NAME:
2271 s = CompileCheckSymbol (obj, stat, expr, code, &staticLink, False);
2272 if (!s)
2273 {
2274 expr->base.type = typePoly;
2275 break;
2276 }
2277 switch (s->symbol.class) {
2278 case class_const:
2279 case class_global:
2280 BuildInst (obj, OpGlobal, inst, stat);
2281 inst->box.box = s->global.value;
2282 assert (s->global.value);
2283 #if 0
2284 inst->var.name = s;
2285 inst->var.staticLink = 0;
2286 #endif
2287 break;
2288 case class_static:
2289 BuildInst (obj, OpStatic, inst, stat);
2290 inst->frame.staticLink = staticLink;
2291 inst->frame.element = s->local.element;
2292 break;
2293 case class_arg:
2294 case class_auto:
2295 BuildInst (obj, OpLocal, inst, stat);
2296 inst->frame.staticLink = staticLink;
2297 inst->frame.element = s->local.element;
2298 break;
2299 default:
2300 CompileError (obj, stat, "Invalid use of %C \"%A\"",
2301 s->symbol.class, expr->atom.atom);
2302 expr->base.type = typePoly;
2303 inst = 0;
2304 break;
2305 }
2306 if (!inst)
2307 break;
2308 expr->base.type = s->symbol.type;
2309 t = CompileRefType (obj, expr, expr->base.type);
2310 if (t)
2311 {
2312 BuildInst (obj, OpUnFunc, inst, stat);
2313 inst->unfunc.func = Dereference;
2314 expr->base.type = t;
2315 }
2316 break;
2317 case VAR:
2318 obj = CompileDecl (obj, expr, evaluate, stat, code);
2319 break;
2320 case NEW:
2321 if (expr->base.type)
2322 obj = CompileType (obj, 0, expr->base.type, stat, code);
2323 obj = CompileInit (obj, expr->tree.left, expr->base.type, stat, code);
2324 break;
2325 case UNION:
2326 if (expr->tree.right)
2327 obj = _CompileExpr (obj, expr->tree.right, True, stat, code);
2328 else
2329 {
2330 BuildInst (obj, OpConst, inst, stat);
2331 inst->constant.constant = Void;
2332 }
2333 SetPush (obj);
2334 t = TypeCanon (expr->base.type);
2335 if (t && t->base.tag == type_union)
2336 {
2337 StructType *st = t->structs.structs;
2338 Type *mt;
2339
2340 expr->tree.left->base.type = StructMemType (st, expr->tree.left->atom.atom);
2341 if (!expr->tree.left->base.type)
2342 {
2343 CompileError (obj, stat, "Union type '%T' has no member \"%A\"",
2344 expr->base.type,
2345 expr->tree.left->atom.atom);
2346 break;
2347 }
2348 mt = TypeCanon (expr->tree.left->base.type);
2349 BuildInst (obj, OpBuildUnion, inst, stat);
2350 inst->structs.structs = st;
2351 if (expr->tree.right)
2352 {
2353 if (mt == typePrim[rep_void])
2354 {
2355 CompileError (obj, stat, "Union type '%T', member '%A' requires no constructor value",
2356 expr->base.type,
2357 expr->tree.left->atom.atom);
2358 break;
2359 }
2360 if (!TypeCombineBinary (expr->tree.left->base.type,
2361 ASSIGN,
2362 expr->tree.right->base.type))
2363 {
2364 CompileError (obj, stat, "Incompatible types, member '%T', value '%T', for union constructor",
2365 expr->tree.left->base.type,
2366 expr->tree.right->base.type);
2367 break;
2368 }
2369 }
2370 else
2371 {
2372 if (mt != typePrim[rep_void])
2373 {
2374 CompileError (obj, stat, "Union member '%A' requires constructor value",
2375 expr->tree.left->atom.atom);
2376 break;
2377 }
2378 }
2379 BuildInst (obj, OpInitUnion, inst, stat);
2380 inst->atom.atom = expr->tree.left->atom.atom;
2381 }
2382 else
2383 {
2384 CompileError (obj, stat, "Incompatible type, type '%T', for union constructor", expr->base.type);
2385 expr->base.type = typePoly;
2386 break;
2387 }
2388 break;
2389 case TEN_NUM:
2390 case OCTAL0_NUM:
2391 case OCTAL_NUM:
2392 case BINARY_NUM:
2393 case HEX_NUM:
2394 case CHAR_CONST:
2395 BuildInst (obj, OpConst, inst, stat);
2396 inst->constant.constant = expr->constant.constant;
2397 expr->base.type = typePrim[rep_integer];
2398 break;
2399 case TEN_FLOAT:
2400 case OCTAL_FLOAT:
2401 case BINARY_FLOAT:
2402 case HEX_FLOAT:
2403 BuildInst (obj, OpConst, inst, stat);
2404 inst->constant.constant = expr->constant.constant;
2405 if (ValueRep(expr->constant.constant) == &IntRep)
2406 expr->base.type = typePrim[rep_integer];
2407 else
2408 expr->base.type = typePrim[ValueTag(expr->constant.constant)];
2409 break;
2410 case STRING_CONST:
2411 BuildInst (obj, OpConst, inst, stat);
2412 inst->constant.constant = expr->constant.constant;
2413 expr->base.type = typePrim[rep_string];
2414 break;
2415 case THREAD_CONST:
2416 BuildInst (obj, OpConst, inst, stat);
2417 inst->constant.constant = expr->constant.constant;
2418 expr->base.type = typePrim[rep_thread];
2419 break;
2420 case VOIDVAL:
2421 BuildInst (obj, OpConst, inst, stat);
2422 inst->constant.constant = expr->constant.constant;
2423 expr->base.type = typePrim[rep_void];
2424 break;
2425 case BOOLVAL:
2426 BuildInst (obj, OpConst, inst, stat);
2427 inst->constant.constant = expr->constant.constant;
2428 expr->base.type = typePrim[rep_bool];
2429 break;
2430 case POLY_CONST:
2431 BuildInst (obj, OpConst, inst, stat);
2432 inst->constant.constant = expr->constant.constant;
2433 expr->base.type = typePoly; /* FIXME composite const type */
2434 break;
2435 case OS:
2436 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
2437
2438 obj = CompileArrayIndex (obj, expr->tree.right,
2439 CompileIndexType (expr->tree.left),
2440 stat, code, &ndim);
2441
2442 if (!ndim)
2443 {
2444 expr->base.type = typePoly;
2445 break;
2446 }
2447
2448 expr->base.type = TypeCombineArray (expr->tree.left->base.type,
2449 ndim,
2450 False);
2451
2452 if (!expr->base.type)
2453 {
2454 CompileError (obj, stat, "Incompatible type '%T', for %d dimension operation",
2455 expr->tree.left->base.type, ndim);
2456 expr->base.type = typePoly;
2457 break;
2458 }
2459 BuildInst (obj, OpArray, inst, stat);
2460 inst->ints.value = ndim;
2461 break;
2462 case OP: /* function call */
2463 obj = CompileCall (obj, expr, TailNever, stat, code, False);
2464 break;
2465 case COLONCOLON:
2466 obj = _CompileExpr (obj, expr->tree.right, evaluate, stat, code);
2467 expr->base.type = expr->tree.right->base.type;
2468 break;
2469 case DOT:
2470 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
2471 expr->base.type = TypeCombineStruct (expr->tree.left->base.type,
2472 expr->base.tag,
2473 expr->tree.right->atom.atom);
2474 if (!expr->base.type)
2475 {
2476 CompileError (obj, stat, "Type '%T' is not a struct or union containing \"%A\"",
2477 expr->tree.left->base.type,
2478 expr->tree.right->atom.atom);
2479 expr->base.type = typePoly;
2480 break;
2481 }
2482 BuildInst (obj, OpDot, inst, stat);
2483 inst->atom.atom = expr->tree.right->atom.atom;
2484 t = CompileRefType (obj, expr, expr->base.type);
2485 if (t)
2486 {
2487 BuildInst (obj, OpUnFunc, inst, stat);
2488 inst->unfunc.func = Dereference;
2489 expr->base.type = t;
2490 }
2491 break;
2492 case ARROW:
2493 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
2494 expr->base.type = TypeCombineStruct (expr->tree.left->base.type,
2495 expr->base.tag,
2496 expr->tree.right->atom.atom);
2497 if (!expr->base.type)
2498 {
2499 CompileError (obj, stat, "Type '%T' is not a struct or union ref containing \"%A\"",
2500 expr->tree.left->base.type,
2501 expr->tree.right->atom.atom);
2502 expr->base.type = typePoly;
2503 break;
2504 }
2505 BuildInst (obj, OpArrow, inst, stat);
2506 inst->atom.atom = expr->tree.right->atom.atom;
2507 t = CompileRefType (obj, expr, expr->base.type);
2508 if (t)
2509 {
2510 BuildInst (obj, OpUnFunc, inst, stat);
2511 inst->unfunc.func = Dereference;
2512 expr->base.type = t;
2513 }
2514 break;
2515 case FUNC:
2516 obj = CompileFunc (obj, expr->code.code, stat, code, 0);
2517 expr->base.type = NewTypeFunc (expr->code.code->base.type,
2518 expr->code.code->base.args);
2519 break;
2520 case STAR: obj = CompileUnFunc (obj, expr, Dereference, stat, code,"*"); break;
2521 case AMPER:
2522 obj = CompileLvalue (obj, expr->tree.left, stat, code, False, False, False,
2523 False, True);
2524 t = CompileRefType (obj, expr->tree.left, expr->tree.left->base.type);
2525 if (!t)
2526 t = expr->tree.left->base.type;
2527 expr->base.type = NewTypeRef (t, True);
2528 if (!expr->base.type)
2529 {
2530 CompileError (obj, stat, "Type '%T' cannot be an l-value",
2531 expr->tree.left->base.type);
2532 expr->base.type = typePoly;
2533 break;
2534 }
2535 break;
2536 case UMINUS: obj = CompileUnOp (obj, expr, NegateOp, stat, code); break;
2537 case LNOT: obj = CompileUnFunc (obj, expr, Lnot, stat, code,"~"); break;
2538 case BANG: obj = CompileUnFunc (obj, expr, Not, stat, code,"!"); break;
2539 case FACT:
2540 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
2541 SetPush (obj);
2542 obj = _CompileExpr (obj, expr->tree.right, True, stat, code);
2543 expr->base.type = TypeCombineUnary (expr->tree.right->base.type,
2544 expr->base.tag);
2545 if (!expr->base.type)
2546 {
2547 CompileError (obj, stat, "Incompatible type, value '%T', for ! operation",
2548 expr->tree.right->base.type);
2549 expr->base.type = typePoly;
2550 break;
2551 }
2552 BuildInst (obj, OpCall, inst, stat);
2553 inst->ints.value = 1;
2554 BuildInst (obj, OpNoop, inst, stat);
2555 break;
2556 case INC:
2557 if (expr->tree.left)
2558 {
2559 obj = CompileLvalue (obj, expr->tree.left, stat, code, False, False, False,
2560 False, False);
2561 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
2562 ASSIGNPLUS,
2563 typePrim[rep_int]);
2564 BuildInst (obj, OpPreOp, inst, stat);
2565 }
2566 else
2567 {
2568 obj = CompileLvalue (obj, expr->tree.right, stat, code,
2569 False, False, False, False, False);
2570 expr->base.type = TypeCombineBinary (expr->tree.right->base.type,
2571 ASSIGNPLUS,
2572 typePrim[rep_int]);
2573 BuildInst (obj, OpPostOp, inst, stat);
2574 }
2575 inst->binop.op = PlusOp;
2576 if (!expr->base.type)
2577 {
2578 CompileError (obj, stat, "Incompatible type, value '%T', for ++ operation ",
2579 expr->tree.left ? expr->tree.left->base.type :
2580 expr->tree.right->base.type);
2581 expr->base.type = typePoly;
2582 break;
2583 }
2584 break;
2585 case DEC:
2586 if (expr->tree.left)
2587 {
2588 obj = CompileLvalue (obj, expr->tree.left, stat, code,
2589 False, False, False, False, False);
2590 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
2591 ASSIGNMINUS,
2592 typePrim[rep_int]);
2593 BuildInst (obj, OpPreOp, inst, stat);
2594 }
2595 else
2596 {
2597 obj = CompileLvalue (obj, expr->tree.right, stat, code,
2598 False, False, False, False, False);
2599 expr->base.type = TypeCombineBinary (expr->tree.right->base.type,
2600 ASSIGNMINUS,
2601 typePrim[rep_int]);
2602 BuildInst (obj, OpPostOp, inst, stat);
2603 }
2604 inst->binop.op = MinusOp;
2605 if (!expr->base.type)
2606 {
2607 CompileError (obj, stat, "Incompatible type, value '%T', for -- operation",
2608 expr->tree.left ? expr->tree.left->base.type :
2609 expr->tree.right->base.type);
2610 expr->base.type = typePoly;
2611 break;
2612 }
2613 break;
2614 case PLUS: obj = CompileBinOp (obj, expr, PlusOp, stat, code); break;
2615 case MINUS: obj = CompileBinOp (obj, expr, MinusOp, stat, code); break;
2616 case TIMES: obj = CompileBinOp (obj, expr, TimesOp, stat, code); break;
2617 case DIVIDE: obj = CompileBinOp (obj, expr, DivideOp, stat, code); break;
2618 case DIV: obj = CompileBinOp (obj, expr, DivOp, stat, code); break;
2619 case MOD: obj = CompileBinOp (obj, expr, ModOp, stat, code); break;
2620 case POW:
2621 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
2622 SetPush (obj);
2623 obj = _CompileExpr (obj, expr->tree.right->tree.left, True, stat, code);
2624 SetPush (obj);
2625 obj = _CompileExpr (obj, expr->tree.right->tree.right, True, stat, code);
2626 expr->base.type = TypeCombineBinary (expr->tree.right->tree.left->base.type,
2627 expr->base.tag,
2628 expr->tree.right->tree.right->base.type);
2629 if (!expr->base.type)
2630 {
2631 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for ** operation",
2632 expr->tree.right->tree.left->base.type,
2633 expr->tree.right->tree.right->base.type);
2634 expr->base.type = typePoly;
2635 break;
2636 }
2637 BuildInst (obj, OpCall, inst, stat);
2638 inst->ints.value = 2;
2639 BuildInst (obj, OpNoop, inst, stat);
2640 break;
2641 case SHIFTL: obj = CompileBinFunc (obj, expr, ShiftL, stat, code, "<<"); break;
2642 case SHIFTR: obj = CompileBinFunc (obj, expr, ShiftR, stat, code, ">>"); break;
2643 case QUEST:
2644 /*
2645 * a ? b : c
2646 *
2647 * a QUEST b COLON c
2648 * +-------------+
2649 * +-------+
2650 */
2651 top_inst = obj->used;
2652 obj = _CompileBoolExpr (obj, expr->tree.left, True, stat, code);
2653 if (obj->used == top_inst + 1 &&
2654 (inst = ObjCode (obj, top_inst))->base.opCode == OpConst)
2655 {
2656 test_inst = -1;
2657 bool_const = True (inst->constant.constant);
2658 obj->used = top_inst;
2659 }
2660 else
2661 {
2662 NewInst (obj, OpBranchFalse, test_inst, stat);
2663 bool_const = False;
2664 }
2665 top_inst = obj->used;
2666 obj = _CompileExpr (obj, expr->tree.right->tree.left, evaluate, stat, code);
2667 if (test_inst == -1)
2668 {
2669 middle_inst = -1;
2670 if (!bool_const)
2671 obj->used = top_inst;
2672 }
2673 else
2674 {
2675 NewInst (obj, OpBranch, middle_inst, stat);
2676 inst = ObjCode (obj, test_inst);
2677 inst->branch.offset = obj->used - test_inst;
2678 inst->branch.mod = BranchModNone;
2679 }
2680
2681 top_inst = obj->used;
2682 obj = _CompileExpr (obj, expr->tree.right->tree.right, evaluate, stat, code);
2683 if (middle_inst == -1)
2684 {
2685 if (bool_const)
2686 obj->used = top_inst;
2687 }
2688 else
2689 {
2690 inst = ObjCode (obj, middle_inst);
2691 inst->branch.offset = obj->used - middle_inst;
2692 inst->branch.mod = BranchModNone;
2693 BuildInst (obj, OpNoop, inst, stat);
2694 }
2695
2696 expr->base.type = TypeCombineBinary (expr->tree.right->tree.left->base.type,
2697 COLON,
2698 expr->tree.right->tree.right->base.type);
2699 if (!expr->base.type)
2700 {
2701 CompileError (obj, stat, "Incompatible types, true '%T', false '%T', for ?: operation",
2702 expr->tree.right->tree.left->base.type,
2703 expr->tree.right->tree.right->base.type);
2704 expr->base.type = typePoly;
2705 break;
2706 }
2707 break;
2708 case LXOR: obj = CompileBinFunc (obj, expr, Lxor, stat, code, "^"); break;
2709 case LAND: obj = CompileBinOp (obj, expr, LandOp, stat, code); break;
2710 case LOR: obj = CompileBinOp (obj, expr, LorOp, stat, code); break;
2711 case AND:
2712 /*
2713 * a && b
2714 *
2715 * a ANDAND b
2716 * +--------+
2717 */
2718 top_inst = obj->used;
2719 obj = _CompileBoolExpr (obj, expr->tree.left, True, stat, code);
2720 if (obj->used == top_inst + 1 &&
2721 (inst = ObjCode (obj, top_inst))->base.opCode == OpConst)
2722 {
2723 test_inst = -1;
2724 bool_const = True (inst->constant.constant);
2725 if (bool_const)
2726 obj->used = top_inst;
2727 }
2728 else
2729 {
2730 NewInst (obj, OpBranchFalse, test_inst, stat);
2731 bool_const = True;
2732 }
2733 middle_inst = obj->used;
2734 /*
2735 * Always compile the RHS to check for errors
2736 */
2737 obj = _CompileBoolExpr (obj, expr->tree.right, evaluate, stat, code);
2738 /*
2739 * Smash any instructions if they'll be skipped
2740 */
2741 if (!bool_const)
2742 obj->used = middle_inst;
2743 if (test_inst >= 0)
2744 {
2745 inst = ObjCode (obj, test_inst);
2746 inst->branch.offset = obj->used - test_inst;
2747 inst->branch.mod = BranchModNone;
2748 BuildInst (obj, OpNoop, inst, stat);
2749 }
2750 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
2751 AND,
2752 expr->tree.right->base.type);
2753 if (!expr->base.type)
2754 {
2755 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for && operation",
2756 expr->tree.left->base.type,
2757 expr->tree.right->base.type);
2758 expr->base.type = typePoly;
2759 break;
2760 }
2761 break;
2762 case OR:
2763 /*
2764 * a || b
2765 *
2766 * a OROR b
2767 * +--------+
2768 */
2769 top_inst = obj->used;
2770 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
2771 if (obj->used == top_inst + 1 &&
2772 (inst = ObjCode (obj, top_inst))->base.opCode == OpConst)
2773 {
2774 test_inst = -1;
2775 bool_const = True (inst->constant.constant);
2776 if (!bool_const)
2777 obj->used = top_inst;
2778 }
2779 else
2780 {
2781 NewInst (obj, OpBranchTrue, test_inst, stat);
2782 bool_const = False;
2783 }
2784 middle_inst = obj->used;
2785 /*
2786 * Always compile the RHS to check for errors
2787 */
2788 obj = _CompileExpr (obj, expr->tree.right, evaluate, stat, code);
2789 /*
2790 * Smash any instructions if they'll be skipped
2791 */
2792 if (bool_const)
2793 obj->used = middle_inst;
2794 if (test_inst >= 0)
2795 {
2796 inst = ObjCode (obj, test_inst);
2797 inst->branch.offset = obj->used - test_inst;
2798 inst->branch.mod = BranchModNone;
2799 BuildInst (obj, OpNoop, inst, stat);
2800 }
2801 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
2802 OR,
2803 expr->tree.right->base.type);
2804 if (!expr->base.type)
2805 {
2806 CompileError (obj, stat, "Incompatible types, left '%T', right, '%T', for || operation",
2807 expr->tree.left->base.type,
2808 expr->tree.right->base.type);
2809 expr->base.type = typePoly;
2810 break;
2811 }
2812 break;
2813 case ASSIGN: obj = CompileAssign (obj, expr, False, stat, code); break;
2814 case ASSIGNPLUS: obj = CompileAssignOp (obj, expr, PlusOp, stat, code); break;
2815 case ASSIGNMINUS: obj = CompileAssignOp (obj, expr, MinusOp, stat, code); break;
2816 case ASSIGNTIMES: obj = CompileAssignOp (obj, expr, TimesOp, stat, code); break;
2817 case ASSIGNDIVIDE: obj = CompileAssignOp (obj, expr, DivideOp, stat, code); break;
2818 case ASSIGNDIV: obj = CompileAssignOp (obj, expr, DivOp, stat, code); break;
2819 case ASSIGNMOD: obj = CompileAssignOp (obj, expr, ModOp, stat, code); break;
2820 case ASSIGNPOW:
2821 obj = _CompileExpr (obj, expr->tree.left, True, stat, code);
2822 SetPush (obj);
2823 obj = CompileLvalue (obj, expr->tree.right->tree.left, stat, code,
2824 False, False, False, False, False);
2825 SetPush (obj);
2826 obj = _CompileExpr (obj, expr->tree.right->tree.right, True, stat, code);
2827 expr->base.type = TypeCombineBinary (expr->tree.right->tree.left->base.type,
2828 expr->base.tag,
2829 expr->tree.right->tree.right->base.type);
2830 if (!expr->base.type)
2831 {
2832 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for **= operation",
2833 expr->tree.right->tree.left->base.type,
2834 expr->tree.right->tree.right->base.type);
2835 expr->base.type = typePoly;
2836 break;
2837 }
2838 BuildInst (obj, OpCall, inst, stat);
2839 inst->ints.value = 2;
2840 BuildInst (obj, OpNoop, inst, stat);
2841 break;
2842 case ASSIGNSHIFTL: obj = CompileAssignFunc (obj, expr, ShiftL, stat, code, "<<"); break;
2843 case ASSIGNSHIFTR: obj = CompileAssignFunc (obj, expr, ShiftR, stat, code, ">>"); break;
2844 case ASSIGNLXOR: obj = CompileAssignFunc (obj, expr, Lxor, stat, code, "^"); break;
2845 case ASSIGNLAND: obj = CompileAssignOp (obj, expr, LandOp, stat, code); break;
2846 case ASSIGNLOR: obj = CompileAssignOp (obj, expr, LorOp, stat, code); break;
2847 case ASSIGNAND:
2848 /*
2849 * a &&= b
2850 *
2851 * a ASSIGNAND b
2852 * +--------+
2853 */
2854 top_inst = obj->used;
2855 obj = CompileLvalue (obj, expr->tree.left, stat, code,
2856 False, False, False, False, False);
2857 SetPush (obj);
2858 NewInst (obj, OpFetch, middle_inst, stat);
2859 NewInst (obj, OpBranchFalse, test_inst, stat);
2860 /* no short circuit */
2861 obj = _CompileBoolExpr (obj, expr->tree.right, True, stat, code);
2862 if (test_inst >= 0)
2863 {
2864 inst = ObjCode (obj, test_inst);
2865 inst->branch.offset = obj->used - test_inst;
2866 inst->branch.mod = BranchModNone;
2867 BuildInst (obj, OpAssign, inst, stat);
2868 NewInst(obj, OpBranch, test_inst, stat);
2869 } else {
2870 NewInst (obj, OpAssign, middle_inst, stat);
2871 NewInst(obj, OpBranch, test_inst, stat);
2872 }
2873 /* short circuit */
2874 NewInst(obj, OpDrop, middle_inst, stat);
2875 inst = ObjCode(obj, test_inst);
2876 inst->branch.offset = obj->used - test_inst;
2877 inst->branch.mod = BranchModNone;
2878 /* exit: is this Noop necessary? */
2879 BuildInst (obj, OpNoop, inst, stat);
2880 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
2881 AND,
2882 expr->tree.right->base.type);
2883 if (!expr->base.type)
2884 {
2885 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for &&= operation",
2886 expr->tree.left->base.type,
2887 expr->tree.right->base.type);
2888 expr->base.type = typePoly;
2889 break;
2890 }
2891 break;
2892 case ASSIGNOR:
2893 /*
2894 * a ||= b
2895 *
2896 * a ASSIGNOR b
2897 * +--------+
2898 */
2899 top_inst = obj->used;
2900 obj = CompileLvalue (obj, expr->tree.left, stat, code,
2901 False, False, False, False, False);
2902 SetPush (obj);
2903 NewInst (obj, OpFetch, middle_inst, stat);
2904 NewInst (obj, OpBranchTrue, test_inst, stat);
2905 /* no short circuit */
2906 obj = _CompileBoolExpr (obj, expr->tree.right, True, stat, code);
2907 if (test_inst >= 0)
2908 {
2909 inst = ObjCode (obj, test_inst);
2910 inst->branch.offset = obj->used - test_inst;
2911 inst->branch.mod = BranchModNone;
2912 BuildInst (obj, OpAssign, inst, stat);
2913 NewInst(obj, OpBranch, test_inst, stat);
2914 } else {
2915 NewInst (obj, OpAssign, middle_inst, stat);
2916 NewInst(obj, OpBranch, test_inst, stat);
2917 }
2918 /* short circuit */
2919 NewInst(obj, OpDrop, middle_inst, stat);
2920 inst = ObjCode(obj, test_inst);
2921 inst->branch.offset = obj->used - test_inst;
2922 inst->branch.mod = BranchModNone;
2923 /* exit: is this Noop necessary? */
2924 BuildInst (obj, OpNoop, inst, stat);
2925 expr->base.type = TypeCombineBinary (expr->tree.left->base.type,
2926 OR,
2927 expr->tree.right->base.type);
2928 if (!expr->base.type)
2929 {
2930 CompileError (obj, stat, "Incompatible types, left '%T', right '%T', for ||= operation",
2931 expr->tree.left->base.type,
2932 expr->tree.right->base.type);
2933 expr->base.type = typePoly;
2934 break;
2935 }
2936 break;
2937 case EQ: obj = CompileBinOp (obj, expr, EqualOp, stat, code); break;
2938 case NE: obj = CompileBinFunc (obj, expr, NotEqual, stat, code,"!="); break;
2939 case LT: obj = CompileBinOp (obj, expr, LessOp, stat, code); break;
2940 case GT: obj = CompileBinFunc (obj, expr, Greater, stat, code,">"); break;
2941 case LE: obj = CompileBinFunc (obj, expr, LessEqual, stat, code,"<="); break;
2942 case GE: obj = CompileBinFunc (obj, expr, GreaterEqual, stat, code,">="); break;
2943 case COMMA:
2944 top_inst = obj->used;
2945 obj = _CompileExpr (obj, expr->tree.left, False, stat, code);
2946 if (obj->used == top_inst + 1 &&
2947 (inst = ObjCode (obj, top_inst))->base.opCode == OpConst)
2948 {
2949 obj->used = top_inst;
2950 }
2951 expr->base.type = expr->tree.left->base.type;
2952 if (expr->tree.right)
2953 {
2954 obj = _CompileExpr (obj, expr->tree.right, evaluate, stat, code);
2955 expr->base.type = expr->tree.right->base.type;
2956 }
2957 break;
2958 case FORK:
2959 BuildInst (obj, OpFork, inst, stat);
2960 inst->obj.obj = CompileExpr (expr->tree.right, code);
2961 expr->base.type = typePrim[rep_thread];
2962 break;
2963 case THREAD:
2964 obj = CompileCall (obj, NewExprTree (OP,
2965 expr->tree.right,
2966 NewExprTree (COMMA,
2967 expr->tree.left,
2968 (Expr *) 0)),
2969 TailNever,
2970 stat, code, False);
2971 expr->base.type = typePrim[rep_thread];
2972 break;
2973 case DOLLAR:
2974 {
2975 ExprPtr value, new;
2976
2977 if (expr->tree.left)
2978 value = expr->tree.left;
2979 else
2980 value = NewExprConst (TEN_NUM, Zero);
2981 new = BuildCall ("History", "fetch", 1, value);
2982 obj = _CompileExpr (obj, new, True, stat, code);
2983 }
2984 expr->base.type = typePoly;
2985 break;
2986 case ISTYPE:
2987 obj = _CompileExpr (obj, expr->type.left, evaluate, stat, code);
2988 BuildInst (obj, OpIsType, inst, stat);
2989 inst->isType.type = expr->type.type;
2990 expr->base.type = typePrim[rep_bool];
2991 break;
2992 case HASMEMBER:
2993 obj = _CompileExpr (obj, expr->tree.left, evaluate, stat, code);
2994 BuildInst (obj, OpHasMember, inst, stat);
2995 inst->atom.atom = expr->tree.right->atom.atom;
2996 expr->base.type = typePrim[rep_bool];
2997 break;
2998 case EXPR:
2999 /* reposition statement reference so top-level errors are nicer*/
3000 obj = _CompileExpr (obj, expr->tree.left, evaluate, expr, code);
3001 expr->base.type = expr->tree.left->base.type;
3002 break;
3003 case OC:
3004 /* statement block embedded in an expression */
3005 obj = _CompileStat (obj, expr, True, code);
3006 BuildInst (obj, OpConst, inst, stat);
3007 inst->constant.constant = Void;
3008 expr->base.type = typePrim[rep_void];
3009 break;
3010 default:
3011 assert(0);
3012 }
3013 assert (!evaluate || expr->base.type);
3014 RETURN (obj);
3015 }
3016
3017 void
CompilePatchLoop(ObjPtr obj,int start,int continue_offset,int break_offset,int catch_offset)3018 CompilePatchLoop (ObjPtr obj,
3019 int start,
3020 int continue_offset,
3021 int break_offset,
3022 int catch_offset)
3023 {
3024 InstPtr inst;
3025
3026 while (start < obj->used)
3027 {
3028 inst = ObjCode (obj, start);
3029 switch (inst->base.opCode) {
3030 case OpBranch:
3031 if (inst->branch.offset == 0)
3032 {
3033 switch (inst->branch.mod) {
3034 case BranchModBreak:
3035 inst->branch.offset = break_offset - start;
3036 break;
3037 case BranchModContinue:
3038 if (continue_offset >= 0)
3039 inst->branch.offset = continue_offset - start;
3040 break;
3041 case BranchModCatch:
3042 if (catch_offset >= 0)
3043 inst->branch.offset = catch_offset - start;
3044 break;
3045 default:
3046 break;
3047 }
3048 }
3049 break;
3050 case OpFarJump:
3051 if (inst->farJump.farJump->inst == -1)
3052 {
3053 switch (inst->farJump.mod) {
3054 case BranchModBreak:
3055 inst->farJump.farJump->inst = break_offset;
3056 break;
3057 case BranchModContinue:
3058 inst->farJump.farJump->inst = continue_offset;
3059 break;
3060 case BranchModReturn:
3061 case BranchModReturnVoid:
3062 inst->farJump.farJump->inst = -2;
3063 break;
3064 case BranchModNone:
3065 case BranchModCatch:
3066 break;
3067 }
3068 }
3069 break;
3070 case OpObj:
3071 if (!inst->code.code->base.builtin &&
3072 inst->code.code->func.body.obj->nonLocal)
3073 {
3074 if (inst->code.code->func.body.obj)
3075 CompilePatchLoop (inst->code.code->func.body.obj, 0,
3076 continue_offset,
3077 break_offset,
3078 -1);
3079 if (inst->code.code->func.staticInit.obj)
3080 CompilePatchLoop (inst->code.code->func.staticInit.obj, 0,
3081 continue_offset,
3082 break_offset, -1);
3083 }
3084 break;
3085 default:
3086 break;
3087 }
3088 ++start;
3089 }
3090 }
3091
3092 static void
CompileMoveObj(ObjPtr obj,int start,int depth,int amount)3093 CompileMoveObj (ObjPtr obj,
3094 int start,
3095 int depth,
3096 int amount)
3097 {
3098 InstPtr inst;
3099
3100 while (start < obj->used)
3101 {
3102 inst = ObjCode (obj, start);
3103 switch (inst->base.opCode) {
3104 case OpFarJump:
3105 if (inst->farJump.farJump->frame == depth &&
3106 inst->farJump.farJump->inst >= 0)
3107 {
3108 inst->farJump.farJump->inst += amount;
3109 }
3110 break;
3111 case OpObj:
3112 if (!inst->code.code->base.builtin &&
3113 inst->code.code->func.body.obj->nonLocal)
3114 {
3115 if (inst->code.code->func.body.obj)
3116 CompileMoveObj (inst->code.code->func.body.obj, 0,
3117 depth + 1, amount);
3118 if (inst->code.code->func.staticInit.obj)
3119 CompileMoveObj (inst->code.code->func.staticInit.obj, 0,
3120 depth + 1, amount);
3121 }
3122 break;
3123 default:
3124 break;
3125 }
3126 ++start;
3127 }
3128 }
3129
3130 static ObjPtr
_CompileNonLocal(ObjPtr obj,BranchMod mod,ExprPtr expr,CodePtr code)3131 _CompileNonLocal (ObjPtr obj, BranchMod mod, ExprPtr expr, CodePtr code)
3132 {
3133 ENTER ();
3134 int twixt = 0, catch = 0, frame = 0;
3135 NonLocal *nl;
3136 InstPtr inst;
3137 int target;
3138
3139 switch (mod) {
3140 case BranchModBreak: target = NON_LOCAL_BREAK; break;
3141 case BranchModContinue: target = NON_LOCAL_CONTINUE; break;
3142 case BranchModReturn:
3143 case BranchModReturnVoid: target = NON_LOCAL_RETURN; break;
3144 case BranchModNone:
3145 default: RETURN(obj);
3146 }
3147 for (nl = obj->nonLocal; nl; nl = nl->prev)
3148 {
3149 if (nl->target & target)
3150 break;
3151 switch (nl->kind) {
3152 case NonLocalTwixt:
3153 twixt++;
3154 break;
3155 case NonLocalTry:
3156 catch++;
3157 break;
3158 case NonLocalCatch:
3159 frame++;
3160 break;
3161 case NonLocalControl:
3162 break;
3163 }
3164 }
3165 if (!nl)
3166 {
3167 switch (target) {
3168 case NON_LOCAL_BREAK:
3169 CompileError (obj, expr, "break not in loop/switch/twixt");
3170 break;
3171 case NON_LOCAL_CONTINUE:
3172 CompileError (obj, expr, "continue not in loop");
3173 break;
3174 case NON_LOCAL_RETURN:
3175 break;
3176 }
3177 }
3178 if (twixt || catch || frame)
3179 {
3180 BuildInst (obj, OpFarJump, inst, expr);
3181 inst->farJump.farJump = 0;
3182 inst->farJump.farJump = NewFarJump (-1, twixt, catch, frame);
3183 inst->farJump.mod = mod;
3184 }
3185 else
3186 {
3187 switch (mod) {
3188 case BranchModReturn:
3189 BuildInst (obj, OpReturn, inst, expr);
3190 break;
3191 case BranchModReturnVoid:
3192 BuildInst (obj, OpReturnVoid, inst, expr);
3193 break;
3194 case BranchModBreak:
3195 case BranchModContinue:
3196 BuildInst (obj, OpBranch, inst, expr);
3197 inst->branch.offset = 0; /* filled in by PatchLoop */
3198 inst->branch.mod = mod;
3199 case BranchModNone:
3200 case BranchModCatch:
3201 break;
3202 }
3203 }
3204 RETURN (obj);
3205 }
3206
3207 /*
3208 * Check if a return foo () can be turned into a tail call.
3209 */
3210 static Bool
_CompileCanTailCall(ObjPtr obj,CodePtr code)3211 _CompileCanTailCall (ObjPtr obj, CodePtr code)
3212 {
3213 /* not in a function ("can't" happen) */
3214 if (!code)
3215 return False;
3216 /* if profiling, disable tail calls to avoid losing information */
3217 if (profiling)
3218 return False;
3219 /* Check for enclosing non-local branch targets */
3220 if (obj->nonLocal != 0)
3221 return False;
3222 /* Check for compiling in a nested exception handler */
3223 if (code->base.func != code)
3224 return False;
3225 return True;
3226 }
3227
3228 ObjPtr
_CompileBoolExpr(ObjPtr obj,ExprPtr expr,Bool evaluate,ExprPtr stat,CodePtr code)3229 _CompileBoolExpr (ObjPtr obj, ExprPtr expr, Bool evaluate, ExprPtr stat, CodePtr code)
3230 {
3231 obj = _CompileExpr (obj, expr, evaluate, stat, code);
3232 if (!TypePoly (expr->base.type) && !TypeBool (expr->base.type))
3233 {
3234 CompileError (obj, expr, "Incompatible type, value '%T', for boolean", expr->base.type);
3235 }
3236 return obj;
3237 }
3238
3239 ObjPtr
_CompileStat(ObjPtr obj,ExprPtr expr,Bool last,CodePtr code)3240 _CompileStat (ObjPtr obj, ExprPtr expr, Bool last, CodePtr code)
3241 {
3242 ENTER ();
3243 int start_inst, top_inst, continue_inst, test_inst, middle_inst;
3244 ExprPtr c;
3245 int ncase, *case_inst, icase;
3246 Bool has_default;
3247 InstPtr inst;
3248 StructType *st;
3249 ObjPtr cobj, bobj;
3250
3251 switch (expr->base.tag) {
3252 case IF:
3253 /*
3254 * if (a) b
3255 *
3256 * a BRANCHFALSE b
3257 * +-------------+
3258 */
3259 top_inst = obj->used;
3260 obj = _CompileBoolExpr (obj, expr->tree.left, True, expr, code);
3261 if (obj->used == top_inst + 1 &&
3262 (inst = ObjCode (obj, top_inst))->base.opCode == OpConst)
3263 {
3264 Bool t = True (inst->constant.constant);
3265
3266 obj->used = top_inst;
3267 if (t)
3268 obj = _CompileStat (obj, expr->tree.right, last, code);
3269 }
3270 else
3271 {
3272 NewInst (obj, OpBranchFalse, test_inst, expr);
3273 obj = _CompileStat (obj, expr->tree.right, last, code);
3274 inst = ObjCode (obj, test_inst);
3275 inst->branch.offset = obj->used - test_inst;
3276 inst->branch.mod = BranchModNone;
3277 }
3278 break;
3279 case ELSE:
3280 /*
3281 * if (a) b else c
3282 *
3283 * a BRANCHFALSE b BRANCH c
3284 * +--------------------+
3285 * +--------+
3286 */
3287 top_inst = obj->used;
3288 obj = _CompileBoolExpr (obj, expr->tree.left, True, expr, code);
3289 if (obj->used == top_inst + 1 &&
3290 (inst = ObjCode (obj, top_inst))->base.opCode == OpConst)
3291 {
3292 Bool t = True (inst->constant.constant);
3293
3294 obj->used = top_inst;
3295 /*
3296 * Check which side wins
3297 */
3298 if (t)
3299 obj = _CompileStat (obj, expr->tree.right->tree.left, last, code);
3300 else
3301 obj = _CompileStat (obj, expr->tree.right->tree.right, last, code);
3302 }
3303 else
3304 {
3305 NewInst (obj, OpBranchFalse, test_inst, expr);
3306 /*
3307 * Compile b
3308 */
3309 obj = _CompileStat (obj, expr->tree.right->tree.left, last, code);
3310 /*
3311 * Branch around else if reachable
3312 */
3313 if (CompileIsReachable (obj, obj->used, 0))
3314 {
3315 NewInst (obj, OpBranch, middle_inst, expr);
3316 }
3317 else
3318 middle_inst = -1;
3319 /*
3320 * Fix up branch on a
3321 */
3322 inst = ObjCode (obj, test_inst);
3323 inst->branch.offset = obj->used - test_inst;
3324 inst->branch.mod = BranchModNone;
3325 /*
3326 * Compile c
3327 */
3328 obj = _CompileStat (obj, expr->tree.right->tree.right, last, code);
3329 /*
3330 * Fix up branch around else if necessary
3331 */
3332 if (middle_inst != -1)
3333 {
3334 inst = ObjCode (obj, middle_inst);
3335 inst->branch.offset = obj->used - middle_inst;
3336 inst->branch.mod = BranchModNone;
3337 }
3338 }
3339 break;
3340 case WHILE:
3341 /*
3342 * while (a) b
3343 *
3344 * a BRANCHFALSE b BRANCH
3345 * +--------------------+
3346 * +---------------+
3347 */
3348
3349 cobj = NewObj (OBJ_INCR, OBJ_STAT_INCR);
3350 cobj = _CompileBoolExpr (cobj, expr->tree.left, True, expr, code);
3351
3352 if (cobj->used == 1 &&
3353 (inst = ObjCode (cobj, 0))->base.opCode == OpConst)
3354 {
3355 Bool t = True (inst->constant.constant);
3356
3357 if (!t)
3358 {
3359 /* strip out the whole while loop */
3360 break;
3361 }
3362 start_inst = -1;
3363 }
3364 else
3365 {
3366 NewInst (obj, OpBranch, start_inst, expr);
3367 }
3368
3369 top_inst = obj->used;
3370 obj->nonLocal = NewNonLocal (obj->nonLocal, NonLocalControl,
3371 NON_LOCAL_BREAK|NON_LOCAL_CONTINUE);
3372 obj = _CompileStat (obj, expr->tree.right, False, code);
3373 obj->nonLocal = obj->nonLocal->prev;
3374
3375 continue_inst = obj->used;
3376
3377 if (start_inst != -1)
3378 {
3379 inst = ObjCode (obj, start_inst);
3380 inst->branch.offset = obj->used - start_inst;
3381 inst->branch.mod = BranchModNone;
3382
3383 middle_inst = obj->used;
3384 obj = AppendObj (obj, cobj);
3385 CompileMoveObj (obj, middle_inst, 0, middle_inst);
3386 BuildInst (obj, OpBranchTrue, inst, expr);
3387 inst->branch.offset = top_inst - ObjLast(obj);
3388 inst->branch.mod = BranchModNone;
3389 }
3390 else
3391 {
3392 BuildInst (obj, OpBranch, inst, expr);
3393 inst->branch.offset = top_inst - ObjLast(obj);
3394 inst->branch.mod = BranchModNone;
3395 }
3396
3397 CompilePatchLoop (obj, top_inst, continue_inst, obj->used, -1);
3398 break;
3399 case DO:
3400 /*
3401 * do a while (b);
3402 *
3403 * a b DO
3404 * +---+
3405 */
3406 top_inst = obj->used;
3407 obj->nonLocal = NewNonLocal (obj->nonLocal, NonLocalControl,
3408 NON_LOCAL_BREAK|NON_LOCAL_CONTINUE);
3409 obj = _CompileStat (obj, expr->tree.left, False, code);
3410 obj->nonLocal = obj->nonLocal->prev;
3411 continue_inst = obj->used;
3412 obj = _CompileBoolExpr (obj, expr->tree.right, True, expr, code);
3413 if (obj->used == continue_inst + 1 &&
3414 (inst = ObjCode (obj, continue_inst))->base.opCode == OpConst)
3415 {
3416 Bool t = True (inst->constant.constant);
3417
3418 obj->used = continue_inst;
3419 if (t)
3420 {
3421 BuildInst (obj, OpBranch, inst, expr);
3422 inst->branch.offset = top_inst - ObjLast(obj);
3423 inst->branch.mod = BranchModNone;
3424 }
3425 }
3426 else
3427 {
3428 BuildInst (obj, OpBranchTrue, inst, expr);
3429 inst->branch.offset = top_inst - ObjLast(obj);
3430 inst->branch.mod = BranchModNone;
3431 }
3432 CompilePatchLoop (obj, top_inst, continue_inst, obj->used, -1);
3433 break;
3434 case FOR:
3435 /*
3436 * for (a; b; c) d
3437 *
3438 * a BRANCH d c b BRANCHTRUE
3439 * +----------+
3440 * +-----+
3441 */
3442 /* a */
3443 if (expr->tree.left->tree.left)
3444 obj = _CompileExpr (obj, expr->tree.left->tree.left, False, expr, code);
3445
3446 test_inst = -1;
3447 start_inst = -1;
3448
3449 /* check for b */
3450 bobj = 0;
3451 if (expr->tree.left->tree.right->tree.left)
3452 {
3453 bobj = NewObj (OBJ_INCR, OBJ_STAT_INCR);
3454 bobj = _CompileBoolExpr (bobj,
3455 expr->tree.left->tree.right->tree.left,
3456 True, expr, code);
3457 NewInst (obj, OpBranch, start_inst, expr);
3458 }
3459
3460 /* check for c */
3461 cobj = 0;
3462 if (expr->tree.left->tree.right->tree.right->tree.left)
3463 {
3464 cobj = NewObj (OBJ_INCR, OBJ_STAT_INCR);
3465 cobj = _CompileExpr (cobj, expr->tree.left->tree.right->tree.right->tree.left, False, expr, code);
3466 }
3467
3468 top_inst = obj->used;
3469
3470 /* d */
3471 obj->nonLocal = NewNonLocal (obj->nonLocal, NonLocalControl,
3472 NON_LOCAL_BREAK|NON_LOCAL_CONTINUE);
3473 obj = _CompileStat (obj, expr->tree.right, False, code);
3474 obj->nonLocal = obj->nonLocal->prev;
3475
3476 /* glue c into place */
3477 continue_inst = obj->used;
3478 if (cobj)
3479 {
3480 middle_inst = obj->used;
3481 obj = AppendObj (obj, cobj);
3482 CompileMoveObj (obj, middle_inst, 0, middle_inst);
3483 }
3484
3485 /* glue b into place */
3486 if (bobj)
3487 {
3488 int middle_inst = obj->used;
3489 obj = AppendObj (obj, bobj);
3490 CompileMoveObj (obj, middle_inst, 0, middle_inst);
3491 if (obj->used == middle_inst + 1 &&
3492 (inst = ObjCode (obj, middle_inst))->base.opCode == OpConst)
3493 {
3494 Bool t = True(inst->constant.constant);
3495
3496 obj->used = middle_inst;
3497 if (t)
3498 {
3499 BuildInst (obj, OpBranch, inst, expr);
3500 inst->branch.offset = top_inst - ObjLast (obj);
3501 inst->branch.mod = BranchModNone;
3502 }
3503 else
3504 {
3505 /* delete whole for body */
3506 ResetInst (obj, start_inst);
3507 continue_inst = top_inst = start_inst;
3508 }
3509 }
3510 else
3511 {
3512
3513 BuildInst (obj, OpBranchTrue, inst, expr);
3514 inst->branch.offset = top_inst - ObjLast(obj);
3515 inst->branch.mod = BranchModNone;
3516 }
3517
3518 /* patch start branch */
3519 inst = ObjCode (obj, start_inst);
3520 inst->branch.offset = middle_inst - start_inst;
3521 inst->branch.mod = BranchModNone;
3522 }
3523 else
3524 {
3525 BuildInst (obj, OpBranch, inst, expr);
3526 inst->branch.offset = top_inst - ObjLast (obj);
3527 inst->branch.mod = BranchModNone;
3528 }
3529
3530 CompilePatchLoop (obj, top_inst, continue_inst, obj->used, -1);
3531 break;
3532 case SWITCH:
3533 case UNION:
3534 /*
3535 * switch (a) { case b: c; case d: e; }
3536 *
3537 * a b CASE d CASE DEFAULT c e
3538 * +------------------+
3539 * +-------------+
3540 * +--------+
3541 */
3542 obj = _CompileExpr (obj, expr->tree.left, True, expr, code);
3543 st = 0;
3544 if (expr->base.tag == SWITCH)
3545 SetPush (obj);
3546 else
3547 {
3548 if (expr->tree.left->base.type)
3549 {
3550 Type *t;
3551
3552 t = TypeCanon (expr->tree.left->base.type);
3553 if (t->base.tag == type_union)
3554 st = t->structs.structs;
3555 else if (!TypePoly (t))
3556 {
3557 CompileError (obj, expr, "Union switch type '%T' not union",
3558 expr->tree.left->base.type);
3559 }
3560 }
3561 }
3562 c = expr->tree.right;
3563 has_default = False;
3564 ncase = 0;
3565 while (c)
3566 {
3567 if (!c->tree.left->tree.left)
3568 has_default = True;
3569 else
3570 ncase++;
3571 c = c->tree.right;
3572 }
3573 /*
3574 * Check to see if the union switch covers
3575 * all possible values
3576 */
3577 test_inst = 0;
3578 if (expr->base.tag == UNION && st)
3579 {
3580 Bool missing = False;
3581 int i;
3582 Atom *atoms = StructTypeAtoms(st);
3583
3584 /*
3585 * See if every member of the union has a case
3586 */
3587 for (i = 0; i < st->nelements; i++)
3588 {
3589 c = expr->tree.right;
3590 while (c)
3591 {
3592 ExprPtr pair = c->tree.left->tree.left;
3593
3594 if (pair)
3595 {
3596 Atom tag = pair->tree.left->atom.atom;
3597 if (tag == atoms[i])
3598 break;
3599 }
3600 c = c->tree.right;
3601 }
3602 if (!c)
3603 {
3604 missing = True;
3605 break;
3606 }
3607 }
3608 if (!missing)
3609 {
3610 test_inst = -1;
3611 if (has_default)
3612 CompileError (obj, expr, "Union switch has unreachable default");
3613 }
3614 if (missing && !has_default)
3615 CompileError (obj, expr, "Union switch missing elements with no default");
3616 }
3617 case_inst = AllocateTemp (ncase * sizeof (int));
3618 /*
3619 * Compile the comparisons
3620 */
3621 c = expr->tree.right;
3622 icase = 0;
3623 while (c)
3624 {
3625 if (c->tree.left->tree.left)
3626 {
3627 if (expr->base.tag == SWITCH) {
3628 obj = _CompileExpr (obj, c->tree.left->tree.left, True, c, code);
3629 if (!TypeCombineBinary(expr->tree.left->base.type, EQ,
3630 c->tree.left->tree.left->base.type)) {
3631 CompileError (obj, expr, "Incompatible types, left '%T', right '%T', for case comparison",
3632 expr->tree.left->base.type,
3633 c->tree.left->tree.left->base.type,
3634 EQ);
3635 expr->base.type = typePoly;
3636 }
3637 }
3638 NewInst (obj, expr->base.tag == SWITCH ? OpCase : OpTagCase,
3639 case_inst[icase], expr);
3640 icase++;
3641 }
3642 c = c->tree.right;
3643 }
3644 /* add default case at the bottom */
3645 if (test_inst == 0)
3646 {
3647 /* don't know what the opcode is yet */
3648 NewInst (obj, expr->base.tag == SWITCH ? OpDefault : OpBranch,
3649 test_inst, expr);
3650 }
3651 top_inst = obj->used;
3652 obj->nonLocal = NewNonLocal (obj->nonLocal, NonLocalControl,
3653 NON_LOCAL_BREAK);
3654 /*
3655 * Compile the statements
3656 */
3657 c = expr->tree.right;
3658 icase = 0;
3659 while (c)
3660 {
3661 ExprPtr s = c->tree.left->tree.right;
3662
3663 /*
3664 * Patch the branch
3665 */
3666 if (c->tree.left->tree.left)
3667 {
3668 inst = ObjCode (obj, case_inst[icase]);
3669 if (expr->base.tag == SWITCH)
3670 {
3671 inst->branch.offset = obj->used - case_inst[icase];
3672 inst->branch.mod = BranchModNone;
3673 }
3674 else
3675 {
3676 ExprPtr pair = c->tree.left->tree.left;
3677 Atom tag = pair->tree.left->atom.atom;
3678 Type *mt = typePoly;
3679
3680 /*
3681 * Find the member type
3682 */
3683 if (st)
3684 {
3685 mt = StructMemType (st, tag);
3686 if (!mt)
3687 {
3688 mt = typePoly;
3689 CompileError (obj, expr, "Union case tag '%A' not in type '%T'",
3690 tag, expr->tree.left->base.type);
3691 }
3692 }
3693
3694 /*
3695 * Make sure there's no fall-through
3696 */
3697 if (icase > 0 && pair->tree.right &&
3698 CompileIsReachable (obj, obj->used, 0))
3699 {
3700 CompileError (obj, expr,
3701 "Fall-through case with variant value");
3702 }
3703 inst->tagcase.offset = obj->used - case_inst[icase];
3704 inst->tagcase.tag = tag;
3705 /*
3706 * this side holds the name to assign the
3707 * switch value to. Set it's type and
3708 * build the assignment
3709 */
3710 if (pair->tree.right)
3711 {
3712 SymbolPtr name = pair->tree.right->atom.symbol;
3713 InstPtr assign;
3714
3715 name->symbol.type = mt;
3716 CompileStorage (obj, expr, name, code);
3717 if (ClassFrame (name->symbol.class))
3718 {
3719 BuildInst (obj, OpTagLocal, assign, expr);
3720 assign->frame.staticLink = 0;
3721 assign->frame.element = name->local.element;
3722 }
3723 else
3724 {
3725 BuildInst (obj, OpTagGlobal, assign, expr);
3726 assign->box.box = name->global.value;
3727 }
3728 }
3729 }
3730 icase++;
3731 }
3732 else if (test_inst >= 0)
3733 {
3734 inst = ObjCode (obj, test_inst);
3735 if (expr->base.tag == SWITCH)
3736 inst->base.opCode = OpDefault;
3737 else
3738 inst->base.opCode = OpBranch;
3739 inst->branch.offset = obj->used - test_inst;
3740 inst->branch.mod = BranchModNone;
3741 test_inst = -1;
3742 }
3743 while (s->tree.left)
3744 {
3745 obj = _CompileStat (obj, s->tree.left, False, code);
3746 s = s->tree.right;
3747 }
3748 c = c->tree.right;
3749 }
3750 obj->nonLocal = obj->nonLocal->prev;
3751 /*
3752 * Add a default branch if necessary
3753 */
3754 if (test_inst >= 0)
3755 {
3756 inst = ObjCode (obj, test_inst);
3757 inst->branch.offset = obj->used - test_inst;
3758 inst->branch.mod = BranchModNone;
3759 }
3760 CompilePatchLoop (obj, top_inst, -1, obj->used, -1);
3761 break;
3762 case FUNC:
3763 obj = CompileDecl (obj, expr, False, expr, code);
3764 break;
3765 case TYPEDEF:
3766 if (expr->tree.left->decl.type)
3767 obj = CompileType (obj, expr->tree.left, expr->tree.left->decl.type,
3768 expr, code);
3769 break;
3770 case OC:
3771 while (expr->tree.left)
3772 {
3773 obj = _CompileStat (obj, expr->tree.left, last && !expr->tree.right->tree.left, code);
3774 expr = expr->tree.right;
3775 }
3776 break;
3777 case BREAK:
3778 obj = _CompileNonLocal (obj, BranchModBreak, expr, code);
3779 break;
3780 case CONTINUE:
3781 obj = _CompileNonLocal (obj, BranchModContinue, expr, code);
3782 break;
3783 case RETURNTOK:
3784 if (!code || !code->base.func)
3785 {
3786 CompileError (obj, expr, "return not in function");
3787 break;
3788 }
3789 if (expr->tree.right)
3790 {
3791 if (expr->tree.right->base.tag == OP &&
3792 _CompileCanTailCall (obj, code))
3793 {
3794 obj = CompileCall (obj, expr->tree.right, TailAlways, expr, code, False);
3795 }
3796 else
3797 {
3798 obj = _CompileExpr (obj, expr->tree.right, True, expr, code);
3799 }
3800 if (ObjCode (obj, ObjLast (obj))->base.opCode != OpTailCall)
3801 obj = _CompileNonLocal (obj, BranchModReturn, expr, code);
3802 expr->base.type = expr->tree.right->base.type;
3803 }
3804 else
3805 {
3806 obj = _CompileNonLocal (obj, BranchModReturnVoid, expr, code);
3807 expr->base.type = typePrim[rep_void];
3808 }
3809 if (!TypeCombineBinary (code->base.func->base.type, ASSIGN, expr->base.type))
3810 {
3811 CompileError (obj, expr, "Incompatible types, formal '%T', actual '%T', for return",
3812 code->base.type, expr->base.type);
3813 break;
3814 }
3815 break;
3816 case EXPR:
3817 if (last && expr->tree.left->base.tag == OP && !profiling)
3818 obj = CompileCall (obj, expr->tree.left, TailVoid, expr, code, False);
3819 else
3820 obj = _CompileExpr (obj, expr->tree.left, False, expr, code);
3821 break;
3822 case SEMI:
3823 break;
3824 case NAMESPACE:
3825 obj = _CompileStat (obj, expr->tree.right, last, code);
3826 break;
3827 case IMPORT:
3828 break;
3829 case CATCH:
3830 obj = CompileCatch (obj, expr->tree.left, expr->tree.right, expr, code, 0);
3831 break;
3832 case RAISE:
3833 obj = CompileRaise (obj, expr, expr, code);
3834 break;
3835 case TWIXT:
3836 obj = CompileTwixt (obj, expr, expr, code);
3837 break;
3838 }
3839 RETURN (obj);
3840 }
3841
3842 static Bool
CompileIsUnconditional(InstPtr inst)3843 CompileIsUnconditional (InstPtr inst)
3844 {
3845 switch (inst->base.opCode) {
3846 case OpBranch:
3847 case OpFarJump:
3848 case OpDefault:
3849 case OpReturn:
3850 case OpReturnVoid:
3851 case OpTailCall:
3852 case OpCatch:
3853 case OpRaise:
3854 return True;
3855 default:
3856 return False;
3857 }
3858 }
3859
3860 static Bool
CompileIsBranch(InstPtr inst)3861 CompileIsBranch (InstPtr inst)
3862 {
3863 switch (inst->base.opCode) {
3864 case OpBranch:
3865 case OpBranchFalse:
3866 case OpBranchTrue:
3867 case OpCase:
3868 case OpTagCase:
3869 case OpDefault:
3870 case OpCatch:
3871 return True;
3872 default:
3873 return False;
3874 }
3875 }
3876
3877 static Bool
CompileIsReachable(ObjPtr obj,int target,int frame)3878 CompileIsReachable (ObjPtr obj, int target, int frame)
3879 {
3880 InstPtr inst;
3881 int i;
3882
3883 for (i = 0; i < obj->used; i++)
3884 {
3885 inst = ObjCode (obj, i);
3886 if (frame == 0 && CompileIsBranch (inst) && i + inst->branch.offset == target)
3887 return True;
3888 if (inst->base.opCode == OpObj &&
3889 !inst->code.code->base.builtin &&
3890 inst->code.code->func.body.obj->nonLocal) {
3891 if (CompileIsReachable(inst->code.code->func.body.obj, target, frame + 1))
3892 return True;
3893 }
3894 if (inst->base.opCode == OpFarJump &&
3895 inst->farJump.farJump->frame == frame &&
3896 inst->farJump.farJump->inst == target)
3897 return True;
3898 if (frame == 0 && i == target - 1 && !CompileIsUnconditional (inst))
3899 return True;
3900 }
3901 return False;
3902 }
3903
3904 ObjPtr
CompileFuncCode(CodePtr code,ExprPtr stat,CodePtr previous,NonLocalPtr nonLocal)3905 CompileFuncCode (CodePtr code,
3906 ExprPtr stat,
3907 CodePtr previous,
3908 NonLocalPtr nonLocal)
3909 {
3910 ENTER ();
3911 ObjPtr obj;
3912 InstPtr inst;
3913 Bool needReturn;
3914
3915 code->base.previous = previous;
3916 obj = NewObj (OBJ_INCR, OBJ_STAT_INCR);
3917 obj->nonLocal = nonLocal;
3918 obj = _CompileStat (obj, code->func.code, True, code);
3919 needReturn = False;
3920 if (!obj->used || CompileIsReachable (obj, obj->used, 0))
3921 needReturn = True;
3922 if (needReturn)
3923 {
3924 /*
3925 * If control reaches the end of the function,
3926 * flag an error for non-void functions,
3927 * don't complain about void functions or catch blocks
3928 */
3929 if (!nonLocal &&
3930 !TypeCombineBinary (code->base.func->base.type, ASSIGN,
3931 typePrim[rep_void]))
3932 {
3933 CompileError (obj, stat, "Control reaches end of function with type '%T'",
3934 code->base.func->base.type);
3935 }
3936 BuildInst (obj, OpReturnVoid, inst, stat);
3937 }
3938 #ifdef DEBUG
3939 ObjDump (obj, 0);
3940 FileFlush (FileStdout, True);
3941 #endif
3942 RETURN (obj);
3943 }
3944
3945 ObjPtr
CompileFunc(ObjPtr obj,CodePtr code,ExprPtr stat,CodePtr previous,NonLocalPtr nonLocal)3946 CompileFunc (ObjPtr obj,
3947 CodePtr code,
3948 ExprPtr stat,
3949 CodePtr previous,
3950 NonLocalPtr nonLocal)
3951 {
3952 ENTER ();
3953 InstPtr inst;
3954 ArgType *args;
3955 ObjPtr staticInit;
3956
3957 for (args = code->base.args; args; args = args->next)
3958 {
3959 CompileStorage (obj, stat, args->symbol, code);
3960 if (!args->varargs)
3961 code->base.argc++;
3962 }
3963 code->func.body.obj = CompileFuncCode (code, stat, previous, nonLocal);
3964 obj->error |= code->func.body.obj->error;
3965 BuildInst (obj, OpObj, inst, stat);
3966 inst->code.code = code;
3967 if ((staticInit = code->func.staticInit.obj))
3968 {
3969 SetPush (obj);
3970 BuildInst (staticInit, OpStaticDone, inst, stat);
3971 /* BuildInst (staticInit, OpEnd, inst, stat); */
3972 #ifdef DEBUG
3973 ObjDump (staticInit, 1);
3974 FileFlush (FileStdout, True);
3975 #endif
3976 code->func.staticInit.obj = staticInit;
3977 BuildInst (obj, OpStaticInit, inst, stat);
3978 BuildInst (obj, OpNoop, inst, stat);
3979 obj->error |= staticInit->error;
3980 }
3981 RETURN (obj);
3982 }
3983
3984 /*
3985 * Get the class, defaulting as appropriate
3986 */
3987 static Class
CompileDeclClass(ExprPtr decls,CodePtr code)3988 CompileDeclClass (ExprPtr decls, CodePtr code)
3989 {
3990 Class class;
3991
3992 class = decls ? decls->decl.class : class_undef;
3993 if (class == class_undef)
3994 class = code ? class_auto : class_global;
3995 return class;
3996 }
3997
3998 /*
3999 * Find the code object to compile the declaration in
4000 */
4001 static CodePtr
CompileDeclCodeCompile(Class class,CodePtr code)4002 CompileDeclCodeCompile (Class class, CodePtr code)
4003 {
4004 CodePtr code_compile = 0;
4005
4006 switch (class) {
4007 case class_global:
4008 case class_const:
4009 /*
4010 * Globals are compiled in the static initializer for
4011 * the outermost enclosing function.
4012 */
4013 code_compile = code;
4014 while (code_compile && code_compile->base.previous)
4015 code_compile = code_compile->base.previous;
4016 break;
4017 case class_static:
4018 /*
4019 * Statics are compiled in the static initializer for
4020 * the nearest enclosing function
4021 */
4022 code_compile = code;
4023 break;
4024 case class_auto:
4025 case class_arg:
4026 /*
4027 * Autos are compiled where they lie; just make sure a function
4028 * exists somewhere to hang them from
4029 */
4030 break;
4031 default:
4032 break;
4033 }
4034 return code_compile;
4035 }
4036
4037 static ObjPtr *
CompileDeclInitObjStart(ObjPtr * obj,CodePtr code,CodePtr code_compile)4038 CompileDeclInitObjStart (ObjPtr *obj, CodePtr code, CodePtr code_compile)
4039 {
4040 ObjPtr *initObj = obj;
4041 if (code_compile)
4042 {
4043 if (!code_compile->func.staticInit.obj)
4044 code_compile->func.staticInit.obj = NewObj (OBJ_INCR, OBJ_STAT_INCR);
4045 initObj = &code_compile->func.staticInit.obj;
4046 code_compile->func.inStaticInit = True;
4047 if (code != code_compile)
4048 code->func.inGlobalInit = True;
4049 }
4050 return initObj;
4051 }
4052
4053 static void
CompileDeclInitObjFinish(ObjPtr * obj,ObjPtr * initObj,CodePtr code,CodePtr code_compile)4054 CompileDeclInitObjFinish (ObjPtr *obj, ObjPtr *initObj, CodePtr code, CodePtr code_compile)
4055 {
4056 if (code_compile)
4057 {
4058 code_compile->func.inStaticInit = False;
4059 code->func.inGlobalInit = False;
4060 }
4061 }
4062
4063 /*
4064 * Compile a type. This consists only of compiling array dimension expressions
4065 * so those values can be used later
4066 */
4067
4068 static ObjPtr
CompileArrayDimValue(ObjPtr obj,TypePtr type,Bool lvalue,ExprPtr stat,CodePtr code)4069 CompileArrayDimValue (ObjPtr obj, TypePtr type, Bool lvalue, ExprPtr stat, CodePtr code)
4070 {
4071 ENTER ();
4072 InstPtr inst = 0;
4073 int d;
4074 CodePtr c;
4075
4076 switch (type->array.storage) {
4077 case DimStorageNone:
4078 assert (0);
4079 break;
4080 case DimStorageGlobal:
4081 BuildInst (obj, OpGlobal, inst, stat);
4082 inst->box.box = type->array.u.global;
4083 break;
4084 case DimStorageStatic:
4085 case DimStorageAuto:
4086 d = 0;
4087 for (c = code; c && c != type->array.u.frame.code; c = c->base.previous)
4088 d++;
4089 if (type->array.storage == DimStorageStatic)
4090 {
4091 BuildInst (obj, OpStatic, inst, stat);
4092 }
4093 else
4094 {
4095 BuildInst (obj, OpLocal, inst, stat);
4096 }
4097 inst->frame.staticLink = d;
4098 inst->frame.element = type->array.u.frame.element;
4099 break;
4100 }
4101 if (lvalue)
4102 inst->base.opCode += 2;
4103 RETURN (obj);
4104 }
4105
4106 static ObjPtr
CompileArrayDims(ObjPtr obj,ExprPtr dim,ExprPtr stat,CodePtr code)4107 CompileArrayDims (ObjPtr obj, ExprPtr dim, ExprPtr stat, CodePtr code)
4108 {
4109 ENTER ();
4110 if (dim)
4111 {
4112 InstPtr inst;
4113 obj = CompileArrayDims (obj, dim->tree.right, stat, code);
4114 obj = _CompileExpr (obj, dim->tree.left, True, stat, code);
4115 BuildInst (obj, OpInitArray, inst, stat);
4116 inst->ainit.dim = 0;
4117 inst->ainit.mode = AInitModeElement;
4118 }
4119 RETURN (obj);
4120 }
4121
4122 static ObjPtr
CompileArrayType(ObjPtr obj,ExprPtr decls,TypePtr type,ExprPtr stat,CodePtr code)4123 CompileArrayType (ObjPtr obj, ExprPtr decls, TypePtr type, ExprPtr stat, CodePtr code)
4124 {
4125 ENTER ();
4126 type->array.dims = CompileCountDeclDimensions (type->array.dimensions);
4127 if (type->array.dims && type->array.dimensions->tree.left)
4128 {
4129 Class class = CompileDeclClass (decls, code);
4130 CodePtr code_compile = CompileDeclCodeCompile (class, code);
4131 ExprPtr dim = type->array.dimensions;
4132 InstPtr inst;
4133 ObjPtr *initObj;
4134
4135 CompileDimensionStorage (obj, class, type, code);
4136
4137 initObj = CompileDeclInitObjStart (&obj, code, code_compile);
4138 /*
4139 * Prepare the lvalue for assignment
4140 */
4141 *initObj = CompileArrayDimValue (*initObj, type, True, stat, code);
4142 /*
4143 * Allocate an array for the dimension information
4144 */
4145 SetPush (*initObj);
4146 BuildInst (*initObj, OpConst, inst, stat);
4147 inst->constant.constant = NewInt (type->array.dims);
4148 SetPush (*initObj);
4149 BuildInst (*initObj, OpBuildArray, inst, stat);
4150 inst->array.ndim = 1;
4151 inst->array.resizable = False;
4152 inst->array.type = typePrim[rep_integer];
4153 /*
4154 * Initialize the dimension array
4155 */
4156 BuildInst (*initObj, OpInitArray, inst, stat);
4157 inst->ainit.mode = AInitModeStart;
4158 inst->ainit.dim = 1;
4159
4160 *initObj = CompileArrayDims (*initObj, dim, stat, code);
4161
4162 BuildInst (*initObj, OpInitArray, inst, stat);
4163 inst->ainit.dim = 1;
4164 inst->ainit.mode = AInitModeElement;
4165 /*
4166 * Assign it
4167 */
4168 BuildInst (*initObj, OpAssign, inst, stat);
4169 inst->assign.initialize = True;
4170 }
4171 RETURN (obj);
4172 }
4173
4174 static ObjPtr
CompileType(ObjPtr obj,ExprPtr decls,TypePtr type,ExprPtr stat,CodePtr code)4175 CompileType (ObjPtr obj, ExprPtr decls, TypePtr type, ExprPtr stat, CodePtr code)
4176 {
4177 ENTER();
4178 ArgType *at, *aat;
4179 StructType *st;
4180 TypeElt *et;
4181 int i, j;
4182
4183 switch (type->base.tag) {
4184 case type_prim:
4185 break;
4186 case type_name:
4187 break;
4188 case type_ref:
4189 obj = CompileType (obj, decls, type->ref.ref, stat, code);
4190 break;
4191 case type_func:
4192 obj = CompileType (obj, decls, type->func.ret, stat, code);
4193 for (at = type->func.args; at; at = at->next) {
4194 if (at->name)
4195 for (aat = at->next; aat; aat = aat->next)
4196 if (aat->name == at->name)
4197 CompileError (obj, stat, "Duplicate function parameter '%A'",
4198 at->name);
4199 obj = CompileType (obj, decls, at->type, stat, code);
4200 }
4201 break;
4202 case type_array:
4203 obj = CompileArrayType (obj, decls, type, stat, code);
4204 obj = CompileType (obj, decls, type->array.type, stat, code);
4205 break;
4206 case type_hash:
4207 obj = CompileType (obj, decls, type->hash.type, stat, code);
4208 obj = CompileType (obj, decls, type->hash.keyType, stat, code);
4209 break;
4210 case type_struct:
4211 case type_union:
4212 st = type->structs.structs;
4213 for (i = 0; i < st->nelements; i++)
4214 {
4215 for (j = 0; j < i; j++)
4216 if (StructTypeAtoms(st)[j] == StructTypeAtoms(st)[i])
4217 CompileError (obj, stat, "Duplicate structure member %A",
4218 StructTypeAtoms(st)[i]);
4219 obj = CompileType (obj, decls, BoxTypesElements(st->types)[i], stat, code);
4220 }
4221 break;
4222 case type_types:
4223 for (et = type->types.elt; et; et = et->next)
4224 obj = CompileType (obj, decls, et->type, stat, code);
4225 break;
4226 }
4227 RETURN (obj);
4228
4229 }
4230
4231 /*
4232 * Compile a declaration expression. Allocate storage for the symbol,
4233 * Typecheck and compile initializers, make sure a needed value
4234 * is left in the accumulator
4235 */
4236
4237 ObjPtr
CompileDecl(ObjPtr obj,ExprPtr decls,Bool evaluate,ExprPtr stat,CodePtr code)4238 CompileDecl (ObjPtr obj, ExprPtr decls,
4239 Bool evaluate, ExprPtr stat, CodePtr code)
4240 {
4241 ENTER ();
4242 SymbolPtr s = 0;
4243 DeclListPtr decl;
4244 TypePtr type = decls->decl.type;
4245 Class class = CompileDeclClass (decls, code);
4246 CodePtr code_compile = CompileDeclCodeCompile (class, code);
4247 ObjPtr *initObj;
4248
4249 if (ClassFrame (class) && !code)
4250 {
4251 CompileError (obj, decls, "Invalid storage class %C", class);
4252 decls->base.type = typePoly;
4253 RETURN (obj);
4254 }
4255 if (type)
4256 obj = CompileType (obj, decls, type, stat, code);
4257 for (decl = decls->decl.decl; decl; decl = decl->next) {
4258 ExprPtr init;
4259
4260 s = decl->symbol;
4261 CompileStorage (obj, decls, s, code);
4262 /*
4263 * Automatically build initializers for composite types
4264 * which fully specify the storage
4265 */
4266 init = decl->init;
4267 if (!init && s)
4268 init = CompileImplicitInit (s->symbol.type);
4269 if (init)
4270 {
4271 InstPtr inst;
4272 ExprPtr lvalue;
4273
4274 /*
4275 * Compile the initializer value
4276 */
4277 initObj = CompileDeclInitObjStart (&obj, code, code_compile);
4278 /*
4279 * Assign it
4280 */
4281 lvalue = NewExprAtom (decl->name, decl->symbol, False);
4282 *initObj = CompileLvalue (*initObj, lvalue,
4283 decls, code, False, True, True,
4284 CompileRefType (obj, lvalue, s->symbol.type) != 0,
4285 False);
4286 SetPush (*initObj);
4287 *initObj = CompileInit (*initObj, init, s->symbol.type, stat, code);
4288 CompileDeclInitObjFinish (&obj, initObj, code, code_compile);
4289
4290 BuildInst (*initObj, OpAssign, inst, stat);
4291 inst->assign.initialize = True;
4292 }
4293 }
4294 if (evaluate)
4295 {
4296 if (s)
4297 {
4298 InstPtr inst;
4299 switch (class) {
4300 case class_global:
4301 case class_const:
4302 BuildInst (obj, OpGlobal, inst, stat);
4303 inst->box.box = s->global.value;
4304 break;
4305 case class_static:
4306 BuildInst (obj, OpStatic, inst, stat);
4307 inst->frame.staticLink = 0;
4308 inst->frame.element = s->local.element;
4309 break;
4310 case class_auto:
4311 case class_arg:
4312 BuildInst (obj, OpLocal, inst, stat);
4313 inst->frame.staticLink = 0;
4314 inst->frame.element = s->local.element;
4315 break;
4316 default:
4317 break;
4318 }
4319 decls->base.type = s->symbol.type;
4320 }
4321 else
4322 decls->base.type = typePoly;
4323 }
4324 RETURN (obj);
4325 }
4326
4327 ObjPtr
CompileStat(ExprPtr expr,CodePtr code)4328 CompileStat (ExprPtr expr, CodePtr code)
4329 {
4330 ENTER ();
4331 ObjPtr obj;
4332 InstPtr inst;
4333
4334 obj = NewObj (OBJ_INCR, OBJ_STAT_INCR);
4335 obj = _CompileStat (obj, expr, False, code);
4336 BuildInst (obj, OpEnd, inst, expr);
4337 #ifdef DEBUG
4338 ObjDump (obj, 0);
4339 FileFlush (FileStdout, True);
4340 #endif
4341 RETURN (obj);
4342 }
4343
4344 ObjPtr
CompileExpr(ExprPtr expr,CodePtr code)4345 CompileExpr (ExprPtr expr, CodePtr code)
4346 {
4347 ENTER ();
4348 ObjPtr obj;
4349 InstPtr inst;
4350 ExprPtr stat;
4351
4352 stat = NewExprTree (EXPR, expr, 0);
4353 obj = NewObj (OBJ_INCR, OBJ_STAT_INCR);
4354 obj = _CompileExpr (obj, expr, True, stat, code);
4355 BuildInst (obj, OpEnd, inst, stat);
4356 #ifdef DEBUG
4357 ObjDump (obj, 0);
4358 FileFlush (FileStdout, True);
4359 #endif
4360 RETURN (obj);
4361 }
4362
4363 const char *const OpNames[] = {
4364 "Noop",
4365 /*
4366 * Statement op codes
4367 */
4368 "Branch",
4369 "BranchFalse",
4370 "BranchTrue",
4371 "Case",
4372 "TagCase",
4373 "TagGlobal",
4374 "TagLocal",
4375 "Default",
4376 "Return",
4377 "ReturnVoid",
4378 "Fork",
4379 "Catch",
4380 "EndCatch",
4381 "Raise",
4382 "OpTwixt",
4383 "OpTwixtDone",
4384 "OpEnterDone",
4385 "OpLeaveDone",
4386 "OpFarJump",
4387 "OpUnwind",
4388 /*
4389 * Expr op codes
4390 */
4391 "Global",
4392 "GlobalRef",
4393 "GlobalRefStore",
4394 "Static",
4395 "StaticRef",
4396 "StaticRefStore",
4397 "Local",
4398 "LocalRef",
4399 "LocalRefStore",
4400 "Fetch",
4401 "Const",
4402 "BuildArray",
4403 "BuildArrayInd",
4404 "InitArray",
4405 "BuildHash",
4406 "InitHash",
4407 "InitHashDef",
4408 "BuildStruct",
4409 "InitStruct",
4410 "BuildUnion",
4411 "InitUnion",
4412 "Array",
4413 "ArrayRef",
4414 "ArrayRefStore",
4415 "VarActual",
4416 "Call",
4417 "TailCall",
4418 "ExceptionCall",
4419 "Dot",
4420 "DotRef",
4421 "DotRefStore",
4422 "Arrow",
4423 "ArrowRef",
4424 "ArrowRefStore",
4425 "Obj",
4426 "StaticInit",
4427 "StaticDone",
4428 "BinOp",
4429 "BinFunc",
4430 "UnOp",
4431 "UnFunc",
4432 "PreOp",
4433 "PostOp",
4434 "Assign",
4435 "AssignOp",
4436 "AssignFunc",
4437 "IsType",
4438 "HasMember",
4439 "End",
4440 "Drop",
4441 };
4442
4443 static char *
ObjBinFuncName(BinaryFunc func)4444 ObjBinFuncName (BinaryFunc func)
4445 {
4446 static const struct {
4447 BinaryFunc func;
4448 char *name;
4449 } funcs[] = {
4450 { ShiftL, "ShiftL" },
4451 { ShiftR, "ShiftR" },
4452 { Lxor, "Lxor" },
4453 { NotEqual, "NotEqual" },
4454 { Greater, "Greater" },
4455 { LessEqual, "LessEqual" },
4456 { GreaterEqual, "GreaterEqual" },
4457 { 0, 0 }
4458 };
4459 int i;
4460
4461 for (i = 0; funcs[i].func; i++)
4462 if (funcs[i].func == func)
4463 return funcs[i].name;
4464 return "<unknown>";
4465 }
4466
4467 static char *
ObjUnFuncName(UnaryFunc func)4468 ObjUnFuncName (UnaryFunc func)
4469 {
4470 static const struct {
4471 UnaryFunc func;
4472 char *name;
4473 } funcs[] = {
4474 { Dereference, "Dereference" },
4475 { Lnot, "Lnot" },
4476 { Not, "Not" },
4477 { Factorial, "Factorial" },
4478 { do_reference, "do_reference" },
4479 { 0, 0 }
4480 };
4481 int i;
4482
4483 for (i = 0; funcs[i].func; i++)
4484 if (funcs[i].func == func)
4485 return funcs[i].name;
4486 return "<unknown>";
4487 }
4488
4489 static void
ObjIndent(int indent)4490 ObjIndent (int indent)
4491 {
4492 int j;
4493 for (j = 0; j < indent; j++)
4494 FilePrintf (FileStdout, " ");
4495 }
4496
4497 static char *
BranchModName(BranchMod mod)4498 BranchModName (BranchMod mod)
4499 {
4500 switch (mod) {
4501 case BranchModNone: return "BranchModNone";
4502 case BranchModBreak: return "BranchModBreak";
4503 case BranchModContinue: return "BranchModContinue";
4504 case BranchModReturn: return "BranchModReturn";
4505 case BranchModReturnVoid: return "BranchModReturnVoid";
4506 case BranchModCatch: return "BranchModCatch";
4507 }
4508 return "?";
4509 }
4510
4511 void
InstDump(InstPtr inst,int indent,int i,int * branch,int maxbranch)4512 InstDump (InstPtr inst, int indent, int i, int *branch, int maxbranch)
4513 {
4514 int j;
4515 Bool realBranch = False;
4516
4517 #ifdef DEBUG
4518 FilePrintf (FileStdout, "%x: ", (int) inst);
4519 #endif
4520 ObjIndent (indent);
4521 FilePrintf (FileStdout, "%s%s %c ",
4522 OpNames[inst->base.opCode],
4523 " " + strlen(OpNames[inst->base.opCode]),
4524 inst->base.flags & InstPush ? '^' : ' ');
4525 switch (inst->base.opCode) {
4526 case OpTagCase:
4527 FilePrintf (FileStdout, "(%A) ", inst->tagcase.tag);
4528 goto branch;
4529 case OpCatch:
4530 FilePrintf (FileStdout, "\"%A\" ",
4531 inst->catch.exception->symbol.name);
4532 goto branch;
4533 case OpBranch:
4534 case OpBranchFalse:
4535 case OpBranchTrue:
4536 case OpCase:
4537 case OpDefault:
4538 realBranch = True;
4539 branch:
4540 if (branch)
4541 {
4542 j = i + inst->branch.offset;
4543 if (0 <= j && j < maxbranch)
4544 FilePrintf (FileStdout, "branch L%d", branch[j]);
4545 else
4546 FilePrintf (FileStdout, "Broken branch %d", inst->branch.offset);
4547 }
4548 else
4549 FilePrintf (FileStdout, "branch %d", inst->branch.offset);
4550 if (realBranch)
4551 FilePrintf (FileStdout, " %s",
4552 BranchModName (inst->branch.mod));
4553 break;
4554 case OpReturn:
4555 case OpReturnVoid:
4556 break;
4557 case OpFork:
4558 FilePrintf (FileStdout, "\n");
4559 ObjDump (inst->obj.obj, indent+1);
4560 break;
4561 case OpEndCatch:
4562 FilePrintf (FileStdout, " %d catches", inst->ints.value);
4563 break;
4564 case OpRaise:
4565 FilePrintf (FileStdout, "%A", inst->raise.exception->symbol.name);
4566 FilePrintf (FileStdout, " argc %d", inst->raise.argc);
4567 break;
4568 case OpTwixt:
4569 if (branch)
4570 {
4571 j = i + inst->twixt.enter;
4572 if (0 <= j && j < maxbranch)
4573 FilePrintf (FileStdout, "enter L%d", branch[j]);
4574 else
4575 FilePrintf (FileStdout, "Broken enter %d", inst->branch.offset);
4576 j = i + inst->twixt.leave;
4577 if (0 <= j && j < maxbranch)
4578 FilePrintf (FileStdout, " leave L%d", branch[j]);
4579 else
4580 FilePrintf (FileStdout, " Broken leave %d", inst->branch.offset);
4581 }
4582 else
4583 {
4584 FilePrintf (FileStdout, "enter %d leave %d",
4585 inst->twixt.enter, inst->twixt.leave);
4586 }
4587 break;
4588 case OpFarJump:
4589 FilePrintf (FileStdout, "twixt %d catch %d frame %d inst %d mod %s",
4590 inst->farJump.farJump->twixt,
4591 inst->farJump.farJump->catch,
4592 inst->farJump.farJump->frame,
4593 inst->farJump.farJump->inst,
4594 BranchModName (inst->farJump.mod));
4595 break;
4596 case OpUnwind:
4597 FilePrintf (FileStdout, "twixt %d catch %d",
4598 inst->unwind.twixt, inst->unwind.catch);
4599 break;
4600 case OpStatic:
4601 case OpStaticRef:
4602 case OpStaticRefStore:
4603 case OpLocal:
4604 case OpLocalRef:
4605 case OpLocalRefStore:
4606 case OpTagLocal:
4607 FilePrintf (FileStdout, " (link %d elt %d)",
4608 inst->frame.staticLink, inst->frame.element);
4609 break;
4610 case OpConst:
4611 FilePrintf (FileStdout, "%v", inst->constant.constant);
4612 break;
4613 case OpCall:
4614 case OpTailCall:
4615 FilePrintf (FileStdout, "%d args", inst->ints.value);
4616 break;
4617 case OpBuildArray:
4618 FilePrintf (FileStdout, "%d dims %sresizable",
4619 inst->array.ndim,
4620 inst->array.resizable ? "" : "un");
4621 break;
4622 case OpInitArray:
4623 FilePrintf (FileStdout, "%d %s",
4624 inst->ainit.dim,
4625 inst->ainit.mode == AInitModeStart ? "start":
4626 inst->ainit.mode == AInitModeElement ? "element":
4627 inst->ainit.mode == AInitModeRepeat ? "repeat":
4628 inst->ainit.mode == AInitModeFunc ? "func":
4629 inst->ainit.mode == AInitModeTest ? "test": "?");
4630 break;
4631 case OpDot:
4632 case OpDotRef:
4633 case OpDotRefStore:
4634 case OpArrow:
4635 case OpArrowRef:
4636 case OpArrowRefStore:
4637 case OpInitStruct:
4638 case OpInitUnion:
4639 FilePrintf (FileStdout, "%s", AtomName (inst->atom.atom));
4640 break;
4641 case OpObj:
4642 FilePrintf (FileStdout, "\n");
4643 if (inst->code.code->func.staticInit.obj)
4644 {
4645 ObjIndent (indent);
4646 FilePrintf (FileStdout, "Static initializer:\n");
4647 ObjDump (inst->code.code->func.staticInit.obj, indent+1);
4648 ObjIndent (indent);
4649 FilePrintf (FileStdout, "Function body:\n");
4650 }
4651 ObjDump (inst->code.code->func.body.obj, indent+1);
4652 break;
4653 case OpBinOp:
4654 case OpPreOp:
4655 case OpPostOp:
4656 case OpAssignOp:
4657 FilePrintf (FileStdout, "%O", inst->binop.op);
4658 break;
4659 case OpBinFunc:
4660 case OpAssignFunc:
4661 FilePrintf (FileStdout, "%s", ObjBinFuncName (inst->binfunc.func));
4662 break;
4663 case OpUnOp:
4664 FilePrintf (FileStdout, "%U", inst->unop.op);
4665 break;
4666 case OpUnFunc:
4667 FilePrintf (FileStdout, "%s", ObjUnFuncName (inst->unfunc.func));
4668 break;
4669 case OpIsType:
4670 FilePrintf (FileStdout, "%T", inst->isType.type);
4671 break;
4672 case OpHasMember:
4673 FilePrintf (FileStdout, "%A", inst->atom.atom);
4674 break;
4675 default:
4676 break;
4677 }
4678 FilePrintf (FileStdout, "\n");
4679 }
4680
4681 void
ObjDump(ObjPtr obj,int indent)4682 ObjDump (ObjPtr obj, int indent)
4683 {
4684 int i, j;
4685 InstPtr inst;
4686 ExprPtr stat;
4687 int *branch;
4688 int b;
4689
4690 branch = AllocateTemp (obj->used * sizeof (int));
4691 memset (branch, '\0', obj->used * sizeof (int));
4692
4693 ObjIndent (indent);
4694 FilePrintf (FileStdout, "%d instructions %d statements (0x%x)\n",
4695 obj->used, obj->used_stat, ObjCode(obj,0));
4696 b = 0;
4697 for (i = 0; i < obj->used; i++)
4698 {
4699 inst = ObjCode(obj, i);
4700 if (CompileIsBranch (inst))
4701 {
4702 j = i + inst->branch.offset;
4703 if (0 <= j && j < obj->used)
4704 if (!branch[j])
4705 branch[j] = ++b;
4706 }
4707 if (inst->base.opCode == OpFarJump)
4708 {
4709 j = inst->farJump.farJump->inst;
4710 if (0 <= j && j < obj->used)
4711 if (!branch[j])
4712 branch[j] = ++b;
4713 }
4714 if (inst->base.opCode == OpTwixt)
4715 {
4716 j = i + inst->twixt.enter;
4717 if (0 <= j && j < obj->used)
4718 if (!branch[j])
4719 branch[j] = ++b;
4720 j = i + inst->twixt.leave;
4721 if (0 <= j && j < obj->used)
4722 if (!branch[j])
4723 branch[j] = ++b;
4724 }
4725 }
4726 b = 0;
4727 stat = 0;
4728 for (i = 0; i < obj->used; i++)
4729 {
4730 ExprPtr nextStat = ObjStatement (obj, inst = ObjCode (obj, i));
4731 if (nextStat && nextStat != stat)
4732 {
4733 stat = nextStat;
4734 FilePrintf (FileStdout, " ");
4735 PrettyStat (FileStdout, stat, False);
4736 }
4737 if (branch[i])
4738 FilePrintf (FileStdout, "L%d:\n", branch[i]);
4739 InstDump (inst, indent, i, branch, obj->used);
4740 }
4741 }
4742
4743