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

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