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

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