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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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