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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2642 - (show annotations) (download) (as text)
Tue Oct 2 09:31:20 2012 UTC (6 years, 2 months ago) by jpye
File MIME type: text/x-csrc
File size: 63273 byte(s)
separate bug 567 and 564, avoid a name clash, eliminate duplicate FindInsts (Dante Stroe?)
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 #include "link.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 asc_intptr_t 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 = (asc_intptr_t)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 /*DS : Implement Non-declarative LINK statement here*/
1631 static void ExecuteInitLnk(struct procFrame *fm, struct Statement *stat){
1632 //printf("\nDS: ExecuteInitLnk called\n");
1633 enum find_errors err;
1634 struct gl_list_t *instances;
1635 symchar *key;
1636
1637 instances = FindInsts(fm->i,LINKStatVlist(stat),&err);
1638 key = LINKStatKey(stat);
1639
1640 CONSOLE_DEBUG("LINKStatVlist(stat) contains %lu",VariableListLength(LINKStatVlist(stat)));
1641 if((instances != NULL) && (key != NULL)){
1642 switch(InstanceKind(fm->i)) {
1643 case MODEL_INST:
1644 CONSOLE_DEBUG("Adding procedural link");
1645 addLinkEntry(fm->i,key,instances,stat,0);
1646 break;
1647 default:
1648 STATEMENT_ERROR(stat, "LINK is not called by a model");
1649 break;
1650 }
1651 }else if(key == NULL){
1652 STATEMENT_ERROR(stat, "Procedural LINK contains impossible key");
1653 }
1654 }
1655
1656
1657 /*DS : Implement UNLINK statement here (Non-declarative only) */
1658 static void ExecuteInitUnlnk(struct procFrame *fm, struct Statement *stat){
1659 enum find_errors err;
1660 struct gl_list_t *instances;
1661 symchar *key;
1662
1663 instances = FindInstances(fm->i,stat->v.lnk.vl->nptr,&err);
1664 key = LINKStatKey(stat);
1665
1666 if((instances != NULL) && (key != NULL)){
1667 switch(InstanceKind(fm->i)) {
1668 case MODEL_INST:
1669 printf("Procedural UNLINK...");
1670 removeLinkEntry(fm->i,key,LINKStatVlist(stat));
1671 break;
1672 default:
1673 STATEMENT_ERROR(stat, "UNLINK is not called by a model");
1674 break;
1675 }
1676 }else if(key == NULL){
1677 STATEMENT_ERROR(stat, "UNLINK contains impossible key");
1678 }
1679 }
1680
1681
1682 static
1683 void ExecuteInitStatement(struct procFrame *fm, struct Statement *stat)
1684 {
1685 #if IDB
1686 FPRINTF(fm->err,"\n");
1687 FPRINTF(fm->err,"EIS-IN: %s\n",FrameControlToString(fm->flow));
1688 FPRINTF(fm->err,"EIS: "); WriteStatement(fm->err,stat,2);
1689 #endif
1690 switch(StatementType(stat)){
1691 case FOR:
1692 ExecuteInitFor(fm,stat);
1693 break;
1694 case ASGN:
1695 ExecuteInitAsgn(fm,stat);
1696 break;
1697 case LNK:
1698 ExecuteInitLnk(fm,stat);
1699 break;
1700 case UNLNK:
1701 ExecuteInitUnlnk(fm,stat);
1702 break;
1703 case RUN:
1704 ExecuteInitRun(fm,stat);
1705 break;
1706 case FIX:/* this function always returns ok. 5/96 */
1707 ExecuteInitFix(fm,stat);
1708 break;
1709 case FREE:
1710 ExecuteInitFree(fm,stat);
1711 break;
1712 case SOLVER:
1713 ExecuteInitSolver(fm,stat);
1714 break;
1715 case OPTION:
1716 ExecuteInitOption(fm,stat);
1717 break;
1718 case SOLVE:
1719 ExecuteInitSolve(fm,stat);
1720 break;
1721 case FLOW:
1722 ExecuteInitFlow(fm);
1723 break;
1724 case EXT:
1725 /* CONSOLE_DEBUG("ABOUT TO ExecuteInitExt"); */
1726 ExecuteInitExt(fm,stat);
1727 break;
1728 case CALL:
1729 ExecuteInitCall(fm,stat);
1730 break;
1731 case WHILE:
1732 ExecuteInitWhile(fm,stat);
1733 break;
1734 case ASSERT:
1735 ExecuteInitAssert(fm,stat);
1736 break;
1737 case IF:
1738 ExecuteInitIf(fm,stat);
1739 break;
1740 case SWITCH:
1741 ExecuteInitSwitch(fm,stat);
1742 break;
1743 case CASGN:
1744 fm->flow = FrameError;
1745 fm->ErrNo = Proc_declarative_constant_assignment;
1746 WriteInitErr(fm, "Assignment of constants is not permitted inside METHODs.");
1747 break;
1748 default:
1749 fm->flow = FrameError;
1750 fm->ErrNo = Proc_bad_statement;
1751 WriteInitErr(fm,"Unexpected statement type in initialization section.");
1752 break;
1753 }
1754 #if IDB
1755 FPRINTF(fm->err,"EIS-OUT: %s\n\n",FrameControlToString(fm->flow));
1756 #endif
1757 return;
1758 }
1759
1760 /* This is our central error handling logic control point.
1761 * This function should not itself return fm->flow == FrameError.
1762 * To the maximum extent possible, do not process errors separately
1763 * elsewhere but defer them to here. That makes maintenance of code
1764 * which handles debugging output and execution logic much simpler.
1765 */
1766 static
1767 void ExecuteInitStatements(struct procFrame *fm, struct StatementList *sl)
1768 {
1769 unsigned c,length;
1770 struct gl_list_t *statements;
1771 struct Statement *stat;
1772 enum FrameControl oldflow;
1773 int stop;
1774
1775 statements = GetList(sl);
1776 length = gl_length(statements);
1777 stop = 0;
1778 oldflow = fm->flow;
1779 for (c = 1; c <= length && !stop; c++){
1780 stat = (struct Statement *)gl_fetch(statements,c);
1781 UpdateProcFrame(fm,stat,fm->i);
1782 /* statements should issue their own complaints */
1783 ExecuteInitStatement(fm,stat);
1784 switch (fm->flow) {
1785 case FrameLoop:
1786 case FrameOK:
1787 fm->flow = oldflow;
1788 break;
1789 case FrameError:
1790 #if IDB
1791 FPRINTF(fm->err,"ERR: "); WriteStatement(fm->err,fm->stat,0);
1792 FPRINTF(fm->err,"\n");
1793 #endif
1794 if ((fm->gen & WP_STOPONERR)!= 0) {
1795 fm->flow = FrameReturn;
1796 stop = 1;
1797 } else {
1798 fm->flow = oldflow;
1799 }
1800 break;
1801 case FrameFallthru: /* say what? */
1802 case FrameContinue:
1803 case FrameBreak:
1804 if (oldflow == FrameLoop) {
1805 stop = 1;
1806 } else {
1807 /* whine about missing loop/switch context.
1808 * should be parser enforced.
1809 */
1810 #if IDB
1811 FPRINTF(fm->err,"LOOP-ERR: "); WriteStatement(fm->err,fm->stat,0);
1812 FPRINTF(fm->err,"\n");
1813 #endif
1814 if ((fm->gen & WP_STOPONERR)!= 0) {
1815 fm->flow = FrameReturn;
1816 stop = 1;
1817 } else {
1818 fm->flow = oldflow;
1819 }
1820 }
1821 break;
1822 case FrameReturn:
1823 #if IDB
1824 FPRINTF(fm->err,"ERR-UNWIND: "); WriteStatement(fm->err,fm->stat,0);
1825 FPRINTF(fm->err,"\n");
1826 #endif
1827 if (/* i/o policy check */1) {
1828 /* whine backtrace*/
1829 }
1830 stop = 1;
1831 break;
1832 /* all cases must be handled here. */
1833 }
1834 if (g_procframe_stop) {
1835 g_procframe_stop = 0;
1836 fm->ErrNo = Proc_user_interrupt;
1837 WriteInitErr(fm,"USER interrupted METHOD execution");
1838 fm->flow = FrameReturn;
1839 stop = 1;
1840 }
1841 }
1842 /* UpdateProcFrame(fm,NULL, fm->i); */ /* leave a mess for messages */
1843 assert(fm->flow != FrameError);
1844 }
1845
1846 /*********************************************************************\
1847 * void ExecuteInitProcedure(i,proc)
1848 * struct Instance *i;
1849 * struct InitProcedure *proc;
1850 * This will execute proc on the instance i.
1851 \*********************************************************************/
1852 /*
1853 * Here's where we enforce stack limits (approximately).
1854 * Here's where we unwind the stack in the event of an
1855 * early return.
1856 */
1857 static
1858 void ExecuteInitProcedure(struct procFrame *fm, struct InitProcedure *proc)
1859 {
1860 struct for_table_t *OldForTable;
1861
1862 g_proc.depth++;
1863 assert(fm != NULL && fm->i != NULL && proc != NULL);
1864 if (g_proc.depth > g_proc.limit) {
1865 g_proc.depth--;
1866 fm->ErrNo = Proc_stack_exceeded_this_frame;
1867 fm->flow = FrameError;
1868 return;
1869 }
1870
1871 OldForTable = GetEvaluationForTable();
1872 SetEvaluationForTable(CreateForTable());
1873 ExecuteInitStatements(fm,ProcStatementList(proc));
1874 DestroyForTable(GetEvaluationForTable());
1875 SetEvaluationForTable(OldForTable);
1876 g_proc.depth--;
1877 }
1878
1879 /* returns overflow or ok. possibly either form of overflow. */
1880 static
1881 void RealInitialize(struct procFrame *fm, struct Name *name)
1882 {
1883 struct Name *instname = NULL;
1884 struct Instance *ptr;
1885 enum find_errors err;
1886 struct InitProcedure *proc;
1887 struct gl_list_t *instances;
1888 unsigned long c,length;
1889 char *morename;
1890 struct procFrame *newfm;
1891 symchar *procname=NULL;
1892 int stop;
1893 int previous_context = GetDeclarativeContext();
1894
1895 morename = WriteNameString(name);
1896 #ifdef INIT_DEBUG
1897 char *name1 = WriteInstanceNameString(fm->i,NULL);
1898 if(fm->proc && fm->proc->name){
1899 CONSOLE_DEBUG("Running METHOD %s on '%s' (from scope %s)",SCP(fm->proc->name),name1,SCP(fm->cname));
1900 }else{
1901 CONSOLE_DEBUG("Running METHOD '%s' (from scope %s)",name1,SCP(fm->cname));
1902 }
1903
1904 ASC_FREE(name1);
1905 #endif
1906 ASC_FREE(morename);
1907
1908 SetDeclarativeContext(1); /* set up for procedural processing */
1909 InstanceNamePart(name,&instname,&procname);
1910
1911 #ifdef INIT_DEBUG
1912 if(procname){
1913 CONSOLE_DEBUG("Procname = %s",SCP(procname));
1914 }
1915 #endif
1916
1917 if (procname != NULL) {
1918 instances = FindInstances(fm->i, instname, &err);
1919 if (instances != NULL) {
1920 length = gl_length(instances);
1921 stop = 0;
1922 for(c=1; c<=length && !stop; c++){
1923 ptr = (struct Instance *)gl_fetch(instances,c);
1924 proc = FindProcedure(ptr,procname);
1925 if (proc != NULL) {
1926 morename = WriteInstanceNameString(ptr,fm->i);
1927 newfm = AddProcFrame(fm,ptr,
1928 (morename!=NULL)?morename:"",
1929 proc,FrameInherit);
1930 /* this usage probably force memory recycle in proctype.c */
1931 if (morename != NULL) {
1932 ascfree(morename);
1933 }
1934 ExecuteInitProcedure(newfm,proc);
1935 switch (newfm->flow) {
1936 case FrameOK:
1937 case FrameLoop:
1938 /* do nothing */
1939 break;
1940 case FrameBreak:
1941 case FrameContinue:
1942 case FrameFallthru:
1943 /* aren't supposed to work across frames, or are they? */
1944 /* do nothing */
1945 break;
1946 case FrameError:
1947 /* having to check this here sucks, but the stack
1948 * limit is not optional.
1949 */
1950 if ((fm->gen & WP_STOPONERR) != 0 || /* ||, not && */
1951 newfm->ErrNo == Proc_stack_exceeded_this_frame) {
1952 fm->flow = newfm->flow;
1953 fm->ErrNo = newfm->ErrNo;
1954 if (fm->ErrNo == Proc_stack_exceeded_this_frame) {
1955 fm->ErrNo = Proc_stack_exceeded;
1956 }
1957 stop = 1;
1958 }
1959 ProcWriteStackCheck(newfm,NULL,name);
1960 break;
1961 case FrameReturn:
1962 if (newfm->ErrNo != Proc_return) {
1963 fm->flow = newfm->flow;
1964 fm->ErrNo = newfm->ErrNo;
1965 ProcWriteStackCheck(newfm,NULL,name);
1966 } /* else was a c-like RETURN;. don't pass upward */
1967 break;
1968 }
1969 #ifdef INIT_DEBUG
1970 CONSOLE_DEBUG("Destroying frame...");
1971 #endif
1972 DestroyProcFrame(newfm);
1973 } else {
1974 fm->flow = FrameError;
1975 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindProcedure failed).");
1976 fm->ErrNo = Proc_proc_not_found;
1977 }
1978 }
1979 gl_destroy(instances);
1980 } else { /* unable to find instances */
1981 fm->flow = FrameError;
1982 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindInstances failed).");
1983 fm->ErrNo = Proc_instance_not_found;
1984 }
1985 } else {
1986 CONSOLE_DEBUG("BAD PROC NAME");
1987 fm->flow = FrameError;
1988 fm->ErrNo = Proc_bad_name;
1989 }
1990 SetDeclarativeContext(previous_context);
1991 DestroyName(instname);
1992 return;
1993 }
1994
1995 /* Convert all those messy result to a proc enum for UI consumption. */
1996 static
1997 enum Proc_enum InitCalcReturn(struct procFrame *fm)
1998 {
1999 switch(fm->flow) {
2000 case FrameOK:
2001 return Proc_all_ok;
2002 case FrameReturn: /* FALLTHROUGH */
2003 case FrameError:
2004 /* whine */
2005 return fm->ErrNo;
2006 case FrameLoop:
2007 /* whine a lot */
2008 case FrameContinue:
2009 return Proc_continue;
2010 case FrameBreak:
2011 return Proc_break;
2012 case FrameFallthru:
2013 return Proc_fallthru;
2014 /* all must be handled in this switch */
2015 }
2016 return -1;
2017 }
2018
2019 /* internal debug head */
2020 static
2021 enum Proc_enum DebugInitialize(struct Instance *context,
2022 struct Name *name,
2023 CONST char *cname,
2024 FILE *err,
2025 wpflags options,
2026 struct gl_list_t *watchpoints,
2027 FILE *log,
2028 struct procFrame *fm)
2029 {
2030 struct procDebug dbi; /* this struct is huge */
2031
2032 CONSOLE_DEBUG("RUNNING METHOD IN DEBUG MODE...");
2033 InitDebugTopProcFrame(fm,context,cname,err,options,&dbi,watchpoints,log);
2034 RealInitialize(fm,name);
2035 return InitCalcReturn(fm);
2036 }
2037
2038 /* internal normal head */
2039 static
2040 enum Proc_enum NormalInitialize(struct procFrame *fm, struct Name *name)
2041 {
2042 RealInitialize(fm,name);
2043 return InitCalcReturn(fm);
2044 }
2045
2046 enum Proc_enum Initialize(struct Instance *context,
2047 struct Name *name,
2048 CONST char *cname,
2049 FILE *err,
2050 wpflags options,
2051 struct gl_list_t *watchpoints,
2052 FILE *log)
2053 {
2054 enum Proc_enum rval;
2055 struct procFrame fm;
2056
2057 #ifdef INIT_DEBUG
2058 char *instname = WriteInstanceNameString(context,NULL);
2059 const char *insttype =
2060 InstanceKind(context)==SIM_INST ? "SIM_INST" :(
2061 InstanceKind(context)==MODEL_INST ? "MODEL_INST" : (
2062 "UNRECOGNIZED-TYPE"));
2063 CONSOLE_DEBUG("Running method '%s' on %s '%s'...",cname,insttype,instname);
2064 ASC_FREE(instname);
2065 #endif
2066
2067 assert(err != NULL);
2068 g_proc.depth = 0;
2069 Asc_SetMethodUserInterrupt(0);
2070 if (watchpoints == NULL) {
2071 InitNormalTopProcFrame(&fm,context,cname,err,options);
2072 rval = NormalInitialize(&fm,name);
2073 if(fm.cname)ASC_FREE(fm.cname);
2074 } else {
2075 CONSOLE_DEBUG("Running method with debug...");
2076 rval = DebugInitialize(context,name,cname,err,options,watchpoints,log,&fm);
2077 }
2078 return rval;
2079 }
2080
2081 /*
2082 * This deals with initializations of the form:
2083 * RUN Type::procname; where Type is model or atom type,
2084 * and procname is a procedure defined within that type.
2085 * If the Type happened to have redefined a procedure from its
2086 * parent class, that procedure would be the one on its
2087 * procedure list and hence the one that would be invoked.
2088 *
2089 */
2090 static
2091 void ClassAccessRealInitialize(struct procFrame *fm,
2092 struct Name *class,
2093 struct Name *name)
2094 {
2095 struct InitProcedure *proc;
2096 struct procFrame *newfm;
2097 struct gl_list_t *plist;
2098 symchar *procname;
2099 symchar *typename;
2100 struct TypeDescription *desc,*conformable;
2101 int previous_context = GetDeclarativeContext();
2102
2103 SetDeclarativeContext(1); /* set up for procedural processing */
2104
2105 typename = SimpleNameIdPtr(class);
2106 if (typename != NULL) {
2107 desc = FindType(typename);
2108 if (desc != NULL) {
2109 conformable = InstanceTypeDesc(fm->i);
2110 if (MoreRefined(conformable,desc)) {
2111 plist = GetInitializationList(desc);
2112 if (plist != NULL) {
2113 procname = SimpleNameIdPtr(name);
2114 if (procname != NULL) {
2115 proc = SearchProcList(plist,procname);
2116 if (proc == NULL) {
2117 proc = SearchProcList(GetUniversalProcedureList(),procname);
2118 }
2119 if (proc != NULL) {
2120 newfm = AddProcFrame(fm,fm->i,"",proc,FrameInherit);
2121 /* apf starts newfm with frameok */
2122 ExecuteInitProcedure(newfm,proc);
2123 switch (newfm->flow) {
2124 case FrameOK:
2125 case FrameLoop:
2126 /* do nothing */
2127 break;
2128 case FrameBreak:
2129 case FrameContinue:
2130 case FrameFallthru:
2131 /* aren't supposed to work across frames are they? */
2132 /* do nothing */
2133 break;
2134 case FrameError:
2135 fm->flow = newfm->flow;
2136 fm->ErrNo = newfm->ErrNo;
2137 ProcWriteStackCheck(newfm,class,name);
2138 /* having to check this here sucks, but the stack
2139 * limit is not optional.
2140 */
2141 if (fm->ErrNo == Proc_stack_exceeded_this_frame) {
2142 fm->ErrNo = Proc_stack_exceeded;
2143 }
2144 break;
2145 case FrameReturn:
2146 if (newfm->ErrNo != Proc_return) {
2147 fm->flow = newfm->flow;
2148 fm->ErrNo = newfm->ErrNo;
2149 ProcWriteStackCheck(newfm,class,name); /* fixme?*/
2150 } /* else was a c-like RETURN;. don't pass upward */
2151 break;
2152 }
2153 DestroyProcFrame(newfm);
2154 } else {
2155 fm->flow = FrameError;
2156 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (SearchProcList).");
2157 fm->ErrNo = Proc_proc_not_found;
2158 }
2159 } else {
2160 fm->flow = FrameError;
2161 fm->ErrNo = Proc_illegal_name_use;
2162 }
2163 } else {
2164 fm->flow = FrameError;
2165 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (GetInitializationList is null).");
2166 fm->ErrNo = Proc_proc_not_found;
2167 }
2168 } else {
2169 fm->flow = FrameError;
2170 fm->ErrNo = Proc_illegal_type_use;
2171 }
2172 } else {
2173 fm->flow = FrameError;
2174 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"PROCEDURE NOT FOUND (FindType failed)\n");
2175 fm->ErrNo = Proc_type_not_found;
2176 }
2177 } else {
2178 fm->flow = FrameError;
2179 fm->ErrNo = Proc_illegal_name_use;
2180 }
2181
2182 SetDeclarativeContext(previous_context);
2183 return;
2184 }
2185
2186 /* internal debug head */
2187 static
2188 enum Proc_enum DebugClassAccessInitialize(struct Instance *context,
2189 struct Name *class,
2190 struct Name *name,
2191 CONST char *cname,
2192 FILE *err,
2193 wpflags options,
2194 struct gl_list_t *watchpoints,
2195 FILE *log,
2196 struct procFrame *fm)
2197 {
2198 struct procDebug dbi; /* this struct is huge */
2199
2200 InitDebugTopProcFrame(fm,context,cname,err,options,&dbi,watchpoints,log);
2201 ClassAccessRealInitialize(fm,class,name);
2202 return InitCalcReturn(fm);
2203 }
2204
2205 /* internal normal head */
2206 static
2207 enum Proc_enum NormalClassAccessInitialize(struct procFrame *fm,
2208 struct Name *class,
2209 struct Name *name)
2210 {
2211 ClassAccessRealInitialize(fm,class,name);
2212 return InitCalcReturn(fm);
2213 }
2214
2215 enum Proc_enum ClassAccessInitialize(struct Instance *context,
2216 struct Name *class,
2217 struct Name *name,
2218 char *cname,
2219 FILE *err,
2220 wpflags options,
2221 struct gl_list_t *watchpoints,
2222 FILE *log)
2223 {
2224 struct procFrame fm;
2225
2226 assert(err != NULL);
2227 g_proc.depth = 0;
2228 Asc_SetMethodUserInterrupt(0);
2229 if (watchpoints == NULL) {
2230 InitNormalTopProcFrame(&fm,context,cname,err,options);
2231 return NormalClassAccessInitialize(&fm,class,name);
2232 } else {
2233 return DebugClassAccessInitialize(context,class,name,cname,
2234 err,options,watchpoints,log,&fm);
2235 }
2236 }
2237
2238 /* vim: set ts=4: */

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