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

Contents of /trunk/ascend/compiler/initialize.c

Parent Directory Parent Directory | Revision Log Revision Log


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

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