/[ascend]/trunk/base/generic/compiler/initialize.c
ViewVC logotype

Contents of /trunk/base/generic/compiler/initialize.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 978 - (show annotations) (download) (as text)
Wed Dec 20 10:26:04 2006 UTC (17 years, 7 months ago) by johnpye
File MIME type: text/x-csrc
File size: 56745 byte(s)
Failed 'ASSERT' statements in a METHOD now cause the statement to be output (as well as its location).
Improved code docs/GPL header for a few files.
Added support for 'ASSERT' in WriteStatement.
Added new WriteStatementError that included var-arg support.
Fixed ASC_ASSERT_RANGE in AscPanic.
1 /* ex:set ts=4: */
2 /*
3 * Initialization Routines
4 * by Tom Epperly
5 * Created: 3/24/1990
6 * Version: $Revision: 1.36 $
7 * Version control file: $RCSfile: initialize.c,v $
8 * Date last modified: $Date: 1998/06/11 15:28:30 $
9 * Last modified by: $Author: ballan $
10 *
11 * This file is part of the Ascend Language Interpreter.
12 *
13 * Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
14 *
15 * The Ascend Language Interpreter is free software; you can redistribute
16 * it and/or modify it under the terms of the GNU General Public License as
17 * published by the Free Software Foundation; either version 2 of the
18 * License, or (at your option) any later version.
19 *
20 * The Ascend Language Interpreter is distributed in hope that it will be
21 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 * General Public License for more details.
24 *
25 * You should have received a copy of the GNU General Public License
26 * along with the program; if not, write to the Free Software Foundation,
27 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
28 * COPYING.
29 *
30 */
31
32 #include <utilities/ascConfig.h>
33 #include <utilities/ascMalloc.h>
34 #include <general/list.h>
35 #include <general/dstring.h>
36 #include "compiler.h"
37 #include "symtab.h"
38 #include "fractions.h"
39 #include "dimen.h"
40 #include "functype.h"
41 #include "expr_types.h"
42 #include "forvars.h"
43 #include "name.h"
44 #include "find.h"
45 #include "vlist.h"
46 #include "instance_enum.h"
47 #include "cmpfunc.h"
48 #include "stattypes.h"
49 #include "statement.h"
50 #include "statio.h"
51 #include "switch.h"
52 #include "module.h"
53 #include "evaluate.h"
54 #include "value_type.h"
55 #include "setinstval.h"
56 #include "extfunc.h"
57 #include "packages.h"
58 #include "instance_io.h"
59 #include "nameio.h"
60 #include "atomvalue.h"
61 #include "instquery.h"
62 #include "slist.h"
63 #include "child.h"
64 #include "type_desc.h"
65 #include "library.h"
66 #include "extcall.h"
67 #include "proc.h"
68 #include "watchpt.h"
69 #include "procframe.h"
70 #include "procio.h"
71 #include "initialize.h"
72 #include "switch.h"
73 #include "exprs.h"
74 #include "sets.h"
75 #include "parentchild.h"
76
77 /* set to 1 for tracing execution the hard way. */
78 #define IDB 0
79
80 /*********************************************************************\
81 There is a stack of procedure calls kept for tracing and breaking
82 recursion errors.
83 INITSTACKLIMIT is the minimum we will allow internally.
84 This is independent of the procframes until we get those
85 solidly cleaned up.
86 \*********************************************************************/
87
88 static
89 struct {
90 unsigned long limit;
91 unsigned long depth;
92 } g_proc = {INITSTACKLIMIT,0L};
93
94 unsigned long GetProcStackLimit(void)
95 {
96 return g_proc.limit;
97 }
98
99 void SetProcStackLimit(unsigned long lim)
100 {
101 if (lim < 3) {
102 FPRINTF(ASCERR,
103 "SetProcStackLimit called with limit too small (%lu). Ignored.\n",lim);
104 return;
105 }
106 if (g_proc.depth) {
107 FPRINTF(ASCERR, "SetProcStackLimit called during evaluation. Ignored.\n");
108 return;
109 }
110 g_proc.limit = lim;
111 return;
112 }
113
114 /* The following 2 forward declarations have been moved out of the
115 * header, where they had no business being, so we can adequately
116 * guard against recursive functions.
117 * static void ExecuteInitRun(struct procFrame *, struct Statement *);
118 * static void ExecuteInitProcedure(struct procFrame *,
119 * struct InitProcedure *);
120 */
121
122
123 static void ExecuteInitStatements(struct procFrame *,struct StatementList *);
124 static void RealInitialize(struct procFrame *, struct Name *);
125 static void ClassAccessRealInitialize(struct procFrame *, struct Name *, struct Name *);
126
127 /* just forward declarations cause we need it */
128
129 /*
130 * modifies the name given to it, if needed shortening it.
131 * If shortening, destroys the cut off part.
132 */
133 static
134 void InstanceNamePart(struct Name *n, struct Name **copy,
135 symchar **procname)
136 {
137 register struct Name *ptr,*tmp;
138
139 /*FPRINTF(ASCERR,"INSTANCE NAME PART, input is n=");
140 WriteName(ASCERR,n);
141 FPRINTF(ASCERR,"\n");
142 */
143
144 if (n==NULL){
145 FPRINTF(ASCERR,"n IS NULL");
146 *copy = NULL;
147 *procname = NULL;
148 return;
149 }
150 if (NextName(n)==NULL) { /* RUN a; a is the procname */
151 *copy = NULL;
152 if (NameId(n) != 0) {
153 *procname = NameIdPtr(n);
154 } else {
155 *procname = NULL;
156 }
157 } else {
158 /* RUN a.b.c.clear; clear is the procname */
159 ptr = *copy = CopyName(n);
160 while (NextName(NextName(ptr))!=NULL) {
161 ptr = NextName(ptr);
162 }
163 tmp = NextName(ptr);
164 LinkNames(ptr,NULL); /* disconnect last part of name */
165 if (NameId(tmp) != 0) {
166 *procname = NameIdPtr(tmp);
167 } else {
168 *procname = NULL;
169 }
170 DestroyName(tmp);
171 }
172 }
173
174 struct InitProcedure *SearchProcList(CONST struct gl_list_t *l,
175 symchar *name)
176 {
177 register unsigned up,c,low;
178 register struct InitProcedure *ptr;
179 register int cmp;
180 assert(AscFindSymbol(name)!=NULL);
181 if (l == NULL) {
182 return NULL;
183 }
184 up = gl_length(l);
185 low = 1;
186 while(low<=up){
187 c = (low+up)/2;
188 ptr = (struct InitProcedure *)gl_fetch(l,c);
189 cmp = CmpSymchar(ProcName(ptr),name);
190 if (cmp == 0) {
191 return ptr;
192 }
193 if (cmp<0) {
194 low = c+1;
195 } else {
196 up = c-1;
197 }
198 }
199 return NULL;
200 }
201
202 struct InitProcedure *FindProcedure(CONST struct Instance *i,
203 symchar *procname)
204 {
205 struct TypeDescription *desc;
206 struct gl_list_t *plist;
207 struct InitProcedure *result = NULL;
208
209 desc = InstanceTypeDesc(i);
210 plist = GetInitializationList(desc);
211 if (plist != NULL){
212 result = SearchProcList(plist,procname);
213 }
214 plist = GetUniversalProcedureList();
215 if (result == NULL && plist != NULL) {
216 /* try for a UNIVERSAL method seen since parsing MODEL of i */
217 result = SearchProcList(plist,procname);
218 }
219 return result;
220 }
221
222
223 /*********************************************************************\
224 * void ExecuteInitRun(fm,stat);
225 * struct procFrame *fm;
226 * struct InitProcedure *proc;
227 * This will execute a run statement, using the given instance as the
228 * context. stat must be a RUN statement. In the event of error will
229 * print appropriate messages to stderr.
230 \*********************************************************************/
231 /*
232 * This returns proc_all_ok in all circumstances except stack overflow.
233 * If within it any other error occurs, it prints the message and
234 * then pretends everything is ok.
235 * This behavior should perhaps be better.
236 */
237 static
238 void ExecuteInitRun(struct procFrame *fm, struct Statement *stat)
239 {
240 struct Name *typename;
241
242 typename = RunStatAccess(stat);
243 if (typename != NULL) {
244 ClassAccessRealInitialize(fm,typename,RunStatName(stat));
245 } else {
246 RealInitialize(fm,RunStatName(stat));
247 }
248 /* an error was encountered */
249 if (fm->flow == FrameError) {
250 ProcWriteRunError(fm);
251 }
252 }
253
254 /**
255 Shared function for FIX and FREE execution
256 @param val is TRUE for 'FIX', or FALSE for 'FREE'.
257 */
258 static void
259 execute_init_fix_or_free(int val, struct procFrame *fm, struct Statement *stat){
260 CONST struct VariableList *vars;
261 enum find_errors e;
262 struct gl_list_t *temp;
263 unsigned i, len;
264 struct Instance *i1, *i2;
265 char *instname;
266 struct TypeDescription *t, *st;
267 CONST struct Name *name;
268 symchar *fixed;
269 /* setup */
270 fixed = AddSymbol("fixed");
271 st = FindType(AddSymbol("solver_var"));
272 if(st==NULL){
273 ERROR_REPORTER_HERE(ASC_PROG_ERR,"'solver_var' type is not yet in library");
274 fm->ErrNo = Proc_type_not_found;
275 return;
276 }
277
278 /* iterate through the variable list */
279 /*CONSOLE_DEBUG("STARTING 'FIX'/'FREE' STATEMENT EXECUTION");*/
280 vars = stat->v.fx.vars;
281 while(vars!=NULL){
282 name = NamePointer(vars);
283 temp = FindInstances(fm->i, name, &e);
284 if(temp==NULL){
285 fm->ErrNo = Proc_bad_name;
286 return;
287 }
288 len = gl_length(temp);
289 for(i=1; i<=len; i++){
290 i1 = (struct Instance *)gl_fetch(temp,i);
291 instname = WriteInstanceNameString(i1,NULL);
292 /*if(val){
293 CONSOLE_DEBUG("ABOUT TO FIX %s",instname);
294 }else{
295 CONSOLE_DEBUG("ABOUT TO FREE %s",instname);
296 }*/
297 ascfree(instname);
298 if(InstanceKind(i1)!=REAL_ATOM_INST){
299 fm->ErrNo = Proc_illegal_type_use;
300 ProcWriteFixError(fm,name);
301 return;
302 }
303 t = InstanceTypeDesc(i1);
304 if(!MoreRefined(t,st)){
305 CONSOLE_DEBUG("Attempted to FIX or FREE variable that is not a refined solver_var.");
306 fm->ErrNo = Proc_illegal_type_use;
307 ProcWriteFixError(fm,name);
308 return;
309 }
310 i2 = ChildByChar(i1,fixed);
311 if(i2==NULL){
312 CONSOLE_DEBUG("Attempted to FIX or FREE a solver_var that doesn't have a 'fixed' child!");
313 fm->ErrNo = Proc_illegal_type_use;
314 ProcWriteFixError(fm,name);
315 return;
316 }
317 if(InstanceKind(i2)!=BOOLEAN_INST){
318 CONSOLE_DEBUG("Attempted to FIX or FREE a solver_var whose 'fixed' child is not boolean!");
319 fm->ErrNo = Proc_illegal_type_use;
320 ProcWriteFixError(fm,name);
321 return;
322 }
323 SetBooleanAtomValue(i2,val,0);
324 }
325 vars = NextVariableNode(vars);
326 }
327 /* CONSOLE_DEBUG("DONE WITH VARLIST"); */
328
329 /* return 'ok' */
330 fm->ErrNo = Proc_all_ok;
331 }
332
333 static void
334 ExecuteInitFix(struct procFrame *fm, struct Statement *stat){
335 execute_init_fix_or_free(TRUE,fm,stat);
336 }
337
338 static void
339 ExecuteInitFree(struct procFrame *fm, struct Statement *stat){
340 execute_init_fix_or_free(FALSE,fm,stat);
341 }
342
343
344 static
345 void ExecuteInitFlow(struct procFrame *fm)
346 {
347 assert(fm!=NULL);
348 assert(fm->stat!=NULL);
349 assert(StatementType(fm->stat)==FLOW);
350 switch (FlowStatControl(fm->stat)) {
351 case fc_break:
352 fm->ErrNo = Proc_break;
353 fm->flow = FrameBreak;
354 break;
355 case fc_continue:
356 fm->ErrNo = Proc_continue;
357 fm->flow = FrameContinue;
358 break;
359 case fc_fallthru:
360 fm->ErrNo = Proc_fallthru;
361 fm->flow = FrameFallthru;
362 break;
363 case fc_return:
364 fm->ErrNo = Proc_return;
365 fm->flow = FrameReturn; /* needs to be caught automagically to frameok
366 * if errno is proc_return.
367 */
368 break;
369 case fc_stop:
370 fm->ErrNo = Proc_stop;
371 fm->flow = FrameError;
372 ProcWriteIfError(fm,"STOP");
373 break;
374 default:
375 break;
376 }
377 }
378
379 /**
380 The following functions have been made static as they are very similar to those used in instantiate.c. They really should be rationalized and exported by instantiate.c. As usual, any function with Special in the name is written by KAA.
381 */
382 #define SELF_NAME "SELF"
383
384 static
385 int SpecialSelfName(CONST struct Name *n)
386 {
387 symchar *id;
388 if (n == NULL) {
389 return 0;
390 }
391 id = SimpleNameIdPtr(n);
392 if (id == NULL) {
393 return 0;
394 }
395 if (strcmp(SCP(id),SELF_NAME)==0) {
396 return 1;
397 } else {
398 return 0;
399 }
400 }
401
402 /**
403 Produces a list of lists of argument instances. a the list returned is never NULL except when out of memory. Entries in this list may be NULL if some argument search fails. Argument search is successful IFF errlist returned is empty (length 0).
404 */
405 static
406 struct gl_list_t *ProcessExtMethodArgs(struct Instance *inst,
407 CONST struct VariableList *vl,
408 struct gl_list_t *errlist)
409 {
410 struct gl_list_t *arglist;
411 struct gl_list_t *branch;
412 CONST struct Name *n;
413 enum find_errors ferr;
414 unsigned long pos;
415
416 ListMode=1;
417 arglist = gl_create(10L);
418 pos = 1;
419 while(vl!=NULL){
420 n = NamePointer(vl);
421 ferr = correct_instance;
422 branch = FindInstances(inst,n,&ferr);
423 if (branch == NULL || ferr != correct_instance) {
424 /* check for SELF only if find fails, so SELF IS_A foo
425 * overrides the normal self.
426 */
427 if (SpecialSelfName(n)) {
428 if (branch == NULL) {
429 branch = gl_create(1L);
430 } else {
431 gl_reset(branch);
432 }
433 /* Self referential instance */
434 gl_append_ptr(branch,(VOIDPTR)inst);
435 } else {
436 gl_append_ptr(errlist,(VOIDPTR)pos); /* error position */
437 gl_append_ptr(errlist,(VOIDPTR)ferr); /* error code */
438 if (branch == NULL) {
439 branch = gl_create(1L); /* create empty branch */
440 }
441 }
442 }
443 assert(branch != NULL);
444 gl_append_ptr(arglist,(VOIDPTR)branch);
445 vl = NextVariableNode(vl);
446 pos++;
447 }
448 ListMode=0;
449 return arglist;
450 }
451
452 static
453 struct gl_list_t *InitCheckExtCallArgs(struct Instance *inst,
454 struct Statement *stat,
455 struct gl_list_t *errs)
456 {
457 CONST struct VariableList *vl;
458 struct gl_list_t *result;
459
460 vl = ExternalStatVlistMethod(stat);
461 result = ProcessExtMethodArgs(inst,vl,errs);
462 return result;
463 }
464
465 static
466 void ExecuteInitCall(struct procFrame *fm, struct Statement *stat)
467 {
468 (void)fm; /* stop gcc whine about unused parameter */
469 (void)stat; /* stop gcc whine about unused parameter */
470 #if 0 /* guts of CALL statement execution need coding. */
471 /* something like ExecuteInitExt only string driven gllist argument
472 * translation +/- varargs BS, etc, etc
473 */
474 #endif
475 }
476
477 /*
478 * This always returns ok. at least as of 5/96.
479 */
480 static
481 void ExecuteInitExt(struct procFrame *fm, struct Statement *stat)
482 {
483 struct ExternalFunc *efunc;
484 CONST char *funcname;
485 struct gl_list_t *arglist=NULL, *errlist;
486 enum find_errors ferr;
487 unsigned long c,len,pos;
488
489 ExtMethodRun *eval_func;
490 void *user_data;
491 int nok;
492
493 funcname = ExternalStatFuncName(stat);
494 efunc = LookupExtFunc(funcname);
495
496 /*CONSOLE_DEBUG("EXECUTEINITEXT func name:'%s'",funcname);*/
497
498 if (efunc == NULL) {
499 CONSOLE_DEBUG("Failed to look up external function");
500 fm->ErrNo = Proc_CallError;
501 fm->flow = FrameError;
502 ProcWriteExtError(fm,funcname,PE_unloaded,0);
503 return;
504 }
505
506 /* CONSOLE_DEBUG("%s: in:%ld, out:%ld", efunc->name, efunc->n_inputs, efunc->n_outputs); */
507
508 eval_func = GetExtMethodRun(efunc);
509 user_data = GetExtMethodUserData(efunc);
510 if (eval_func == NULL) {
511 CONSOLE_DEBUG("GetValueFunc(efunc) returned NULL");
512 fm->ErrNo = Proc_CallError;
513 fm->flow = FrameError;
514 ProcWriteExtError(fm,funcname,PE_nulleval,0);
515 return;
516 }
517
518 errlist = gl_create(1);
519 arglist = InitCheckExtCallArgs(fm->i,stat,errlist);
520 len = gl_length(errlist);
521 if (len != 0) {
522 CONSOLE_DEBUG("InitCheckExtCallArgs returned items in errlist...");
523 fm->flow = FrameError;
524 ProcWriteExtError(fm,funcname,PE_argswrong,0);
525 c = 1;
526 assert((len & 0x1) == 0); /* must be even */
527 while (c < len) {
528 /* works because error position/code pairs */
529 pos = (unsigned long)gl_fetch(errlist,c);
530 c++; /* Wait, who let that dirty word in here!? */
531 ferr = (enum find_errors)gl_fetch(errlist,c);
532 c++;
533 switch (ferr) {
534 case unmade_instance:
535 fm->ErrNo = Proc_instance_not_found;
536 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
537 break;
538 case undefined_instance:
539 fm->ErrNo = Proc_name_not_found;
540 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
541 break;
542 case impossible_instance:
543 fm->ErrNo = Proc_illegal_name_use;
544 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
545 break; /* move write to procio */
546 case correct_instance:
547 fm->ErrNo = Proc_CallError;
548 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
549 break;
550 default:
551 fm->ErrNo = Proc_bad_name;
552 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
553 break;
554 }
555 }
556 fm->ErrNo = Proc_CallError;
557 if (arglist != NULL) {
558 DestroySpecialList(arglist);
559 }
560 if (errlist != NULL) {
561 gl_destroy(errlist);
562 }
563 return;
564 }
565
566 /* CONSOLE_DEBUG("CHECKED EXTERNAL ARGS, OK"); */
567
568 nok = (*eval_func)(fm->i,arglist,user_data);
569
570 /* CONSOLE_DEBUG("BACK FROM RUNING FUNC AT %p",eval_func); */
571
572 /* this should switch on Proc_CallXXXXX */
573 /* should switch on proc_enum call bits to translate Proc_Call
574 * flow of control to our fm->flow.
575 */
576 if (nok) {
577 fm->flow = FrameError; /* move write to procio */
578 CONSOLE_DEBUG("NOK");
579 ProcWriteExtError(fm,funcname,PE_evalerr,0);
580 } else {
581 fm->flow = FrameOK;
582 }
583 if (arglist != NULL) {
584 DestroySpecialList(arglist);
585 }
586 if (errlist != NULL) {
587 gl_destroy(errlist);
588 }
589
590 return;
591 }
592
593 /*
594 * executes a for loop
595 */
596 static
597 void ExecuteInitFor(struct procFrame *fm, struct Statement *stat)
598 {
599 symchar *name;
600 struct Expr *ex;
601 struct StatementList *sl;
602 unsigned long c,len;
603 int direction; /* was declared unsigned long, but used as int (JDS 12/11/2005) */
604 struct value_t value;
605 struct set_t *sptr;
606 struct for_var_t *fv;
607 enum FrameControl oldflow;
608
609 c = direction = 1; /* shut up gcc */
610
611 name = ForStatIndex(stat);
612 ex = ForStatExpr(stat);
613 sl = ForStatStmts(stat);
614 fv = FindForVar(GetEvaluationForTable(),name);
615 if (fv != NULL) { /* duplicated for variable */
616 fm->flow = FrameError;
617 fm->ErrNo = Proc_for_duplicate_index;
618 ProcWriteForError(fm);
619 return;
620 }
621 assert(GetEvaluationContext()==NULL);
622 SetEvaluationContext(fm->i);
623 value = EvaluateExpr(ex,NULL,InstanceEvaluateName);
624 SetEvaluationContext(NULL);
625 switch(ValueKind(value)){
626 case error_value:
627 fm->flow = FrameError;
628 fm->ErrNo = Proc_for_set_err;
629 ProcWriteForError(fm);
630 break;
631 case set_value:
632 sptr = SetValue(value);
633 switch(SetKind(sptr)){
634 case empty_set:
635 break;
636 case integer_set:
637 fv = CreateForVar(name);
638 SetForVarType(fv,f_integer);
639 AddLoopVariable(GetEvaluationForTable(),fv);
640 len = Cardinality(sptr);
641 switch(ForLoopOrder(stat)){
642 case f_random:
643 /* fall through, that should never occur due to parser. */
644 case f_increasing:
645 direction = 1;
646 c = 1;
647 break;
648 case f_decreasing:
649 direction = -1;
650 c = len;
651 break;
652 }
653 /* we handle all logic with one for loop to avoid
654 * duplicate code insanity.
655 */
656 oldflow = fm->flow;
657 fm->flow = FrameLoop;
658 for(/* init c in switch above */;
659 c >= 1 && c <= len &&
660 fm->flow != FrameBreak && fm->flow != FrameReturn;
661 c += direction) {
662 SetForInteger(fv,FetchIntMember(sptr,c));
663 ExecuteInitStatements(fm,sl);
664 switch (fm->flow) {
665 case FrameOK:
666 case FrameContinue:
667 fm->flow = FrameLoop;
668 break;
669 case FrameLoop:
670 case FrameBreak:
671 case FrameFallthru:
672 case FrameReturn:
673 break;
674 case FrameError: /*EISS not to return this!*/
675 default: /* should never happen */
676 #if IDB
677 FPRINTF(fm->err,"ERR-NEVER1: "); WriteStatement(fm->err,stat,0);
678 FPRINTF(fm->err,"\n");
679 #endif
680 fm->flow = FrameReturn;
681 break;
682 }
683 }
684 /* post loop flow processing */
685 switch (fm->flow) {
686 case FrameLoop:
687 case FrameBreak:
688 fm->flow = oldflow;
689 break;
690 default:
691 break; /* let return, fallthru out to next level */
692 }
693 RemoveForVariable(GetEvaluationForTable());
694 break; /* integer_set */
695 case string_set:
696 fv = CreateForVar(name);
697 SetForVarType(fv,f_symbol);
698 AddLoopVariable(GetEvaluationForTable(),fv);
699 len = Cardinality(sptr);
700 switch(ForLoopOrder(stat)){
701 case f_random:
702 /* fall through, that should never occur due to parser. */
703 case f_increasing:
704 direction = 1;
705 c = 1;
706 break;
707 case f_decreasing:
708 direction = -1;
709 c = len;
710 break;
711 }
712 oldflow = fm->flow;
713 fm->flow = FrameLoop;
714 for(/* init c in switch above */;
715 c >= 1 && c <= len &&
716 fm->flow != FrameBreak && fm->flow != FrameReturn;
717 c += direction) {
718 SetForSymbol(fv,FetchStrMember(sptr,c));
719 ExecuteInitStatements(fm,sl);
720 switch (fm->flow) {
721 case FrameOK:
722 case FrameContinue:
723 fm->flow = FrameLoop;
724 break;
725 case FrameLoop:
726 case FrameBreak:
727 case FrameReturn:
728 case FrameFallthru:
729 break;
730 case FrameError: /*EISS not to return this!*/
731 default: /* should never happen */
732 #if IDB
733 FPRINTF(fm->err,"ERR-NEVER2: "); WriteStatement(fm->err,stat,0);
734 FPRINTF(fm->err,"\n");
735 #endif
736 fm->flow = FrameReturn;
737 break;
738 }
739 }
740 /* post loop flow processing */
741 switch (fm->flow) {
742 case FrameLoop:
743 case FrameBreak:
744 fm->flow = oldflow;
745 break;
746 default:
747 break;
748 }
749 RemoveForVariable(GetEvaluationForTable());
750 break;
751 }
752 break;
753 default:
754 fm->flow = FrameError;
755 fm->ErrNo = Proc_for_not_set;
756 ProcWriteForError(fm);
757 break;
758 }
759 DestroyValue(&value);
760 return;
761 }
762
763 static void
764 ExecuteInitAssert(struct procFrame *fm, struct Statement *stat){
765 struct value_t value;
766 int testerr;
767 assert(GetEvaluationContext()==NULL);
768 SetEvaluationContext(fm->i);
769 value = EvaluateExpr(AssertStatExpr(stat),NULL,InstanceEvaluateName);
770 SetEvaluationContext(NULL);
771 testerr = 1; /* set 0 on success */
772 switch(ValueKind(value)){
773 case boolean_value:
774 testerr = 0;
775 if(BooleanValue(value)){
776 WriteStatementError(ASC_USER_SUCCESS,stat,0,"Assertion OK");
777 }else{
778 WriteStatementError(ASC_USER_ERROR,stat,1,"Assertion failed");
779 }
780 break;
781 case real_value:
782 fm->flow = FrameError;
783 fm->ErrNo = Proc_if_real_expr;
784 break;
785 case integer_value:
786 fm->flow = FrameError;
787 fm->ErrNo = Proc_if_integer_expr;
788 break;
789 case symbol_value:
790 fm->flow = FrameError;
791 fm->ErrNo = Proc_if_symbol_expr;
792 break;
793 case set_value: /* FALLTHROUGH */
794 case list_value:
795 fm->flow = FrameError;
796 fm->ErrNo = Proc_if_set_expr;
797 break;
798 case error_value:
799 fm->flow = FrameError;
800 fm->ErrNo = Proc_if_expr_error_confused;
801 switch (ErrorValue(value)) {
802 case type_conflict:
803 fm->ErrNo = Proc_if_expr_error_typeconflict;
804 break;
805 case name_unfound:
806 fm->ErrNo = Proc_if_expr_error_nameunfound;
807 break;
808 case incorrect_name:
809 fm->ErrNo = Proc_if_expr_error_incorrectname;
810 break;
811 case undefined_value:
812 fm->ErrNo = Proc_if_expr_error_undefinedvalue;
813 break;
814 case dimension_conflict:
815 fm->ErrNo = Proc_if_expr_error_dimensionconflict;
816 break;
817 case empty_choice:
818 fm->ErrNo = Proc_if_expr_error_emptychoice;
819 break;
820 case empty_intersection:
821 fm->ErrNo = Proc_if_expr_error_emptyintersection;
822 break;
823 default:
824 ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unhandled case");
825 }
826 break;
827 default:
828 fm->flow = FrameError;
829 fm->ErrNo = Proc_if_not_logical;
830 break;
831 }
832 if (fm->flow == FrameError && testerr) {
833 ProcWriteIfError(fm,"TEST");
834 }
835 DestroyValue(&value);
836 return;
837 }
838
839 static
840 void ExecuteInitIf(struct procFrame *fm, struct Statement *stat)
841 {
842 struct value_t value;
843 int iferr;
844
845 assert(GetEvaluationContext()==NULL);
846 SetEvaluationContext(fm->i);
847 value = EvaluateExpr(IfStatExpr(stat),NULL,InstanceEvaluateName);
848 SetEvaluationContext(NULL);
849 iferr = 1; /* set 0 on success */
850 switch(ValueKind(value)){
851 case boolean_value:
852 iferr = 0;
853 if (BooleanValue(value)) {
854 ExecuteInitStatements(fm,IfStatThen(stat));
855 } else {
856 if (IfStatElse(stat) != NULL) {
857 ExecuteInitStatements(fm,IfStatElse(stat));
858 }
859 }
860 break;
861 case real_value:
862 fm->flow = FrameError;
863 fm->ErrNo = Proc_if_real_expr;
864 break;
865 case integer_value:
866 fm->flow = FrameError;
867 fm->ErrNo = Proc_if_integer_expr;
868 break;
869 case symbol_value:
870 fm->flow = FrameError;
871 fm->ErrNo = Proc_if_symbol_expr;
872 break;
873 case set_value: /* FALLTHROUGH */
874 case list_value:
875 fm->flow = FrameError;
876 fm->ErrNo = Proc_if_set_expr;
877 break;
878 case error_value:
879 fm->flow = FrameError;
880 fm->ErrNo = Proc_if_expr_error_confused;
881 switch (ErrorValue(value)) {
882 case type_conflict:
883 fm->ErrNo = Proc_if_expr_error_typeconflict;
884 break;
885 case name_unfound:
886 fm->ErrNo = Proc_if_expr_error_nameunfound;
887 break;
888 case incorrect_name:
889 fm->ErrNo = Proc_if_expr_error_incorrectname;
890 break;
891 case undefined_value:
892 fm->ErrNo = Proc_if_expr_error_undefinedvalue;
893 break;
894 case dimension_conflict:
895 fm->ErrNo = Proc_if_expr_error_dimensionconflict;
896 break;
897 case empty_choice:
898 fm->ErrNo = Proc_if_expr_error_emptychoice;
899 break;
900 case empty_intersection:
901 fm->ErrNo = Proc_if_expr_error_emptyintersection;
902 break;
903 default:
904 break;
905 }
906 break;
907 default:
908 fm->flow = FrameError;
909 fm->ErrNo = Proc_if_not_logical;
910 break;
911 }
912 if (fm->flow == FrameError && iferr) {
913 ProcWriteIfError(fm,"IF");
914 }
915 DestroyValue(&value);
916 return;
917 }
918
919 /*
920 */
921 static
922 void ExecuteInitWhile(struct procFrame *fm, struct Statement *stat)
923 {
924 struct value_t value;
925 int iferr;
926 int stop;
927 long limit = WP_MAXTRIPS;
928 enum FrameControl oldflow;
929
930 assert(GetEvaluationContext()==NULL);
931 stop = 0;
932 oldflow = fm->flow;
933 fm->flow = FrameLoop;
934 while (!stop) {
935 assert(fm->flow == FrameLoop);
936 SetEvaluationContext(fm->i);
937 value = EvaluateExpr(WhileStatExpr(stat),NULL,InstanceEvaluateName);
938 SetEvaluationContext(NULL);
939 iferr = 1; /* set 0 on success */
940 limit--;
941 switch(ValueKind(value)){
942 case boolean_value:
943 iferr = 0;
944 if (BooleanValue(value)) {
945 ExecuteInitStatements(fm,WhileStatBlock(stat));
946 switch (fm->flow) {
947 case FrameOK:
948 case FrameContinue:
949 fm->flow = FrameLoop;
950 break;
951 case FrameLoop:
952 break;
953 case FrameBreak: /* break while loop only */
954 case FrameFallthru: /* while must be inside switch...*/
955 case FrameReturn:
956 stop = 1;
957 break;
958 case FrameError: /* EISS is not supposed to let this happen */
959 default: /* should never happen */
960 #if IDB
961 FPRINTF(fm->err,"ERR-NEVER3: "); WriteStatement(fm->err,stat,0);
962 FPRINTF(fm->err,"\n");
963 #endif
964 fm->flow = FrameReturn;
965 break;
966 }
967 } else {
968 stop = 1;
969 }
970 break;
971 case real_value:
972 fm->flow = FrameError;
973 fm->ErrNo = Proc_if_real_expr;
974 break;
975 case integer_value:
976 fm->flow = FrameError;
977 fm->ErrNo = Proc_if_integer_expr;
978 break;
979 case symbol_value:
980 fm->flow = FrameError;
981 fm->ErrNo = Proc_if_symbol_expr;
982 break;
983 case set_value: /* FALLTHROUGH */
984 case list_value:
985 fm->flow = FrameError;
986 fm->ErrNo = Proc_if_set_expr;
987 break;
988 case error_value:
989 fm->flow = FrameError;
990 fm->ErrNo = Proc_if_expr_error_confused;
991 switch (ErrorValue(value)) {
992 case type_conflict:
993 fm->ErrNo = Proc_if_expr_error_typeconflict;
994 break;
995 case name_unfound:
996 fm->ErrNo = Proc_if_expr_error_nameunfound;
997 break;
998 case incorrect_name:
999 fm->ErrNo = Proc_if_expr_error_incorrectname;
1000 break;
1001 case undefined_value:
1002 fm->ErrNo = Proc_if_expr_error_undefinedvalue;
1003 break;
1004 case dimension_conflict:
1005 fm->ErrNo = Proc_if_expr_error_dimensionconflict;
1006 break;
1007 case empty_choice:
1008 fm->ErrNo = Proc_if_expr_error_emptychoice;
1009 break;
1010 case empty_intersection:
1011 fm->ErrNo = Proc_if_expr_error_emptyintersection;
1012 break;
1013 default:
1014 break;
1015 }
1016 break;
1017 default:
1018 fm->flow = FrameError;
1019 fm->ErrNo = Proc_if_not_logical;
1020 break;
1021 }
1022 if (fm->flow == FrameError && iferr) {
1023 ProcWriteIfError(fm,"WHILE");
1024 }
1025 DestroyValue(&value);
1026 if (limit < 0) {
1027 stop = 1;
1028 fm->flow = FrameError;
1029 fm->ErrNo = Proc_infinite_loop;
1030 ProcWriteIfError(fm,"WHILE");
1031 }
1032 } /* endwhile */
1033 /* post loop processing */
1034 switch (fm->flow) {
1035 case FrameLoop:
1036 case FrameBreak:
1037 fm->flow = oldflow;
1038 break;
1039 default: /* let return, fallthru, out to next scope */
1040 break;
1041 }
1042 return;
1043 }
1044
1045
1046 /*
1047 * Compare current values of the switching variables with
1048 * the set of values in a CASE of a SWITCH statement, and try to find
1049 * is such values are the same.
1050 * If they are, the function will return Proc_case_matched,
1051 * else, it will return Proc_case_unmatched unless there is an error.
1052 * The possible error returns are legion, and this function
1053 * handles issuing error messages for them.
1054 *
1055 * If s given is NULL AND arm is -1, simply verifies that vlist elements
1056 * exist/are assigned. Normally this is only of use in checking
1057 * the OTHERWISE branch of the switch.
1058 * s must NOT be NULL unless arm is -1.
1059 */
1060 static
1061 void AnalyzeSwitchCase(struct procFrame *fm, struct VariableList *vlist,
1062 struct Set *s, int arm)
1063 {
1064 CONST struct Expr *expr;
1065 CONST struct Name *name;
1066 symchar *value;
1067 symchar *symvar;
1068 CONST struct VariableList *vl;
1069 CONST struct Set *values;
1070 int val;
1071 int pos;
1072 int valvar;
1073 struct gl_list_t *instances;
1074 struct Instance *inst;
1075 enum find_errors err;
1076 symchar *str;
1077 struct for_var_t *fvp;
1078
1079 assert(vlist != NULL);
1080 vl = vlist;
1081 fm->ErrNo = Proc_case_matched;
1082 pos = 0;
1083 if (s==NULL && arm == -1) {
1084 /* check vlist only */
1085 while (vl!=NULL) {
1086 pos++;
1087 name = NamePointer(vl);
1088 instances = FindInstances(fm->i,name,&err);
1089 if (instances == NULL){
1090 switch (err) {
1091 case unmade_instance:
1092 fm->ErrNo = Proc_instance_not_found;
1093 break;
1094 case undefined_instance:
1095 fm->ErrNo = Proc_name_not_found;
1096 break;
1097 case impossible_instance:
1098 fm->ErrNo = Proc_illegal_name_use;
1099 break;
1100 case correct_instance:
1101 fm->ErrNo = Proc_CallError;
1102 break;
1103 }
1104 }
1105 if (gl_length(instances)==1) {
1106 inst = (struct Instance *)gl_fetch(instances,1);
1107 gl_destroy(instances);
1108 if (!AtomAssigned(inst)) {
1109 fm->ErrNo = Proc_case_undefined_value;
1110 break; /* while */
1111 }
1112 } else {
1113 fm->ErrNo = Proc_case_extra_values;
1114 gl_destroy(instances);
1115 break; /* while */
1116 }
1117 vl = NextVariableNode(vl);
1118 }
1119 if (fm->ErrNo != Proc_case_matched) {
1120 ProcWriteCaseError(fm,arm,pos);
1121 }
1122 fm->flow = FrameError;
1123 return;
1124 }
1125
1126 assert(s!= NULL);
1127 values = s;
1128
1129 while (vl!=NULL) {
1130 pos++;
1131 name = NamePointer(vl);
1132 expr = GetSingleExpr(values);
1133 instances = FindInstances(fm->i,name,&err);
1134 if (instances == NULL){
1135 switch (err) {
1136 case unmade_instance:
1137 fm->ErrNo = Proc_instance_not_found;
1138 break;
1139 case undefined_instance:
1140 fm->ErrNo = Proc_name_not_found;
1141 break;
1142 case impossible_instance:
1143 fm->ErrNo = Proc_illegal_name_use;
1144 break;
1145 case correct_instance:
1146 fm->ErrNo = Proc_CallError; /* move write to procio */
1147 break;
1148 }
1149 } else {
1150 if (gl_length(instances)==1) {
1151 inst = (struct Instance *)gl_fetch(instances,1);
1152 gl_destroy(instances);
1153 if (!AtomAssigned(inst)) {
1154 fm->ErrNo = Proc_case_undefined_value;
1155 break;
1156 }
1157 switch(ExprType(expr)) {
1158 case e_boolean:
1159 if ((InstanceKind(inst) & IBOOL) == 0) {
1160 fm->ErrNo = Proc_case_boolean_mismatch;
1161 break;
1162 }
1163 val = ExprBValue(expr);
1164 if (val == 2) { /* ANY */
1165 break;
1166 }
1167 valvar = GetBooleanAtomValue(inst);
1168 if (val != valvar) {
1169 fm->ErrNo = Proc_case_unmatched;
1170 }
1171 break;
1172 case e_int:
1173 if ((InstanceKind(inst) & IINT) == 0) {
1174 fm->ErrNo = Proc_case_integer_mismatch;
1175 break;
1176 }
1177 val = ExprIValue(expr);
1178 valvar = GetIntegerAtomValue(inst);
1179 if (val != valvar) {
1180 fm->ErrNo = Proc_case_unmatched;
1181 }
1182 break;
1183 case e_symbol:
1184 if ((InstanceKind(inst) & ISYM) == 0) {
1185 fm->ErrNo = Proc_case_symbol_mismatch;
1186 break;
1187 }
1188 symvar = ExprSymValue(expr);
1189 value = GetSymbolAtomValue(inst);
1190 assert(AscFindSymbol(symvar)!=NULL);
1191 assert(AscFindSymbol(value)!=NULL);
1192 if (symvar != value) {
1193 fm->ErrNo = Proc_case_unmatched;
1194 }
1195 break;
1196 case e_var:
1197 /* evar ok only if a loop index? */
1198 if ((GetEvaluationForTable() != NULL) &&
1199 (NULL != (str = SimpleNameIdPtr(ExprName(expr)))) &&
1200 (NULL != (fvp=FindForVar(GetEvaluationForTable(),str)))) {
1201 switch (GetForKind(fvp)) {
1202 case f_integer:
1203 if ((InstanceKind(inst) & IINT) == 0) {
1204 fm->ErrNo = Proc_case_integer_mismatch;
1205 break;
1206 }
1207 val = GetForInteger(fvp);
1208 valvar = GetIntegerAtomValue(inst);
1209 if (val != valvar) {
1210 fm->ErrNo = Proc_case_unmatched;
1211 }
1212 break;
1213 case f_symbol:
1214 if ((InstanceKind(inst) & ISYM) == 0) {
1215 fm->ErrNo = Proc_case_symbol_mismatch;
1216 break;
1217 }
1218 symvar = GetForSymbol(fvp);
1219 value = GetSymbolAtomValue(inst);
1220 if (symvar != value) {
1221 fm->ErrNo = Proc_case_unmatched;
1222 }
1223 break;
1224 default:
1225 fm->ErrNo = Proc_case_wrong_index;
1226 break;
1227 }
1228 } else {
1229 fm->ErrNo = Proc_case_wrong_index;
1230 }
1231 break;
1232 default:
1233 fm->ErrNo = Proc_case_wrong_value;
1234 }
1235 } else {
1236 gl_destroy(instances);
1237 fm->ErrNo = Proc_case_extra_values;
1238 }
1239 }
1240 if (fm->ErrNo != Proc_case_matched) {
1241 break;
1242 }
1243 vl = NextVariableNode(vl);
1244 values = NextSet(values);
1245 }
1246 if (fm->ErrNo != Proc_case_matched && fm->ErrNo != Proc_case_unmatched) {
1247 ProcWriteCaseError(fm,arm,pos);
1248 fm->flow = FrameError;
1249 }
1250 return;
1251 }
1252
1253 /* This function will determine which case of a SWITCH statement
1254 * applies for the current values of the switching variables.
1255 * this function will call for the execution of the cases which
1256 * match. It handles OTHERWISE properly (case when set == NULL).
1257 */
1258
1259 static
1260 void ExecuteInitSwitch(struct procFrame *fm, struct Statement *stat)
1261 {
1262 struct VariableList *vlist;
1263 struct SwitchList *sw;
1264 struct Set *set;
1265 struct StatementList *sl;
1266 int arm;
1267 int case_match;
1268 int fallthru;
1269 enum FrameControl oldflow;
1270
1271 vlist = SwitchStatVL(stat);
1272 sw = SwitchStatCases(stat);
1273 case_match = 0;
1274
1275 arm = 0;
1276 oldflow = fm->flow;
1277 while (sw!=NULL) { /* && notbreak. fixme */
1278 arm++;
1279 set = SwitchSetList(sw);
1280 sl = SwitchStatementList(sw);
1281 if (set != NULL) {
1282 AnalyzeSwitchCase(fm,vlist,set,arm); /*add fallthru arg */
1283 switch (fm->ErrNo) {
1284 case Proc_case_matched:
1285 case_match++;
1286 /* could put fallthru handling here if in grammar */
1287 fm->ErrNo = Proc_all_ok;
1288 fm->flow = FrameLoop;
1289 ExecuteInitStatements(fm,sl);
1290 switch (fm->flow) {
1291 case FrameLoop:
1292 case FrameOK:
1293 fm->flow = oldflow;
1294 fallthru = 0;
1295 break;
1296 case FrameReturn:
1297 return;
1298 case FrameBreak: /* not properly implemented. fixme */
1299 fallthru = 0;
1300 break;
1301 case FrameContinue:
1302 if (oldflow == FrameLoop) {
1303 return;
1304 }
1305 break;
1306 case FrameFallthru: /* not implemented */
1307 fallthru = 1;
1308 case FrameError: /* EISS not supposed to return this */
1309 default:
1310 break;
1311 }
1312 break;
1313 case Proc_case_unmatched:
1314 break;
1315 default:
1316 /* fixme policy might suppress error return */
1317 fm->flow = FrameError;
1318 return;
1319 }
1320 } else {
1321 /* OTHERWISE arm, which we seem to be assuming comes last */
1322 if (!case_match) {
1323 AnalyzeSwitchCase(fm,vlist,NULL,-1);
1324 if (fm->ErrNo == Proc_case_matched) {
1325 fm->ErrNo = Proc_all_ok;
1326 ExecuteInitStatements(fm,sl);
1327 case_match = 1;
1328 if (fm->ErrNo != Proc_all_ok) {
1329 /* fixme logic */
1330 WriteInitErr(fm,"Error in execution of SWITCH statements\n");
1331 break;
1332 }
1333 }
1334 }
1335 }
1336 sw = NextSwitchCase(sw);
1337 }
1338 if (case_match == 0) {
1339 WriteInitWarn(fm,"No case matched in SWITCH statement\n");
1340 }
1341 return;
1342 }
1343
1344 /* i is generally NOT fm->i, but in the scope of fm->i */
1345 static
1346 void AssignInitValue(struct Instance *i, struct value_t v, struct procFrame *fm)
1347 {
1348 CONST dim_type *dim;
1349 int assignerr = 1; /* set 0 on success */
1350 switch(InstanceKind(i)) {
1351 case MODEL_INST:
1352 case ARRAY_INT_INST:
1353 case ARRAY_ENUM_INST:
1354 case REL_INST:
1355 fm->ErrNo = Proc_nonatom_assignment;
1356 fm->flow = FrameError;
1357 break;
1358 case DUMMY_INST:
1359 /* cpp string concatenation */
1360 assignerr = 0;
1361 WriteInitWarn(fm,"Assignment to an unSELECTed_part ignored."
1362 "SELECT should be shadowed by SWITCH in METHODS");
1363 break;
1364 case INTEGER_INST:
1365 case INTEGER_ATOM_INST:
1366 if (ValueKind(v)!=integer_value){
1367 fm->ErrNo = Proc_noninteger_assignment;
1368 fm->flow = FrameError;
1369 } else {
1370 assignerr = 0;
1371 SetIntegerAtomValue(i,IntegerValue(v),0);
1372 }
1373 break;
1374 case SET_INST:
1375 case SET_ATOM_INST:
1376 case REAL_CONSTANT_INST:
1377 case BOOLEAN_CONSTANT_INST:
1378 case INTEGER_CONSTANT_INST:
1379 case SYMBOL_CONSTANT_INST:
1380 fm->ErrNo = Proc_declarative_constant_assignment;
1381 fm->flow = FrameError;
1382 break;
1383 case REAL_INST:
1384 case REAL_ATOM_INST:
1385 switch(ValueKind(v)){
1386 case real_value:
1387 dim = CheckDimensionsMatch(RealValueDimensions(v),RealAtomDims(i));
1388 if (dim==NULL){
1389 PrintDimenMessage("Inconsistent units in assignment"
1390 ,"LHS",RealAtomDims(i)
1391 ,"RHS",RealValueDimensions(v)
1392 );
1393 fm->ErrNo = Proc_nonconsistent_assignment;
1394 fm->flow = FrameError;
1395 } else {
1396 assignerr = 0;
1397 if (dim!=RealAtomDims(i)) {
1398 SetRealAtomDims(i,dim);
1399 }
1400 SetRealAtomValue(i,RealValue(v),0);
1401 }
1402 break;
1403 case integer_value:
1404 dim = CheckDimensionsMatch(Dimensionless(),RealAtomDims(i));
1405 if (dim==NULL){
1406 PrintDimenMessage("Inconsistent units in assignment"
1407 ,"LHS",RealAtomDims(i)
1408 ,"RHS",RealValueDimensions(v)
1409 );
1410 fm->ErrNo = Proc_nonconsistent_assignment;
1411 fm->flow = FrameError;
1412 } else {
1413 assignerr = 0;
1414 if (dim != RealAtomDims(i)) {
1415 SetRealAtomDims(i,dim);
1416 }
1417 SetRealAtomValue(i,(double)IntegerValue(v),0);
1418 }
1419 break;
1420 default:
1421 fm->ErrNo = Proc_nonreal_assignment;
1422 fm->flow = FrameError;
1423 break;
1424 }
1425 break;
1426 case BOOLEAN_INST:
1427 case BOOLEAN_ATOM_INST:
1428 if (ValueKind(v)!=boolean_value){
1429 fm->ErrNo = Proc_nonboolean_assignment;
1430 fm->flow = FrameError;
1431 } else {
1432 assignerr = 0;
1433 SetBooleanAtomValue(i,BooleanValue(v),0);
1434 }
1435 break;
1436 case SYMBOL_INST:
1437 case SYMBOL_ATOM_INST:
1438 if (ValueKind(v)!=symbol_value){
1439 fm->ErrNo = Proc_nonsymbol_assignment;
1440 fm->flow = FrameError;
1441 } else {
1442 assignerr = 0;
1443 SetSymbolAtomValue(i,SymbolValue(v));
1444 }
1445 break;
1446 default:
1447 fm->ErrNo = Proc_nonsense_assignment;
1448 fm->flow = FrameError;
1449 break;
1450 }
1451 if (assignerr) {
1452 ProcWriteAssignmentError(fm);
1453 }
1454 }
1455
1456 /* this function always returns ok. 5/96 */
1457 static
1458 void ExecuteInitAsgn(struct procFrame *fm, struct Statement *stat)
1459 {
1460 struct gl_list_t *instances;
1461 struct Instance *inst;
1462 unsigned c,len;
1463 enum FrameControl oldflow;
1464 struct value_t value;
1465 enum find_errors err;
1466
1467 instances = FindInstances(fm->i,DefaultStatVar(stat),&err);
1468 if (instances != NULL){
1469 assert(GetEvaluationContext()==NULL);
1470 SetEvaluationContext(fm->i);
1471 value = EvaluateExpr(DefaultStatRHS(stat),NULL,InstanceEvaluateName);
1472 SetEvaluationContext(NULL);
1473 if (ValueKind(value)==error_value) {
1474 fm->ErrNo = Proc_rhs_error;
1475 fm->flow = FrameError;
1476 ProcWriteAssignmentError(fm);
1477 } else {
1478 len = gl_length(instances);
1479 oldflow = fm->flow;
1480 for(c=1;c<=len;c++){
1481 inst = (struct Instance *)gl_fetch(instances,c);
1482 AssignInitValue(inst,value,fm); /* does its own errors */
1483 if (fm->flow == FrameError) {
1484 if (/* fm->policy-check */0) {
1485 fm->flow = oldflow; /* suppress error flow */
1486 } else {
1487 break; /* skip rest of loop */
1488 }
1489 }
1490 }
1491 }
1492 DestroyValue(&value);
1493 gl_destroy(instances);
1494 } else {
1495 /* error finding left hand side */
1496 fm->ErrNo = Proc_lhs_error;
1497 fm->flow = FrameError;
1498 ProcWriteAssignmentError(fm);
1499 }
1500 return /* Proc_all_ok */;
1501 }
1502
1503 static
1504 void ExecuteInitStatement(struct procFrame *fm, struct Statement *stat)
1505 {
1506 #if IDB
1507 FPRINTF(fm->err,"\n");
1508 FPRINTF(fm->err,"EIS-IN: %s\n",FrameControlToString(fm->flow));
1509 FPRINTF(fm->err,"EIS: "); WriteStatement(fm->err,stat,2);
1510 #endif
1511 switch(StatementType(stat)){
1512 case FOR:
1513 ExecuteInitFor(fm,stat);
1514 break;
1515 case ASGN:
1516 ExecuteInitAsgn(fm,stat);
1517 break;
1518 case RUN:
1519 ExecuteInitRun(fm,stat);
1520 break;
1521 case FIX:
1522 ExecuteInitFix(fm,stat);
1523 break;
1524 case FREE:
1525 ExecuteInitFree(fm,stat);
1526 break;
1527 case FLOW:
1528 ExecuteInitFlow(fm);
1529 break;
1530 case EXT:
1531 /* CONSOLE_DEBUG("ABOUT TO ExecuteInitExt"); */
1532 ExecuteInitExt(fm,stat);
1533 break;
1534 case CALL:
1535 ExecuteInitCall(fm,stat);
1536 break;
1537 case WHILE:
1538 ExecuteInitWhile(fm,stat);
1539 break;
1540 case ASSERT:
1541 ExecuteInitAssert(fm,stat);
1542 break;
1543 case IF:
1544 ExecuteInitIf(fm,stat);
1545 break;
1546 case SWITCH:
1547 ExecuteInitSwitch(fm,stat);
1548 break;
1549 case CASGN:
1550 fm->flow = FrameError;
1551 fm->ErrNo = Proc_declarative_constant_assignment;
1552 WriteInitErr(fm,
1553 "Incorrect statement type (constant assigned)"
1554 " in initialization section");
1555 break;
1556 default:
1557 fm->flow = FrameError;
1558 fm->ErrNo = Proc_bad_statement;
1559 WriteInitErr(fm,"Unexpected statement type in initialization section");
1560 break;
1561 }
1562 #if IDB
1563 FPRINTF(fm->err,"EIS-OUT: %s\n\n",FrameControlToString(fm->flow));
1564 #endif
1565 return;
1566 }
1567
1568 /* This is our central error handling logic control point.
1569 * This function should not itself return fm->flow == FrameError.
1570 * To the maximum extent possible, do not process errors separately
1571 * elsewhere but defer them to here. That makes maintenance of code
1572 * which handles debugging output and execution logic much simpler.
1573 */
1574 static
1575 void ExecuteInitStatements(struct procFrame *fm, struct StatementList *sl)
1576 {
1577 unsigned c,length;
1578 struct gl_list_t *statements;
1579 struct Statement *stat;
1580 enum FrameControl oldflow;
1581 int stop;
1582
1583 statements = GetList(sl);
1584 length = gl_length(statements);
1585 stop = 0;
1586 oldflow = fm->flow;
1587 for (c = 1; c <= length && !stop; c++){
1588 stat = (struct Statement *)gl_fetch(statements,c);
1589 UpdateProcFrame(fm,stat,fm->i);
1590 /* statements should issue their own complaints */
1591 ExecuteInitStatement(fm,stat);
1592 switch (fm->flow) {
1593 case FrameLoop:
1594 case FrameOK:
1595 fm->flow = oldflow;
1596 break;
1597 case FrameError:
1598 #if IDB
1599 FPRINTF(fm->err,"ERR: "); WriteStatement(fm->err,fm->stat,0);
1600 FPRINTF(fm->err,"\n");
1601 #endif
1602 if ((fm->gen & WP_STOPONERR)!= 0) {
1603 fm->flow = FrameReturn;
1604 stop = 1;
1605 } else {
1606 fm->flow = oldflow;
1607 }
1608 break;
1609 case FrameFallthru: /* say what? */
1610 case FrameContinue:
1611 case FrameBreak:
1612 if (oldflow == FrameLoop) {
1613 stop = 1;
1614 } else {
1615 /* whine about missing loop/switch context.
1616 * should be parser enforced.
1617 */
1618 #if IDB
1619 FPRINTF(fm->err,"LOOP-ERR: "); WriteStatement(fm->err,fm->stat,0);
1620 FPRINTF(fm->err,"\n");
1621 #endif
1622 if ((fm->gen & WP_STOPONERR)!= 0) {
1623 fm->flow = FrameReturn;
1624 stop = 1;
1625 } else {
1626 fm->flow = oldflow;
1627 }
1628 }
1629 break;
1630 case FrameReturn:
1631 #if IDB
1632 FPRINTF(fm->err,"ERR-UNWIND: "); WriteStatement(fm->err,fm->stat,0);
1633 FPRINTF(fm->err,"\n");
1634 #endif
1635 if (/* i/o policy check */1) {
1636 /* whine backtrace*/
1637 }
1638 stop = 1;
1639 break;
1640 /* all cases must be handled here. */
1641 }
1642 if (g_procframe_stop) {
1643 g_procframe_stop = 0;
1644 fm->ErrNo = Proc_user_interrupt;
1645 WriteInitErr(fm,"USER interrupted METHOD execution");
1646 fm->flow = FrameReturn;
1647 stop = 1;
1648 }
1649 }
1650 /* UpdateProcFrame(fm,NULL, fm->i); */ /* leave a mess for messages */
1651 assert(fm->flow != FrameError);
1652 }
1653
1654 /*********************************************************************\
1655 * void ExecuteInitProcedure(i,proc)
1656 * struct Instance *i;
1657 * struct InitProcedure *proc;
1658 * This will execute proc on the instance i.
1659 \*********************************************************************/
1660 /*
1661 * Here's where we enforce stack limits (approximately).
1662 * Here's where we unwind the stack in the event of an
1663 * early return.
1664 */
1665 static
1666 void ExecuteInitProcedure(struct procFrame *fm, struct InitProcedure *proc)
1667 {
1668 struct for_table_t *OldForTable;
1669
1670 g_proc.depth++;
1671 assert(fm != NULL && fm->i != NULL && proc != NULL);
1672 if (g_proc.depth > g_proc.limit) {
1673 g_proc.depth--;
1674 fm->ErrNo = Proc_stack_exceeded_this_frame;
1675 fm->flow = FrameError;
1676 return;
1677 }
1678
1679 OldForTable = GetEvaluationForTable();
1680 SetEvaluationForTable(CreateForTable());
1681 ExecuteInitStatements(fm,ProcStatementList(proc));
1682 DestroyForTable(GetEvaluationForTable());
1683 SetEvaluationForTable(OldForTable);
1684 g_proc.depth--;
1685 }
1686
1687 /* returns overflow or ok. possibly either form of overflow. */
1688 static
1689 void RealInitialize(struct procFrame *fm, struct Name *name)
1690 {
1691 struct Name *instname = NULL;
1692 struct Instance *ptr;
1693 enum find_errors err;
1694 struct InitProcedure *proc;
1695 struct gl_list_t *instances;
1696 unsigned long c,length;
1697 char *morename;
1698 struct procFrame *newfm;
1699 symchar *procname=NULL;
1700 int stop;
1701 int previous_context = GetDeclarativeContext();
1702
1703 morename = WriteNameString(name);
1704 CONSOLE_DEBUG("Running method '%s'...",morename);
1705 ASC_FREE(morename);
1706
1707 SetDeclarativeContext(1); /* set up for procedural processing */
1708 InstanceNamePart(name,&instname,&procname);
1709
1710 if (procname != NULL) {
1711 instances = FindInstances(fm->i, instname, &err);
1712 if (instances != NULL) {
1713 length = gl_length(instances);
1714 stop = 0;
1715 for(c=1; c<=length && !stop; c++){
1716 ptr = (struct Instance *)gl_fetch(instances,c);
1717 proc = FindProcedure(ptr,procname);
1718 if (proc != NULL) {
1719 morename = WriteInstanceNameString(ptr,fm->i);
1720 newfm = AddProcFrame(fm,ptr,
1721 (morename!=NULL)?morename:"",
1722 proc,FrameInherit);
1723 /* this usage probably force memory recycle in proctype.c */
1724 if (morename != NULL) {
1725 ascfree(morename);
1726 }
1727 ExecuteInitProcedure(newfm,proc);
1728 switch (newfm->flow) {
1729 case FrameOK:
1730 case FrameLoop:
1731 /* do nothing */
1732 break;
1733 case FrameBreak:
1734 case FrameContinue:
1735 case FrameFallthru:
1736 /* aren't supposed to work across frames, or are they? */
1737 /* do nothing */
1738 break;
1739 case FrameError:
1740 /* having to check this here sucks, but the stack
1741 * limit is not optional.
1742 */
1743 if ((fm->gen & WP_STOPONERR) != 0 || /* ||, not && */
1744 newfm->ErrNo == Proc_stack_exceeded_this_frame) {
1745 fm->flow = newfm->flow;
1746 fm->ErrNo = newfm->ErrNo;
1747 if (fm->ErrNo == Proc_stack_exceeded_this_frame) {
1748 fm->ErrNo = Proc_stack_exceeded;
1749 }
1750 stop = 1;
1751 }
1752 ProcWriteStackCheck(newfm,NULL,name);
1753 break;
1754 case FrameReturn:
1755 if (newfm->ErrNo != Proc_return) {
1756 fm->flow = newfm->flow;
1757 fm->ErrNo = newfm->ErrNo;
1758 ProcWriteStackCheck(newfm,NULL,name);
1759 } /* else was a c-like RETURN;. don't pass upward */
1760 break;
1761 }
1762 DestroyProcFrame(newfm);
1763 } else {
1764 fm->flow = FrameError;
1765 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindProcedure failed).");
1766 fm->ErrNo = Proc_proc_not_found;
1767 }
1768 }
1769 gl_destroy(instances);
1770 } else { /* unable to find instances */
1771 fm->flow = FrameError;
1772 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindInstances failed).");
1773 fm->ErrNo = Proc_instance_not_found;
1774 }
1775 } else {
1776 CONSOLE_DEBUG("BAD PROC NAME");
1777 fm->flow = FrameError;
1778 fm->ErrNo = Proc_bad_name;
1779 }
1780 SetDeclarativeContext(previous_context);
1781 DestroyName(instname);
1782 return;
1783 }
1784
1785 /* Convert all those messy result to a proc enum for UI consumption. */
1786 static
1787 enum Proc_enum InitCalcReturn(struct procFrame *fm)
1788 {
1789 switch(fm->flow) {
1790 case FrameOK:
1791 return Proc_all_ok;
1792 case FrameReturn: /* FALLTHROUGH */
1793 case FrameError:
1794 /* whine */
1795 return fm->ErrNo;
1796 case FrameLoop:
1797 /* whine a lot */
1798 case FrameContinue:
1799 return Proc_continue;
1800 case FrameBreak:
1801 return Proc_break;
1802 case FrameFallthru:
1803 return Proc_fallthru;
1804 /* all must be handled in this switch */
1805 }
1806 return -1;
1807 }
1808
1809 /* internal debug head */
1810 static
1811 enum Proc_enum DebugInitialize(struct Instance *context,
1812 struct Name *name,
1813 char *cname,
1814 FILE *err,
1815 wpflags options,
1816 struct gl_list_t *watchpoints,
1817 FILE *log,
1818 struct procFrame *fm)
1819 {
1820 struct procDebug dbi; /* this struct is huge */
1821
1822 CONSOLE_DEBUG("RUNNING METHOD IN DEBUG MODE...");
1823 InitDebugTopProcFrame(fm,context,cname,err,options,&dbi,watchpoints,log);
1824 RealInitialize(fm,name);
1825 return InitCalcReturn(fm);
1826 }
1827
1828 /* internal normal head */
1829 static
1830 enum Proc_enum NormalInitialize(struct procFrame *fm, struct Name *name)
1831 {
1832 RealInitialize(fm,name);
1833 return InitCalcReturn(fm);
1834 }
1835
1836 enum Proc_enum Initialize(struct Instance *context,
1837 struct Name *name,
1838 char *cname,
1839 FILE *err,
1840 wpflags options,
1841 struct gl_list_t *watchpoints,
1842 FILE *log)
1843 {
1844 enum Proc_enum rval;
1845 struct procFrame fm;
1846
1847 CONSOLE_DEBUG("RUNNING METHOD...");
1848
1849 assert(err != NULL);
1850 g_proc.depth = 0;
1851 Asc_SetMethodUserInterrupt(0);
1852 if (watchpoints == NULL) {
1853 InitNormalTopProcFrame(&fm,context,cname,err,options);
1854 rval = NormalInitialize(&fm,name);
1855 } else {
1856 CONSOLE_DEBUG("DEBUG");
1857 rval = DebugInitialize(context,name,cname,err,options,watchpoints,log,&fm);
1858 }
1859 return rval;
1860 }
1861
1862 /*
1863 * This deals with initializations of the form:
1864 * RUN Type::procname; where Type is model or atom type,
1865 * and procname is a procedure defined within that type.
1866 * If the Type happened to have redefined a procedure from its
1867 * parent class, that procedure would be the one on its
1868 * procedure list and hence the one that would be invoked.
1869 *
1870 */
1871 static
1872 void ClassAccessRealInitialize(struct procFrame *fm,
1873 struct Name *class,
1874 struct Name *name)
1875 {
1876 struct InitProcedure *proc;
1877 struct procFrame *newfm;
1878 struct gl_list_t *plist;
1879 symchar *procname;
1880 symchar *typename;
1881 struct TypeDescription *desc,*conformable;
1882 int previous_context = GetDeclarativeContext();
1883
1884 SetDeclarativeContext(1); /* set up for procedural processing */
1885
1886 typename = SimpleNameIdPtr(class);
1887 if (typename != NULL) {
1888 desc = FindType(typename);
1889 if (desc != NULL) {
1890 conformable = InstanceTypeDesc(fm->i);
1891 if (MoreRefined(conformable,desc)) {
1892 plist = GetInitializationList(desc);
1893 if (plist != NULL) {
1894 procname = SimpleNameIdPtr(name);
1895 if (procname != NULL) {
1896 proc = SearchProcList(plist,procname);
1897 if (proc == NULL) {
1898 proc = SearchProcList(GetUniversalProcedureList(),procname);
1899 }
1900 if (proc != NULL) {
1901 newfm = AddProcFrame(fm,fm->i,"",proc,FrameInherit);
1902 /* apf starts newfm with frameok */
1903 ExecuteInitProcedure(newfm,proc);
1904 switch (newfm->flow) {
1905 case FrameOK:
1906 case FrameLoop:
1907 /* do nothing */
1908 break;
1909 case FrameBreak:
1910 case FrameContinue:
1911 case FrameFallthru:
1912 /* aren't supposed to work across frames are they? */
1913 /* do nothing */
1914 break;
1915 case FrameError:
1916 fm->flow = newfm->flow;
1917 fm->ErrNo = newfm->ErrNo;
1918 ProcWriteStackCheck(newfm,class,name);
1919 /* having to check this here sucks, but the stack
1920 * limit is not optional.
1921 */
1922 if (fm->ErrNo == Proc_stack_exceeded_this_frame) {
1923 fm->ErrNo = Proc_stack_exceeded;
1924 }
1925 break;
1926 case FrameReturn:
1927 if (newfm->ErrNo != Proc_return) {
1928 fm->flow = newfm->flow;
1929 fm->ErrNo = newfm->ErrNo;
1930 ProcWriteStackCheck(newfm,class,name); /* fixme?*/
1931 } /* else was a c-like RETURN;. don't pass upward */
1932 break;
1933 }
1934 DestroyProcFrame(newfm);
1935 } else {
1936 fm->flow = FrameError;
1937 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (SearchProcList).");
1938 fm->ErrNo = Proc_proc_not_found;
1939 }
1940 } else {
1941 fm->flow = FrameError;
1942 fm->ErrNo = Proc_illegal_name_use;
1943 }
1944 } else {
1945 fm->flow = FrameError;
1946 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (GetInitializationList is null).");
1947 fm->ErrNo = Proc_proc_not_found;
1948 }
1949 } else {
1950 fm->flow = FrameError;
1951 fm->ErrNo = Proc_illegal_type_use;
1952 }
1953 } else {
1954 fm->flow = FrameError;
1955 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindType failed)\n");
1956 fm->ErrNo = Proc_type_not_found;
1957 }
1958 } else {
1959 fm->flow = FrameError;
1960 fm->ErrNo = Proc_illegal_name_use;
1961 }
1962
1963 SetDeclarativeContext(previous_context);
1964 return;
1965 }
1966
1967 /* internal debug head */
1968 static
1969 enum Proc_enum DebugClassAccessInitialize(struct Instance *context,
1970 struct Name *class,
1971 struct Name *name,
1972 char *cname,
1973 FILE *err,
1974 wpflags options,
1975 struct gl_list_t *watchpoints,
1976 FILE *log,
1977 struct procFrame *fm)
1978 {
1979 struct procDebug dbi; /* this struct is huge */
1980
1981 InitDebugTopProcFrame(fm,context,cname,err,options,&dbi,watchpoints,log);
1982 ClassAccessRealInitialize(fm,class,name);
1983 return InitCalcReturn(fm);
1984 }
1985
1986 /* internal normal head */
1987 static
1988 enum Proc_enum NormalClassAccessInitialize(struct procFrame *fm,
1989 struct Name *class,
1990 struct Name *name)
1991 {
1992 ClassAccessRealInitialize(fm,class,name);
1993 return InitCalcReturn(fm);
1994 }
1995
1996 enum Proc_enum ClassAccessInitialize(struct Instance *context,
1997 struct Name *class,
1998 struct Name *name,
1999 char *cname,
2000 FILE *err,
2001 wpflags options,
2002 struct gl_list_t *watchpoints,
2003 FILE *log)
2004 {
2005 struct procFrame fm;
2006
2007 assert(err != NULL);
2008 g_proc.depth = 0;
2009 Asc_SetMethodUserInterrupt(0);
2010 if (watchpoints == NULL) {
2011 InitNormalTopProcFrame(&fm,context,cname,err,options);
2012 return NormalClassAccessInitialize(&fm,class,name);
2013 } else {
2014 return DebugClassAccessInitialize(context,class,name,cname,
2015 err,options,watchpoints,log,&fm);
2016 }
2017 }

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22