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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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