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