/[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 910 - (show annotations) (download) (as text)
Thu Oct 26 13:35:25 2006 UTC (13 years, 8 months ago) by johnpye
File MIME type: text/x-csrc
File size: 56623 byte(s)
In instantiate.c, made new blackbox code tolerant of blackboxes that don't need initialisation.
Removed some debug output.
Expanded 'extfntest.py' a little bit, for ease of testing.
Converted 'blackbox is experimental' warnings to one-time-only.
Minor change to way that webbrowser is invoked under linux.
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 *ProcessExtMethodArgs(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 CONST struct VariableList *vl;
463 struct gl_list_t *result;
464
465 vl = ExternalStatVlistMethod(stat);
466 result = ProcessExtMethodArgs(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 */
479 #endif
480 }
481
482 /*
483 * This always returns ok. at least as of 5/96.
484 */
485 static
486 void ExecuteInitExt(struct procFrame *fm, struct Statement *stat)
487 {
488 struct ExternalFunc *efunc;
489 CONST char *funcname;
490 struct gl_list_t *arglist=NULL, *errlist;
491 enum find_errors ferr;
492 unsigned long c,len,pos;
493
494 ExtMethodRun *eval_func;
495 void *user_data;
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 user_data = GetExtMethodUserData(efunc);
515 if (eval_func == NULL) {
516 CONSOLE_DEBUG("GetValueFunc(efunc) returned NULL");
517 fm->ErrNo = Proc_CallError;
518 fm->flow = FrameError;
519 ProcWriteExtError(fm,funcname,PE_nulleval,0);
520 return;
521 }
522
523 errlist = gl_create(1);
524 arglist = InitCheckExtCallArgs(fm->i,stat,errlist);
525 len = gl_length(errlist);
526 if (len != 0) {
527 CONSOLE_DEBUG("InitCheckExtCallArgs returned items in errlist...");
528 fm->flow = FrameError;
529 ProcWriteExtError(fm,funcname,PE_argswrong,0);
530 c = 1;
531 assert((len & 0x1) == 0); /* must be even */
532 while (c < len) {
533 /* works because error position/code pairs */
534 pos = (unsigned long)gl_fetch(errlist,c);
535 c++; /* Wait, who let that dirty word in here!? */
536 ferr = (enum find_errors)gl_fetch(errlist,c);
537 c++;
538 switch (ferr) {
539 case unmade_instance:
540 fm->ErrNo = Proc_instance_not_found;
541 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
542 break;
543 case undefined_instance:
544 fm->ErrNo = Proc_name_not_found;
545 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
546 break;
547 case impossible_instance:
548 fm->ErrNo = Proc_illegal_name_use;
549 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
550 break; /* move write to procio */
551 case correct_instance:
552 fm->ErrNo = Proc_CallError;
553 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
554 break;
555 default:
556 fm->ErrNo = Proc_bad_name;
557 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
558 break;
559 }
560 }
561 fm->ErrNo = Proc_CallError;
562 if (arglist != NULL) {
563 DestroySpecialList(arglist);
564 }
565 if (errlist != NULL) {
566 gl_destroy(errlist);
567 }
568 return;
569 }
570
571 /* CONSOLE_DEBUG("CHECKED EXTERNAL ARGS, OK"); */
572
573 nok = (*eval_func)(fm->i,arglist,user_data);
574
575 /* CONSOLE_DEBUG("BACK FROM RUNING FUNC AT %p",eval_func); */
576
577 /* this should switch on Proc_CallXXXXX */
578 /* should switch on proc_enum call bits to translate Proc_Call
579 * flow of control to our fm->flow.
580 */
581 if (nok) {
582 fm->flow = FrameError; /* move write to procio */
583 ERROR_REPORTER_HERE(ASC_USER_NOTE,"NOK");
584 ProcWriteExtError(fm,funcname,PE_evalerr,0);
585 } else {
586 fm->flow = FrameOK;
587 }
588 if (arglist != NULL) {
589 DestroySpecialList(arglist);
590 }
591 if (errlist != NULL) {
592 gl_destroy(errlist);
593 }
594
595 return;
596 }
597
598 /*
599 * executes a for loop
600 */
601 static
602 void ExecuteInitFor(struct procFrame *fm, struct Statement *stat)
603 {
604 symchar *name;
605 struct Expr *ex;
606 struct StatementList *sl;
607 unsigned long c,len;
608 int direction; /* was declared unsigned long, but used as int (JDS 12/11/2005) */
609 struct value_t value;
610 struct set_t *sptr;
611 struct for_var_t *fv;
612 enum FrameControl oldflow;
613
614 c = direction = 1; /* shut up gcc */
615
616 name = ForStatIndex(stat);
617 ex = ForStatExpr(stat);
618 sl = ForStatStmts(stat);
619 fv = FindForVar(GetEvaluationForTable(),name);
620 if (fv != NULL) { /* duplicated for variable */
621 fm->flow = FrameError;
622 fm->ErrNo = Proc_for_duplicate_index;
623 ProcWriteForError(fm);
624 return;
625 }
626 assert(GetEvaluationContext()==NULL);
627 SetEvaluationContext(fm->i);
628 value = EvaluateExpr(ex,NULL,InstanceEvaluateName);
629 SetEvaluationContext(NULL);
630 switch(ValueKind(value)){
631 case error_value:
632 fm->flow = FrameError;
633 fm->ErrNo = Proc_for_set_err;
634 ProcWriteForError(fm);
635 break;
636 case set_value:
637 sptr = SetValue(value);
638 switch(SetKind(sptr)){
639 case empty_set:
640 break;
641 case integer_set:
642 fv = CreateForVar(name);
643 SetForVarType(fv,f_integer);
644 AddLoopVariable(GetEvaluationForTable(),fv);
645 len = Cardinality(sptr);
646 switch(ForLoopOrder(stat)){
647 case f_random:
648 /* fall through, that should never occur due to parser. */
649 case f_increasing:
650 direction = 1;
651 c = 1;
652 break;
653 case f_decreasing:
654 direction = -1;
655 c = len;
656 break;
657 }
658 /* we handle all logic with one for loop to avoid
659 * duplicate code insanity.
660 */
661 oldflow = fm->flow;
662 fm->flow = FrameLoop;
663 for(/* init c in switch above */;
664 c >= 1 && c <= len &&
665 fm->flow != FrameBreak && fm->flow != FrameReturn;
666 c += direction) {
667 SetForInteger(fv,FetchIntMember(sptr,c));
668 ExecuteInitStatements(fm,sl);
669 switch (fm->flow) {
670 case FrameOK:
671 case FrameContinue:
672 fm->flow = FrameLoop;
673 break;
674 case FrameLoop:
675 case FrameBreak:
676 case FrameFallthru:
677 case FrameReturn:
678 break;
679 case FrameError: /*EISS not to return this!*/
680 default: /* should never happen */
681 #if IDB
682 FPRINTF(fm->err,"ERR-NEVER1: "); WriteStatement(fm->err,stat,0);
683 FPRINTF(fm->err,"\n");
684 #endif
685 fm->flow = FrameReturn;
686 break;
687 }
688 }
689 /* post loop flow processing */
690 switch (fm->flow) {
691 case FrameLoop:
692 case FrameBreak:
693 fm->flow = oldflow;
694 break;
695 default:
696 break; /* let return, fallthru out to next level */
697 }
698 RemoveForVariable(GetEvaluationForTable());
699 break; /* integer_set */
700 case string_set:
701 fv = CreateForVar(name);
702 SetForVarType(fv,f_symbol);
703 AddLoopVariable(GetEvaluationForTable(),fv);
704 len = Cardinality(sptr);
705 switch(ForLoopOrder(stat)){
706 case f_random:
707 /* fall through, that should never occur due to parser. */
708 case f_increasing:
709 direction = 1;
710 c = 1;
711 break;
712 case f_decreasing:
713 direction = -1;
714 c = len;
715 break;
716 }
717 oldflow = fm->flow;
718 fm->flow = FrameLoop;
719 for(/* init c in switch above */;
720 c >= 1 && c <= len &&
721 fm->flow != FrameBreak && fm->flow != FrameReturn;
722 c += direction) {
723 SetForSymbol(fv,FetchStrMember(sptr,c));
724 ExecuteInitStatements(fm,sl);
725 switch (fm->flow) {
726 case FrameOK:
727 case FrameContinue:
728 fm->flow = FrameLoop;
729 break;
730 case FrameLoop:
731 case FrameBreak:
732 case FrameReturn:
733 case FrameFallthru:
734 break;
735 case FrameError: /*EISS not to return this!*/
736 default: /* should never happen */
737 #if IDB
738 FPRINTF(fm->err,"ERR-NEVER2: "); WriteStatement(fm->err,stat,0);
739 FPRINTF(fm->err,"\n");
740 #endif
741 fm->flow = FrameReturn;
742 break;
743 }
744 }
745 /* post loop flow processing */
746 switch (fm->flow) {
747 case FrameLoop:
748 case FrameBreak:
749 fm->flow = oldflow;
750 break;
751 default:
752 break;
753 }
754 RemoveForVariable(GetEvaluationForTable());
755 break;
756 }
757 break;
758 default:
759 fm->flow = FrameError;
760 fm->ErrNo = Proc_for_not_set;
761 ProcWriteForError(fm);
762 break;
763 }
764 DestroyValue(&value);
765 return;
766 }
767
768 static void
769 ExecuteInitAssert(struct procFrame *fm, struct Statement *stat){
770 struct value_t value;
771 int testerr;
772 assert(GetEvaluationContext()==NULL);
773 SetEvaluationContext(fm->i);
774 value = EvaluateExpr(AssertStatExpr(stat),NULL,InstanceEvaluateName);
775 SetEvaluationContext(NULL);
776 testerr = 1; /* set 0 on success */
777 switch(ValueKind(value)){
778 case boolean_value:
779 testerr = 0;
780 if(BooleanValue(value)){
781 ERROR_REPORTER_STAT(ASC_USER_SUCCESS,stat,"Assertion OK");
782 }else{
783 ERROR_REPORTER_STAT(ASC_USER_ERROR,stat,"Assertion failed");
784 }
785 break;
786 case real_value:
787 fm->flow = FrameError;
788 fm->ErrNo = Proc_if_real_expr;
789 break;
790 case integer_value:
791 fm->flow = FrameError;
792 fm->ErrNo = Proc_if_integer_expr;
793 break;
794 case symbol_value:
795 fm->flow = FrameError;
796 fm->ErrNo = Proc_if_symbol_expr;
797 break;
798 case set_value: /* FALLTHROUGH */
799 case list_value:
800 fm->flow = FrameError;
801 fm->ErrNo = Proc_if_set_expr;
802 break;
803 case error_value:
804 fm->flow = FrameError;
805 fm->ErrNo = Proc_if_expr_error_confused;
806 switch (ErrorValue(value)) {
807 case type_conflict:
808 fm->ErrNo = Proc_if_expr_error_typeconflict;
809 break;
810 case name_unfound:
811 fm->ErrNo = Proc_if_expr_error_nameunfound;
812 break;
813 case incorrect_name:
814 fm->ErrNo = Proc_if_expr_error_incorrectname;
815 break;
816 case undefined_value:
817 fm->ErrNo = Proc_if_expr_error_undefinedvalue;
818 break;
819 case dimension_conflict:
820 fm->ErrNo = Proc_if_expr_error_dimensionconflict;
821 break;
822 case empty_choice:
823 fm->ErrNo = Proc_if_expr_error_emptychoice;
824 break;
825 case empty_intersection:
826 fm->ErrNo = Proc_if_expr_error_emptyintersection;
827 break;
828 default:
829 ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unhandled case");
830 }
831 break;
832 default:
833 fm->flow = FrameError;
834 fm->ErrNo = Proc_if_not_logical;
835 break;
836 }
837 if (fm->flow == FrameError && testerr) {
838 ProcWriteIfError(fm,"TEST");
839 }
840 DestroyValue(&value);
841 return;
842 }
843
844 static
845 void ExecuteInitIf(struct procFrame *fm, struct Statement *stat)
846 {
847 struct value_t value;
848 int iferr;
849
850 assert(GetEvaluationContext()==NULL);
851 SetEvaluationContext(fm->i);
852 value = EvaluateExpr(IfStatExpr(stat),NULL,InstanceEvaluateName);
853 SetEvaluationContext(NULL);
854 iferr = 1; /* set 0 on success */
855 switch(ValueKind(value)){
856 case boolean_value:
857 iferr = 0;
858 if (BooleanValue(value)) {
859 ExecuteInitStatements(fm,IfStatThen(stat));
860 } else {
861 if (IfStatElse(stat) != NULL) {
862 ExecuteInitStatements(fm,IfStatElse(stat));
863 }
864 }
865 break;
866 case real_value:
867 fm->flow = FrameError;
868 fm->ErrNo = Proc_if_real_expr;
869 break;
870 case integer_value:
871 fm->flow = FrameError;
872 fm->ErrNo = Proc_if_integer_expr;
873 break;
874 case symbol_value:
875 fm->flow = FrameError;
876 fm->ErrNo = Proc_if_symbol_expr;
877 break;
878 case set_value: /* FALLTHROUGH */
879 case list_value:
880 fm->flow = FrameError;
881 fm->ErrNo = Proc_if_set_expr;
882 break;
883 case error_value:
884 fm->flow = FrameError;
885 fm->ErrNo = Proc_if_expr_error_confused;
886 switch (ErrorValue(value)) {
887 case type_conflict:
888 fm->ErrNo = Proc_if_expr_error_typeconflict;
889 break;
890 case name_unfound:
891 fm->ErrNo = Proc_if_expr_error_nameunfound;
892 break;
893 case incorrect_name:
894 fm->ErrNo = Proc_if_expr_error_incorrectname;
895 break;
896 case undefined_value:
897 fm->ErrNo = Proc_if_expr_error_undefinedvalue;
898 break;
899 case dimension_conflict:
900 fm->ErrNo = Proc_if_expr_error_dimensionconflict;
901 break;
902 case empty_choice:
903 fm->ErrNo = Proc_if_expr_error_emptychoice;
904 break;
905 case empty_intersection:
906 fm->ErrNo = Proc_if_expr_error_emptyintersection;
907 break;
908 default:
909 break;
910 }
911 break;
912 default:
913 fm->flow = FrameError;
914 fm->ErrNo = Proc_if_not_logical;
915 break;
916 }
917 if (fm->flow == FrameError && iferr) {
918 ProcWriteIfError(fm,"IF");
919 }
920 DestroyValue(&value);
921 return;
922 }
923
924 /*
925 */
926 static
927 void ExecuteInitWhile(struct procFrame *fm, struct Statement *stat)
928 {
929 struct value_t value;
930 int iferr;
931 int stop;
932 long limit = WP_MAXTRIPS;
933 enum FrameControl oldflow;
934
935 assert(GetEvaluationContext()==NULL);
936 stop = 0;
937 oldflow = fm->flow;
938 fm->flow = FrameLoop;
939 while (!stop) {
940 assert(fm->flow == FrameLoop);
941 SetEvaluationContext(fm->i);
942 value = EvaluateExpr(WhileStatExpr(stat),NULL,InstanceEvaluateName);
943 SetEvaluationContext(NULL);
944 iferr = 1; /* set 0 on success */
945 limit--;
946 switch(ValueKind(value)){
947 case boolean_value:
948 iferr = 0;
949 if (BooleanValue(value)) {
950 ExecuteInitStatements(fm,WhileStatBlock(stat));
951 switch (fm->flow) {
952 case FrameOK:
953 case FrameContinue:
954 fm->flow = FrameLoop;
955 break;
956 case FrameLoop:
957 break;
958 case FrameBreak: /* break while loop only */
959 case FrameFallthru: /* while must be inside switch...*/
960 case FrameReturn:
961 stop = 1;
962 break;
963 case FrameError: /* EISS is not supposed to let this happen */
964 default: /* should never happen */
965 #if IDB
966 FPRINTF(fm->err,"ERR-NEVER3: "); WriteStatement(fm->err,stat,0);
967 FPRINTF(fm->err,"\n");
968 #endif
969 fm->flow = FrameReturn;
970 break;
971 }
972 } else {
973 stop = 1;
974 }
975 break;
976 case real_value:
977 fm->flow = FrameError;
978 fm->ErrNo = Proc_if_real_expr;
979 break;
980 case integer_value:
981 fm->flow = FrameError;
982 fm->ErrNo = Proc_if_integer_expr;
983 break;
984 case symbol_value:
985 fm->flow = FrameError;
986 fm->ErrNo = Proc_if_symbol_expr;
987 break;
988 case set_value: /* FALLTHROUGH */
989 case list_value:
990 fm->flow = FrameError;
991 fm->ErrNo = Proc_if_set_expr;
992 break;
993 case error_value:
994 fm->flow = FrameError;
995 fm->ErrNo = Proc_if_expr_error_confused;
996 switch (ErrorValue(value)) {
997 case type_conflict:
998 fm->ErrNo = Proc_if_expr_error_typeconflict;
999 break;
1000 case name_unfound:
1001 fm->ErrNo = Proc_if_expr_error_nameunfound;
1002 break;
1003 case incorrect_name:
1004 fm->ErrNo = Proc_if_expr_error_incorrectname;
1005 break;
1006 case undefined_value:
1007 fm->ErrNo = Proc_if_expr_error_undefinedvalue;
1008 break;
1009 case dimension_conflict:
1010 fm->ErrNo = Proc_if_expr_error_dimensionconflict;
1011 break;
1012 case empty_choice:
1013 fm->ErrNo = Proc_if_expr_error_emptychoice;
1014 break;
1015 case empty_intersection:
1016 fm->ErrNo = Proc_if_expr_error_emptyintersection;
1017 break;
1018 default:
1019 break;
1020 }
1021 break;
1022 default:
1023 fm->flow = FrameError;
1024 fm->ErrNo = Proc_if_not_logical;
1025 break;
1026 }
1027 if (fm->flow == FrameError && iferr) {
1028 ProcWriteIfError(fm,"WHILE");
1029 }
1030 DestroyValue(&value);
1031 if (limit < 0) {
1032 stop = 1;
1033 fm->flow = FrameError;
1034 fm->ErrNo = Proc_infinite_loop;
1035 ProcWriteIfError(fm,"WHILE");
1036 }
1037 } /* endwhile */
1038 /* post loop processing */
1039 switch (fm->flow) {
1040 case FrameLoop:
1041 case FrameBreak:
1042 fm->flow = oldflow;
1043 break;
1044 default: /* let return, fallthru, out to next scope */
1045 break;
1046 }
1047 return;
1048 }
1049
1050
1051 /*
1052 * Compare current values of the switching variables with
1053 * the set of values in a CASE of a SWITCH statement, and try to find
1054 * is such values are the same.
1055 * If they are, the function will return Proc_case_matched,
1056 * else, it will return Proc_case_unmatched unless there is an error.
1057 * The possible error returns are legion, and this function
1058 * handles issuing error messages for them.
1059 *
1060 * If s given is NULL AND arm is -1, simply verifies that vlist elements
1061 * exist/are assigned. Normally this is only of use in checking
1062 * the OTHERWISE branch of the switch.
1063 * s must NOT be NULL unless arm is -1.
1064 */
1065 static
1066 void AnalyzeSwitchCase(struct procFrame *fm, struct VariableList *vlist,
1067 struct Set *s, int arm)
1068 {
1069 CONST struct Expr *expr;
1070 CONST struct Name *name;
1071 symchar *value;
1072 symchar *symvar;
1073 CONST struct VariableList *vl;
1074 CONST struct Set *values;
1075 int val;
1076 int pos;
1077 int valvar;
1078 struct gl_list_t *instances;
1079 struct Instance *inst;
1080 enum find_errors err;
1081 symchar *str;
1082 struct for_var_t *fvp;
1083
1084 assert(vlist != NULL);
1085 vl = vlist;
1086 fm->ErrNo = Proc_case_matched;
1087 pos = 0;
1088 if (s==NULL && arm == -1) {
1089 /* check vlist only */
1090 while (vl!=NULL) {
1091 pos++;
1092 name = NamePointer(vl);
1093 instances = FindInstances(fm->i,name,&err);
1094 if (instances == NULL){
1095 switch (err) {
1096 case unmade_instance:
1097 fm->ErrNo = Proc_instance_not_found;
1098 break;
1099 case undefined_instance:
1100 fm->ErrNo = Proc_name_not_found;
1101 break;
1102 case impossible_instance:
1103 fm->ErrNo = Proc_illegal_name_use;
1104 break;
1105 case correct_instance:
1106 fm->ErrNo = Proc_CallError;
1107 break;
1108 }
1109 }
1110 if (gl_length(instances)==1) {
1111 inst = (struct Instance *)gl_fetch(instances,1);
1112 gl_destroy(instances);
1113 if (!AtomAssigned(inst)) {
1114 fm->ErrNo = Proc_case_undefined_value;
1115 break; /* while */
1116 }
1117 } else {
1118 fm->ErrNo = Proc_case_extra_values;
1119 gl_destroy(instances);
1120 break; /* while */
1121 }
1122 vl = NextVariableNode(vl);
1123 }
1124 if (fm->ErrNo != Proc_case_matched) {
1125 ProcWriteCaseError(fm,arm,pos);
1126 }
1127 fm->flow = FrameError;
1128 return;
1129 }
1130
1131 assert(s!= NULL);
1132 values = s;
1133
1134 while (vl!=NULL) {
1135 pos++;
1136 name = NamePointer(vl);
1137 expr = GetSingleExpr(values);
1138 instances = FindInstances(fm->i,name,&err);
1139 if (instances == NULL){
1140 switch (err) {
1141 case unmade_instance:
1142 fm->ErrNo = Proc_instance_not_found;
1143 break;
1144 case undefined_instance:
1145 fm->ErrNo = Proc_name_not_found;
1146 break;
1147 case impossible_instance:
1148 fm->ErrNo = Proc_illegal_name_use;
1149 break;
1150 case correct_instance:
1151 fm->ErrNo = Proc_CallError; /* move write to procio */
1152 break;
1153 }
1154 } else {
1155 if (gl_length(instances)==1) {
1156 inst = (struct Instance *)gl_fetch(instances,1);
1157 gl_destroy(instances);
1158 if (!AtomAssigned(inst)) {
1159 fm->ErrNo = Proc_case_undefined_value;
1160 break;
1161 }
1162 switch(ExprType(expr)) {
1163 case e_boolean:
1164 if ((InstanceKind(inst) & IBOOL) == 0) {
1165 fm->ErrNo = Proc_case_boolean_mismatch;
1166 break;
1167 }
1168 val = ExprBValue(expr);
1169 if (val == 2) { /* ANY */
1170 break;
1171 }
1172 valvar = GetBooleanAtomValue(inst);
1173 if (val != valvar) {
1174 fm->ErrNo = Proc_case_unmatched;
1175 }
1176 break;
1177 case e_int:
1178 if ((InstanceKind(inst) & IINT) == 0) {
1179 fm->ErrNo = Proc_case_integer_mismatch;
1180 break;
1181 }
1182 val = ExprIValue(expr);
1183 valvar = GetIntegerAtomValue(inst);
1184 if (val != valvar) {
1185 fm->ErrNo = Proc_case_unmatched;
1186 }
1187 break;
1188 case e_symbol:
1189 if ((InstanceKind(inst) & ISYM) == 0) {
1190 fm->ErrNo = Proc_case_symbol_mismatch;
1191 break;
1192 }
1193 symvar = ExprSymValue(expr);
1194 value = GetSymbolAtomValue(inst);
1195 assert(AscFindSymbol(symvar)!=NULL);
1196 assert(AscFindSymbol(value)!=NULL);
1197 if (symvar != value) {
1198 fm->ErrNo = Proc_case_unmatched;
1199 }
1200 break;
1201 case e_var:
1202 /* evar ok only if a loop index? */
1203 if ((GetEvaluationForTable() != NULL) &&
1204 (NULL != (str = SimpleNameIdPtr(ExprName(expr)))) &&
1205 (NULL != (fvp=FindForVar(GetEvaluationForTable(),str)))) {
1206 switch (GetForKind(fvp)) {
1207 case f_integer:
1208 if ((InstanceKind(inst) & IINT) == 0) {
1209 fm->ErrNo = Proc_case_integer_mismatch;
1210 break;
1211 }
1212 val = GetForInteger(fvp);
1213 valvar = GetIntegerAtomValue(inst);
1214 if (val != valvar) {
1215 fm->ErrNo = Proc_case_unmatched;
1216 }
1217 break;
1218 case f_symbol:
1219 if ((InstanceKind(inst) & ISYM) == 0) {
1220 fm->ErrNo = Proc_case_symbol_mismatch;
1221 break;
1222 }
1223 symvar = GetForSymbol(fvp);
1224 value = GetSymbolAtomValue(inst);
1225 if (symvar != value) {
1226 fm->ErrNo = Proc_case_unmatched;
1227 }
1228 break;
1229 default:
1230 fm->ErrNo = Proc_case_wrong_index;
1231 break;
1232 }
1233 } else {
1234 fm->ErrNo = Proc_case_wrong_index;
1235 }
1236 break;
1237 default:
1238 fm->ErrNo = Proc_case_wrong_value;
1239 }
1240 } else {
1241 gl_destroy(instances);
1242 fm->ErrNo = Proc_case_extra_values;
1243 }
1244 }
1245 if (fm->ErrNo != Proc_case_matched) {
1246 break;
1247 }
1248 vl = NextVariableNode(vl);
1249 values = NextSet(values);
1250 }
1251 if (fm->ErrNo != Proc_case_matched && fm->ErrNo != Proc_case_unmatched) {
1252 ProcWriteCaseError(fm,arm,pos);
1253 fm->flow = FrameError;
1254 }
1255 return;
1256 }
1257
1258 /* This function will determine which case of a SWITCH statement
1259 * applies for the current values of the switching variables.
1260 * this function will call for the execution of the cases which
1261 * match. It handles OTHERWISE properly (case when set == NULL).
1262 */
1263
1264 static
1265 void ExecuteInitSwitch(struct procFrame *fm, struct Statement *stat)
1266 {
1267 struct VariableList *vlist;
1268 struct SwitchList *sw;
1269 struct Set *set;
1270 struct StatementList *sl;
1271 int arm;
1272 int case_match;
1273 int fallthru;
1274 enum FrameControl oldflow;
1275
1276 vlist = SwitchStatVL(stat);
1277 sw = SwitchStatCases(stat);
1278 case_match = 0;
1279
1280 arm = 0;
1281 oldflow = fm->flow;
1282 while (sw!=NULL) { /* && notbreak. fixme */
1283 arm++;
1284 set = SwitchSetList(sw);
1285 sl = SwitchStatementList(sw);
1286 if (set != NULL) {
1287 AnalyzeSwitchCase(fm,vlist,set,arm); /*add fallthru arg */
1288 switch (fm->ErrNo) {
1289 case Proc_case_matched:
1290 case_match++;
1291 /* could put fallthru handling here if in grammar */
1292 fm->ErrNo = Proc_all_ok;
1293 fm->flow = FrameLoop;
1294 ExecuteInitStatements(fm,sl);
1295 switch (fm->flow) {
1296 case FrameLoop:
1297 case FrameOK:
1298 fm->flow = oldflow;
1299 fallthru = 0;
1300 break;
1301 case FrameReturn:
1302 return;
1303 case FrameBreak: /* not properly implemented. fixme */
1304 fallthru = 0;
1305 break;
1306 case FrameContinue:
1307 if (oldflow == FrameLoop) {
1308 return;
1309 }
1310 break;
1311 case FrameFallthru: /* not implemented */
1312 fallthru = 1;
1313 case FrameError: /* EISS not supposed to return this */
1314 default:
1315 break;
1316 }
1317 break;
1318 case Proc_case_unmatched:
1319 break;
1320 default:
1321 /* fixme policy might suppress error return */
1322 fm->flow = FrameError;
1323 return;
1324 }
1325 } else {
1326 /* OTHERWISE arm, which we seem to be assuming comes last */
1327 if (!case_match) {
1328 AnalyzeSwitchCase(fm,vlist,NULL,-1);
1329 if (fm->ErrNo == Proc_case_matched) {
1330 fm->ErrNo = Proc_all_ok;
1331 ExecuteInitStatements(fm,sl);
1332 case_match = 1;
1333 if (fm->ErrNo != Proc_all_ok) {
1334 /* fixme logic */
1335 WriteInitErr(fm,"Error in execution of SWITCH statements\n");
1336 break;
1337 }
1338 }
1339 }
1340 }
1341 sw = NextSwitchCase(sw);
1342 }
1343 if (case_match == 0) {
1344 WriteInitWarn(fm,"No case matched in SWITCH statement\n");
1345 }
1346 return;
1347 }
1348
1349 /* i is generally NOT fm->i, but in the scope of fm->i */
1350 static
1351 void AssignInitValue(struct Instance *i, struct value_t v, struct procFrame *fm)
1352 {
1353 CONST dim_type *dim;
1354 int assignerr = 1; /* set 0 on success */
1355 switch(InstanceKind(i)) {
1356 case MODEL_INST:
1357 case ARRAY_INT_INST:
1358 case ARRAY_ENUM_INST:
1359 case REL_INST:
1360 fm->ErrNo = Proc_nonatom_assignment;
1361 fm->flow = FrameError;
1362 break;
1363 case DUMMY_INST:
1364 /* cpp string concatenation */
1365 assignerr = 0;
1366 WriteInitWarn(fm,"Assignment to an unSELECTed_part ignored."
1367 "SELECT should be shadowed by SWITCH in METHODS");
1368 break;
1369 case INTEGER_INST:
1370 case INTEGER_ATOM_INST:
1371 if (ValueKind(v)!=integer_value){
1372 fm->ErrNo = Proc_noninteger_assignment;
1373 fm->flow = FrameError;
1374 } else {
1375 assignerr = 0;
1376 SetIntegerAtomValue(i,IntegerValue(v),0);
1377 }
1378 break;
1379 case SET_INST:
1380 case SET_ATOM_INST:
1381 case REAL_CONSTANT_INST:
1382 case BOOLEAN_CONSTANT_INST:
1383 case INTEGER_CONSTANT_INST:
1384 case SYMBOL_CONSTANT_INST:
1385 fm->ErrNo = Proc_declarative_constant_assignment;
1386 fm->flow = FrameError;
1387 break;
1388 case REAL_INST:
1389 case REAL_ATOM_INST:
1390 switch(ValueKind(v)){
1391 case real_value:
1392 dim = CheckDimensionsMatch(RealValueDimensions(v),RealAtomDims(i));
1393 if (dim==NULL){
1394 PrintDimenMessage("Inconsistent units in assignment"
1395 ,"LHS",RealAtomDims(i)
1396 ,"RHS",RealValueDimensions(v)
1397 );
1398 fm->ErrNo = Proc_nonconsistent_assignment;
1399 fm->flow = FrameError;
1400 } else {
1401 assignerr = 0;
1402 if (dim!=RealAtomDims(i)) {
1403 SetRealAtomDims(i,dim);
1404 }
1405 SetRealAtomValue(i,RealValue(v),0);
1406 }
1407 break;
1408 case integer_value:
1409 dim = CheckDimensionsMatch(Dimensionless(),RealAtomDims(i));
1410 if (dim==NULL){
1411 PrintDimenMessage("Inconsistent units in assignment"
1412 ,"LHS",RealAtomDims(i)
1413 ,"RHS",RealValueDimensions(v)
1414 );
1415 fm->ErrNo = Proc_nonconsistent_assignment;
1416 fm->flow = FrameError;
1417 } else {
1418 assignerr = 0;
1419 if (dim != RealAtomDims(i)) {
1420 SetRealAtomDims(i,dim);
1421 }
1422 SetRealAtomValue(i,(double)IntegerValue(v),0);
1423 }
1424 break;
1425 default:
1426 fm->ErrNo = Proc_nonreal_assignment;
1427 fm->flow = FrameError;
1428 break;
1429 }
1430 break;
1431 case BOOLEAN_INST:
1432 case BOOLEAN_ATOM_INST:
1433 if (ValueKind(v)!=boolean_value){
1434 fm->ErrNo = Proc_nonboolean_assignment;
1435 fm->flow = FrameError;
1436 } else {
1437 assignerr = 0;
1438 SetBooleanAtomValue(i,BooleanValue(v),0);
1439 }
1440 break;
1441 case SYMBOL_INST:
1442 case SYMBOL_ATOM_INST:
1443 if (ValueKind(v)!=symbol_value){
1444 fm->ErrNo = Proc_nonsymbol_assignment;
1445 fm->flow = FrameError;
1446 } else {
1447 assignerr = 0;
1448 SetSymbolAtomValue(i,SymbolValue(v));
1449 }
1450 break;
1451 default:
1452 fm->ErrNo = Proc_nonsense_assignment;
1453 fm->flow = FrameError;
1454 break;
1455 }
1456 if (assignerr) {
1457 ProcWriteAssignmentError(fm);
1458 }
1459 }
1460
1461 /* this function always returns ok. 5/96 */
1462 static
1463 void ExecuteInitAsgn(struct procFrame *fm, struct Statement *stat)
1464 {
1465 struct gl_list_t *instances;
1466 struct Instance *inst;
1467 unsigned c,len;
1468 enum FrameControl oldflow;
1469 struct value_t value;
1470 enum find_errors err;
1471
1472 instances = FindInstances(fm->i,DefaultStatVar(stat),&err);
1473 if (instances != NULL){
1474 assert(GetEvaluationContext()==NULL);
1475 SetEvaluationContext(fm->i);
1476 value = EvaluateExpr(DefaultStatRHS(stat),NULL,InstanceEvaluateName);
1477 SetEvaluationContext(NULL);
1478 if (ValueKind(value)==error_value) {
1479 fm->ErrNo = Proc_rhs_error;
1480 fm->flow = FrameError;
1481 ProcWriteAssignmentError(fm);
1482 } else {
1483 len = gl_length(instances);
1484 oldflow = fm->flow;
1485 for(c=1;c<=len;c++){
1486 inst = (struct Instance *)gl_fetch(instances,c);
1487 AssignInitValue(inst,value,fm); /* does its own errors */
1488 if (fm->flow == FrameError) {
1489 if (/* fm->policy-check */0) {
1490 fm->flow = oldflow; /* suppress error flow */
1491 } else {
1492 break; /* skip rest of loop */
1493 }
1494 }
1495 }
1496 }
1497 DestroyValue(&value);
1498 gl_destroy(instances);
1499 } else {
1500 /* error finding left hand side */
1501 fm->ErrNo = Proc_lhs_error;
1502 fm->flow = FrameError;
1503 ProcWriteAssignmentError(fm);
1504 }
1505 return /* Proc_all_ok */;
1506 }
1507
1508 static
1509 void ExecuteInitStatement(struct procFrame *fm, struct Statement *stat)
1510 {
1511 #if IDB
1512 FPRINTF(fm->err,"\n");
1513 FPRINTF(fm->err,"EIS-IN: %s\n",FrameControlToString(fm->flow));
1514 FPRINTF(fm->err,"EIS: "); WriteStatement(fm->err,stat,2);
1515 #endif
1516 switch(StatementType(stat)){
1517 case FOR:
1518 ExecuteInitFor(fm,stat);
1519 break;
1520 case ASGN:
1521 ExecuteInitAsgn(fm,stat);
1522 break;
1523 case RUN:
1524 ExecuteInitRun(fm,stat);
1525 break;
1526 case FIX:
1527 ExecuteInitFix(fm,stat);
1528 break;
1529 case FREE:
1530 ExecuteInitFree(fm,stat);
1531 break;
1532 case FLOW:
1533 ExecuteInitFlow(fm);
1534 break;
1535 case EXT:
1536 /* CONSOLE_DEBUG("ABOUT TO ExecuteInitExt"); */
1537 ExecuteInitExt(fm,stat);
1538 break;
1539 case CALL:
1540 ExecuteInitCall(fm,stat);
1541 break;
1542 case WHILE:
1543 ExecuteInitWhile(fm,stat);
1544 break;
1545 case ASSERT:
1546 ExecuteInitAssert(fm,stat);
1547 break;
1548 case IF:
1549 ExecuteInitIf(fm,stat);
1550 break;
1551 case SWITCH:
1552 ExecuteInitSwitch(fm,stat);
1553 break;
1554 case CASGN:
1555 fm->flow = FrameError;
1556 fm->ErrNo = Proc_declarative_constant_assignment;
1557 WriteInitErr(fm,
1558 "Incorrect statement type (constant assigned)"
1559 " in initialization section");
1560 break;
1561 default:
1562 fm->flow = FrameError;
1563 fm->ErrNo = Proc_bad_statement;
1564 WriteInitErr(fm,"Unexpected statement type in initialization section");
1565 break;
1566 }
1567 #if IDB
1568 FPRINTF(fm->err,"EIS-OUT: %s\n\n",FrameControlToString(fm->flow));
1569 #endif
1570 return;
1571 }
1572
1573 /* This is our central error handling logic control point.
1574 * This function should not itself return fm->flow == FrameError.
1575 * To the maximum extent possible, do not process errors separately
1576 * elsewhere but defer them to here. That makes maintenance of code
1577 * which handles debugging output and execution logic much simpler.
1578 */
1579 static
1580 void ExecuteInitStatements(struct procFrame *fm, struct StatementList *sl)
1581 {
1582 unsigned c,length;
1583 struct gl_list_t *statements;
1584 struct Statement *stat;
1585 enum FrameControl oldflow;
1586 int stop;
1587
1588 statements = GetList(sl);
1589 length = gl_length(statements);
1590 stop = 0;
1591 oldflow = fm->flow;
1592 for (c = 1; c <= length && !stop; c++){
1593 stat = (struct Statement *)gl_fetch(statements,c);
1594 UpdateProcFrame(fm,stat,fm->i);
1595 /* statements should issue their own complaints */
1596 ExecuteInitStatement(fm,stat);
1597 switch (fm->flow) {
1598 case FrameLoop:
1599 case FrameOK:
1600 fm->flow = oldflow;
1601 break;
1602 case FrameError:
1603 #if IDB
1604 FPRINTF(fm->err,"ERR: "); WriteStatement(fm->err,fm->stat,0);
1605 FPRINTF(fm->err,"\n");
1606 #endif
1607 if ((fm->gen & WP_STOPONERR)!= 0) {
1608 fm->flow = FrameReturn;
1609 stop = 1;
1610 } else {
1611 fm->flow = oldflow;
1612 }
1613 break;
1614 case FrameFallthru: /* say what? */
1615 case FrameContinue:
1616 case FrameBreak:
1617 if (oldflow == FrameLoop) {
1618 stop = 1;
1619 } else {
1620 /* whine about missing loop/switch context.
1621 * should be parser enforced.
1622 */
1623 #if IDB
1624 FPRINTF(fm->err,"LOOP-ERR: "); WriteStatement(fm->err,fm->stat,0);
1625 FPRINTF(fm->err,"\n");
1626 #endif
1627 if ((fm->gen & WP_STOPONERR)!= 0) {
1628 fm->flow = FrameReturn;
1629 stop = 1;
1630 } else {
1631 fm->flow = oldflow;
1632 }
1633 }
1634 break;
1635 case FrameReturn:
1636 #if IDB
1637 FPRINTF(fm->err,"ERR-UNWIND: "); WriteStatement(fm->err,fm->stat,0);
1638 FPRINTF(fm->err,"\n");
1639 #endif
1640 if (/* i/o policy check */1) {
1641 /* whine backtrace*/
1642 }
1643 stop = 1;
1644 break;
1645 /* all cases must be handled here. */
1646 }
1647 if (g_procframe_stop) {
1648 g_procframe_stop = 0;
1649 fm->ErrNo = Proc_user_interrupt;
1650 WriteInitErr(fm,"USER interrupted METHOD execution");
1651 fm->flow = FrameReturn;
1652 stop = 1;
1653 }
1654 }
1655 /* UpdateProcFrame(fm,NULL, fm->i); */ /* leave a mess for messages */
1656 assert(fm->flow != FrameError);
1657 }
1658
1659 /*********************************************************************\
1660 * void ExecuteInitProcedure(i,proc)
1661 * struct Instance *i;
1662 * struct InitProcedure *proc;
1663 * This will execute proc on the instance i.
1664 \*********************************************************************/
1665 /*
1666 * Here's where we enforce stack limits (approximately).
1667 * Here's where we unwind the stack in the event of an
1668 * early return.
1669 */
1670 static
1671 void ExecuteInitProcedure(struct procFrame *fm, struct InitProcedure *proc)
1672 {
1673 struct for_table_t *OldForTable;
1674
1675 g_proc.depth++;
1676 assert(fm != NULL && fm->i != NULL && proc != NULL);
1677 if (g_proc.depth > g_proc.limit) {
1678 g_proc.depth--;
1679 fm->ErrNo = Proc_stack_exceeded_this_frame;
1680 fm->flow = FrameError;
1681 return;
1682 }
1683
1684 OldForTable = GetEvaluationForTable();
1685 SetEvaluationForTable(CreateForTable());
1686 ExecuteInitStatements(fm,ProcStatementList(proc));
1687 DestroyForTable(GetEvaluationForTable());
1688 SetEvaluationForTable(OldForTable);
1689 g_proc.depth--;
1690 }
1691
1692 /* returns overflow or ok. possibly either form of overflow. */
1693 static
1694 void RealInitialize(struct procFrame *fm, struct Name *name)
1695 {
1696 struct Name *instname = NULL;
1697 struct Instance *ptr;
1698 enum find_errors err;
1699 struct InitProcedure *proc;
1700 struct gl_list_t *instances;
1701 unsigned long c,length;
1702 char *morename;
1703 struct procFrame *newfm;
1704 symchar *procname=NULL;
1705 int stop;
1706 int previous_context = GetDeclarativeContext();
1707
1708 SetDeclarativeContext(1); /* set up for procedural processing */
1709 InstanceNamePart(name,&instname,&procname);
1710
1711 if (procname != NULL) {
1712 instances = FindInstances(fm->i, instname, &err);
1713 if (instances != NULL) {
1714 length = gl_length(instances);
1715 stop = 0;
1716 for(c=1; c<=length && !stop; c++){
1717 ptr = (struct Instance *)gl_fetch(instances,c);
1718 proc = FindProcedure(ptr,procname);
1719 if (proc != NULL) {
1720 morename = WriteInstanceNameString(ptr,fm->i);
1721 newfm = AddProcFrame(fm,ptr,
1722 (morename!=NULL)?morename:"",
1723 proc,FrameInherit);
1724 /* this usage probably force memory recycle in proctype.c */
1725 if (morename != NULL) {
1726 ascfree(morename);
1727 }
1728 ExecuteInitProcedure(newfm,proc);
1729 switch (newfm->flow) {
1730 case FrameOK:
1731 case FrameLoop:
1732 /* do nothing */
1733 break;
1734 case FrameBreak:
1735 case FrameContinue:
1736 case FrameFallthru:
1737 /* aren't supposed to work across frames, or are they? */
1738 /* do nothing */
1739 break;
1740 case FrameError:
1741 /* having to check this here sucks, but the stack
1742 * limit is not optional.
1743 */
1744 if ((fm->gen & WP_STOPONERR) != 0 || /* ||, not && */
1745 newfm->ErrNo == Proc_stack_exceeded_this_frame) {
1746 fm->flow = newfm->flow;
1747 fm->ErrNo = newfm->ErrNo;
1748 if (fm->ErrNo == Proc_stack_exceeded_this_frame) {
1749 fm->ErrNo = Proc_stack_exceeded;
1750 }
1751 stop = 1;
1752 }
1753 ProcWriteStackCheck(newfm,NULL,name);
1754 break;
1755 case FrameReturn:
1756 if (newfm->ErrNo != Proc_return) {
1757 fm->flow = newfm->flow;
1758 fm->ErrNo = newfm->ErrNo;
1759 ProcWriteStackCheck(newfm,NULL,name);
1760 } /* else was a c-like RETURN;. don't pass upward */
1761 break;
1762 }
1763 DestroyProcFrame(newfm);
1764 } else {
1765 fm->flow = FrameError;
1766 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindProcedure failed).");
1767 fm->ErrNo = Proc_proc_not_found;
1768 }
1769 }
1770 gl_destroy(instances);
1771 } else { /* unable to find instances */
1772 fm->flow = FrameError;
1773 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindInstances failed).");
1774 fm->ErrNo = Proc_instance_not_found;
1775 }
1776 } else {
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 InitDebugTopProcFrame(fm,context,cname,err,options,&dbi,watchpoints,log);
1823 RealInitialize(fm,name);
1824 return InitCalcReturn(fm);
1825 }
1826
1827 /* internal normal head */
1828 static
1829 enum Proc_enum NormalInitialize(struct procFrame *fm, struct Name *name)
1830 {
1831 RealInitialize(fm,name);
1832 return InitCalcReturn(fm);
1833 }
1834
1835 enum Proc_enum Initialize(struct Instance *context,
1836 struct Name *name,
1837 char *cname,
1838 FILE *err,
1839 wpflags options,
1840 struct gl_list_t *watchpoints,
1841 FILE *log)
1842 {
1843 enum Proc_enum rval;
1844 struct procFrame fm;
1845
1846 assert(err != NULL);
1847 g_proc.depth = 0;
1848 Asc_SetMethodUserInterrupt(0);
1849 if (watchpoints == NULL) {
1850 InitNormalTopProcFrame(&fm,context,cname,err,options);
1851 rval = NormalInitialize(&fm,name);
1852 } else {
1853 rval = DebugInitialize(context,name,cname,err,options,watchpoints,log,&fm);
1854 }
1855 return rval;
1856 }
1857
1858 /*
1859 * This deals with initializations of the form:
1860 * RUN Type::procname; where Type is model or atom type,
1861 * and procname is a procedure defined within that type.
1862 * If the Type happened to have redefined a procedure from its
1863 * parent class, that procedure would be the one on its
1864 * procedure list and hence the one that would be invoked.
1865 *
1866 */
1867 static
1868 void ClassAccessRealInitialize(struct procFrame *fm,
1869 struct Name *class,
1870 struct Name *name)
1871 {
1872 struct InitProcedure *proc;
1873 struct procFrame *newfm;
1874 struct gl_list_t *plist;
1875 symchar *procname;
1876 symchar *typename;
1877 struct TypeDescription *desc,*conformable;
1878 int previous_context = GetDeclarativeContext();
1879
1880 SetDeclarativeContext(1); /* set up for procedural processing */
1881
1882 typename = SimpleNameIdPtr(class);
1883 if (typename != NULL) {
1884 desc = FindType(typename);
1885 if (desc != NULL) {
1886 conformable = InstanceTypeDesc(fm->i);
1887 if (MoreRefined(conformable,desc)) {
1888 plist = GetInitializationList(desc);
1889 if (plist != NULL) {
1890 procname = SimpleNameIdPtr(name);
1891 if (procname != NULL) {
1892 proc = SearchProcList(plist,procname);
1893 if (proc == NULL) {
1894 proc = SearchProcList(GetUniversalProcedureList(),procname);
1895 }
1896 if (proc != NULL) {
1897 newfm = AddProcFrame(fm,fm->i,"",proc,FrameInherit);
1898 /* apf starts newfm with frameok */
1899 ExecuteInitProcedure(newfm,proc);
1900 switch (newfm->flow) {
1901 case FrameOK:
1902 case FrameLoop:
1903 /* do nothing */
1904 break;
1905 case FrameBreak:
1906 case FrameContinue:
1907 case FrameFallthru:
1908 /* aren't supposed to work across frames are they? */
1909 /* do nothing */
1910 break;
1911 case FrameError:
1912 fm->flow = newfm->flow;
1913 fm->ErrNo = newfm->ErrNo;
1914 ProcWriteStackCheck(newfm,class,name);
1915 /* having to check this here sucks, but the stack
1916 * limit is not optional.
1917 */
1918 if (fm->ErrNo == Proc_stack_exceeded_this_frame) {
1919 fm->ErrNo = Proc_stack_exceeded;
1920 }
1921 break;
1922 case FrameReturn:
1923 if (newfm->ErrNo != Proc_return) {
1924 fm->flow = newfm->flow;
1925 fm->ErrNo = newfm->ErrNo;
1926 ProcWriteStackCheck(newfm,class,name); /* fixme?*/
1927 } /* else was a c-like RETURN;. don't pass upward */
1928 break;
1929 }
1930 DestroyProcFrame(newfm);
1931 } else {
1932 fm->flow = FrameError;
1933 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (SearchProcList).");
1934 fm->ErrNo = Proc_proc_not_found;
1935 }
1936 } else {
1937 fm->flow = FrameError;
1938 fm->ErrNo = Proc_illegal_name_use;
1939 }
1940 } else {
1941 fm->flow = FrameError;
1942 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (GetInitializationList is null).");
1943 fm->ErrNo = Proc_proc_not_found;
1944 }
1945 } else {
1946 fm->flow = FrameError;
1947 fm->ErrNo = Proc_illegal_type_use;
1948 }
1949 } else {
1950 fm->flow = FrameError;
1951 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindType failed)\n");
1952 fm->ErrNo = Proc_type_not_found;
1953 }
1954 } else {
1955 fm->flow = FrameError;
1956 fm->ErrNo = Proc_illegal_name_use;
1957 }
1958
1959 SetDeclarativeContext(previous_context);
1960 return;
1961 }
1962
1963 /* internal debug head */
1964 static
1965 enum Proc_enum DebugClassAccessInitialize(struct Instance *context,
1966 struct Name *class,
1967 struct Name *name,
1968 char *cname,
1969 FILE *err,
1970 wpflags options,
1971 struct gl_list_t *watchpoints,
1972 FILE *log,
1973 struct procFrame *fm)
1974 {
1975 struct procDebug dbi; /* this struct is huge */
1976
1977 InitDebugTopProcFrame(fm,context,cname,err,options,&dbi,watchpoints,log);
1978 ClassAccessRealInitialize(fm,class,name);
1979 return InitCalcReturn(fm);
1980 }
1981
1982 /* internal normal head */
1983 static
1984 enum Proc_enum NormalClassAccessInitialize(struct procFrame *fm,
1985 struct Name *class,
1986 struct Name *name)
1987 {
1988 ClassAccessRealInitialize(fm,class,name);
1989 return InitCalcReturn(fm);
1990 }
1991
1992 enum Proc_enum ClassAccessInitialize(struct Instance *context,
1993 struct Name *class,
1994 struct Name *name,
1995 char *cname,
1996 FILE *err,
1997 wpflags options,
1998 struct gl_list_t *watchpoints,
1999 FILE *log)
2000 {
2001 struct procFrame fm;
2002
2003 assert(err != NULL);
2004 g_proc.depth = 0;
2005 Asc_SetMethodUserInterrupt(0);
2006 if (watchpoints == NULL) {
2007 InitNormalTopProcFrame(&fm,context,cname,err,options);
2008 return NormalClassAccessInitialize(&fm,class,name);
2009 } else {
2010 return DebugClassAccessInitialize(context,class,name,cname,
2011 err,options,watchpoints,log,&fm);
2012 }
2013 }

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