1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 08/16/14 */
5 /* */
6 /* PROCEDURAL FUNCTIONS MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Contains the code for several procedural */
11 /* functions including if, while, loop-for-count, bind, */
12 /* progn, return, break, and switch */
13 /* */
14 /* Principal Programmer(s): */
15 /* Gary D. Riley */
16 /* Brian L. Dantes */
17 /* */
18 /* Contributing Programmer(s): */
19 /* */
20 /* Revision History: */
21 /* */
22 /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */
23 /* */
24 /* Changed name of variable exp to theExp */
25 /* because of Unix compiler warnings of shadowed */
26 /* definitions. */
27 /* */
28 /* 6.24: Renamed BOOLEAN macro type to intBool. */
29 /* */
30 /* 6.30: Local variables set with the bind function */
31 /* persist until a reset/clear command is issued. */
32 /* */
33 /* Changed garbage collection algorithm. */
34 /* */
35 /* Support for long long integers. */
36 /* */
37 /*************************************************************/
38
39 #define _PRCDRFUN_SOURCE_
40
41 #include <stdio.h>
42 #define _STDIO_INCLUDED_
43
44 #include "setup.h"
45
46 #include "argacces.h"
47 #include "constrnt.h"
48 #include "cstrnchk.h"
49 #include "cstrnops.h"
50 #include "envrnmnt.h"
51 #include "exprnpsr.h"
52 #include "memalloc.h"
53 #include "multifld.h"
54 #include "prcdrpsr.h"
55 #include "router.h"
56 #include "scanner.h"
57 #include "utility.h"
58
59 #include "prcdrfun.h"
60
61 #if DEFGLOBAL_CONSTRUCT
62 #include "globldef.h"
63 #endif
64
65 /***************************************/
66 /* LOCAL INTERNAL FUNCTION DEFINITIONS */
67 /***************************************/
68
69 static void DeallocateProceduralFunctionData(void *);
70
71 /**********************************************/
72 /* ProceduralFunctionDefinitions: Initializes */
73 /* the procedural functions. */
74 /**********************************************/
ProceduralFunctionDefinitions(void * theEnv)75 globle void ProceduralFunctionDefinitions(
76 void *theEnv)
77 {
78 AllocateEnvironmentData(theEnv,PRCDRFUN_DATA,sizeof(struct procedureFunctionData),DeallocateProceduralFunctionData);
79
80 #if ! RUN_TIME
81 EnvDefineFunction2(theEnv,"if", 'u', PTIEF IfFunction, "IfFunction", NULL);
82 EnvDefineFunction2(theEnv,"while", 'u', PTIEF WhileFunction, "WhileFunction", NULL);
83 EnvDefineFunction2(theEnv,"loop-for-count",'u', PTIEF LoopForCountFunction, "LoopForCountFunction", NULL);
84 EnvDefineFunction2(theEnv,"(get-loop-count)",'g', PTIEF GetLoopCount, "GetLoopCount", NULL);
85 EnvDefineFunction2(theEnv,"bind", 'u', PTIEF BindFunction, "BindFunction", NULL);
86 EnvDefineFunction2(theEnv,"progn", 'u', PTIEF PrognFunction, "PrognFunction", NULL);
87 EnvDefineFunction2(theEnv,"return", 'u', PTIEF ReturnFunction, "ReturnFunction",NULL);
88 EnvDefineFunction2(theEnv,"break", 'v', PTIEF BreakFunction, "BreakFunction",NULL);
89 EnvDefineFunction2(theEnv,"switch", 'u', PTIEF SwitchFunction, "SwitchFunction",NULL);
90
91 ProceduralFunctionParsers(theEnv);
92
93 FuncSeqOvlFlags(theEnv,"progn",FALSE,FALSE);
94 FuncSeqOvlFlags(theEnv,"if",FALSE,FALSE);
95 FuncSeqOvlFlags(theEnv,"while",FALSE,FALSE);
96 FuncSeqOvlFlags(theEnv,"loop-for-count",FALSE,FALSE);
97 FuncSeqOvlFlags(theEnv,"return",FALSE,FALSE);
98 FuncSeqOvlFlags(theEnv,"switch",FALSE,FALSE);
99 #endif
100
101 EnvAddResetFunction(theEnv,"bind",FlushBindList,0);
102 EnvAddClearFunction(theEnv,"bind",FlushBindList,0);
103 }
104
105 /*************************************************************/
106 /* DeallocateProceduralFunctionData: Deallocates environment */
107 /* data for procedural functions. */
108 /*************************************************************/
DeallocateProceduralFunctionData(void * theEnv)109 static void DeallocateProceduralFunctionData(
110 void *theEnv)
111 {
112 DATA_OBJECT_PTR nextPtr, garbagePtr;
113
114 garbagePtr = ProcedureFunctionData(theEnv)->BindList;
115
116 while (garbagePtr != NULL)
117 {
118 nextPtr = garbagePtr->next;
119 rtn_struct(theEnv,dataObject,garbagePtr);
120 garbagePtr = nextPtr;
121 }
122 }
123
124 /***************************************/
125 /* WhileFunction: H/L access routine */
126 /* for the while function. */
127 /***************************************/
WhileFunction(void * theEnv,DATA_OBJECT_PTR returnValue)128 globle void WhileFunction(
129 void *theEnv,
130 DATA_OBJECT_PTR returnValue)
131 {
132 DATA_OBJECT theResult;
133 struct garbageFrame newGarbageFrame;
134 struct garbageFrame *oldGarbageFrame;
135
136 /*====================================================*/
137 /* Evaluate the body of the while loop as long as the */
138 /* while condition evaluates to a non-FALSE value. */
139 /*====================================================*/
140
141 oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
142 memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
143 newGarbageFrame.priorFrame = oldGarbageFrame;
144 UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
145
146 EnvRtnUnknown(theEnv,1,&theResult);
147 while (((theResult.value != EnvFalseSymbol(theEnv)) ||
148 (theResult.type != SYMBOL)) &&
149 (EvaluationData(theEnv)->HaltExecution != TRUE))
150 {
151 if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
152 break;
153
154 EnvRtnUnknown(theEnv,2,&theResult);
155
156 if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
157 break;
158
159 CleanCurrentGarbageFrame(theEnv,NULL);
160 CallPeriodicTasks(theEnv);
161
162 EnvRtnUnknown(theEnv,1,&theResult);
163 }
164
165 /*=====================================================*/
166 /* Reset the break flag. The return flag is not reset */
167 /* because the while loop is probably contained within */
168 /* a deffunction or RHS of a rule which needs to be */
169 /* returned from as well. */
170 /*=====================================================*/
171
172 ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
173
174 /*====================================================*/
175 /* If the return command was issued, then return that */
176 /* value, otherwise return the symbol FALSE. */
177 /*====================================================*/
178
179 if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
180 {
181 returnValue->type = theResult.type;
182 returnValue->value = theResult.value;
183 returnValue->begin = theResult.begin;
184 returnValue->end = theResult.end;
185 }
186 else
187 {
188 returnValue->type = SYMBOL;
189 returnValue->value = EnvFalseSymbol(theEnv);
190 }
191
192 RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,returnValue);
193 CallPeriodicTasks(theEnv);
194 }
195
196 /********************************************/
197 /* LoopForCountFunction: H/L access routine */
198 /* for the loop-for-count function. */
199 /********************************************/
LoopForCountFunction(void * theEnv,DATA_OBJECT_PTR loopResult)200 globle void LoopForCountFunction(
201 void *theEnv,
202 DATA_OBJECT_PTR loopResult)
203 {
204 DATA_OBJECT arg_ptr;
205 long long iterationEnd;
206 LOOP_COUNTER_STACK *tmpCounter;
207 struct garbageFrame newGarbageFrame;
208 struct garbageFrame *oldGarbageFrame;
209
210 tmpCounter = get_struct(theEnv,loopCounterStack);
211 tmpCounter->loopCounter = 0L;
212 tmpCounter->nxt = ProcedureFunctionData(theEnv)->LoopCounterStack;
213 ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter;
214 if (EnvArgTypeCheck(theEnv,"loop-for-count",1,INTEGER,&arg_ptr) == FALSE)
215 {
216 loopResult->type = SYMBOL;
217 loopResult->value = EnvFalseSymbol(theEnv);
218 ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
219 rtn_struct(theEnv,loopCounterStack,tmpCounter);
220 return;
221 }
222 tmpCounter->loopCounter = DOToLong(arg_ptr);
223 if (EnvArgTypeCheck(theEnv,"loop-for-count",2,INTEGER,&arg_ptr) == FALSE)
224 {
225 loopResult->type = SYMBOL;
226 loopResult->value = EnvFalseSymbol(theEnv);
227 ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
228 rtn_struct(theEnv,loopCounterStack,tmpCounter);
229 return;
230 }
231
232 oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
233 memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
234 newGarbageFrame.priorFrame = oldGarbageFrame;
235 UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
236
237 iterationEnd = DOToLong(arg_ptr);
238 while ((tmpCounter->loopCounter <= iterationEnd) &&
239 (EvaluationData(theEnv)->HaltExecution != TRUE))
240 {
241 if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
242 break;
243
244 EnvRtnUnknown(theEnv,3,&arg_ptr);
245
246 if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
247 break;
248
249 CleanCurrentGarbageFrame(theEnv,NULL);
250 CallPeriodicTasks(theEnv);
251
252 tmpCounter->loopCounter++;
253 }
254
255 ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
256 if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
257 {
258 loopResult->type = arg_ptr.type;
259 loopResult->value = arg_ptr.value;
260 loopResult->begin = arg_ptr.begin;
261 loopResult->end = arg_ptr.end;
262 }
263 else
264 {
265 loopResult->type = SYMBOL;
266 loopResult->value = EnvFalseSymbol(theEnv);
267 }
268 ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
269 rtn_struct(theEnv,loopCounterStack,tmpCounter);
270
271 RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,loopResult);
272 CallPeriodicTasks(theEnv);
273 }
274
275 /*****************/
276 /* GetLoopCount: */
277 /*****************/
GetLoopCount(void * theEnv)278 globle long long GetLoopCount(
279 void *theEnv)
280 {
281 int depth;
282 LOOP_COUNTER_STACK *tmpCounter;
283
284 depth = ValueToInteger(GetFirstArgument()->value);
285 tmpCounter = ProcedureFunctionData(theEnv)->LoopCounterStack;
286 while (depth > 0)
287 {
288 tmpCounter = tmpCounter->nxt;
289 depth--;
290 }
291 return(tmpCounter->loopCounter);
292 }
293
294 /************************************/
295 /* IfFunction: H/L access routine */
296 /* for the if function. */
297 /************************************/
IfFunction(void * theEnv,DATA_OBJECT_PTR returnValue)298 globle void IfFunction(
299 void *theEnv,
300 DATA_OBJECT_PTR returnValue)
301 {
302 int numArgs;
303 struct expr *theExpr;
304
305 /*============================================*/
306 /* Check for the correct number of arguments. */
307 /*============================================*/
308
309 if ((EvaluationData(theEnv)->CurrentExpression->argList == NULL) ||
310 (EvaluationData(theEnv)->CurrentExpression->argList->nextArg == NULL))
311 {
312 EnvArgRangeCheck(theEnv,"if",2,3);
313 returnValue->type = SYMBOL;
314 returnValue->value = EnvFalseSymbol(theEnv);
315 return;
316 }
317
318 if (EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg == NULL)
319 { numArgs = 2; }
320 else if (EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg->nextArg == NULL)
321 { numArgs = 3; }
322 else
323 {
324 EnvArgRangeCheck(theEnv,"if",2,3);
325 returnValue->type = SYMBOL;
326 returnValue->value = EnvFalseSymbol(theEnv);
327 return;
328 }
329
330 /*=========================*/
331 /* Evaluate the condition. */
332 /*=========================*/
333
334 EvaluateExpression(theEnv,EvaluationData(theEnv)->CurrentExpression->argList,returnValue);
335
336 if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
337 {
338 returnValue->type = SYMBOL;
339 returnValue->value = EnvFalseSymbol(theEnv);
340 return;
341 }
342
343 /*=========================================*/
344 /* If the condition evaluated to FALSE and */
345 /* an "else" portion exists, evaluate it */
346 /* and return the value. */
347 /*=========================================*/
348
349 if ((returnValue->value == EnvFalseSymbol(theEnv)) &&
350 (returnValue->type == SYMBOL) &&
351 (numArgs == 3))
352 {
353 theExpr = EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg;
354 switch (theExpr->type)
355 {
356 case INTEGER:
357 case FLOAT:
358 case SYMBOL:
359 case STRING:
360 #if OBJECT_SYSTEM
361 case INSTANCE_NAME:
362 case INSTANCE_ADDRESS:
363 #endif
364 case EXTERNAL_ADDRESS:
365 returnValue->type = theExpr->type;
366 returnValue->value = theExpr->value;
367 break;
368
369 default:
370 EvaluateExpression(theEnv,theExpr,returnValue);
371 break;
372 }
373 return;
374 }
375
376 /*===================================================*/
377 /* Otherwise if the symbol evaluated to a non-FALSE */
378 /* value, evaluate the "then" portion and return it. */
379 /*===================================================*/
380
381 else if ((returnValue->value != EnvFalseSymbol(theEnv)) ||
382 (returnValue->type != SYMBOL))
383 {
384 theExpr = EvaluationData(theEnv)->CurrentExpression->argList->nextArg;
385 switch (theExpr->type)
386 {
387 case INTEGER:
388 case FLOAT:
389 case SYMBOL:
390 case STRING:
391 #if OBJECT_SYSTEM
392 case INSTANCE_NAME:
393 case INSTANCE_ADDRESS:
394 #endif
395 case EXTERNAL_ADDRESS:
396 returnValue->type = theExpr->type;
397 returnValue->value = theExpr->value;
398 break;
399
400 default:
401 EvaluateExpression(theEnv,theExpr,returnValue);
402 break;
403 }
404 return;
405 }
406
407 /*=========================================*/
408 /* Return FALSE if the condition evaluated */
409 /* to FALSE and there is no "else" portion */
410 /* of the if statement. */
411 /*=========================================*/
412
413 returnValue->type = SYMBOL;
414 returnValue->value = EnvFalseSymbol(theEnv);
415 return;
416 }
417
418 /**************************************/
419 /* BindFunction: H/L access routine */
420 /* for the bind function. */
421 /**************************************/
BindFunction(void * theEnv,DATA_OBJECT_PTR returnValue)422 globle void BindFunction(
423 void *theEnv,
424 DATA_OBJECT_PTR returnValue)
425 {
426 DATA_OBJECT *theBind, *lastBind;
427 int found = FALSE,
428 unbindVar = FALSE;
429 SYMBOL_HN *variableName = NULL;
430 #if DEFGLOBAL_CONSTRUCT
431 struct defglobal *theGlobal = NULL;
432 #endif
433
434 /*===============================================*/
435 /* Determine the name of the variable to be set. */
436 /*===============================================*/
437
438 #if DEFGLOBAL_CONSTRUCT
439 if (GetFirstArgument()->type == DEFGLOBAL_PTR)
440 { theGlobal = (struct defglobal *) GetFirstArgument()->value; }
441 else
442 #endif
443 {
444 EvaluateExpression(theEnv,GetFirstArgument(),returnValue);
445 variableName = (SYMBOL_HN *) DOPToPointer(returnValue);
446 }
447
448 /*===========================================*/
449 /* Determine the new value for the variable. */
450 /*===========================================*/
451
452 if (GetFirstArgument()->nextArg == NULL)
453 { unbindVar = TRUE; }
454 else if (GetFirstArgument()->nextArg->nextArg == NULL)
455 { EvaluateExpression(theEnv,GetFirstArgument()->nextArg,returnValue); }
456 else
457 { StoreInMultifield(theEnv,returnValue,GetFirstArgument()->nextArg,TRUE); }
458
459 /*==================================*/
460 /* Bind a defglobal if appropriate. */
461 /*==================================*/
462
463 #if DEFGLOBAL_CONSTRUCT
464 if (theGlobal != NULL)
465 {
466 QSetDefglobalValue(theEnv,theGlobal,returnValue,unbindVar);
467 return;
468 }
469 #endif
470
471 /*===============================================*/
472 /* Search for the variable in the list of binds. */
473 /*===============================================*/
474
475 theBind = ProcedureFunctionData(theEnv)->BindList;
476 lastBind = NULL;
477
478 while ((theBind != NULL) && (found == FALSE))
479 {
480 if (theBind->supplementalInfo == (void *) variableName)
481 { found = TRUE; }
482 else
483 {
484 lastBind = theBind;
485 theBind = theBind->next;
486 }
487 }
488
489 /*========================================================*/
490 /* If variable was not in the list of binds, then add it. */
491 /* Make sure that this operation preserves the bind list */
492 /* as a stack. */
493 /*========================================================*/
494
495 if (found == FALSE)
496 {
497 if (unbindVar == FALSE)
498 {
499 theBind = get_struct(theEnv,dataObject);
500 theBind->supplementalInfo = (void *) variableName;
501 IncrementSymbolCount(variableName);
502 theBind->next = NULL;
503 if (lastBind == NULL)
504 { ProcedureFunctionData(theEnv)->BindList = theBind; }
505 else
506 { lastBind->next = theBind; }
507 }
508 else
509 {
510 returnValue->type = SYMBOL;
511 returnValue->value = EnvFalseSymbol(theEnv);
512 return;
513 }
514 }
515 else
516 { ValueDeinstall(theEnv,theBind); }
517
518 /*================================*/
519 /* Set the value of the variable. */
520 /*================================*/
521
522 if (unbindVar == FALSE)
523 {
524 theBind->type = returnValue->type;
525 theBind->value = returnValue->value;
526 theBind->begin = returnValue->begin;
527 theBind->end = returnValue->end;
528 ValueInstall(theEnv,returnValue);
529 }
530 else
531 {
532 if (lastBind == NULL) ProcedureFunctionData(theEnv)->BindList = theBind->next;
533 else lastBind->next = theBind->next;
534 DecrementSymbolCount(theEnv,(struct symbolHashNode *) theBind->supplementalInfo);
535 rtn_struct(theEnv,dataObject,theBind);
536 returnValue->type = SYMBOL;
537 returnValue->value = EnvFalseSymbol(theEnv);
538 }
539 }
540
541 /*******************************************/
542 /* GetBoundVariable: Searches the BindList */
543 /* for a specified variable. */
544 /*******************************************/
GetBoundVariable(void * theEnv,DATA_OBJECT_PTR vPtr,SYMBOL_HN * varName)545 globle intBool GetBoundVariable(
546 void *theEnv,
547 DATA_OBJECT_PTR vPtr,
548 SYMBOL_HN *varName)
549 {
550 DATA_OBJECT_PTR bindPtr;
551
552 for (bindPtr = ProcedureFunctionData(theEnv)->BindList; bindPtr != NULL; bindPtr = bindPtr->next)
553 {
554 if (bindPtr->supplementalInfo == (void *) varName)
555 {
556 vPtr->type = bindPtr->type;
557 vPtr->value = bindPtr->value;
558 vPtr->begin = bindPtr->begin;
559 vPtr->end = bindPtr->end;
560 return(TRUE);
561 }
562 }
563
564 return(FALSE);
565 }
566
567 /*************************************************/
568 /* FlushBindList: Removes all variables from the */
569 /* list of currently bound local variables. */
570 /*************************************************/
FlushBindList(void * theEnv)571 globle void FlushBindList(
572 void *theEnv)
573 {
574 ReturnValues(theEnv,ProcedureFunctionData(theEnv)->BindList,TRUE);
575 ProcedureFunctionData(theEnv)->BindList = NULL;
576 }
577
578 /***************************************/
579 /* PrognFunction: H/L access routine */
580 /* for the progn function. */
581 /***************************************/
PrognFunction(void * theEnv,DATA_OBJECT_PTR returnValue)582 globle void PrognFunction(
583 void *theEnv,
584 DATA_OBJECT_PTR returnValue)
585 {
586 struct expr *argPtr;
587
588 argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
589
590 if (argPtr == NULL)
591 {
592 returnValue->type = SYMBOL;
593 returnValue->value = EnvFalseSymbol(theEnv);
594 return;
595 }
596
597 while ((argPtr != NULL) && (GetHaltExecution(theEnv) != TRUE))
598 {
599 EvaluateExpression(theEnv,argPtr,returnValue);
600
601 if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
602 break;
603 argPtr = argPtr->nextArg;
604 }
605
606 if (GetHaltExecution(theEnv) == TRUE)
607 {
608 returnValue->type = SYMBOL;
609 returnValue->value = EnvFalseSymbol(theEnv);
610 return;
611 }
612
613 return;
614 }
615
616 /*****************************************************************/
617 /* ReturnFunction: H/L access routine for the return function. */
618 /*****************************************************************/
ReturnFunction(void * theEnv,DATA_OBJECT_PTR result)619 globle void ReturnFunction(
620 void *theEnv,
621 DATA_OBJECT_PTR result)
622 {
623 if (EnvRtnArgCount(theEnv) == 0)
624 {
625 result->type = RVOID;
626 result->value = EnvFalseSymbol(theEnv);
627 }
628 else
629 EnvRtnUnknown(theEnv,1,result);
630 ProcedureFunctionData(theEnv)->ReturnFlag = TRUE;
631 }
632
633 /***************************************************************/
634 /* BreakFunction: H/L access routine for the break function. */
635 /***************************************************************/
BreakFunction(void * theEnv)636 globle void BreakFunction(
637 void *theEnv)
638 {
639 ProcedureFunctionData(theEnv)->BreakFlag = TRUE;
640 }
641
642 /*****************************************************************/
643 /* SwitchFunction: H/L access routine for the switch function. */
644 /*****************************************************************/
SwitchFunction(void * theEnv,DATA_OBJECT_PTR result)645 globle void SwitchFunction(
646 void *theEnv,
647 DATA_OBJECT_PTR result)
648 {
649 DATA_OBJECT switch_val,case_val;
650 EXPRESSION *theExp;
651
652 result->type = SYMBOL;
653 result->value = EnvFalseSymbol(theEnv);
654
655 /* ==========================
656 Get the value to switch on
657 ========================== */
658 EvaluateExpression(theEnv,GetFirstArgument(),&switch_val);
659 if (EvaluationData(theEnv)->EvaluationError)
660 return;
661 for (theExp = GetFirstArgument()->nextArg ; theExp != NULL ; theExp = theExp->nextArg->nextArg)
662 {
663 /* =================================================
664 RVOID is the default case (if any) for the switch
665 ================================================= */
666 if (theExp->type == RVOID)
667 {
668 EvaluateExpression(theEnv,theExp->nextArg,result);
669 return;
670 }
671
672 /* ====================================================
673 If the case matches, evaluate the actions and return
674 ==================================================== */
675 EvaluateExpression(theEnv,theExp,&case_val);
676 if (EvaluationData(theEnv)->EvaluationError)
677 return;
678 if (switch_val.type == case_val.type)
679 {
680 if ((case_val.type == MULTIFIELD) ? MultifieldDOsEqual(&switch_val,&case_val) :
681 (switch_val.value == case_val.value))
682 {
683 EvaluateExpression(theEnv,theExp->nextArg,result);
684 return;
685 }
686 }
687 }
688 }
689
690
691
692
693
694