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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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