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

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