1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 08/16/14 */
5 /* */
6 /* INSTANCE MODIFY AND DUPLICATE MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Instance modify and duplicate support routines */
11 /* */
12 /* Principal Programmer(s): */
13 /* Brian L. Dantes */
14 /* */
15 /* Contributing Programmer(s): */
16 /* */
17 /* */
18 /* Revision History: */
19 /* */
20 /* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */
21 /* */
22 /* Changed name of variable exp to theExp */
23 /* because of Unix compiler warnings of shadowed */
24 /* definitions. */
25 /* */
26 /* 6.24: Converted INSTANCE_PATTERN_MATCHING to */
27 /* DEFRULE_CONSTRUCT. */
28 /* */
29 /* 6.30: Added DATA_OBJECT_ARRAY primitive type. */
30 /* */
31 /* Changed integer type/precision. */
32 /* */
33 /* The return value of DirectMessage indicates */
34 /* whether an execution error has occurred. */
35 /* */
36 /*************************************************************/
37
38 /* =========================================
39 *****************************************
40 EXTERNAL DEFINITIONS
41 =========================================
42 ***************************************** */
43 #include "setup.h"
44
45 #if OBJECT_SYSTEM
46
47 #if DEFRULE_CONSTRUCT
48 #include "network.h"
49 #include "objrtmch.h"
50 #endif
51
52 #include "argacces.h"
53 #include "memalloc.h"
54 #include "envrnmnt.h"
55 #include "extnfunc.h"
56 #include "inscom.h"
57 #include "insfun.h"
58 #include "insmngr.h"
59 #include "inspsr.h"
60 #include "miscfun.h"
61 #include "msgcom.h"
62 #include "msgfun.h"
63 #include "msgpass.h"
64 #include "prccode.h"
65 #include "router.h"
66
67 #define _INSMODDP_SOURCE_
68 #include "insmoddp.h"
69
70 /* =========================================
71 *****************************************
72 INTERNALLY VISIBLE FUNCTION HEADERS
73 =========================================
74 ***************************************** */
75
76 static DATA_OBJECT *EvaluateSlotOverrides(void *,EXPRESSION *,int *,int *);
77 static void DeleteSlotOverrideEvaluations(void *,DATA_OBJECT *,int);
78 static void ModifyMsgHandlerSupport(void *,DATA_OBJECT *,int);
79 static void DuplicateMsgHandlerSupport(void *,DATA_OBJECT *,int);
80
81 /* =========================================
82 *****************************************
83 EXTERNALLY VISIBLE FUNCTIONS
84 =========================================
85 ***************************************** */
86
87 #if (! RUN_TIME)
88
89 /***************************************************
90 NAME : SetupInstanceModDupCommands
91 DESCRIPTION : Defines function interfaces for
92 modify- and duplicate- instance
93 functions
94 INPUTS : None
95 RETURNS : Nothing useful
96 SIDE EFFECTS : Functions defined to KB
97 NOTES : None
98 ***************************************************/
SetupInstanceModDupCommands(void * theEnv)99 globle void SetupInstanceModDupCommands(
100 void *theEnv)
101 {
102 #if DEFRULE_CONSTRUCT
103 EnvDefineFunction2(theEnv,"modify-instance",'u',PTIEF InactiveModifyInstance,"InactiveModifyInstance",NULL);
104 EnvDefineFunction2(theEnv,"active-modify-instance",'u',PTIEF ModifyInstance,"ModifyInstance",NULL);
105 AddFunctionParser(theEnv,"active-modify-instance",ParseInitializeInstance);
106 EnvDefineFunction2(theEnv,"message-modify-instance",'u',PTIEF InactiveMsgModifyInstance,
107 "InactiveMsgModifyInstance",NULL);
108 EnvDefineFunction2(theEnv,"active-message-modify-instance",'u',PTIEF MsgModifyInstance,
109 "MsgModifyInstance",NULL);
110 AddFunctionParser(theEnv,"active-message-modify-instance",ParseInitializeInstance);
111
112 EnvDefineFunction2(theEnv,"duplicate-instance",'u',
113 PTIEF InactiveDuplicateInstance,"InactiveDuplicateInstance",NULL);
114 EnvDefineFunction2(theEnv,"active-duplicate-instance",'u',PTIEF DuplicateInstance,"DuplicateInstance",NULL);
115 AddFunctionParser(theEnv,"active-duplicate-instance",ParseInitializeInstance);
116 EnvDefineFunction2(theEnv,"message-duplicate-instance",'u',PTIEF InactiveMsgDuplicateInstance,
117 "InactiveMsgDuplicateInstance",NULL);
118 EnvDefineFunction2(theEnv,"active-message-duplicate-instance",'u',PTIEF MsgDuplicateInstance,
119 "MsgDuplicateInstance",NULL);
120 AddFunctionParser(theEnv,"active-message-duplicate-instance",ParseInitializeInstance);
121 #else
122 EnvDefineFunction2(theEnv,"modify-instance",'u',PTIEF ModifyInstance,"ModifyInstance",NULL);
123 EnvDefineFunction2(theEnv,"message-modify-instance",'u',PTIEF MsgModifyInstance,
124 "MsgModifyInstance",NULL);
125 EnvDefineFunction2(theEnv,"duplicate-instance",'u',PTIEF DuplicateInstance,"DuplicateInstance",NULL);
126 EnvDefineFunction2(theEnv,"message-duplicate-instance",'u',PTIEF MsgDuplicateInstance,
127 "MsgDuplicateInstance",NULL);
128 #endif
129
130 EnvDefineFunction2(theEnv,"(direct-modify)",'u',PTIEF DirectModifyMsgHandler,"DirectModifyMsgHandler",NULL);
131 EnvDefineFunction2(theEnv,"(message-modify)",'u',PTIEF MsgModifyMsgHandler,"MsgModifyMsgHandler",NULL);
132 EnvDefineFunction2(theEnv,"(direct-duplicate)",'u',PTIEF DirectDuplicateMsgHandler,"DirectDuplicateMsgHandler",NULL);
133 EnvDefineFunction2(theEnv,"(message-duplicate)",'u',PTIEF MsgDuplicateMsgHandler,"MsgDuplicateMsgHandler",NULL);
134
135 AddFunctionParser(theEnv,"modify-instance",ParseInitializeInstance);
136 AddFunctionParser(theEnv,"message-modify-instance",ParseInitializeInstance);
137 AddFunctionParser(theEnv,"duplicate-instance",ParseInitializeInstance);
138 AddFunctionParser(theEnv,"message-duplicate-instance",ParseInitializeInstance);
139 }
140
141 #endif
142
143 /*************************************************************
144 NAME : ModifyInstance
145 DESCRIPTION : Modifies slots of an instance via the
146 direct-modify message
147 INPUTS : The address of the result value
148 RETURNS : Nothing useful
149 SIDE EFFECTS : Slot updates performed directly
150 NOTES : H/L Syntax:
151 (modify-instance <instance> <slot-override>*)
152 *************************************************************/
ModifyInstance(void * theEnv,DATA_OBJECT * result)153 globle void ModifyInstance(
154 void *theEnv,
155 DATA_OBJECT *result)
156 {
157 INSTANCE_TYPE *ins;
158 EXPRESSION theExp;
159 DATA_OBJECT *overrides;
160 int oldOMDMV,overrideCount,error;
161
162 /* ===========================================
163 The slot-overrides need to be evaluated now
164 to resolve any variable references before a
165 new frame is pushed for message-handler
166 execution
167 =========================================== */
168
169 overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg,
170 &overrideCount,&error);
171 if (error)
172 {
173 SetpType(result,SYMBOL);
174 SetpValue(result,EnvFalseSymbol(theEnv));
175 return;
176 }
177
178 /* ==================================
179 Find the instance and make sure it
180 wasn't deleted by the overrides
181 ================================== */
182 ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)));
183 if (ins == NULL)
184 {
185 SetpType(result,SYMBOL);
186 SetpValue(result,EnvFalseSymbol(theEnv));
187 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
188 return;
189 }
190
191 /* ======================================
192 We are passing the slot override
193 expression information along
194 to whatever message-handler implements
195 the modify
196 ====================================== */
197 theExp.type = DATA_OBJECT_ARRAY;
198 theExp.value = (void *) overrides;
199 theExp.argList = NULL;
200 theExp.nextArg = NULL;
201
202 oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid;
203 InstanceData(theEnv)->ObjectModDupMsgValid = TRUE;
204 DirectMessage(theEnv,FindSymbolHN(theEnv,DIRECT_MODIFY_STRING),ins,result,&theExp);
205 InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV;
206
207 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
208 }
209
210 /*************************************************************
211 NAME : MsgModifyInstance
212 DESCRIPTION : Modifies slots of an instance via the
213 direct-modify message
214 INPUTS : The address of the result value
215 RETURNS : Nothing useful
216 SIDE EFFECTS : Slot updates performed with put- messages
217 NOTES : H/L Syntax:
218 (message-modify-instance <instance>
219 <slot-override>*)
220 *************************************************************/
MsgModifyInstance(void * theEnv,DATA_OBJECT * result)221 globle void MsgModifyInstance(
222 void *theEnv,
223 DATA_OBJECT *result)
224 {
225 INSTANCE_TYPE *ins;
226 EXPRESSION theExp;
227 DATA_OBJECT *overrides;
228 int oldOMDMV,overrideCount,error;
229
230 /* ===========================================
231 The slot-overrides need to be evaluated now
232 to resolve any variable references before a
233 new frame is pushed for message-handler
234 execution
235 =========================================== */
236 overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg,
237 &overrideCount,&error);
238 if (error)
239 {
240 SetpType(result,SYMBOL);
241 SetpValue(result,EnvFalseSymbol(theEnv));
242 return;
243 }
244
245 /* ==================================
246 Find the instance and make sure it
247 wasn't deleted by the overrides
248 ================================== */
249 ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)));
250 if (ins == NULL)
251 {
252 SetpType(result,SYMBOL);
253 SetpValue(result,EnvFalseSymbol(theEnv));
254 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
255 return;
256 }
257
258 /* ======================================
259 We are passing the slot override
260 expression information along
261 to whatever message-handler implements
262 the modify
263 ====================================== */
264 theExp.type = DATA_OBJECT_ARRAY;
265 theExp.value = (void *) overrides;
266 theExp.argList = NULL;
267 theExp.nextArg = NULL;
268
269 oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid;
270 InstanceData(theEnv)->ObjectModDupMsgValid = TRUE;
271 DirectMessage(theEnv,FindSymbolHN(theEnv,MSG_MODIFY_STRING),ins,result,&theExp);
272 InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV;
273
274 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
275 }
276
277 /*************************************************************
278 NAME : DuplicateInstance
279 DESCRIPTION : Duplicates an instance via the
280 direct-duplicate message
281 INPUTS : The address of the result value
282 RETURNS : Nothing useful
283 SIDE EFFECTS : Slot updates performed directly
284 NOTES : H/L Syntax:
285 (duplicate-instance <instance>
286 [to <instance-name>] <slot-override>*)
287 *************************************************************/
DuplicateInstance(void * theEnv,DATA_OBJECT * result)288 globle void DuplicateInstance(
289 void *theEnv,
290 DATA_OBJECT *result)
291 {
292 INSTANCE_TYPE *ins;
293 DATA_OBJECT newName;
294 EXPRESSION theExp[2];
295 DATA_OBJECT *overrides;
296 int oldOMDMV,overrideCount,error;
297
298 /* ===========================================
299 The slot-overrides need to be evaluated now
300 to resolve any variable references before a
301 new frame is pushed for message-handler
302 execution
303 =========================================== */
304 overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg->nextArg,
305 &overrideCount,&error);
306 if (error)
307 {
308 SetpType(result,SYMBOL);
309 SetpValue(result,EnvFalseSymbol(theEnv));
310 return;
311 }
312
313 /* ==================================
314 Find the instance and make sure it
315 wasn't deleted by the overrides
316 ================================== */
317 ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)));
318 if (ins == NULL)
319 {
320 SetpType(result,SYMBOL);
321 SetpValue(result,EnvFalseSymbol(theEnv));
322 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
323 return;
324 }
325 if (EnvArgTypeCheck(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
326 2,INSTANCE_NAME,&newName) == FALSE)
327 {
328 SetpType(result,SYMBOL);
329 SetpValue(result,EnvFalseSymbol(theEnv));
330 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
331 return;
332 }
333
334 /* ======================================
335 We are passing the slot override
336 expression information along
337 to whatever message-handler implements
338 the duplicate
339 ====================================== */
340 theExp[0].type = INSTANCE_NAME;
341 theExp[0].value = newName.value;
342 theExp[0].argList = NULL;
343 theExp[0].nextArg = &theExp[1];
344 theExp[1].type = DATA_OBJECT_ARRAY;
345 theExp[1].value = (void *) overrides;
346 theExp[1].argList = NULL;
347 theExp[1].nextArg = NULL;
348
349 oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid;
350 InstanceData(theEnv)->ObjectModDupMsgValid = TRUE;
351 DirectMessage(theEnv,FindSymbolHN(theEnv,DIRECT_DUPLICATE_STRING),ins,result,&theExp[0]);
352 InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV;
353
354 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
355 }
356
357 /*************************************************************
358 NAME : MsgDuplicateInstance
359 DESCRIPTION : Duplicates an instance via the
360 message-duplicate message
361 INPUTS : The address of the result value
362 RETURNS : Nothing useful
363 SIDE EFFECTS : Slot updates performed w/ int & put- messages
364 NOTES : H/L Syntax:
365 (duplicate-instance <instance>
366 [to <instance-name>] <slot-override>*)
367 *************************************************************/
MsgDuplicateInstance(void * theEnv,DATA_OBJECT * result)368 globle void MsgDuplicateInstance(
369 void *theEnv,
370 DATA_OBJECT *result)
371 {
372 INSTANCE_TYPE *ins;
373 DATA_OBJECT newName;
374 EXPRESSION theExp[2];
375 DATA_OBJECT *overrides;
376 int oldOMDMV,overrideCount,error;
377
378 /* ===========================================
379 The slot-overrides need to be evaluated now
380 to resolve any variable references before a
381 new frame is pushed for message-handler
382 execution
383 =========================================== */
384 overrides = EvaluateSlotOverrides(theEnv,GetFirstArgument()->nextArg->nextArg,
385 &overrideCount,&error);
386 if (error)
387 {
388 SetpType(result,SYMBOL);
389 SetpValue(result,EnvFalseSymbol(theEnv));
390 return;
391 }
392
393 /* ==================================
394 Find the instance and make sure it
395 wasn't deleted by the overrides
396 ================================== */
397 ins = CheckInstance(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)));
398 if (ins == NULL)
399 {
400 SetpType(result,SYMBOL);
401 SetpValue(result,EnvFalseSymbol(theEnv));
402 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
403 return;
404 }
405 if (EnvArgTypeCheck(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
406 2,INSTANCE_NAME,&newName) == FALSE)
407 {
408 SetpType(result,SYMBOL);
409 SetpValue(result,EnvFalseSymbol(theEnv));
410 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
411 return;
412 }
413
414 /* ======================================
415 We are passing the slot override
416 expression information along
417 to whatever message-handler implements
418 the duplicate
419 ====================================== */
420 theExp[0].type = INSTANCE_NAME;
421 theExp[0].value = newName.value;
422 theExp[0].argList = NULL;
423 theExp[0].nextArg = &theExp[1];
424 theExp[1].type = DATA_OBJECT_ARRAY;
425 theExp[1].value = (void *) overrides;
426 theExp[1].argList = NULL;
427 theExp[1].nextArg = NULL;
428
429 oldOMDMV = InstanceData(theEnv)->ObjectModDupMsgValid;
430 InstanceData(theEnv)->ObjectModDupMsgValid = TRUE;
431 DirectMessage(theEnv,FindSymbolHN(theEnv,MSG_DUPLICATE_STRING),ins,result,&theExp[0]);
432 InstanceData(theEnv)->ObjectModDupMsgValid = oldOMDMV;
433
434 DeleteSlotOverrideEvaluations(theEnv,overrides,overrideCount);
435 }
436
437 #if DEFRULE_CONSTRUCT
438
439 /**************************************************************
440 NAME : InactiveModifyInstance
441 DESCRIPTION : Modifies slots of an instance of a class
442 Pattern-matching is automatically
443 delayed until the slot updates are done
444 INPUTS : The address of the result value
445 RETURNS : Nothing useful
446 SIDE EFFECTS : Slot updates performed directly
447 NOTES : H/L Syntax:
448 (modify-instance <instance-name>
449 <slot-override>*)
450 **************************************************************/
InactiveModifyInstance(void * theEnv,DATA_OBJECT * result)451 globle void InactiveModifyInstance(
452 void *theEnv,
453 DATA_OBJECT *result)
454 {
455 int ov;
456
457 ov = SetDelayObjectPatternMatching(theEnv,TRUE);
458 ModifyInstance(theEnv,result);
459 SetDelayObjectPatternMatching(theEnv,ov);
460 }
461
462 /**************************************************************
463 NAME : InactiveMsgModifyInstance
464 DESCRIPTION : Modifies slots of an instance of a class
465 Pattern-matching is automatically
466 delayed until the slot updates are done
467 INPUTS : The address of the result value
468 RETURNS : Nothing useful
469 SIDE EFFECTS : Slot updates performed with put- messages
470 NOTES : H/L Syntax:
471 (message-modify-instance <instance-name>
472 <slot-override>*)
473 **************************************************************/
InactiveMsgModifyInstance(void * theEnv,DATA_OBJECT * result)474 globle void InactiveMsgModifyInstance(
475 void *theEnv,
476 DATA_OBJECT *result)
477 {
478 int ov;
479
480 ov = SetDelayObjectPatternMatching(theEnv,TRUE);
481 MsgModifyInstance(theEnv,result);
482 SetDelayObjectPatternMatching(theEnv,ov);
483 }
484
485 /*******************************************************************
486 NAME : InactiveDuplicateInstance
487 DESCRIPTION : Duplicates an instance of a class
488 Pattern-matching is automatically
489 delayed until the slot updates are done
490 INPUTS : The address of the result value
491 RETURNS : Nothing useful
492 SIDE EFFECTS : Slot updates performed directly
493 NOTES : H/L Syntax:
494 (duplicate-instance <instance> [to <instance-name>]
495 <slot-override>*)
496 *******************************************************************/
InactiveDuplicateInstance(void * theEnv,DATA_OBJECT * result)497 globle void InactiveDuplicateInstance(
498 void *theEnv,
499 DATA_OBJECT *result)
500 {
501 int ov;
502
503 ov = SetDelayObjectPatternMatching(theEnv,TRUE);
504 DuplicateInstance(theEnv,result);
505 SetDelayObjectPatternMatching(theEnv,ov);
506 }
507
508 /**************************************************************
509 NAME : InactiveMsgDuplicateInstance
510 DESCRIPTION : Duplicates an instance of a class
511 Pattern-matching is automatically
512 delayed until the slot updates are done
513 INPUTS : The address of the result value
514 RETURNS : Nothing useful
515 SIDE EFFECTS : Slot updates performed with put- messages
516 NOTES : H/L Syntax:
517 (message-duplicate-instance <instance>
518 [to <instance-name>]
519 <slot-override>*)
520 **************************************************************/
InactiveMsgDuplicateInstance(void * theEnv,DATA_OBJECT * result)521 globle void InactiveMsgDuplicateInstance(
522 void *theEnv,
523 DATA_OBJECT *result)
524 {
525 int ov;
526
527 ov = SetDelayObjectPatternMatching(theEnv,TRUE);
528 MsgDuplicateInstance(theEnv,result);
529 SetDelayObjectPatternMatching(theEnv,ov);
530 }
531
532 #endif
533
534 /*****************************************************
535 NAME : DirectDuplicateMsgHandler
536 DESCRIPTION : Implementation for the USER class
537 handler direct-duplicate
538
539 Implements duplicate-instance message
540 with a series of direct slot
541 placements
542 INPUTS : A data object buffer to hold the
543 result
544 RETURNS : Nothing useful
545 SIDE EFFECTS : Slot values updated
546 NOTES : None
547 *****************************************************/
DirectDuplicateMsgHandler(void * theEnv,DATA_OBJECT * result)548 globle void DirectDuplicateMsgHandler(
549 void *theEnv,
550 DATA_OBJECT *result)
551 {
552 DuplicateMsgHandlerSupport(theEnv,result,FALSE);
553 }
554
555 /*****************************************************
556 NAME : MsgDuplicateMsgHandler
557 DESCRIPTION : Implementation for the USER class
558 handler message-duplicate
559
560 Implements duplicate-instance message
561 with a series of put- messages
562 INPUTS : A data object buffer to hold the
563 result
564 RETURNS : Nothing useful
565 SIDE EFFECTS : Slot values updated
566 NOTES : None
567 *****************************************************/
MsgDuplicateMsgHandler(void * theEnv,DATA_OBJECT * result)568 globle void MsgDuplicateMsgHandler(
569 void *theEnv,
570 DATA_OBJECT *result)
571 {
572 DuplicateMsgHandlerSupport(theEnv,result,TRUE);
573 }
574
575 /***************************************************
576 NAME : DirectModifyMsgHandler
577 DESCRIPTION : Implementation for the USER class
578 handler direct-modify
579
580 Implements modify-instance message
581 with a series of direct slot
582 placements
583 INPUTS : A data object buffer to hold the
584 result
585 RETURNS : Nothing useful
586 SIDE EFFECTS : Slot values updated
587 NOTES : None
588 ***************************************************/
DirectModifyMsgHandler(void * theEnv,DATA_OBJECT * result)589 globle void DirectModifyMsgHandler(
590 void *theEnv,
591 DATA_OBJECT *result)
592 {
593 ModifyMsgHandlerSupport(theEnv,result,FALSE);
594 }
595
596 /***************************************************
597 NAME : MsgModifyMsgHandler
598 DESCRIPTION : Implementation for the USER class
599 handler message-modify
600
601 Implements modify-instance message
602 with a series of put- messages
603 INPUTS : A data object buffer to hold the
604 result
605 RETURNS : Nothing useful
606 SIDE EFFECTS : Slot values updated
607 NOTES : None
608 ***************************************************/
MsgModifyMsgHandler(void * theEnv,DATA_OBJECT * result)609 globle void MsgModifyMsgHandler(
610 void *theEnv,
611 DATA_OBJECT *result)
612 {
613 ModifyMsgHandlerSupport(theEnv,result,TRUE);
614 }
615
616 /* =========================================
617 *****************************************
618 INTERNALLY VISIBLE FUNCTIONS
619 =========================================
620 ***************************************** */
621
622 /***********************************************************
623 NAME : EvaluateSlotOverrides
624 DESCRIPTION : Evaluates the slot-override expressions
625 for modify-instance and duplicate-instance
626 Evaluations are stored in an array of
627 data objects, where the supplementalInfo
628 field points at the name of the slot
629 The data object next fields are used
630 to link the array as well.
631 INPUTS : 1) The slot override expressions
632 2) A buffer to hold the number
633 of slot overrides
634 3) A buffer to hold an error flag
635 RETURNS : The slot override data object array
636 SIDE EFFECTS : Data object array allocated and initialized
637 override count and error buffers set
638 NOTES : Slot overrides must be evaluated before
639 calling supporting message-handlers for
640 modify- and duplicate-instance in the
641 event that the overrides contain variable
642 references to an outer frame
643 ***********************************************************/
EvaluateSlotOverrides(void * theEnv,EXPRESSION * ovExprs,int * ovCnt,int * error)644 static DATA_OBJECT *EvaluateSlotOverrides(
645 void *theEnv,
646 EXPRESSION *ovExprs,
647 int *ovCnt,
648 int *error)
649 {
650 DATA_OBJECT *ovs;
651 int ovi;
652 void *slotName;
653
654 *error = FALSE;
655
656 /* ==========================================
657 There are two expressions chains for every
658 slot override: one for the slot name and
659 one for the slot value
660 ========================================== */
661 *ovCnt = CountArguments(ovExprs) / 2;
662 if (*ovCnt == 0)
663 return(NULL);
664
665 /* ===============================================
666 Evaluate all the slot override names and values
667 and store them in a contiguous array
668 =============================================== */
669 ovs = (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * (*ovCnt)));
670 ovi = 0;
671 while (ovExprs != NULL)
672 {
673 if (EvaluateExpression(theEnv,ovExprs,&ovs[ovi]))
674 goto EvaluateOverridesError;
675 if (ovs[ovi].type != SYMBOL)
676 {
677 ExpectedTypeError1(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
678 ovi+1,"slot name");
679 SetEvaluationError(theEnv,TRUE);
680 goto EvaluateOverridesError;
681 }
682 slotName = ovs[ovi].value;
683 if (ovExprs->nextArg->argList)
684 {
685 if (EvaluateAndStoreInDataObject(theEnv,FALSE,ovExprs->nextArg->argList,
686 &ovs[ovi],TRUE) == FALSE)
687 goto EvaluateOverridesError;
688 }
689 else
690 {
691 SetpDOBegin(&ovs[ovi],1);
692 SetpDOEnd(&ovs[ovi],0);
693 SetpType(&ovs[ovi],MULTIFIELD);
694 SetpValue(&ovs[ovi],ProceduralPrimitiveData(theEnv)->NoParamValue);
695 }
696 ovs[ovi].supplementalInfo = slotName;
697 ovExprs = ovExprs->nextArg->nextArg;
698 ovs[ovi].next = (ovExprs != NULL) ? &ovs[ovi+1] : NULL;
699 ovi++;
700 }
701 return(ovs);
702
703 EvaluateOverridesError:
704 rm(theEnv,(void *) ovs,(sizeof(DATA_OBJECT) * (*ovCnt)));
705 *error = TRUE;
706 return(NULL);
707 }
708
709 /**********************************************************
710 NAME : DeleteSlotOverrideEvaluations
711 DESCRIPTION : Deallocates slot override evaluation array
712 INPUTS : 1) The data object array
713 2) The number of elements
714 RETURNS : Nothing useful
715 SIDE EFFECTS : Deallocates slot override data object
716 array for modify- and duplicate- instance
717 NOTES : None
718 **********************************************************/
DeleteSlotOverrideEvaluations(void * theEnv,DATA_OBJECT * ovEvals,int ovCnt)719 static void DeleteSlotOverrideEvaluations(
720 void *theEnv,
721 DATA_OBJECT *ovEvals,
722 int ovCnt)
723 {
724 if (ovEvals != NULL)
725 rm(theEnv,(void *) ovEvals,(sizeof(DATA_OBJECT) * ovCnt));
726 }
727
728 /**********************************************************
729 NAME : ModifyMsgHandlerSupport
730 DESCRIPTION : Support routine for DirectModifyMsgHandler
731 and MsgModifyMsgHandler
732
733 Performs a series of slot updates
734 directly or with messages
735 INPUTS : 1) A data object buffer to hold the result
736 2) A flag indicating whether to use
737 put- messages or direct placement
738 RETURNS : Nothing useful
739 SIDE EFFECTS : Slots updated (messages sent)
740 NOTES : None
741 **********************************************************/
ModifyMsgHandlerSupport(void * theEnv,DATA_OBJECT * result,int msgpass)742 static void ModifyMsgHandlerSupport(
743 void *theEnv,
744 DATA_OBJECT *result,
745 int msgpass)
746 {
747 DATA_OBJECT *slotOverrides,*newval,temp,junk;
748 EXPRESSION msgExp;
749 INSTANCE_TYPE *ins;
750 INSTANCE_SLOT *insSlot;
751
752 result->type = SYMBOL;
753 result->value = EnvFalseSymbol(theEnv);
754 if (InstanceData(theEnv)->ObjectModDupMsgValid == FALSE)
755 {
756 PrintErrorID(theEnv,"INSMODDP",1,FALSE);
757 EnvPrintRouter(theEnv,WERROR,"Direct/message-modify message valid only in modify-instance.\n");
758 SetEvaluationError(theEnv,TRUE);
759 return;
760 }
761 InstanceData(theEnv)->ObjectModDupMsgValid = FALSE;
762
763 ins = GetActiveInstance(theEnv);
764 if (ins->garbage)
765 {
766 StaleInstanceAddress(theEnv,"modify-instance",0);
767 SetEvaluationError(theEnv,TRUE);
768 return;
769 }
770
771 /* =======================================
772 Retrieve the slot override data objects
773 passed from ModifyInstance - the slot
774 name is stored in the supplementalInfo
775 field - and the next fields are links
776 ======================================= */
777 slotOverrides = (DATA_OBJECT *) GetNthMessageArgument(theEnv,1)->value;
778
779 while (slotOverrides != NULL)
780 {
781 /* ===========================================================
782 No evaluation or error checking needs to be done
783 since this has already been done by EvaluateSlotOverrides()
784 =========================================================== */
785 insSlot = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) slotOverrides->supplementalInfo);
786 if (insSlot == NULL)
787 {
788 SlotExistError(theEnv,ValueToString(slotOverrides->supplementalInfo),"modify-instance");
789 SetEvaluationError(theEnv,TRUE);
790 return;
791 }
792 if (msgpass)
793 {
794 msgExp.type = slotOverrides->type;
795 if (msgExp.type != MULTIFIELD)
796 msgExp.value = slotOverrides->value;
797 else
798 msgExp.value = (void *) slotOverrides;
799 msgExp.argList = NULL;
800 msgExp.nextArg = NULL;
801 if (! DirectMessage(theEnv,insSlot->desc->overrideMessage,ins,&temp,&msgExp))
802 return;
803 }
804 else
805 {
806 if (insSlot->desc->multiple && (slotOverrides->type != MULTIFIELD))
807 {
808 temp.type = MULTIFIELD;
809 temp.value = EnvCreateMultifield(theEnv,1L);
810 SetDOBegin(temp,1);
811 SetDOEnd(temp,1);
812 SetMFType(temp.value,1,(short) slotOverrides->type);
813 SetMFValue(temp.value,1,slotOverrides->value);
814 newval = &temp;
815 }
816 else
817 newval = slotOverrides;
818 if (PutSlotValue(theEnv,ins,insSlot,newval,&junk,"modify-instance") == FALSE)
819 return;
820 }
821
822 slotOverrides = slotOverrides->next;
823 }
824 result->value = EnvTrueSymbol(theEnv);
825 }
826
827 /*************************************************************
828 NAME : DuplicateMsgHandlerSupport
829 DESCRIPTION : Support routine for DirectDuplicateMsgHandler
830 and MsgDuplicateMsgHandler
831
832 Performs a series of slot updates
833 directly or with messages
834 INPUTS : 1) A data object buffer to hold the result
835 2) A flag indicating whether to use
836 put- messages or direct placement
837 RETURNS : Nothing useful
838 SIDE EFFECTS : Slots updated (messages sent)
839 NOTES : None
840 *************************************************************/
DuplicateMsgHandlerSupport(void * theEnv,DATA_OBJECT * result,int msgpass)841 static void DuplicateMsgHandlerSupport(
842 void *theEnv,
843 DATA_OBJECT *result,
844 int msgpass)
845 {
846 INSTANCE_TYPE *srcins,*dstins;
847 SYMBOL_HN *newName;
848 DATA_OBJECT *slotOverrides;
849 EXPRESSION *valArg,msgExp;
850 long i;
851 int oldMkInsMsgPass;
852 INSTANCE_SLOT *dstInsSlot;
853 DATA_OBJECT temp,junk,*newval;
854 intBool success;
855
856 result->type = SYMBOL;
857 result->value = EnvFalseSymbol(theEnv);
858 if (InstanceData(theEnv)->ObjectModDupMsgValid == FALSE)
859 {
860 PrintErrorID(theEnv,"INSMODDP",2,FALSE);
861 EnvPrintRouter(theEnv,WERROR,"Direct/message-duplicate message valid only in duplicate-instance.\n");
862 SetEvaluationError(theEnv,TRUE);
863 return;
864 }
865 InstanceData(theEnv)->ObjectModDupMsgValid = FALSE;
866
867 /* ==================================
868 Grab the slot override expressions
869 and determine the source instance
870 and the name of the new instance
871 ================================== */
872 srcins = GetActiveInstance(theEnv);
873 newName = (SYMBOL_HN *) GetNthMessageArgument(theEnv,1)->value;
874 slotOverrides = (DATA_OBJECT *) GetNthMessageArgument(theEnv,2)->value;
875 if (srcins->garbage)
876 {
877 StaleInstanceAddress(theEnv,"duplicate-instance",0);
878 SetEvaluationError(theEnv,TRUE);
879 return;
880 }
881 if (newName == srcins->name)
882 {
883 PrintErrorID(theEnv,"INSMODDP",3,FALSE);
884 EnvPrintRouter(theEnv,WERROR,"Instance copy must have a different name in duplicate-instance.\n");
885 SetEvaluationError(theEnv,TRUE);
886 return;
887 }
888
889 /* ==========================================
890 Create an uninitialized new instance of
891 the new name (delete old version - if any)
892 ========================================== */
893 oldMkInsMsgPass = InstanceData(theEnv)->MkInsMsgPass;
894 InstanceData(theEnv)->MkInsMsgPass = msgpass;
895 dstins = BuildInstance(theEnv,newName,srcins->cls,TRUE);
896 InstanceData(theEnv)->MkInsMsgPass = oldMkInsMsgPass;
897 if (dstins == NULL)
898 return;
899 dstins->busy++;
900
901 /* ================================
902 Place slot overrides directly or
903 with put- messages
904 ================================ */
905 while (slotOverrides != NULL)
906 {
907 /* ===========================================================
908 No evaluation or error checking needs to be done
909 since this has already been done by EvaluateSlotOverrides()
910 =========================================================== */
911 dstInsSlot = FindInstanceSlot(theEnv,dstins,(SYMBOL_HN *) slotOverrides->supplementalInfo);
912 if (dstInsSlot == NULL)
913 {
914 SlotExistError(theEnv,ValueToString(slotOverrides->supplementalInfo),
915 "duplicate-instance");
916 goto DuplicateError;
917 }
918 if (msgpass)
919 {
920 msgExp.type = slotOverrides->type;
921 if (msgExp.type != MULTIFIELD)
922 msgExp.value = slotOverrides->value;
923 else
924 msgExp.value = (void *) slotOverrides;
925 msgExp.argList = NULL;
926 msgExp.nextArg = NULL;
927 if (! DirectMessage(theEnv,dstInsSlot->desc->overrideMessage,dstins,&temp,&msgExp))
928 goto DuplicateError;
929 }
930 else
931 {
932 if (dstInsSlot->desc->multiple && (slotOverrides->type != MULTIFIELD))
933 {
934 temp.type = MULTIFIELD;
935 temp.value = EnvCreateMultifield(theEnv,1L);
936 SetDOBegin(temp,1);
937 SetDOEnd(temp,1);
938 SetMFType(temp.value,1,(short) slotOverrides->type);
939 SetMFValue(temp.value,1,slotOverrides->value);
940 newval = &temp;
941 }
942 else
943 newval = slotOverrides;
944 if (PutSlotValue(theEnv,dstins,dstInsSlot,newval,&junk,"duplicate-instance") == FALSE)
945 goto DuplicateError;
946 }
947 dstInsSlot->override = TRUE;
948 slotOverrides = slotOverrides->next;
949 }
950
951 /* =======================================
952 Copy values from source instance to new
953 directly or with put- messages
954 ======================================= */
955 for (i = 0 ; i < dstins->cls->localInstanceSlotCount ; i++)
956 {
957 if (dstins->slots[i].override == FALSE)
958 {
959 if (msgpass)
960 {
961 temp.type = (unsigned short) srcins->slots[i].type;
962 temp.value = srcins->slots[i].value;
963 if (temp.type == MULTIFIELD)
964 {
965 SetDOBegin(temp,1);
966 SetDOEnd(temp,GetMFLength(temp.value));
967 }
968 valArg = ConvertValueToExpression(theEnv,&temp);
969 success = DirectMessage(theEnv,dstins->slots[i].desc->overrideMessage,
970 dstins,&temp,valArg);
971 ReturnExpression(theEnv,valArg);
972 if (! success)
973 goto DuplicateError;
974 }
975 else
976 {
977 temp.type = (unsigned short) srcins->slots[i].type;
978 temp.value = srcins->slots[i].value;
979 if (srcins->slots[i].type == MULTIFIELD)
980 {
981 SetDOBegin(temp,1);
982 SetDOEnd(temp,GetMFLength(srcins->slots[i].value));
983 }
984 if (PutSlotValue(theEnv,dstins,&dstins->slots[i],&temp,&junk,"duplicate-instance")
985 == FALSE)
986 goto DuplicateError;
987 }
988 }
989 }
990
991 /* =======================================
992 Send init message for message-duplicate
993 ======================================= */
994 if (msgpass)
995 {
996 for (i = 0 ; i < dstins->cls->instanceSlotCount ; i++)
997 dstins->slotAddresses[i]->override = TRUE;
998 dstins->initializeInProgress = 1;
999 DirectMessage(theEnv,MessageHandlerData(theEnv)->INIT_SYMBOL,dstins,result,NULL);
1000 }
1001 dstins->busy--;
1002 if (dstins->garbage)
1003 {
1004 result->type = SYMBOL;
1005 result->value = EnvFalseSymbol(theEnv);
1006 SetEvaluationError(theEnv,TRUE);
1007 }
1008 else
1009 {
1010 result->type = INSTANCE_NAME;
1011 result->value = (void *) GetFullInstanceName(theEnv,dstins);
1012 }
1013 return;
1014
1015 DuplicateError:
1016 dstins->busy--;
1017 QuashInstance(theEnv,dstins);
1018 SetEvaluationError(theEnv,TRUE);
1019 }
1020
1021 #endif
1022
1023
1024