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

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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