/[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 1290 - (show annotations) (download) (as text)
Mon Feb 26 04:54:45 2007 UTC (17 years, 5 months ago) by johnpye
File MIME type: text/x-csrc
File size: 56312 byte(s)
Added new 'default' functionality plus test case
1 /* ex:set ts=4: */
2 /*
3 * Initialization Routines
4 * by Tom Epperly
5 * Created: 3/24/1990
6 * Version: $Revision: 1.36 $
7 * Version control file: $RCSfile: initialize.c,v $
8 * Date last modified: $Date: 1998/06/11 15:28:30 $
9 * Last modified by: $Author: ballan $
10 *
11 * This file is part of the Ascend Language Interpreter.
12 *
13 * Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
14 *
15 * The Ascend Language Interpreter is free software; you can redistribute
16 * it and/or modify it under the terms of the GNU General Public License as
17 * published by the Free Software Foundation; either version 2 of the
18 * License, or (at your option) any later version.
19 *
20 * The Ascend Language Interpreter is distributed in hope that it will be
21 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
23 * General Public License for more details.
24 *
25 * You should have received a copy of the GNU General Public License
26 * along with the program; if not, write to the Free Software Foundation,
27 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
28 * COPYING.
29 *
30 */
31
32 #include <utilities/ascConfig.h>
33 #include <utilities/ascMalloc.h>
34 #include <general/list.h>
35 #include <general/dstring.h>
36
37 #include "symtab.h"
38 #include "functype.h"
39 #include "expr_types.h"
40 #include "forvars.h"
41 #include "name.h"
42 #include "find.h"
43 #include "vlist.h"
44 #include "instance_enum.h"
45 #include "cmpfunc.h"
46 #include "stattypes.h"
47 #include "statement.h"
48 #include "statio.h"
49 #include "switch.h"
50 #include "evaluate.h"
51 #include "value_type.h"
52 #include "setinstval.h"
53 #include "extfunc.h"
54 #include "packages.h"
55 #include "instance_io.h"
56 #include "nameio.h"
57 #include "atomvalue.h"
58 #include "instquery.h"
59 #include "type_desc.h"
60 #include "library.h"
61 #include "extcall.h"
62 #include "proc.h"
63 #include "watchpt.h"
64 #include "procframe.h"
65 #include "procio.h"
66 #include "initialize.h"
67 #include "switch.h"
68 #include "exprs.h"
69 #include "sets.h"
70 #include "parentchild.h"
71
72 /* set to 1 for tracing execution the hard way. */
73 #define IDB 0
74
75 /*********************************************************************\
76 There is a stack of procedure calls kept for tracing and breaking
77 recursion errors.
78 INITSTACKLIMIT is the minimum we will allow internally.
79 This is independent of the procframes until we get those
80 solidly cleaned up.
81 \*********************************************************************/
82
83 static
84 struct {
85 unsigned long limit;
86 unsigned long depth;
87 } g_proc = {INITSTACKLIMIT,0L};
88
89 unsigned long GetProcStackLimit(void)
90 {
91 return g_proc.limit;
92 }
93
94 void SetProcStackLimit(unsigned long lim)
95 {
96 if (lim < 3) {
97 FPRINTF(ASCERR,
98 "SetProcStackLimit called with limit too small (%lu). Ignored.\n",lim);
99 return;
100 }
101 if (g_proc.depth) {
102 FPRINTF(ASCERR, "SetProcStackLimit called during evaluation. Ignored.\n");
103 return;
104 }
105 g_proc.limit = lim;
106 return;
107 }
108
109 /* The following 2 forward declarations have been moved out of the
110 * header, where they had no business being, so we can adequately
111 * guard against recursive functions.
112 * static void ExecuteInitRun(struct procFrame *, struct Statement *);
113 * static void ExecuteInitProcedure(struct procFrame *,
114 * struct InitProcedure *);
115 */
116
117
118 static void ExecuteInitStatements(struct procFrame *,struct StatementList *);
119 static void RealInitialize(struct procFrame *, struct Name *);
120 static void ClassAccessRealInitialize(struct procFrame *, struct Name *, struct Name *);
121
122 /* just forward declarations cause we need it */
123
124 /*
125 * modifies the name given to it, if needed shortening it.
126 * If shortening, destroys the cut off part.
127 */
128 static
129 void InstanceNamePart(struct Name *n, struct Name **copy,
130 symchar **procname)
131 {
132 register struct Name *ptr,*tmp;
133
134 /*FPRINTF(ASCERR,"INSTANCE NAME PART, input is n=");
135 WriteName(ASCERR,n);
136 FPRINTF(ASCERR,"\n");
137 */
138
139 if (n==NULL){
140 FPRINTF(ASCERR,"n IS NULL");
141 *copy = NULL;
142 *procname = NULL;
143 return;
144 }
145 if (NextName(n)==NULL) { /* RUN a; a is the procname */
146 *copy = NULL;
147 if (NameId(n) != 0) {
148 *procname = NameIdPtr(n);
149 } else {
150 *procname = NULL;
151 }
152 } else {
153 /* RUN a.b.c.clear; clear is the procname */
154 ptr = *copy = CopyName(n);
155 while (NextName(NextName(ptr))!=NULL) {
156 ptr = NextName(ptr);
157 }
158 tmp = NextName(ptr);
159 LinkNames(ptr,NULL); /* disconnect last part of name */
160 if (NameId(tmp) != 0) {
161 *procname = NameIdPtr(tmp);
162 } else {
163 *procname = NULL;
164 }
165 DestroyName(tmp);
166 }
167 }
168
169 struct InitProcedure *SearchProcList(CONST struct gl_list_t *l,
170 symchar *name)
171 {
172 register unsigned up,c,low;
173 register struct InitProcedure *ptr;
174 register int cmp;
175 assert(AscFindSymbol(name)!=NULL);
176 if (l == NULL) {
177 return NULL;
178 }
179 up = gl_length(l);
180 low = 1;
181 while(low<=up){
182 c = (low+up)/2;
183 ptr = (struct InitProcedure *)gl_fetch(l,c);
184 cmp = CmpSymchar(ProcName(ptr),name);
185 if (cmp == 0) {
186 return ptr;
187 }
188 if (cmp<0) {
189 low = c+1;
190 } else {
191 up = c-1;
192 }
193 }
194 return NULL;
195 }
196
197 struct InitProcedure *FindProcedure(CONST struct Instance *i,
198 symchar *procname
199 ){
200 struct TypeDescription *desc;
201 desc = InstanceTypeDesc(i);
202 return FindMethod(desc, procname); /* this code in type_desc.c now -- JP */
203 }
204
205
206 /*********************************************************************\
207 * void ExecuteInitRun(fm,stat);
208 * struct procFrame *fm;
209 * struct InitProcedure *proc;
210 * This will execute a run statement, using the given instance as the
211 * context. stat must be a RUN statement. In the event of error will
212 * print appropriate messages to stderr.
213 \*********************************************************************/
214 /*
215 * This returns proc_all_ok in all circumstances except stack overflow.
216 * If within it any other error occurs, it prints the message and
217 * then pretends everything is ok.
218 * This behavior should perhaps be better.
219 */
220 static
221 void ExecuteInitRun(struct procFrame *fm, struct Statement *stat)
222 {
223 struct Name *typename;
224
225 typename = RunStatAccess(stat);
226 if (typename != NULL) {
227 ClassAccessRealInitialize(fm,typename,RunStatName(stat));
228 } else {
229 RealInitialize(fm,RunStatName(stat));
230 }
231 /* an error was encountered */
232 if (fm->flow == FrameError) {
233 ProcWriteRunError(fm);
234 }
235 }
236
237 /**
238 Shared function for FIX and FREE execution
239 @param val is TRUE for 'FIX', or FALSE for 'FREE'.
240 */
241 static void
242 execute_init_fix_or_free(int val, struct procFrame *fm, struct Statement *stat){
243 CONST struct VariableList *vars;
244 enum find_errors e;
245 struct gl_list_t *temp;
246 unsigned i, len;
247 struct Instance *i1, *i2;
248 char *instname;
249 struct TypeDescription *t, *st;
250 CONST struct Name *name;
251 symchar *fixed;
252 /* setup */
253 fixed = AddSymbol("fixed");
254 st = FindType(AddSymbol("solver_var"));
255 if(st==NULL){
256 ERROR_REPORTER_HERE(ASC_PROG_ERR,"'solver_var' type is not yet in library");
257 fm->ErrNo = Proc_type_not_found;
258 return;
259 }
260
261 /* iterate through the variable list */
262 /*CONSOLE_DEBUG("STARTING 'FIX'/'FREE' STATEMENT EXECUTION");*/
263 vars = stat->v.fx.vars;
264 while(vars!=NULL){
265 name = NamePointer(vars);
266 temp = FindInstances(fm->i, name, &e);
267 if(temp==NULL){
268 fm->ErrNo = Proc_bad_name;
269 return;
270 }
271 len = gl_length(temp);
272 for(i=1; i<=len; i++){
273 i1 = (struct Instance *)gl_fetch(temp,i);
274 instname = WriteInstanceNameString(i1,NULL);
275 /*if(val){
276 CONSOLE_DEBUG("ABOUT TO FIX %s",instname);
277 }else{
278 CONSOLE_DEBUG("ABOUT TO FREE %s",instname);
279 }*/
280 ascfree(instname);
281 if(InstanceKind(i1)!=REAL_ATOM_INST){
282 fm->ErrNo = Proc_illegal_type_use;
283 ProcWriteFixError(fm,name);
284 return;
285 }
286 t = InstanceTypeDesc(i1);
287 if(!MoreRefined(t,st)){
288 CONSOLE_DEBUG("Attempted to FIX or FREE variable that is not a refined solver_var.");
289 fm->ErrNo = Proc_illegal_type_use;
290 ProcWriteFixError(fm,name);
291 return;
292 }
293 i2 = ChildByChar(i1,fixed);
294 if(i2==NULL){
295 CONSOLE_DEBUG("Attempted to FIX or FREE a solver_var that doesn't have a 'fixed' child!");
296 fm->ErrNo = Proc_illegal_type_use;
297 ProcWriteFixError(fm,name);
298 return;
299 }
300 if(InstanceKind(i2)!=BOOLEAN_INST){
301 CONSOLE_DEBUG("Attempted to FIX or FREE a solver_var whose 'fixed' child is not boolean!");
302 fm->ErrNo = Proc_illegal_type_use;
303 ProcWriteFixError(fm,name);
304 return;
305 }
306 SetBooleanAtomValue(i2,val,0);
307 }
308 vars = NextVariableNode(vars);
309 }
310 /* CONSOLE_DEBUG("DONE WITH VARLIST"); */
311
312 /* return 'ok' */
313 fm->ErrNo = Proc_all_ok;
314 }
315
316 static void
317 ExecuteInitFix(struct procFrame *fm, struct Statement *stat){
318 execute_init_fix_or_free(TRUE,fm,stat);
319 }
320
321 static void
322 ExecuteInitFree(struct procFrame *fm, struct Statement *stat){
323 execute_init_fix_or_free(FALSE,fm,stat);
324 }
325
326
327 static
328 void ExecuteInitFlow(struct procFrame *fm)
329 {
330 assert(fm!=NULL);
331 assert(fm->stat!=NULL);
332 assert(StatementType(fm->stat)==FLOW);
333 switch (FlowStatControl(fm->stat)) {
334 case fc_break:
335 fm->ErrNo = Proc_break;
336 fm->flow = FrameBreak;
337 break;
338 case fc_continue:
339 fm->ErrNo = Proc_continue;
340 fm->flow = FrameContinue;
341 break;
342 case fc_fallthru:
343 fm->ErrNo = Proc_fallthru;
344 fm->flow = FrameFallthru;
345 break;
346 case fc_return:
347 fm->ErrNo = Proc_return;
348 fm->flow = FrameReturn; /* needs to be caught automagically to frameok
349 * if errno is proc_return.
350 */
351 break;
352 case fc_stop:
353 fm->ErrNo = Proc_stop;
354 fm->flow = FrameError;
355 ProcWriteIfError(fm,"STOP");
356 break;
357 default:
358 break;
359 }
360 }
361
362 /**
363 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.
364 */
365 #define SELF_NAME "SELF"
366
367 static
368 int SpecialSelfName(CONST struct Name *n)
369 {
370 symchar *id;
371 if (n == NULL) {
372 return 0;
373 }
374 id = SimpleNameIdPtr(n);
375 if (id == NULL) {
376 return 0;
377 }
378 if (strcmp(SCP(id),SELF_NAME)==0) {
379 return 1;
380 } else {
381 return 0;
382 }
383 }
384
385 /**
386 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).
387 */
388 static
389 struct gl_list_t *ProcessExtMethodArgs(struct Instance *inst,
390 CONST struct VariableList *vl,
391 struct gl_list_t *errlist)
392 {
393 struct gl_list_t *arglist;
394 struct gl_list_t *branch;
395 CONST struct Name *n;
396 enum find_errors ferr;
397 unsigned long pos;
398
399 ListMode=1;
400 arglist = gl_create(10L);
401 pos = 1;
402 while(vl!=NULL){
403 n = NamePointer(vl);
404 ferr = correct_instance;
405 branch = FindInstances(inst,n,&ferr);
406 if (branch == NULL || ferr != correct_instance) {
407 /* check for SELF only if find fails, so SELF IS_A foo
408 * overrides the normal self.
409 */
410 if (SpecialSelfName(n)) {
411 if (branch == NULL) {
412 branch = gl_create(1L);
413 } else {
414 gl_reset(branch);
415 }
416 /* Self referential instance */
417 gl_append_ptr(branch,(VOIDPTR)inst);
418 } else {
419 gl_append_ptr(errlist,(VOIDPTR)pos); /* error position */
420 gl_append_ptr(errlist,(VOIDPTR)ferr); /* error code */
421 if (branch == NULL) {
422 branch = gl_create(1L); /* create empty branch */
423 }
424 }
425 }
426 assert(branch != NULL);
427 gl_append_ptr(arglist,(VOIDPTR)branch);
428 vl = NextVariableNode(vl);
429 pos++;
430 }
431 ListMode=0;
432 return arglist;
433 }
434
435 static
436 struct gl_list_t *InitCheckExtCallArgs(struct Instance *inst,
437 struct Statement *stat,
438 struct gl_list_t *errs)
439 {
440 CONST struct VariableList *vl;
441 struct gl_list_t *result;
442
443 vl = ExternalStatVlistMethod(stat);
444 result = ProcessExtMethodArgs(inst,vl,errs);
445 return result;
446 }
447
448 static
449 void ExecuteInitCall(struct procFrame *fm, struct Statement *stat)
450 {
451 (void)fm; /* stop gcc whine about unused parameter */
452 (void)stat; /* stop gcc whine about unused parameter */
453 #if 0 /* guts of CALL statement execution need coding. */
454 /* something like ExecuteInitExt only string driven gllist argument
455 * translation +/- varargs BS, etc, etc
456 */
457 #endif
458 }
459
460 /*
461 * This always returns ok. at least as of 5/96.
462 */
463 static
464 void ExecuteInitExt(struct procFrame *fm, struct Statement *stat)
465 {
466 struct ExternalFunc *efunc;
467 CONST char *funcname;
468 struct gl_list_t *arglist=NULL, *errlist;
469 enum find_errors ferr;
470 unsigned long c,len,pos;
471
472 ExtMethodRun *eval_func;
473 void *user_data;
474 int nok;
475
476 funcname = ExternalStatFuncName(stat);
477 efunc = LookupExtFunc(funcname);
478
479 /*CONSOLE_DEBUG("EXECUTEINITEXT func name:'%s'",funcname);*/
480
481 if (efunc == NULL) {
482 CONSOLE_DEBUG("Failed to look up external function");
483 fm->ErrNo = Proc_CallError;
484 fm->flow = FrameError;
485 ProcWriteExtError(fm,funcname,PE_unloaded,0);
486 return;
487 }
488
489 /* CONSOLE_DEBUG("%s: in:%ld, out:%ld", efunc->name, efunc->n_inputs, efunc->n_outputs); */
490
491 eval_func = GetExtMethodRun(efunc);
492 user_data = GetExtMethodUserData(efunc);
493 if (eval_func == NULL) {
494 CONSOLE_DEBUG("GetValueFunc(efunc) returned NULL");
495 fm->ErrNo = Proc_CallError;
496 fm->flow = FrameError;
497 ProcWriteExtError(fm,funcname,PE_nulleval,0);
498 return;
499 }
500
501 errlist = gl_create(1);
502 arglist = InitCheckExtCallArgs(fm->i,stat,errlist);
503 len = gl_length(errlist);
504 if (len != 0) {
505 CONSOLE_DEBUG("InitCheckExtCallArgs returned items in errlist...");
506 fm->flow = FrameError;
507 ProcWriteExtError(fm,funcname,PE_argswrong,0);
508 c = 1;
509 assert((len & 0x1) == 0); /* must be even */
510 while (c < len) {
511 /* works because error position/code pairs */
512 pos = (unsigned long)gl_fetch(errlist,c);
513 c++; /* Wait, who let that dirty word in here!? */
514 ferr = (enum find_errors)gl_fetch(errlist,c);
515 c++;
516 switch (ferr) {
517 case unmade_instance:
518 fm->ErrNo = Proc_instance_not_found;
519 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
520 break;
521 case undefined_instance:
522 fm->ErrNo = Proc_name_not_found;
523 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
524 break;
525 case impossible_instance:
526 fm->ErrNo = Proc_illegal_name_use;
527 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
528 break; /* move write to procio */
529 case correct_instance:
530 fm->ErrNo = Proc_CallError;
531 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
532 break;
533 default:
534 fm->ErrNo = Proc_bad_name;
535 ProcWriteExtError(fm,funcname,PE_badarg,(int)pos);
536 break;
537 }
538 }
539 fm->ErrNo = Proc_CallError;
540 if (arglist != NULL) {
541 DestroySpecialList(arglist);
542 }
543 if (errlist != NULL) {
544 gl_destroy(errlist);
545 }
546 return;
547 }
548
549 /* CONSOLE_DEBUG("CHECKED EXTERNAL ARGS, OK"); */
550
551 nok = (*eval_func)(fm->i,arglist,user_data);
552
553 /* CONSOLE_DEBUG("BACK FROM RUNING FUNC AT %p",eval_func); */
554
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 CONSOLE_DEBUG("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 WriteStatementError(ASC_USER_SUCCESS,stat,0,"Assertion OK");
760 }else{
761 WriteStatementError(ASC_USER_ERROR,stat,1,"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 PrintDimenMessage("Inconsistent units in assignment"
1373 ,"LHS",RealAtomDims(i)
1374 ,"RHS",RealValueDimensions(v)
1375 );
1376 fm->ErrNo = Proc_nonconsistent_assignment;
1377 fm->flow = FrameError;
1378 } else {
1379 assignerr = 0;
1380 if (dim!=RealAtomDims(i)) {
1381 SetRealAtomDims(i,dim);
1382 }
1383 SetRealAtomValue(i,RealValue(v),0);
1384 }
1385 break;
1386 case integer_value:
1387 dim = CheckDimensionsMatch(Dimensionless(),RealAtomDims(i));
1388 if (dim==NULL){
1389 PrintDimenMessage("Inconsistent units in assignment"
1390 ,"LHS",RealAtomDims(i)
1391 ,"RHS",RealValueDimensions(v)
1392 );
1393 fm->ErrNo = Proc_nonconsistent_assignment;
1394 fm->flow = FrameError;
1395 } else {
1396 assignerr = 0;
1397 if (dim != RealAtomDims(i)) {
1398 SetRealAtomDims(i,dim);
1399 }
1400 SetRealAtomValue(i,(double)IntegerValue(v),0);
1401 }
1402 break;
1403 default:
1404 fm->ErrNo = Proc_nonreal_assignment;
1405 fm->flow = FrameError;
1406 break;
1407 }
1408 break;
1409 case BOOLEAN_INST:
1410 case BOOLEAN_ATOM_INST:
1411 if (ValueKind(v)!=boolean_value){
1412 fm->ErrNo = Proc_nonboolean_assignment;
1413 fm->flow = FrameError;
1414 } else {
1415 assignerr = 0;
1416 SetBooleanAtomValue(i,BooleanValue(v),0);
1417 }
1418 break;
1419 case SYMBOL_INST:
1420 case SYMBOL_ATOM_INST:
1421 if (ValueKind(v)!=symbol_value){
1422 fm->ErrNo = Proc_nonsymbol_assignment;
1423 fm->flow = FrameError;
1424 } else {
1425 assignerr = 0;
1426 SetSymbolAtomValue(i,SymbolValue(v));
1427 }
1428 break;
1429 default:
1430 fm->ErrNo = Proc_nonsense_assignment;
1431 fm->flow = FrameError;
1432 break;
1433 }
1434 if (assignerr) {
1435 ProcWriteAssignmentError(fm);
1436 }
1437 }
1438
1439 /* this function always returns ok. 5/96 */
1440 static
1441 void ExecuteInitAsgn(struct procFrame *fm, struct Statement *stat)
1442 {
1443 struct gl_list_t *instances;
1444 struct Instance *inst;
1445 unsigned c,len;
1446 enum FrameControl oldflow;
1447 struct value_t value;
1448 enum find_errors err;
1449
1450 instances = FindInstances(fm->i,DefaultStatVar(stat),&err);
1451 if (instances != NULL){
1452 assert(GetEvaluationContext()==NULL);
1453 SetEvaluationContext(fm->i);
1454 value = EvaluateExpr(DefaultStatRHS(stat),NULL,InstanceEvaluateName);
1455 SetEvaluationContext(NULL);
1456 if (ValueKind(value)==error_value) {
1457 fm->ErrNo = Proc_rhs_error;
1458 fm->flow = FrameError;
1459 ProcWriteAssignmentError(fm);
1460 } else {
1461 len = gl_length(instances);
1462 oldflow = fm->flow;
1463 for(c=1;c<=len;c++){
1464 inst = (struct Instance *)gl_fetch(instances,c);
1465 AssignInitValue(inst,value,fm); /* does its own errors */
1466 if (fm->flow == FrameError) {
1467 if (/* fm->policy-check */0) {
1468 fm->flow = oldflow; /* suppress error flow */
1469 } else {
1470 break; /* skip rest of loop */
1471 }
1472 }
1473 }
1474 }
1475 DestroyValue(&value);
1476 gl_destroy(instances);
1477 } else {
1478 /* error finding left hand side */
1479 fm->ErrNo = Proc_lhs_error;
1480 fm->flow = FrameError;
1481 ProcWriteAssignmentError(fm);
1482 }
1483 return /* Proc_all_ok */;
1484 }
1485
1486 static
1487 void ExecuteInitStatement(struct procFrame *fm, struct Statement *stat)
1488 {
1489 #if IDB
1490 FPRINTF(fm->err,"\n");
1491 FPRINTF(fm->err,"EIS-IN: %s\n",FrameControlToString(fm->flow));
1492 FPRINTF(fm->err,"EIS: "); WriteStatement(fm->err,stat,2);
1493 #endif
1494 switch(StatementType(stat)){
1495 case FOR:
1496 ExecuteInitFor(fm,stat);
1497 break;
1498 case ASGN:
1499 ExecuteInitAsgn(fm,stat);
1500 break;
1501 case RUN:
1502 ExecuteInitRun(fm,stat);
1503 break;
1504 case FIX:
1505 ExecuteInitFix(fm,stat);
1506 break;
1507 case FREE:
1508 ExecuteInitFree(fm,stat);
1509 break;
1510 case FLOW:
1511 ExecuteInitFlow(fm);
1512 break;
1513 case EXT:
1514 /* CONSOLE_DEBUG("ABOUT TO ExecuteInitExt"); */
1515 ExecuteInitExt(fm,stat);
1516 break;
1517 case CALL:
1518 ExecuteInitCall(fm,stat);
1519 break;
1520 case WHILE:
1521 ExecuteInitWhile(fm,stat);
1522 break;
1523 case ASSERT:
1524 ExecuteInitAssert(fm,stat);
1525 break;
1526 case IF:
1527 ExecuteInitIf(fm,stat);
1528 break;
1529 case SWITCH:
1530 ExecuteInitSwitch(fm,stat);
1531 break;
1532 case CASGN:
1533 fm->flow = FrameError;
1534 fm->ErrNo = Proc_declarative_constant_assignment;
1535 WriteInitErr(fm,
1536 "Incorrect statement type (constant assigned)"
1537 " in initialization section");
1538 break;
1539 default:
1540 fm->flow = FrameError;
1541 fm->ErrNo = Proc_bad_statement;
1542 WriteInitErr(fm,"Unexpected statement type in initialization section");
1543 break;
1544 }
1545 #if IDB
1546 FPRINTF(fm->err,"EIS-OUT: %s\n\n",FrameControlToString(fm->flow));
1547 #endif
1548 return;
1549 }
1550
1551 /* This is our central error handling logic control point.
1552 * This function should not itself return fm->flow == FrameError.
1553 * To the maximum extent possible, do not process errors separately
1554 * elsewhere but defer them to here. That makes maintenance of code
1555 * which handles debugging output and execution logic much simpler.
1556 */
1557 static
1558 void ExecuteInitStatements(struct procFrame *fm, struct StatementList *sl)
1559 {
1560 unsigned c,length;
1561 struct gl_list_t *statements;
1562 struct Statement *stat;
1563 enum FrameControl oldflow;
1564 int stop;
1565
1566 statements = GetList(sl);
1567 length = gl_length(statements);
1568 stop = 0;
1569 oldflow = fm->flow;
1570 for (c = 1; c <= length && !stop; c++){
1571 stat = (struct Statement *)gl_fetch(statements,c);
1572 UpdateProcFrame(fm,stat,fm->i);
1573 /* statements should issue their own complaints */
1574 ExecuteInitStatement(fm,stat);
1575 switch (fm->flow) {
1576 case FrameLoop:
1577 case FrameOK:
1578 fm->flow = oldflow;
1579 break;
1580 case FrameError:
1581 #if IDB
1582 FPRINTF(fm->err,"ERR: "); WriteStatement(fm->err,fm->stat,0);
1583 FPRINTF(fm->err,"\n");
1584 #endif
1585 if ((fm->gen & WP_STOPONERR)!= 0) {
1586 fm->flow = FrameReturn;
1587 stop = 1;
1588 } else {
1589 fm->flow = oldflow;
1590 }
1591 break;
1592 case FrameFallthru: /* say what? */
1593 case FrameContinue:
1594 case FrameBreak:
1595 if (oldflow == FrameLoop) {
1596 stop = 1;
1597 } else {
1598 /* whine about missing loop/switch context.
1599 * should be parser enforced.
1600 */
1601 #if IDB
1602 FPRINTF(fm->err,"LOOP-ERR: "); WriteStatement(fm->err,fm->stat,0);
1603 FPRINTF(fm->err,"\n");
1604 #endif
1605 if ((fm->gen & WP_STOPONERR)!= 0) {
1606 fm->flow = FrameReturn;
1607 stop = 1;
1608 } else {
1609 fm->flow = oldflow;
1610 }
1611 }
1612 break;
1613 case FrameReturn:
1614 #if IDB
1615 FPRINTF(fm->err,"ERR-UNWIND: "); WriteStatement(fm->err,fm->stat,0);
1616 FPRINTF(fm->err,"\n");
1617 #endif
1618 if (/* i/o policy check */1) {
1619 /* whine backtrace*/
1620 }
1621 stop = 1;
1622 break;
1623 /* all cases must be handled here. */
1624 }
1625 if (g_procframe_stop) {
1626 g_procframe_stop = 0;
1627 fm->ErrNo = Proc_user_interrupt;
1628 WriteInitErr(fm,"USER interrupted METHOD execution");
1629 fm->flow = FrameReturn;
1630 stop = 1;
1631 }
1632 }
1633 /* UpdateProcFrame(fm,NULL, fm->i); */ /* leave a mess for messages */
1634 assert(fm->flow != FrameError);
1635 }
1636
1637 /*********************************************************************\
1638 * void ExecuteInitProcedure(i,proc)
1639 * struct Instance *i;
1640 * struct InitProcedure *proc;
1641 * This will execute proc on the instance i.
1642 \*********************************************************************/
1643 /*
1644 * Here's where we enforce stack limits (approximately).
1645 * Here's where we unwind the stack in the event of an
1646 * early return.
1647 */
1648 static
1649 void ExecuteInitProcedure(struct procFrame *fm, struct InitProcedure *proc)
1650 {
1651 struct for_table_t *OldForTable;
1652
1653 g_proc.depth++;
1654 assert(fm != NULL && fm->i != NULL && proc != NULL);
1655 if (g_proc.depth > g_proc.limit) {
1656 g_proc.depth--;
1657 fm->ErrNo = Proc_stack_exceeded_this_frame;
1658 fm->flow = FrameError;
1659 return;
1660 }
1661
1662 OldForTable = GetEvaluationForTable();
1663 SetEvaluationForTable(CreateForTable());
1664 ExecuteInitStatements(fm,ProcStatementList(proc));
1665 DestroyForTable(GetEvaluationForTable());
1666 SetEvaluationForTable(OldForTable);
1667 g_proc.depth--;
1668 }
1669
1670 /* returns overflow or ok. possibly either form of overflow. */
1671 static
1672 void RealInitialize(struct procFrame *fm, struct Name *name)
1673 {
1674 struct Name *instname = NULL;
1675 struct Instance *ptr;
1676 enum find_errors err;
1677 struct InitProcedure *proc;
1678 struct gl_list_t *instances;
1679 unsigned long c,length;
1680 char *morename;
1681 struct procFrame *newfm;
1682 symchar *procname=NULL;
1683 int stop;
1684 int previous_context = GetDeclarativeContext();
1685
1686 morename = WriteNameString(name);
1687 CONSOLE_DEBUG("Running method '%s'...",morename);
1688 ASC_FREE(morename);
1689
1690 SetDeclarativeContext(1); /* set up for procedural processing */
1691 InstanceNamePart(name,&instname,&procname);
1692
1693 if (procname != NULL) {
1694 instances = FindInstances(fm->i, instname, &err);
1695 if (instances != NULL) {
1696 length = gl_length(instances);
1697 stop = 0;
1698 for(c=1; c<=length && !stop; c++){
1699 ptr = (struct Instance *)gl_fetch(instances,c);
1700 proc = FindProcedure(ptr,procname);
1701 if (proc != NULL) {
1702 morename = WriteInstanceNameString(ptr,fm->i);
1703 newfm = AddProcFrame(fm,ptr,
1704 (morename!=NULL)?morename:"",
1705 proc,FrameInherit);
1706 /* this usage probably force memory recycle in proctype.c */
1707 if (morename != NULL) {
1708 ascfree(morename);
1709 }
1710 ExecuteInitProcedure(newfm,proc);
1711 switch (newfm->flow) {
1712 case FrameOK:
1713 case FrameLoop:
1714 /* do nothing */
1715 break;
1716 case FrameBreak:
1717 case FrameContinue:
1718 case FrameFallthru:
1719 /* aren't supposed to work across frames, or are they? */
1720 /* do nothing */
1721 break;
1722 case FrameError:
1723 /* having to check this here sucks, but the stack
1724 * limit is not optional.
1725 */
1726 if ((fm->gen & WP_STOPONERR) != 0 || /* ||, not && */
1727 newfm->ErrNo == Proc_stack_exceeded_this_frame) {
1728 fm->flow = newfm->flow;
1729 fm->ErrNo = newfm->ErrNo;
1730 if (fm->ErrNo == Proc_stack_exceeded_this_frame) {
1731 fm->ErrNo = Proc_stack_exceeded;
1732 }
1733 stop = 1;
1734 }
1735 ProcWriteStackCheck(newfm,NULL,name);
1736 break;
1737 case FrameReturn:
1738 if (newfm->ErrNo != Proc_return) {
1739 fm->flow = newfm->flow;
1740 fm->ErrNo = newfm->ErrNo;
1741 ProcWriteStackCheck(newfm,NULL,name);
1742 } /* else was a c-like RETURN;. don't pass upward */
1743 break;
1744 }
1745 DestroyProcFrame(newfm);
1746 } else {
1747 fm->flow = FrameError;
1748 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindProcedure failed).");
1749 fm->ErrNo = Proc_proc_not_found;
1750 }
1751 }
1752 gl_destroy(instances);
1753 } else { /* unable to find instances */
1754 fm->flow = FrameError;
1755 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindInstances failed).");
1756 fm->ErrNo = Proc_instance_not_found;
1757 }
1758 } else {
1759 CONSOLE_DEBUG("BAD PROC NAME");
1760 fm->flow = FrameError;
1761 fm->ErrNo = Proc_bad_name;
1762 }
1763 SetDeclarativeContext(previous_context);
1764 DestroyName(instname);
1765 return;
1766 }
1767
1768 /* Convert all those messy result to a proc enum for UI consumption. */
1769 static
1770 enum Proc_enum InitCalcReturn(struct procFrame *fm)
1771 {
1772 switch(fm->flow) {
1773 case FrameOK:
1774 return Proc_all_ok;
1775 case FrameReturn: /* FALLTHROUGH */
1776 case FrameError:
1777 /* whine */
1778 return fm->ErrNo;
1779 case FrameLoop:
1780 /* whine a lot */
1781 case FrameContinue:
1782 return Proc_continue;
1783 case FrameBreak:
1784 return Proc_break;
1785 case FrameFallthru:
1786 return Proc_fallthru;
1787 /* all must be handled in this switch */
1788 }
1789 return -1;
1790 }
1791
1792 /* internal debug head */
1793 static
1794 enum Proc_enum DebugInitialize(struct Instance *context,
1795 struct Name *name,
1796 char *cname,
1797 FILE *err,
1798 wpflags options,
1799 struct gl_list_t *watchpoints,
1800 FILE *log,
1801 struct procFrame *fm)
1802 {
1803 struct procDebug dbi; /* this struct is huge */
1804
1805 CONSOLE_DEBUG("RUNNING METHOD IN DEBUG MODE...");
1806 InitDebugTopProcFrame(fm,context,cname,err,options,&dbi,watchpoints,log);
1807 RealInitialize(fm,name);
1808 return InitCalcReturn(fm);
1809 }
1810
1811 /* internal normal head */
1812 static
1813 enum Proc_enum NormalInitialize(struct procFrame *fm, struct Name *name)
1814 {
1815 RealInitialize(fm,name);
1816 return InitCalcReturn(fm);
1817 }
1818
1819 enum Proc_enum Initialize(struct Instance *context,
1820 struct Name *name,
1821 char *cname,
1822 FILE *err,
1823 wpflags options,
1824 struct gl_list_t *watchpoints,
1825 FILE *log)
1826 {
1827 enum Proc_enum rval;
1828 struct procFrame fm;
1829
1830 CONSOLE_DEBUG("RUNNING METHOD...");
1831
1832 assert(err != NULL);
1833 g_proc.depth = 0;
1834 Asc_SetMethodUserInterrupt(0);
1835 if (watchpoints == NULL) {
1836 InitNormalTopProcFrame(&fm,context,cname,err,options);
1837 rval = NormalInitialize(&fm,name);
1838 } else {
1839 CONSOLE_DEBUG("DEBUG");
1840 rval = DebugInitialize(context,name,cname,err,options,watchpoints,log,&fm);
1841 }
1842 return rval;
1843 }
1844
1845 /*
1846 * This deals with initializations of the form:
1847 * RUN Type::procname; where Type is model or atom type,
1848 * and procname is a procedure defined within that type.
1849 * If the Type happened to have redefined a procedure from its
1850 * parent class, that procedure would be the one on its
1851 * procedure list and hence the one that would be invoked.
1852 *
1853 */
1854 static
1855 void ClassAccessRealInitialize(struct procFrame *fm,
1856 struct Name *class,
1857 struct Name *name)
1858 {
1859 struct InitProcedure *proc;
1860 struct procFrame *newfm;
1861 struct gl_list_t *plist;
1862 symchar *procname;
1863 symchar *typename;
1864 struct TypeDescription *desc,*conformable;
1865 int previous_context = GetDeclarativeContext();
1866
1867 SetDeclarativeContext(1); /* set up for procedural processing */
1868
1869 typename = SimpleNameIdPtr(class);
1870 if (typename != NULL) {
1871 desc = FindType(typename);
1872 if (desc != NULL) {
1873 conformable = InstanceTypeDesc(fm->i);
1874 if (MoreRefined(conformable,desc)) {
1875 plist = GetInitializationList(desc);
1876 if (plist != NULL) {
1877 procname = SimpleNameIdPtr(name);
1878 if (procname != NULL) {
1879 proc = SearchProcList(plist,procname);
1880 if (proc == NULL) {
1881 proc = SearchProcList(GetUniversalProcedureList(),procname);
1882 }
1883 if (proc != NULL) {
1884 newfm = AddProcFrame(fm,fm->i,"",proc,FrameInherit);
1885 /* apf starts newfm with frameok */
1886 ExecuteInitProcedure(newfm,proc);
1887 switch (newfm->flow) {
1888 case FrameOK:
1889 case FrameLoop:
1890 /* do nothing */
1891 break;
1892 case FrameBreak:
1893 case FrameContinue:
1894 case FrameFallthru:
1895 /* aren't supposed to work across frames are they? */
1896 /* do nothing */
1897 break;
1898 case FrameError:
1899 fm->flow = newfm->flow;
1900 fm->ErrNo = newfm->ErrNo;
1901 ProcWriteStackCheck(newfm,class,name);
1902 /* having to check this here sucks, but the stack
1903 * limit is not optional.
1904 */
1905 if (fm->ErrNo == Proc_stack_exceeded_this_frame) {
1906 fm->ErrNo = Proc_stack_exceeded;
1907 }
1908 break;
1909 case FrameReturn:
1910 if (newfm->ErrNo != Proc_return) {
1911 fm->flow = newfm->flow;
1912 fm->ErrNo = newfm->ErrNo;
1913 ProcWriteStackCheck(newfm,class,name); /* fixme?*/
1914 } /* else was a c-like RETURN;. don't pass upward */
1915 break;
1916 }
1917 DestroyProcFrame(newfm);
1918 } else {
1919 fm->flow = FrameError;
1920 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (SearchProcList).");
1921 fm->ErrNo = Proc_proc_not_found;
1922 }
1923 } else {
1924 fm->flow = FrameError;
1925 fm->ErrNo = Proc_illegal_name_use;
1926 }
1927 } else {
1928 fm->flow = FrameError;
1929 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (GetInitializationList is null).");
1930 fm->ErrNo = Proc_proc_not_found;
1931 }
1932 } else {
1933 fm->flow = FrameError;
1934 fm->ErrNo = Proc_illegal_type_use;
1935 }
1936 } else {
1937 fm->flow = FrameError;
1938 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindType failed)\n");
1939 fm->ErrNo = Proc_type_not_found;
1940 }
1941 } else {
1942 fm->flow = FrameError;
1943 fm->ErrNo = Proc_illegal_name_use;
1944 }
1945
1946 SetDeclarativeContext(previous_context);
1947 return;
1948 }
1949
1950 /* internal debug head */
1951 static
1952 enum Proc_enum DebugClassAccessInitialize(struct Instance *context,
1953 struct Name *class,
1954 struct Name *name,
1955 char *cname,
1956 FILE *err,
1957 wpflags options,
1958 struct gl_list_t *watchpoints,
1959 FILE *log,
1960 struct procFrame *fm)
1961 {
1962 struct procDebug dbi; /* this struct is huge */
1963
1964 InitDebugTopProcFrame(fm,context,cname,err,options,&dbi,watchpoints,log);
1965 ClassAccessRealInitialize(fm,class,name);
1966 return InitCalcReturn(fm);
1967 }
1968
1969 /* internal normal head */
1970 static
1971 enum Proc_enum NormalClassAccessInitialize(struct procFrame *fm,
1972 struct Name *class,
1973 struct Name *name)
1974 {
1975 ClassAccessRealInitialize(fm,class,name);
1976 return InitCalcReturn(fm);
1977 }
1978
1979 enum Proc_enum ClassAccessInitialize(struct Instance *context,
1980 struct Name *class,
1981 struct Name *name,
1982 char *cname,
1983 FILE *err,
1984 wpflags options,
1985 struct gl_list_t *watchpoints,
1986 FILE *log)
1987 {
1988 struct procFrame fm;
1989
1990 assert(err != NULL);
1991 g_proc.depth = 0;
1992 Asc_SetMethodUserInterrupt(0);
1993 if (watchpoints == NULL) {
1994 InitNormalTopProcFrame(&fm,context,cname,err,options);
1995 return NormalClassAccessInitialize(&fm,class,name);
1996 } else {
1997 return DebugClassAccessInitialize(context,class,name,cname,
1998 err,options,watchpoints,log,&fm);
1999 }
2000 }

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