1 /* statements
2
3 Copyright (C) 1994-1997 University of Dortmund
4 Department of Electrical Engineering, AG SIV
5
6 VAUL is free software; you can redistribute it and/or modify it
7 under the terms of the GNU Library General Public License as
8 published by the Free Software Foundation; either version 2 of the
9 License, or (at your option) any later version.
10
11 VAUL is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
13 or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General
14 Public License for more details.
15
16 You should have received a copy of the GNU Library General Public
17 License along with VAUL; see the file COPYING.LIB. If not, write
18 to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
19 Boston, MA 02111-1307 USA.
20
21
22 */
23
24 #include <freehdl/vaul-parser.h>
25 #include <freehdl/vaul-chunk.h>
26 #include <freehdl/vaul-dunit.h>
27 #include <freehdl/vaul-util.h>
28
29 #include <stdio.h>
30 #include <stdlib.h>
31 #include <assert.h>
32
33 #define psr vaul_parser
34
35 pIIR_ProcedureCallStatement
build_ProcedureCallStat(int lineno,pVAUL_Name name)36 psr::build_ProcedureCallStat (int lineno, pVAUL_Name name)
37 {
38 pIIR_Expression e = build_Expr (name);
39 overload_resolution (e, NULL, VAUL_VOID_TYPE, true, true);
40 if (e && e->is(VAUL_PROCEDURE_CALL))
41 return mIIR_ProcedureCallStatement (lineno, pVAUL_ProcedureCall(e)->proc,
42 pVAUL_ProcedureCall(e)->actuals);
43 else
44 {
45 if (e)
46 error("%:%n is not a procedure call", name, name);
47 return NULL;
48 }
49 }
50
51 pIIR_ConstantDeclaration
fix_for_scheme(pVAUL_ForScheme pfs)52 psr::fix_for_scheme (pVAUL_ForScheme pfs)
53 {
54 // XXX - merge this with build_IndexConstraint
55
56 pIIR_Range range = NULL;
57 pIIR_Type type = NULL;
58 pIIR_Subtype subtype = NULL;
59
60 if (pfs->range == NULL)
61 ;
62 else if (pfs->range->is(VAUL_PRE_INDEX_RANGE_CONSTRAINT))
63 {
64 if ((range = pVAUL_PreIndexRangeConstraint(pfs->range)->range) != NULL)
65 {
66 if (range->is(IR_EXPLICIT_RANGE))
67 {
68 pIIR_ExplicitRange er = pIIR_ExplicitRange(range);
69 if ((type = find_index_range_type(er)) != NULL)
70 {
71 overload_resolution (er->left, type);
72 overload_resolution (er->right, type);
73 subtype = mIIR_ScalarSubtype (pfs->pos, type->base, type,
74 NULL, range);
75 }
76 }
77 else if (range->is(IR_ARRAY_RANGE))
78 {
79 type = pIIR_ArrayRange(range)->type;
80 subtype = mIIR_ScalarSubtype (pfs->pos, type->base, type,
81 NULL, range);
82 }
83 else
84 assert (false);
85 }
86 }
87 else if (pfs->range->is(VAUL_PRE_INDEX_SUBTYPE_CONSTRAINT))
88 {
89 type = pVAUL_PreIndexSubtypeConstraint(pfs->range)->type;
90 if (!is_discrete_type(type))
91 error ("%n is not a discrete type", type);
92 else if (type)
93 {
94 if (type->is(IR_SCALAR_SUBTYPE)
95 && pIIR_ScalarSubtype(type)->range->is(IR_RANGE))
96 subtype = pIIR_ScalarSubtype (type);
97 else
98 {
99 range = get_scalar_type_range (type);
100 subtype = mIIR_ScalarSubtype (pfs->pos, type->base, type,
101 NULL, range);
102 }
103 }
104 }
105 else
106 vaul_fatal ("fix_for_scheme confused.\n");
107
108 return mIIR_ConstantDeclaration (pfs->pos, pfs->var, subtype, NULL);
109 }
110
111 pIIR_LoopStatement
push_loop(int lineno,pIIR_Label label,pVAUL_IterationScheme scheme)112 psr::push_loop (int lineno, pIIR_Label label, pVAUL_IterationScheme scheme)
113 {
114 pIIR_LoopDeclarativeRegion region = pIIR_LoopDeclarativeRegion (
115 add_decl(cur_scope, mIIR_LoopDeclarativeRegion (lineno, NULL, NULL)));
116 push_scope(region);
117
118 pIIR_LoopStatement st = NULL;
119
120 if (scheme == NULL)
121 st = mIIR_LoopStatement (lineno, NULL, region);
122 else if (scheme->is(VAUL_WHILE_SCHEME))
123 st = mIIR_WhileLoopStatement (lineno, NULL, region,
124 pVAUL_WhileScheme(scheme)->condition);
125 else if (scheme->is(VAUL_FOR_SCHEME))
126 {
127 pIIR_ConstantDeclaration c = fix_for_scheme (pVAUL_ForScheme (scheme));
128 add_decl (cur_scope, c);
129 st = mIIR_ForLoopStatement (lineno, NULL, region, c);
130 }
131
132 region->loop_statement = st;
133 st->declarative_region = region;
134 st->label = label;
135 if (label)
136 label->statement = st;
137 return st;
138 }
139
140 pIIR_LoopStatement
pop_loop(pIIR_SequentialStatementList stats,pIIR_Identifier id)141 psr::pop_loop (pIIR_SequentialStatementList stats, pIIR_Identifier id)
142 {
143 if (cur_scope && !cur_scope->is(IR_LOOP_DECLARATIVE_REGION))
144 {
145 info ("confusion, expect failure");
146 while (cur_scope && !cur_scope->is(IR_LOOP_DECLARATIVE_REGION))
147 pop_scope (cur_scope);
148 }
149
150 if (cur_scope == NULL)
151 return NULL;
152
153 assert (cur_scope && cur_scope->is(IR_LOOP_DECLARATIVE_REGION));
154
155 pIIR_LoopDeclarativeRegion region = pIIR_LoopDeclarativeRegion(cur_scope);
156 pop_scope (region);
157
158 if (region->loop_statement == NULL)
159 return NULL;
160
161 if (id)
162 {
163 pIIR_Label l = region->loop_statement->label;
164 if (l && !vaul_name_eq (l->declarator, id))
165 error("%n does not match loop label %n", id, l->declarator);
166 else if (l == NULL)
167 error ("loop has no label");
168 }
169 region->loop_statement->sequence_of_statements = stats;
170
171 return region->loop_statement;
172 }
173
174 pIIR_ConcurrentGenerateStatement
push_GenerateStat(int lineno,pVAUL_IterationScheme scheme)175 psr::push_GenerateStat (int lineno, pVAUL_IterationScheme scheme)
176 {
177 pIIR_ConcurrentGenerateStatement g = NULL;
178
179 if (scheme->is(VAUL_FOR_SCHEME))
180 {
181 pIIR_ConstantDeclaration loop_var =
182 fix_for_scheme (pVAUL_ForScheme(scheme));
183 g = mIIR_ConcurrentGenerateForStatement (lineno, NULL, NULL, loop_var);
184 add_decl (g, loop_var);
185 }
186 else if (scheme->is(VAUL_IF_SCHEME))
187 {
188 pIIR_Expression cond = pVAUL_IfScheme(scheme)->condition;
189 g = mIIR_ConcurrentGenerateIfStatement (lineno, NULL, NULL, cond);
190 }
191
192 add_decl (cur_scope, g);
193 push_scope (g);
194
195 return g;
196 }
197
198 void
add_to_signal_list(pIIR_ExpressionList & sigs,pIIR_ObjectReference sig)199 psr::add_to_signal_list (pIIR_ExpressionList &sigs, pIIR_ObjectReference sig)
200 {
201 pIIR_ExpressionList *slp;
202 for (slp = &sigs; *slp; slp = &(*slp)->rest)
203 if ((*slp)->first == sig) // XXX - does this really work?
204 return;
205 *slp = mIIR_ExpressionList ((IIR_PosInfo *)NULL, sig, *slp);
206 }
207
208 void
get_implicit_signals(pIIR_ExpressionList & sigs,pIIR_Expression e)209 psr::get_implicit_signals (pIIR_ExpressionList &sigs, pIIR_Expression e)
210 {
211 if (e == NULL)
212 return;
213
214 if (e->is(IR_FUNCTION_CALL))
215 {
216 for (pIIR_AssociationList al =
217 pIIR_FunctionCall(e)->parameter_association_list;
218 al; al = al->rest)
219 if (al->first)
220 get_implicit_signals (sigs, al->first->actual);
221 }
222 else if (e->is(IR_TYPE_CONVERSION))
223 get_implicit_signals (sigs, pIIR_TypeConversion(e)->expression);
224 else if (e->is(IR_QUALIFIED_EXPRESSION))
225 get_implicit_signals (sigs, pIIR_QualifiedExpression(e)->expression);
226 else if (e->is(IR_OBJECT_REFERENCE))
227 {
228 pIIR_ObjectReference mor = pIIR_ObjectReference(e);
229 if (is_signal (mor))
230 add_to_signal_list (sigs, mor);
231 }
232 else if (e->is(IR_ATTR_SIG_FUNC))
233 add_to_signal_list (sigs, pIIR_AttrSigFunc(e)->signal);
234 else if (e->is(IR_ENUM_LITERAL_REFERENCE)
235 || e->is(IR_ABSTRACT_LITERAL_EXPRESSION)
236 || e->is(IR_ARRAY_LITERAL_EXPRESSION))
237 {
238 // ignore
239 }
240 else if (e->is(IR_ATTR_ARRAY_FUNC))
241 {
242 if (pIIR_AttrArrayFunc(e)->array)
243 get_implicit_signals (sigs, pIIR_AttrArrayFunc(e)->array);
244 }
245 else if (e->is(IR_ARRAY_AGGREGATE))
246 {
247 for (pIIR_IndexedAssociationList l =
248 pIIR_ArrayAggregate (e)->indexed_association_list;
249 l; l = l->rest)
250 get_implicit_signals (sigs, l->first->value);
251 }
252 else
253 info ("xxx - %s not scanned for implicit signals", e->kind_name());
254 }
255
256 pIIR_ProcessStatement
build_Process(int lineno,pIIR_ExpressionList sensitivities,bool pp)257 psr::build_Process (int lineno, pIIR_ExpressionList sensitivities, bool pp)
258 {
259 if (sensitivities == no_sens_list)
260 return mIIR_ProcessStatement (lineno, NULL, pp, NULL);
261 else
262 return mIIR_SensitizedProcessStatement (lineno, NULL, pp, NULL,
263 sensitivities);
264 }
265
266 pIIR_ProcessStatement
build_condal_Process(pIIR_Identifier l,bool pp,pVAUL_CondalSignalAssign csa)267 psr::build_condal_Process (pIIR_Identifier l,
268 bool pp, pVAUL_CondalSignalAssign csa)
269 {
270 if (csa == NULL || csa->target == NULL || csa->wave == NULL)
271 return NULL;
272
273 pIIR_ExpressionList sens = NULL;
274
275 pIIR_SequentialStatementList stats = NULL, *statp = &stats;
276 for (pVAUL_CondalWaveform cw = csa->wave; cw; cw = cw->else_wave)
277 {
278 pIIR_SignalAssignmentStatement ass = build_SignalAssignment (cw->pos,
279 csa->target,
280 csa->delay,
281 cw->wave);
282 if (ass)
283 {
284 for (pIIR_WaveformList wfl = ass->waveform; wfl; wfl = wfl->rest)
285 if (wfl->first)
286 get_implicit_signals (sens, wfl->first->value);
287 }
288 if (cw->condition)
289 {
290 get_implicit_signals (sens, cw->condition);
291 pIIR_IfStatement s =
292 mIIR_IfStatement (cw->pos, cw->condition,
293 mIIR_SequentialStatementList (ass->pos,
294 ass,
295 NULL),
296 NULL);
297 *statp = mIIR_SequentialStatementList (cw->pos, s, NULL);
298 statp = &s->else_sequence;
299 }
300 else
301 {
302 *statp = mIIR_SequentialStatementList (cw->pos, ass, NULL);
303 break;
304 }
305 }
306
307 if (stats)
308 stats->rest = mIIR_SequentialStatementList (csa->pos,
309 mIIR_WaitStatement (csa->pos,
310 NULL,
311 NULL,
312 sens),
313 NULL);
314
315 pIIR_ImplicitProcessStatement p = mIIR_ImplicitProcessStatement (csa->pos, l, pp, stats);
316 if (csa->guarded)
317 p->guarded = true;
318 // p->orig_statement = csa;
319 add_decl (p);
320 return p;
321 }
322
323 pIIR_ProcessStatement
build_sel_Process(pIIR_Identifier l,bool pp,pVAUL_SelSignalAssign ssa)324 psr::build_sel_Process (pIIR_Identifier l,
325 bool pp, pVAUL_SelSignalAssign ssa)
326 {
327 if (ssa == NULL || ssa->target == NULL || ssa->wave == NULL)
328 return NULL;
329
330 pIIR_ExpressionList sens = NULL;
331
332 pIIR_CaseStatementAlternativeList ca = NULL;
333 for (pVAUL_SelWaveform sw = ssa->wave; sw; sw = sw->next_wave)
334 {
335 pIIR_SignalAssignmentStatement ass = build_SignalAssignment (sw->pos,
336 ssa->target,
337 ssa->delay,
338 sw->wave);
339 if (ass)
340 for(pIIR_WaveformList wfl = ass->waveform; wfl; wfl = wfl->rest)
341 if (wfl->first)
342 get_implicit_signals (sens, wfl->first->value);
343 pIIR_CaseStatementAlternative a =
344 mIIR_CaseStatementAlternative (sw->pos,
345 mIIR_SequentialStatementList (ass->pos,
346 ass,
347 NULL),
348 sw->choice);
349 ca = mIIR_CaseStatementAlternativeList (sw->pos, a, ca);
350 }
351
352 pIIR_CaseStatement stat = build_CaseStat (ssa->pos, ssa->value, ca);
353 if (stat)
354 get_implicit_signals (sens, stat->expression);
355 else
356 return NULL;
357
358 pIIR_SequentialStatementList stats =
359 mIIR_SequentialStatementList (stat->pos, stat, NULL);
360 stats->rest =
361 mIIR_SequentialStatementList (ssa->pos,
362 mIIR_WaitStatement (ssa->pos,
363 NULL,
364 NULL,
365 sens),
366 NULL);
367
368 pIIR_ImplicitProcessStatement p = mIIR_ImplicitProcessStatement (ssa->pos, l, pp, stats);
369 if (ssa->guarded)
370 p->guarded = true;
371 // p->orig_statement = ssa;
372 add_decl (p);
373 return p;
374 }
375
376 pIIR_ProcessStatement
build_conc_AssertStat(int lno,pIIR_Identifier label,bool pp,pIIR_AssertionStatement as)377 psr::build_conc_AssertStat (int lno, pIIR_Identifier label,
378 bool pp, pIIR_AssertionStatement as)
379 {
380 if (as == NULL)
381 return NULL;
382
383 pIIR_ExpressionList sens = NULL;
384 get_implicit_signals (sens, as->assertion_condition);
385
386 pIIR_SequentialStatementList stats =
387 mIIR_SequentialStatementList (as->pos, as, NULL);
388 stats->rest =
389 mIIR_SequentialStatementList (lno,
390 mIIR_WaitStatement (lno,
391 NULL,
392 NULL,
393 sens),
394 NULL);
395
396 pIIR_ImplicitProcessStatement p = mIIR_ImplicitProcessStatement (lno, label, pp, stats);
397 // p->orig_statement = as;
398 add_decl (p);
399 return p;
400 }
401
402 pIIR_ProcessStatement
build_conc_ProcedureCall(int lno,pIIR_Identifier label,bool pp,pIIR_ProcedureCallStatement pcs)403 psr::build_conc_ProcedureCall (int lno, pIIR_Identifier label,
404 bool pp, pIIR_ProcedureCallStatement pcs)
405 {
406 if (pcs == NULL)
407 return NULL;
408
409 pIIR_ExpressionList sens = NULL;
410 for (pIIR_AssociationList al = pcs->actual_parameter_part; al; al = al->rest)
411 if (al->first)
412 get_implicit_signals (sens, al->first->actual);
413
414 pIIR_SequentialStatementList stats =
415 mIIR_SequentialStatementList (pcs->pos, pcs, NULL);
416 stats->rest =
417 mIIR_SequentialStatementList (lno,
418 mIIR_WaitStatement (lno,
419 NULL,
420 NULL,
421 sens),
422 NULL);
423
424 pIIR_ImplicitProcessStatement p = mIIR_ImplicitProcessStatement (lno, label, pp,
425 stats);
426 // p->orig_statement = pcs;
427 add_decl (p);
428 return p;
429 }
430
431 pIIR_ConcurrentStatement
build_conc_ProcedureCall_or_ComponentInst(int pos,pIIR_Identifier label,pVAUL_Name mark)432 psr::build_conc_ProcedureCall_or_ComponentInst (int pos,
433 pIIR_Identifier label,
434 pVAUL_Name mark)
435 {
436 pIIR_Declaration decl = find_single_decl (mark, IR_DECLARATION, NULL);
437 if (decl == NULL)
438 return NULL;
439
440 // XXX - what if there is both a procedure and component in scope?
441
442 if (decl->is(IR_SUBPROGRAM_DECLARATION))
443 {
444 // This is really a procedure call without arguments
445 pIIR_ProcedureCallStatement pcs = build_ProcedureCallStat (pos, mark);
446 return build_conc_ProcedureCall (pos, label, false, pcs);
447 }
448
449 pIIR_ComponentDeclaration c =
450 pIIR_ComponentDeclaration (find_single_decl (mark,
451 IR_COMPONENT_DECLARATION,
452 "component"));
453
454 pIIR_BindingIndication bi = build_BindingIndic (make_posinfo (pos),
455 c, NULL, NULL);
456 pIIR_ConcurrentStatement cs = build_CompInst (pos, label, bi);
457 add_decl (cs);
458 return cs;
459 }
460
461 pIIR_LoopControlStatement
build_LoopControlStat(int pos,IR_Kind k,pIIR_Identifier loop,pIIR_Expression when)462 psr::build_LoopControlStat (int pos, IR_Kind k,
463 pIIR_Identifier loop, pIIR_Expression when)
464 {
465 pIIR_LoopControlStatement lcs = NULL;
466
467 pIIR_LoopDeclarativeRegion sc = NULL;
468 if (loop)
469 {
470 pIIR_Label l = pIIR_Label(find_single_decl (mVAUL_SimpleName (pos, loop),
471 IR_LABEL, "label"));
472 if (l && l->statement)
473 {
474 if (l->statement->is(IR_LOOP_STATEMENT))
475 sc = pIIR_LoopStatement(l->statement)->declarative_region;
476 else
477 error ("%n is not a loop statement", loop);
478 }
479 }
480
481 pIIR_DeclarativeRegion s = cur_scope;
482 while (s && (!s->is(IR_LOOP_DECLARATIVE_REGION) || (sc && s != sc)))
483 s = s->declarative_region;
484
485 if (s == NULL)
486 {
487 error(loop? "%s statement is not in loop labeled `%n'"
488 : "%s statement outside of loop",
489 (k == IR_NEXT_STATEMENT)? "next" : "exit", loop);
490 }
491 else
492 {
493 assert (s->is(IR_LOOP_DECLARATIVE_REGION));
494 pIIR_LoopStatement l = pIIR_LoopDeclarativeRegion(s)->loop_statement;
495 /*
496 lcs = ((k == IR_NEXT_STATEMENT)?
497 mIIR_NextStatement (pos, l, when) :
498 mIIR_ExitStatement (pos, l, when));
499 */
500 if(k == IR_NEXT_STATEMENT)
501 lcs = mIIR_NextStatement (pos, l, when);
502 else
503 lcs = mIIR_ExitStatement (pos, l, when);
504 }
505
506 return lcs;
507 }
508
509 bool
check_target(pIIR_Expression t,VAUL_ObjectClass oc,const char * oc_label)510 psr::check_target (pIIR_Expression t, VAUL_ObjectClass oc,
511 const char *oc_label)
512 {
513 if (t == NULL)
514 return true;
515
516 if (t->is(IR_RECORD_AGGREGATE))
517 {
518 pIIR_RecordAggregate ra = pIIR_RecordAggregate(t);
519 for (pIIR_ElementAssociationList al = ra->element_association_list;
520 al; al = al->rest)
521 {
522 if (al->first && !check_target (al->first->value, oc, oc_label))
523 return false;
524 }
525 return true;
526 }
527 else if (t->is(IR_ARRAY_AGGREGATE))
528 {
529 pIIR_ArrayAggregate aa = pIIR_ArrayAggregate(t);
530 for (pIIR_IndexedAssociationList al = aa->indexed_association_list;
531 al; al = al->rest)
532 {
533 if (al->first && !check_target(al->first->value, oc, oc_label))
534 return false;
535 }
536 return true;
537 }
538
539 if (!t->is(IR_OBJECT_REFERENCE)
540 || vaul_get_class (pIIR_ObjectReference(t)) != oc)
541 {
542 error ("%:%n is not a %s", t, t, oc_label);
543 return false;
544 }
545
546 check_for_update (t);
547
548 return true;
549 }
550
551
552 pIIR_VariableAssignmentStatement
build_VarAssignment(int pos,pIIR_Expression t,pIIR_Expression v)553 psr::build_VarAssignment (int pos, pIIR_Expression t, pIIR_Expression v)
554 {
555 if (t == NULL || v == NULL)
556 return NULL;
557
558 if (t->is(VAUL_AMBG_AGGREGATE))
559 {
560 overload_resolution (v, IR_COMPOSITE_TYPE);
561 if (v == NULL)
562 return NULL;
563 pIIR_Type vt = expr_type (v);
564 overload_resolution_not_for_read (t, vt);
565 }
566 else if (t->is(IR_OBJECT_REFERENCE))
567 overload_resolution (v, vaul_get_type (pIIR_ObjectReference(t)));
568 else
569 return NULL;
570
571 if (check_target(t, VAUL_ObjClass_Variable, "variable"))
572 return mIIR_VariableAssignmentStatement (pos, t, v);
573 else
574 return NULL;
575 }
576
577 pIIR_SignalAssignmentStatement
build_SignalAssignment(pIIR_PosInfo pos,pIIR_Expression t,pVAUL_DelayMechanism delay,pIIR_WaveformList wf)578 psr::build_SignalAssignment (pIIR_PosInfo pos,
579 pIIR_Expression t,
580 pVAUL_DelayMechanism delay,
581 pIIR_WaveformList wf)
582 {
583 if (t == NULL || wf == NULL)
584 return NULL;
585
586 if (t->is(VAUL_AMBG_AGGREGATE))
587 {
588 bool all_composite = true;
589 for (pIIR_WaveformList wl = wf; wl; wl = wl->rest)
590 {
591 pIIR_WaveformElement we = wl->first;
592 if (we)
593 {
594 overload_resolution (we->value, IR_COMPOSITE_TYPE);
595 if (we->value == NULL)
596 all_composite = false;
597 }
598 }
599 if (!all_composite)
600 return NULL;
601
602 pIIR_Type comp_type = NULL;
603 bool ct_valid = true;
604 for (pIIR_WaveformList _wl = wf; _wl; _wl = _wl->rest)
605 {
606 pIIR_Type t = expr_type(_wl->first->value);
607 if(t && comp_type != t && comp_type != NULL)
608 ct_valid = false;
609 else
610 comp_type = t;
611 }
612 if (!ct_valid)
613 {
614 error ("the types of all waveform elements must be the same");
615 info ("they are, in order:");
616 for (pIIR_WaveformList wl = wf; wl; wl = wl->rest)
617 {
618 pIIR_Type t = expr_type (wl->first->value);
619 info ("%: %n", t, t);
620 }
621 return NULL;
622 }
623
624 overload_resolution_not_for_read (t, comp_type);
625
626 }
627 else if (t->is(IR_OBJECT_REFERENCE))
628 {
629 pIIR_Type type = vaul_get_type (pIIR_ObjectReference(t));
630 for (pIIR_WaveformList wl = wf; wl; wl = wl->rest)
631 if (wl->first)
632 overload_resolution (wl->first->value, type);
633 }
634 else
635 {
636 error ("%:%n can not be a target", t, t);
637 return NULL;
638 }
639
640 if (check_target(t, VAUL_ObjClass_Signal, "signal"))
641 {
642 pIIR_SignalAssignmentStatement s;
643 if (delay && delay->is(VAUL_DELAY_INERTIAL))
644 s = mIIR_SignalAssignmentStatement (pos, t,
645 IR_INERTIAL_DELAY,
646 (pVAUL_DelayInertial(delay)
647 ->rejection_time),
648 wf);
649 else
650 s = mIIR_SignalAssignmentStatement (pos, t, IR_TRANSPORT_DELAY, NULL,
651 wf);
652 return s;
653 }
654 else
655 return NULL;
656 }
657
658 static bool
is_character_type(pIIR_Type t)659 is_character_type (pIIR_Type t)
660 {
661 if (t == NULL || (t = vaul_get_base (t)) == NULL)
662 return false;
663
664 if (!t->is(IR_ENUMERATION_TYPE))
665 return false;
666
667 pIIR_EnumerationType et = pIIR_EnumerationType(t);
668 for (pIIR_EnumerationLiteralList el =
669 pIIR_EnumerationType(t)->enumeration_literals;
670 el; el = el->rest)
671 if (el->first && el->first->declarator &&
672 el->first->declarator->is(IR_CHARACTER_LITERAL))
673 return true;
674 return false;
675 }
676
possible_switch_expr_type(pIIR_Type t)677 static bool possible_switch_expr_type(pIIR_Type t)
678 {
679 if(t == NULL)
680 return false;
681 pIIR_Type bt = vaul_get_base (t);
682
683 if(bt->is(IR_SCALAR_TYPE) ||
684 bt->is(IR_ENUMERATION_TYPE))
685 return true;
686 if(!bt->is(IR_ARRAY_TYPE))
687 return false;
688
689 pIIR_ArrayType at = pIIR_ArrayType(bt);
690 if(!at->index_types || at->index_types->rest)
691 return false;
692 return is_character_type(at->element_type);
693 }
694
695 pIIR_CaseStatement
build_CaseStat(pIIR_PosInfo pos,pIIR_Expression swex,pIIR_CaseStatementAlternativeList alts)696 psr::build_CaseStat (pIIR_PosInfo pos, pIIR_Expression swex,
697 pIIR_CaseStatementAlternativeList alts)
698 {
699 if (swex == NULL)
700 return NULL;
701
702 pIIR_Type_vector *swex_types = ambg_expr_types (swex);
703 assert (swex_types);
704
705 if (swex_types->size() == 0)
706 return NULL;
707
708 bool valid_type = true;
709 pIIR_Type swex_type = NULL;
710 for (int i = 0; i < swex_types->size(); i++)
711 if (possible_switch_expr_type((*swex_types)[i]))
712 {
713 if (swex_type)
714 valid_type = false;
715 swex_type = (*swex_types)[i];
716 }
717
718 if (!valid_type)
719 {
720 error ("%:type of case expression is ambigous, it could be:", swex);
721 for (int i = 0; i < swex_types->size(); i++)
722 if (possible_switch_expr_type((*swex_types)[i]))
723 info ("%: %n", (*swex_types)[i], (*swex_types)[i]);
724 return NULL;
725 }
726
727 if (swex_type == NULL)
728 {
729 error ("%:type of case expression is invalid, it could be:", swex);
730 for (int i = 0; i < swex_types->size(); i++)
731 info ("%: %n", (*swex_types)[i], (*swex_types)[i]);
732 return NULL;
733 }
734
735 if (swex->subtype->declaration == NULL)
736 {
737 swex_type = get_type(mVAUL_SimpleName(pos, make_id("integer")));
738 //pVAUL_SelName sn = mVAUL_SelName(pos, mVAUL_SimpleName(pos, make_id("std")),
739 // make_id("standard"));
740 //pIIR_Declaration spack = find_single_decl (sn, VAUL_STANDARD_PACKAGE, "(the) standard package");
741 //vaul_decl_set ds(this);
742 //find_decls (ds, mVAUL_SimpleName(pos, make_id("integer")), spack, true);
743 swex->subtype = swex_type;
744 }
745
746 delete swex_types;
747
748 overload_resolution (swex, swex_type);
749 for (pIIR_CaseStatementAlternativeList al = alts; al; al = al->rest)
750 {
751 pIIR_CaseStatementAlternative a = al->first;
752 for (pIIR_ChoiceList cl = a->choices; cl; cl = cl->rest)
753 {
754 pIIR_Choice c = cl->first;
755 if (c->is(IR_CHOICE_BY_EXPRESSION))
756 overload_resolution (pIIR_ChoiceByExpression(c)->value, swex_type);
757 else if (c->is(IR_CHOICE_BY_RANGE))
758 {
759 #if 1
760 pIIR_Range range = pIIR_ChoiceByRange(c)->range;
761 ensure_range_type (range, swex_type);
762 #else
763 #endif
764 }
765 else if (c->is(IR_CHOICE_BY_OTHERS))
766 ;
767 else
768 info ("XXX - no `%s' choices", c->kind_name());
769 }
770 }
771
772 return mIIR_CaseStatement(pos, swex, alts);
773 }
774
775 void
push_concurrent_stats_tail(pIIR_ConcurrentStatementList * pl)776 psr::push_concurrent_stats_tail (pIIR_ConcurrentStatementList *pl)
777 {
778 cstat_item *i = new cstat_item;
779 i->tail = i->start_tail = pl;
780 i->prev = cstat_tail;
781 i->context = cur_scope;
782 cstat_tail = i;
783
784 if (consumer)
785 consumer->push_conc_context (i->context);
786 }
787
788 void
pop_concurrent_stats_tail(pIIR_ConcurrentStatementList * pl)789 psr::pop_concurrent_stats_tail (pIIR_ConcurrentStatementList *pl)
790 {
791 assert (cstat_tail && cstat_tail->start_tail == pl);
792
793 cstat_item *i = cstat_tail;
794 cstat_tail = i->prev;
795 delete i;
796
797 if (consumer)
798 consumer->pop_conc_context (cstat_tail? cstat_tail->context : NULL);
799 }
800
801 void
add_to_concurrent_stats_tail(pIIR_ConcurrentStatement s)802 psr::add_to_concurrent_stats_tail (pIIR_ConcurrentStatement s)
803 {
804 assert (cstat_tail && cstat_tail->tail);
805
806 if (s == NULL)
807 return;
808
809 if (consumer)
810 {
811 if (!consumer->consume_conc_stat (s))
812 {
813 rem_decl (s->declarative_region, s);
814 return;
815 }
816 }
817
818 pIIR_ConcurrentStatementList l =
819 mIIR_ConcurrentStatementList (s->pos, s, NULL);
820 *cstat_tail->tail = l;
821 cstat_tail->tail = &l->rest;
822 }
823
vaul_consumer()824 vaul_consumer::vaul_consumer ()
825 {
826 }
827
~vaul_consumer()828 vaul_consumer::~vaul_consumer ()
829 {
830 }
831
832 void
push_conc_context(pIIR_DeclarativeRegion context)833 vaul_consumer::push_conc_context (pIIR_DeclarativeRegion context)
834 {
835 }
836
837 bool
consume_conc_stat(pIIR_ConcurrentStatement stat)838 vaul_consumer::consume_conc_stat (pIIR_ConcurrentStatement stat)
839 {
840 return true;
841 }
842
843 void
pop_conc_context(pIIR_DeclarativeRegion context)844 vaul_consumer::pop_conc_context (pIIR_DeclarativeRegion context)
845 {
846 }
847
848 bool
consume_pbody_decl(pIIR_Declaration decl)849 vaul_consumer::consume_pbody_decl (pIIR_Declaration decl)
850 {
851 return true;
852 }
853