1 /*******************************************************/
2 /* "C" Language Integrated Production System */
3 /* */
4 /* CLIPS Version 6.30 02/05/15 */
5 /* */
6 /* INSTANCE FUNCTIONS MODULE */
7 /*******************************************************/
8
9 /*************************************************************/
10 /* Purpose: Internal instance manipulation 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 log to logName */
23 /* because of Unix compiler warnings of shadowed */
24 /* definitions. */
25 /* */
26 /* Changed name of variable exp to theExp */
27 /* because of Unix compiler warnings of shadowed */
28 /* definitions. */
29 /* */
30 /* 6.24: Link error occurs for the SlotExistError */
31 /* function when OBJECT_SYSTEM is set to 0 in */
32 /* setup.h. DR0865 */
33 /* */
34 /* Converted INSTANCE_PATTERN_MATCHING to */
35 /* DEFRULE_CONSTRUCT. */
36 /* */
37 /* Renamed BOOLEAN macro type to intBool. */
38 /* */
39 /* Moved EvaluateAndStoreInDataObject to */
40 /* evaluatn.c */
41 /* */
42 /* 6.30: Removed conditional code for unsupported */
43 /* compilers/operating systems (IBM_MCW, */
44 /* MAC_MCW, and IBM_TBC). */
45 /* */
46 /* Changed integer type/precision. */
47 /* */
48 /* Changed garbage collection algorithm. */
49 /* */
50 /* Support for long long integers. */
51 /* */
52 /* Added const qualifiers to remove C++ */
53 /* deprecation warnings. */
54 /* */
55 /* Converted API macros to function calls. */
56 /* */
57 /* Fixed slot override default ?NONE bug. */
58 /* */
59 /* Instances of the form [<name>] are now */
60 /* searched for in all modules. */
61 /* */
62 /*************************************************************/
63
64 /* =========================================
65 *****************************************
66 EXTERNAL DEFINITIONS
67 =========================================
68 ***************************************** */
69
70 #include <stdlib.h>
71
72 #include "setup.h"
73
74 #if OBJECT_SYSTEM
75
76 #include "argacces.h"
77 #include "classcom.h"
78 #include "classfun.h"
79 #include "cstrnchk.h"
80 #include "engine.h"
81 #include "envrnmnt.h"
82 #include "inscom.h"
83 #include "insmngr.h"
84 #include "memalloc.h"
85 #include "modulutl.h"
86 #include "msgcom.h"
87 #include "msgfun.h"
88 #include "prccode.h"
89 #include "router.h"
90 #include "utility.h"
91
92 #if DEFRULE_CONSTRUCT
93 #include "drive.h"
94 #include "objrtmch.h"
95 #endif
96
97 #define _INSFUN_SOURCE_
98 #include "insfun.h"
99
100 /* =========================================
101 *****************************************
102 CONSTANTS
103 =========================================
104 ***************************************** */
105 #define BIG_PRIME 11329
106
107 /* =========================================
108 *****************************************
109 INTERNALLY VISIBLE FUNCTION HEADERS
110 =========================================
111 ***************************************** */
112
113 static INSTANCE_TYPE *FindImportedInstance(void *,struct defmodule *,struct defmodule *,INSTANCE_TYPE *);
114
115 #if DEFRULE_CONSTRUCT
116 static void NetworkModifyForSharedSlot(void *,int,DEFCLASS *,SLOT_DESC *);
117 #endif
118
119 /* =========================================
120 *****************************************
121 EXTERNALLY VISIBLE FUNCTIONS
122 =========================================
123 ***************************************** */
124
125 /***************************************************
126 NAME : EnvIncrementInstanceCount
127 DESCRIPTION : Increments instance busy count -
128 prevents it from being deleted
129 INPUTS : The address of the instance
130 RETURNS : Nothing useful
131 SIDE EFFECTS : Count set
132 NOTES : None
133 ***************************************************/
EnvIncrementInstanceCount(void * theEnv,void * vptr)134 globle void EnvIncrementInstanceCount(
135 void *theEnv,
136 void *vptr)
137 {
138 #if MAC_XCD
139 #pragma unused(theEnv)
140 #endif
141
142 ((INSTANCE_TYPE *) vptr)->busy++;
143 }
144
145 /***************************************************
146 NAME : EnvDecrementInstanceCount
147 DESCRIPTION : Decrements instance busy count -
148 might allow it to be deleted
149 INPUTS : The address of the instance
150 RETURNS : Nothing useful
151 SIDE EFFECTS : Count set
152 NOTES : None
153 ***************************************************/
EnvDecrementInstanceCount(void * theEnv,void * vptr)154 globle void EnvDecrementInstanceCount(
155 void *theEnv,
156 void *vptr)
157 {
158 #if MAC_XCD
159 #pragma unused(theEnv)
160 #endif
161
162 ((INSTANCE_TYPE *) vptr)->busy--;
163 }
164
165 /***************************************************
166 NAME : InitializeInstanceTable
167 DESCRIPTION : Initializes instance hash table
168 to all NULL addresses
169 INPUTS : None
170 RETURNS : Nothing useful
171 SIDE EFFECTS : Hash table initialized
172 NOTES : None
173 ***************************************************/
InitializeInstanceTable(void * theEnv)174 globle void InitializeInstanceTable(
175 void *theEnv)
176 {
177 register int i;
178
179 InstanceData(theEnv)->InstanceTable = (INSTANCE_TYPE **)
180 gm2(theEnv,(int) (sizeof(INSTANCE_TYPE *) * INSTANCE_TABLE_HASH_SIZE));
181 for (i = 0 ; i < INSTANCE_TABLE_HASH_SIZE ; i++)
182 InstanceData(theEnv)->InstanceTable[i] = NULL;
183 }
184
185 /*******************************************************
186 NAME : CleanupInstances
187 DESCRIPTION : Iterates through instance garbage
188 list looking for nodes that
189 have become unused - and purges
190 them
191 INPUTS : None
192 RETURNS : Nothing useful
193 SIDE EFFECTS : Non-busy instance garbage nodes deleted
194 NOTES : None
195 *******************************************************/
CleanupInstances(void * theEnv)196 globle void CleanupInstances(
197 void *theEnv)
198 {
199 IGARBAGE *gprv,*gtmp,*dump;
200
201 if (InstanceData(theEnv)->MaintainGarbageInstances)
202 return;
203 gprv = NULL;
204 gtmp = InstanceData(theEnv)->InstanceGarbageList;
205 while (gtmp != NULL)
206 {
207 #if DEFRULE_CONSTRUCT
208 if ((gtmp->ins->busy == 0)
209 && (gtmp->ins->header.busyCount == 0))
210 #else
211 if (gtmp->ins->busy == 0)
212 #endif
213 {
214 DecrementSymbolCount(theEnv,gtmp->ins->name);
215 rtn_struct(theEnv,instance,gtmp->ins);
216 if (gprv == NULL)
217 InstanceData(theEnv)->InstanceGarbageList = gtmp->nxt;
218 else
219 gprv->nxt = gtmp->nxt;
220 dump = gtmp;
221 gtmp = gtmp->nxt;
222 rtn_struct(theEnv,igarbage,dump);
223 }
224 else
225 {
226 gprv = gtmp;
227 gtmp = gtmp->nxt;
228 }
229 }
230 }
231
232 /*******************************************************
233 NAME : HashInstance
234 DESCRIPTION : Generates a hash index for a given
235 instance name
236 INPUTS : The address of the instance name SYMBOL_HN
237 RETURNS : The hash index value
238 SIDE EFFECTS : None
239 NOTES : Counts on the fact that the symbol
240 has already been hashed into the
241 symbol table - uses that hash value
242 multiplied by a prime for a new hash
243 *******************************************************/
HashInstance(SYMBOL_HN * cname)244 globle unsigned HashInstance(
245 SYMBOL_HN *cname)
246 {
247 unsigned long tally;
248
249 tally = ((unsigned long) cname->bucket) * BIG_PRIME;
250 return((unsigned) (tally % INSTANCE_TABLE_HASH_SIZE));
251 }
252
253 /***************************************************
254 NAME : DestroyAllInstances
255 DESCRIPTION : Deallocates all instances,
256 reinitializes hash table and
257 resets class instance pointers
258 INPUTS : None
259 RETURNS : Nothing useful
260 SIDE EFFECTS : All instances deallocated
261 NOTES : None
262 ***************************************************/
DestroyAllInstances(void * theEnv)263 globle void DestroyAllInstances(
264 void *theEnv)
265 {
266 INSTANCE_TYPE *iptr;
267 int svmaintain;
268
269 SaveCurrentModule(theEnv);
270 svmaintain = InstanceData(theEnv)->MaintainGarbageInstances;
271 InstanceData(theEnv)->MaintainGarbageInstances = TRUE;
272 iptr = InstanceData(theEnv)->InstanceList;
273 while (iptr != NULL)
274 {
275 EnvSetCurrentModule(theEnv,(void *) iptr->cls->header.whichModule->theModule);
276 DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,iptr,NULL,NULL);
277 iptr = iptr->nxtList;
278 while ((iptr != NULL) ? iptr->garbage : FALSE)
279 iptr = iptr->nxtList;
280 }
281 InstanceData(theEnv)->MaintainGarbageInstances = svmaintain;
282 RestoreCurrentModule(theEnv);
283 }
284
285 /******************************************************
286 NAME : RemoveInstanceData
287 DESCRIPTION : Deallocates all the data objects
288 in instance slots and then dealloactes
289 the slots themeselves
290 INPUTS : The instance
291 RETURNS : Nothing useful
292 SIDE EFFECTS : Instance slots removed
293 NOTES : An instance made with CopyInstanceData
294 will have shared values removed
295 in all cases because they are not
296 "real" instances.
297 Instance class busy count decremented
298 ******************************************************/
RemoveInstanceData(void * theEnv,INSTANCE_TYPE * ins)299 globle void RemoveInstanceData(
300 void *theEnv,
301 INSTANCE_TYPE *ins)
302 {
303 long i;
304 INSTANCE_SLOT *sp;
305
306 DecrementDefclassBusyCount(theEnv,(void *) ins->cls);
307 for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
308 {
309 sp = ins->slotAddresses[i];
310 if ((sp == &sp->desc->sharedValue) ?
311 (--sp->desc->sharedCount == 0) : TRUE)
312 {
313 if (sp->desc->multiple)
314 {
315 MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) sp->value);
316 AddToMultifieldList(theEnv,(MULTIFIELD_PTR) sp->value);
317 }
318 else
319 AtomDeinstall(theEnv,(int) sp->type,sp->value);
320 sp->value = NULL;
321 }
322 }
323 if (ins->cls->instanceSlotCount != 0)
324 {
325 rm(theEnv,(void *) ins->slotAddresses,
326 (ins->cls->instanceSlotCount * sizeof(INSTANCE_SLOT *)));
327 if (ins->cls->localInstanceSlotCount != 0)
328 rm(theEnv,(void *) ins->slots,
329 (ins->cls->localInstanceSlotCount * sizeof(INSTANCE_SLOT)));
330 }
331 ins->slots = NULL;
332 ins->slotAddresses = NULL;
333 }
334
335 /***************************************************************************
336 NAME : FindInstanceBySymbol
337 DESCRIPTION : Looks up a specified instance in the instance hash table
338 INPUTS : The symbol for the name of the instance
339 RETURNS : The address of the found instance, NULL otherwise
340 SIDE EFFECTS : None
341 NOTES : An instance is searched for by name first in the
342 current module - then in imported modules according
343 to the order given in the current module's definition.
344 Instances of the form [<name>] are now searched for in
345 all modules.
346 ***************************************************************************/
FindInstanceBySymbol(void * theEnv,SYMBOL_HN * moduleAndInstanceName)347 globle INSTANCE_TYPE *FindInstanceBySymbol(
348 void *theEnv,
349 SYMBOL_HN *moduleAndInstanceName)
350 {
351 unsigned modulePosition,searchImports;
352 SYMBOL_HN *moduleName,*instanceName;
353 struct defmodule *currentModule,*theModule;
354
355 currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
356
357 /* =======================================
358 Instance names of the form [<name>] are
359 searched for only in the current module
360 ======================================= */
361 modulePosition = FindModuleSeparator(ValueToString(moduleAndInstanceName));
362 if (modulePosition == FALSE)
363 {
364 /*
365 theModule = currentModule;
366 instanceName = moduleAndInstanceName;
367 searchImports = FALSE;
368 */
369 INSTANCE_TYPE *ins;
370
371 ins = InstanceData(theEnv)->InstanceTable[HashInstance(moduleAndInstanceName)];
372 while (ins != NULL)
373 {
374 if (ins->name == moduleAndInstanceName)
375 { return ins; }
376 ins = ins->nxtHash;
377 }
378 return(NULL);
379 }
380
381 /* =========================================
382 Instance names of the form [::<name>] are
383 searched for in the current module and
384 imported modules in the definition order
385 ========================================= */
386 else if (modulePosition == 1)
387 {
388 theModule = currentModule;
389 instanceName = ExtractConstructName(theEnv,modulePosition,ValueToString(moduleAndInstanceName));
390 searchImports = TRUE;
391 }
392
393 /* =============================================
394 Instance names of the form [<module>::<name>]
395 are searched for in the specified module
396 ============================================= */
397 else
398 {
399 moduleName = ExtractModuleName(theEnv,modulePosition,ValueToString(moduleAndInstanceName));
400 theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName));
401 instanceName = ExtractConstructName(theEnv,modulePosition,ValueToString(moduleAndInstanceName));
402 if (theModule == NULL)
403 return(NULL);
404 searchImports = FALSE;
405 }
406 return(FindInstanceInModule(theEnv,instanceName,theModule,currentModule,searchImports));
407 }
408
409 /***************************************************
410 NAME : FindInstanceInModule
411 DESCRIPTION : Finds an instance of the given name
412 in the given module in scope of
413 the given current module
414 (will also search imported modules
415 if specified)
416 INPUTS : 1) The instance name (no module)
417 2) The module to search
418 3) The currently active module
419 4) A flag indicating whether
420 to search imported modules of
421 given module as well
422 RETURNS : The instance (NULL if none found)
423 SIDE EFFECTS : None
424 NOTES : The class no longer needs to be in
425 scope of the current module if the
426 instance's module name has been specified.
427 ***************************************************/
FindInstanceInModule(void * theEnv,SYMBOL_HN * instanceName,struct defmodule * theModule,struct defmodule * currentModule,unsigned searchImports)428 globle INSTANCE_TYPE *FindInstanceInModule(
429 void *theEnv,
430 SYMBOL_HN *instanceName,
431 struct defmodule *theModule,
432 struct defmodule *currentModule,
433 unsigned searchImports)
434 {
435 INSTANCE_TYPE *startInstance,*ins;
436
437 /* ===============================
438 Find the first instance of the
439 correct name in the hash chain
440 =============================== */
441 startInstance = InstanceData(theEnv)->InstanceTable[HashInstance(instanceName)];
442 while (startInstance != NULL)
443 {
444 if (startInstance->name == instanceName)
445 break;
446 startInstance = startInstance->nxtHash;
447 }
448
449 if (startInstance == NULL)
450 return(NULL);
451
452 /* ===========================================
453 Look for the instance in the specified
454 module - if the class of the found instance
455 is in scope of the current module, we have
456 found the instance
457 =========================================== */
458 for (ins = startInstance ;
459 (ins != NULL) ? (ins->name == startInstance->name) : FALSE ;
460 ins = ins->nxtHash)
461 //if ((ins->cls->header.whichModule->theModule == theModule) &&
462 // DefclassInScope(theEnv,ins->cls,currentModule))
463 if (ins->cls->header.whichModule->theModule == theModule)
464 return(ins);
465
466 /* ================================
467 For ::<name> formats, we need to
468 search imported modules too
469 ================================ */
470 if (searchImports == FALSE)
471 return(NULL);
472 MarkModulesAsUnvisited(theEnv);
473 return(FindImportedInstance(theEnv,theModule,currentModule,startInstance));
474 }
475
476 /********************************************************************
477 NAME : FindInstanceSlot
478 DESCRIPTION : Finds an instance slot by name
479 INPUTS : 1) The address of the instance
480 2) The symbolic name of the slot
481 RETURNS : The address of the slot, NULL if not found
482 SIDE EFFECTS : None
483 NOTES : None
484 ********************************************************************/
FindInstanceSlot(void * theEnv,INSTANCE_TYPE * ins,SYMBOL_HN * sname)485 globle INSTANCE_SLOT *FindInstanceSlot(
486 void *theEnv,
487 INSTANCE_TYPE *ins,
488 SYMBOL_HN *sname)
489 {
490 register int i;
491
492 i = FindInstanceTemplateSlot(theEnv,ins->cls,sname);
493 return((i != -1) ? ins->slotAddresses[i] : NULL);
494 }
495
496 /********************************************************************
497 NAME : FindInstanceTemplateSlot
498 DESCRIPTION : Performs a search on an class's instance
499 template slot array to find a slot by name
500 INPUTS : 1) The address of the class
501 2) The symbolic name of the slot
502 RETURNS : The index of the slot, -1 if not found
503 SIDE EFFECTS : None
504 NOTES : The slot's unique id is used as index into
505 the slot map array.
506 ********************************************************************/
FindInstanceTemplateSlot(void * theEnv,DEFCLASS * cls,SYMBOL_HN * sname)507 globle int FindInstanceTemplateSlot(
508 void *theEnv,
509 DEFCLASS *cls,
510 SYMBOL_HN *sname)
511 {
512 int sid;
513
514 sid = FindSlotNameID(theEnv,sname);
515 if (sid == -1)
516 return(-1);
517 if (sid > (int) cls->maxSlotNameID)
518 return(-1);
519 return((int) cls->slotNameMap[sid] - 1);
520 }
521
522 /*******************************************************
523 NAME : PutSlotValue
524 DESCRIPTION : Evaluates new slot-expression and
525 stores it as a multifield
526 variable for the slot.
527 INPUTS : 1) The address of the instance
528 (NULL if no trace-messages desired)
529 2) The address of the slot
530 3) The address of the value
531 4) DATA_OBJECT_PTR to store the
532 set value
533 5) The command doing the put-
534 RETURNS : FALSE on errors, or TRUE
535 SIDE EFFECTS : Old value deleted and new one allocated
536 Old value symbols deinstalled
537 New value symbols installed
538 NOTES : None
539 *******************************************************/
PutSlotValue(void * theEnv,INSTANCE_TYPE * ins,INSTANCE_SLOT * sp,DATA_OBJECT * val,DATA_OBJECT * setVal,const char * theCommand)540 globle int PutSlotValue(
541 void *theEnv,
542 INSTANCE_TYPE *ins,
543 INSTANCE_SLOT *sp,
544 DATA_OBJECT *val,
545 DATA_OBJECT *setVal,
546 const char *theCommand)
547 {
548 if (ValidSlotValue(theEnv,val,sp->desc,ins,theCommand) == FALSE)
549 {
550 SetpType(setVal,SYMBOL);
551 SetpValue(setVal,EnvFalseSymbol(theEnv));
552 return(FALSE);
553 }
554 return(DirectPutSlotValue(theEnv,ins,sp,val,setVal));
555 }
556
557 /*******************************************************
558 NAME : DirectPutSlotValue
559 DESCRIPTION : Evaluates new slot-expression and
560 stores it as a multifield
561 variable for the slot.
562 INPUTS : 1) The address of the instance
563 (NULL if no trace-messages desired)
564 2) The address of the slot
565 3) The address of the value
566 4) DATA_OBJECT_PTR to store the
567 set value
568 RETURNS : FALSE on errors, or TRUE
569 SIDE EFFECTS : Old value deleted and new one allocated
570 Old value symbols deinstalled
571 New value symbols installed
572 NOTES : None
573 *******************************************************/
DirectPutSlotValue(void * theEnv,INSTANCE_TYPE * ins,INSTANCE_SLOT * sp,DATA_OBJECT * val,DATA_OBJECT * setVal)574 globle int DirectPutSlotValue(
575 void *theEnv,
576 INSTANCE_TYPE *ins,
577 INSTANCE_SLOT *sp,
578 DATA_OBJECT *val,
579 DATA_OBJECT *setVal)
580 {
581 register long i,j; /* 6.04 Bug Fix */
582 #if DEFRULE_CONSTRUCT
583 int sharedTraversalID;
584 INSTANCE_SLOT *bsp,**spaddr;
585 #endif
586 DATA_OBJECT tmpVal;
587
588 SetpType(setVal,SYMBOL);
589 SetpValue(setVal,EnvFalseSymbol(theEnv));
590 if (val == NULL)
591 {
592 SystemError(theEnv,"INSFUN",1);
593 EnvExitRouter(theEnv,EXIT_FAILURE);
594 }
595 else if (GetpValue(val) == ProceduralPrimitiveData(theEnv)->NoParamValue)
596 {
597 if (sp->desc->dynamicDefault)
598 {
599 val = &tmpVal;
600 if (!EvaluateAndStoreInDataObject(theEnv,sp->desc->multiple,
601 (EXPRESSION *) sp->desc->defaultValue,val,TRUE))
602 return(FALSE);
603 }
604 else if (sp->desc->defaultValue != NULL)
605 { val = (DATA_OBJECT *) sp->desc->defaultValue; }
606 else
607 {
608 PrintErrorID(theEnv,"INSMNGR",14,FALSE);
609 EnvPrintRouter(theEnv,WERROR,"Override required for slot ");
610 EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
611 EnvPrintRouter(theEnv,WERROR," in instance ");
612 EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
613 EnvPrintRouter(theEnv,WERROR,".\n");
614 SetEvaluationError(theEnv,TRUE);
615 return(FALSE);
616 }
617 }
618 #if DEFRULE_CONSTRUCT
619 if (EngineData(theEnv)->JoinOperationInProgress && sp->desc->reactive &&
620 (ins->cls->reactive || sp->desc->shared))
621 {
622 PrintErrorID(theEnv,"INSFUN",5,FALSE);
623 EnvPrintRouter(theEnv,WERROR,"Cannot modify reactive instance slots while\n");
624 EnvPrintRouter(theEnv,WERROR," pattern-matching is in process.\n");
625 SetEvaluationError(theEnv,TRUE);
626 return(FALSE);
627 }
628
629 /* =============================================
630 If we are about to change a slot of an object
631 which is a basis for a firing rule, we need
632 to make sure that slot is copied first
633 ============================================= */
634 if (ins->basisSlots != NULL)
635 {
636 spaddr = &ins->slotAddresses[ins->cls->slotNameMap[sp->desc->slotName->id] - 1];
637 bsp = ins->basisSlots + (spaddr - ins->slotAddresses);
638 if (bsp->value == NULL)
639 {
640 bsp->type = sp->type;
641 bsp->value = sp->value;
642 if (sp->desc->multiple)
643 MultifieldInstall(theEnv,(MULTIFIELD_PTR) bsp->value);
644 else
645 AtomInstall(theEnv,(int) bsp->type,bsp->value);
646 }
647 }
648
649 #endif
650 if (sp->desc->multiple == 0)
651 {
652 AtomDeinstall(theEnv,(int) sp->type,sp->value);
653
654 /* ======================================
655 Assumed that multfield already checked
656 to be of cardinality 1
657 ====================================== */
658 if (GetpType(val) == MULTIFIELD)
659 {
660 sp->type = GetMFType(GetpValue(val),GetpDOBegin(val));
661 sp->value = GetMFValue(GetpValue(val),GetpDOBegin(val));
662 }
663 else
664 {
665 sp->type = val->type;
666 sp->value = val->value;
667 }
668 AtomInstall(theEnv,(int) sp->type,sp->value);
669 SetpType(setVal,sp->type);
670 SetpValue(setVal,sp->value);
671 }
672 else
673 {
674 MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) sp->value);
675 AddToMultifieldList(theEnv,(MULTIFIELD_PTR) sp->value);
676 sp->type = MULTIFIELD;
677 if (val->type == MULTIFIELD)
678 {
679 sp->value = CreateMultifield2(theEnv,(unsigned long) GetpDOLength(val));
680 for (i = 1 , j = GetpDOBegin(val) ; i <= GetpDOLength(val) ; i++ , j++)
681 {
682 SetMFType(sp->value,i,GetMFType(val->value,j));
683 SetMFValue(sp->value,i,GetMFValue(val->value,j));
684 }
685 }
686 else
687 {
688 sp->value = CreateMultifield2(theEnv,1L);
689 SetMFType(sp->value,1,(short) val->type);
690 SetMFValue(sp->value,1,val->value);
691 }
692 MultifieldInstall(theEnv,(struct multifield *) sp->value);
693 SetpType(setVal,MULTIFIELD);
694 SetpValue(setVal,sp->value);
695 SetpDOBegin(setVal,1);
696 SetpDOEnd(setVal,GetMFLength(sp->value));
697 }
698 /* ==================================================
699 6.05 Bug fix - any slot set directly or indirectly
700 by a slot override or other side-effect during an
701 instance initialization should not have its
702 default value set
703 ================================================== */
704
705 sp->override = ins->initializeInProgress;
706
707 #if DEBUGGING_FUNCTIONS
708 if (ins->cls->traceSlots)
709 {
710 if (sp->desc->shared)
711 EnvPrintRouter(theEnv,WTRACE,"::= shared slot ");
712 else
713 EnvPrintRouter(theEnv,WTRACE,"::= local slot ");
714 EnvPrintRouter(theEnv,WTRACE,ValueToString(sp->desc->slotName->name));
715 EnvPrintRouter(theEnv,WTRACE," in instance ");
716 EnvPrintRouter(theEnv,WTRACE,ValueToString(ins->name));
717 EnvPrintRouter(theEnv,WTRACE," <- ");
718 if (sp->type != MULTIFIELD)
719 PrintAtom(theEnv,WTRACE,(int) sp->type,sp->value);
720 else
721 PrintMultifield(theEnv,WTRACE,(MULTIFIELD_PTR) sp->value,0,
722 (long) (GetInstanceSlotLength(sp) - 1),TRUE);
723 EnvPrintRouter(theEnv,WTRACE,"\n");
724 }
725 #endif
726 InstanceData(theEnv)->ChangesToInstances = TRUE;
727
728 #if DEFRULE_CONSTRUCT
729 if (ins->cls->reactive && sp->desc->reactive)
730 {
731 /* ============================================
732 If we have changed a shared slot, we need to
733 perform a Rete update for every instance
734 which contains this slot
735 ============================================ */
736 if (sp->desc->shared)
737 {
738 sharedTraversalID = GetTraversalID(theEnv);
739 if (sharedTraversalID != -1)
740 {
741 NetworkModifyForSharedSlot(theEnv,sharedTraversalID,sp->desc->cls,sp->desc);
742 ReleaseTraversalID(theEnv);
743 }
744 else
745 {
746 PrintErrorID(theEnv,"INSFUN",6,FALSE);
747 EnvPrintRouter(theEnv,WERROR,"Unable to pattern-match on shared slot ");
748 EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
749 EnvPrintRouter(theEnv,WERROR," in class ");
750 EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sp->desc->cls));
751 EnvPrintRouter(theEnv,WERROR,".\n");
752 }
753 }
754 else
755 ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sp->desc->slotName->id);
756 }
757 #endif
758
759 return(TRUE);
760 }
761
762 /*******************************************************************
763 NAME : ValidSlotValue
764 DESCRIPTION : Determines if a value is appropriate
765 for a slot-value
766 INPUTS : 1) The value buffer
767 2) Slot descriptor
768 3) Instance for which slot is being checked
769 (can be NULL)
770 4) Buffer holding printout of the offending command
771 (if NULL assumes message-handler is executing
772 and calls PrintHandler for CurrentCore instead)
773 RETURNS : TRUE if value is OK, FALSE otherwise
774 SIDE EFFECTS : Sets EvaluationError if slot is not OK
775 NOTES : Examines all fields of a multi-field
776 *******************************************************************/
ValidSlotValue(void * theEnv,DATA_OBJECT * val,SLOT_DESC * sd,INSTANCE_TYPE * ins,const char * theCommand)777 globle int ValidSlotValue(
778 void *theEnv,
779 DATA_OBJECT *val,
780 SLOT_DESC *sd,
781 INSTANCE_TYPE *ins,
782 const char *theCommand)
783 {
784 register int violationCode;
785
786 /* ===================================
787 Special NoParamValue means to reset
788 slot to default value
789 =================================== */
790 if (GetpValue(val) == ProceduralPrimitiveData(theEnv)->NoParamValue)
791 return(TRUE);
792 if ((sd->multiple == 0) && (val->type == MULTIFIELD) &&
793 (GetpDOLength(val) != 1))
794 {
795 PrintErrorID(theEnv,"INSFUN",7,FALSE);
796 PrintDataObject(theEnv,WERROR,val);
797 EnvPrintRouter(theEnv,WERROR," illegal for single-field ");
798 PrintSlot(theEnv,WERROR,sd,ins,theCommand);
799 EnvPrintRouter(theEnv,WERROR,".\n");
800 SetEvaluationError(theEnv,TRUE);
801 return(FALSE);
802 }
803 if (val->type == RVOID)
804 {
805 PrintErrorID(theEnv,"INSFUN",8,FALSE);
806 EnvPrintRouter(theEnv,WERROR,"Void function illegal value for ");
807 PrintSlot(theEnv,WERROR,sd,ins,theCommand);
808 EnvPrintRouter(theEnv,WERROR,".\n");
809 SetEvaluationError(theEnv,TRUE);
810 return(FALSE);
811 }
812 if (EnvGetDynamicConstraintChecking(theEnv))
813 {
814 violationCode = ConstraintCheckDataObject(theEnv,val,sd->constraint);
815 if (violationCode != NO_VIOLATION)
816 {
817 PrintErrorID(theEnv,"CSTRNCHK",1,FALSE);
818 if ((GetpType(val) == MULTIFIELD) && (sd->multiple == 0))
819 PrintAtom(theEnv,WERROR,GetMFType(GetpValue(val),GetpDOBegin(val)),
820 GetMFValue(GetpValue(val),GetpDOEnd(val)));
821 else
822 PrintDataObject(theEnv,WERROR,val);
823 EnvPrintRouter(theEnv,WERROR," for ");
824 PrintSlot(theEnv,WERROR,sd,ins,theCommand);
825 ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0,
826 violationCode,sd->constraint,FALSE);
827 SetEvaluationError(theEnv,TRUE);
828 return(FALSE);
829 }
830 }
831 return(TRUE);
832 }
833
834 /********************************************************
835 NAME : CheckInstance
836 DESCRIPTION : Checks to see if the first argument to
837 a function is a valid instance
838 INPUTS : Name of the calling function
839 RETURNS : The address of the instance
840 SIDE EFFECTS : EvaluationError set and messages printed
841 on errors
842 NOTES : Used by Initialize and ModifyInstance
843 ********************************************************/
CheckInstance(void * theEnv,const char * func)844 globle INSTANCE_TYPE *CheckInstance(
845 void *theEnv,
846 const char *func)
847 {
848 INSTANCE_TYPE *ins;
849 DATA_OBJECT temp;
850
851 EvaluateExpression(theEnv,GetFirstArgument(),&temp);
852 if (temp.type == INSTANCE_ADDRESS)
853 {
854 ins = (INSTANCE_TYPE *) temp.value;
855 if (ins->garbage == 1)
856 {
857 StaleInstanceAddress(theEnv,func,0);
858 SetEvaluationError(theEnv,TRUE);
859 return(NULL);
860 }
861 }
862 else if ((temp.type == INSTANCE_NAME) ||
863 (temp.type == SYMBOL))
864 {
865 ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
866 if (ins == NULL)
867 {
868 NoInstanceError(theEnv,ValueToString(temp.value),func);
869 return(NULL);
870 }
871 }
872 else
873 {
874 PrintErrorID(theEnv,"INSFUN",1,FALSE);
875 EnvPrintRouter(theEnv,WERROR,"Expected a valid instance in function ");
876 EnvPrintRouter(theEnv,WERROR,func);
877 EnvPrintRouter(theEnv,WERROR,".\n");
878 SetEvaluationError(theEnv,TRUE);
879 return(NULL);
880 }
881 return(ins);
882 }
883
884 /***************************************************
885 NAME : NoInstanceError
886 DESCRIPTION : Prints out an appropriate error
887 message when an instance cannot be
888 found for a function
889 INPUTS : 1) The instance name
890 2) The function name
891 RETURNS : Nothing useful
892 SIDE EFFECTS : None
893 NOTES : None
894 ***************************************************/
NoInstanceError(void * theEnv,const char * iname,const char * func)895 globle void NoInstanceError(
896 void *theEnv,
897 const char *iname,
898 const char *func)
899 {
900 PrintErrorID(theEnv,"INSFUN",2,FALSE);
901 EnvPrintRouter(theEnv,WERROR,"No such instance ");
902 EnvPrintRouter(theEnv,WERROR,iname);
903 EnvPrintRouter(theEnv,WERROR," in function ");
904 EnvPrintRouter(theEnv,WERROR,func);
905 EnvPrintRouter(theEnv,WERROR,".\n");
906 SetEvaluationError(theEnv,TRUE);
907 }
908
909 /***************************************************
910 NAME : StaleInstanceAddress
911 DESCRIPTION : Prints out an appropriate error
912 message when an instance address
913 is no longer valid
914 INPUTS : The function name
915 RETURNS : Nothing useful
916 SIDE EFFECTS : None
917 NOTES : None
918 ***************************************************/
StaleInstanceAddress(void * theEnv,const char * func,int whichArg)919 globle void StaleInstanceAddress(
920 void *theEnv,
921 const char *func,
922 int whichArg)
923 {
924 PrintErrorID(theEnv,"INSFUN",4,FALSE);
925 EnvPrintRouter(theEnv,WERROR,"Invalid instance-address in function ");
926 EnvPrintRouter(theEnv,WERROR,func);
927 if (whichArg > 0)
928 {
929 EnvPrintRouter(theEnv,WERROR,", argument #");
930 PrintLongInteger(theEnv,WERROR,(long long) whichArg);
931 }
932 EnvPrintRouter(theEnv,WERROR,".\n");
933 }
934
935 /**********************************************************************
936 NAME : EnvGetInstancesChanged
937 DESCRIPTION : Returns whether instances have changed
938 (any were added/deleted or slot values were changed)
939 since last time flag was set to FALSE
940 INPUTS : None
941 RETURNS : The instances-changed flag
942 SIDE EFFECTS : None
943 NOTES : Used by interfaces to update instance windows
944 **********************************************************************/
EnvGetInstancesChanged(void * theEnv)945 globle int EnvGetInstancesChanged(
946 void *theEnv)
947 {
948 return(InstanceData(theEnv)->ChangesToInstances);
949 }
950
951 /*******************************************************
952 NAME : EnvSetInstancesChanged
953 DESCRIPTION : Sets instances-changed flag (see above)
954 INPUTS : The value (TRUE or FALSE)
955 RETURNS : Nothing useful
956 SIDE EFFECTS : The flag is set
957 NOTES : None
958 *******************************************************/
EnvSetInstancesChanged(void * theEnv,int changed)959 globle void EnvSetInstancesChanged(
960 void *theEnv,
961 int changed)
962 {
963 InstanceData(theEnv)->ChangesToInstances = changed;
964 }
965
966 /*******************************************************************
967 NAME : PrintSlot
968 DESCRIPTION : Displays the name and origin of a slot
969 INPUTS : 1) The logical output name
970 2) The slot descriptor
971 3) The instance source (can be NULL)
972 4) Buffer holding printout of the offending command
973 (if NULL assumes message-handler is executing
974 and calls PrintHandler for CurrentCore instead)
975 RETURNS : Nothing useful
976 SIDE EFFECTS : Message printed
977 NOTES : None
978 *******************************************************************/
PrintSlot(void * theEnv,const char * logName,SLOT_DESC * sd,INSTANCE_TYPE * ins,const char * theCommand)979 globle void PrintSlot(
980 void *theEnv,
981 const char *logName,
982 SLOT_DESC *sd,
983 INSTANCE_TYPE *ins,
984 const char *theCommand)
985 {
986 EnvPrintRouter(theEnv,logName,"slot ");
987 EnvPrintRouter(theEnv,logName,ValueToString(sd->slotName->name));
988 if (ins != NULL)
989 {
990 EnvPrintRouter(theEnv,logName," of instance [");
991 EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
992 EnvPrintRouter(theEnv,logName,"]");
993 }
994 else if (sd->cls != NULL)
995 {
996 EnvPrintRouter(theEnv,logName," of class ");
997 EnvPrintRouter(theEnv,logName,EnvGetDefclassName(theEnv,(void *) sd->cls));
998 }
999 EnvPrintRouter(theEnv,logName," found in ");
1000 if (theCommand != NULL)
1001 EnvPrintRouter(theEnv,logName,theCommand);
1002 else
1003 PrintHandler(theEnv,logName,MessageHandlerData(theEnv)->CurrentCore->hnd,FALSE);
1004 }
1005
1006 /*****************************************************
1007 NAME : PrintInstanceNameAndClass
1008 DESCRIPTION : Displays an instance's name and class
1009 INPUTS : 1) Logical name of output
1010 2) The instance
1011 3) Flag indicating whether to
1012 print carriage-return at end
1013 RETURNS : Nothing useful
1014 SIDE EFFECTS : Instnace name and class printed
1015 NOTES : None
1016 *****************************************************/
PrintInstanceNameAndClass(void * theEnv,const char * logicalName,INSTANCE_TYPE * theInstance,intBool linefeedFlag)1017 globle void PrintInstanceNameAndClass(
1018 void *theEnv,
1019 const char *logicalName,
1020 INSTANCE_TYPE *theInstance,
1021 intBool linefeedFlag)
1022 {
1023 EnvPrintRouter(theEnv,logicalName,"[");
1024 EnvPrintRouter(theEnv,logicalName,EnvGetInstanceName(theEnv,(void *) theInstance));
1025 EnvPrintRouter(theEnv,logicalName,"] of ");
1026 PrintClassName(theEnv,logicalName,theInstance->cls,linefeedFlag);
1027 }
1028
1029 /***************************************************
1030 NAME : PrintInstanceName
1031 DESCRIPTION : Used by the rule system commands
1032 such as (matches) and (agenda)
1033 to print out the name of an instance
1034 INPUTS : 1) The logical output name
1035 2) A pointer to the instance
1036 RETURNS : Nothing useful
1037 SIDE EFFECTS : Name of instance printed
1038 NOTES : None
1039 ***************************************************/
PrintInstanceName(void * theEnv,const char * logName,void * vins)1040 globle void PrintInstanceName(
1041 void *theEnv,
1042 const char *logName,
1043 void *vins)
1044 {
1045 INSTANCE_TYPE *ins;
1046
1047 ins = (INSTANCE_TYPE *) vins;
1048 if (ins->garbage)
1049 {
1050 EnvPrintRouter(theEnv,logName,"<stale instance [");
1051 EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
1052 EnvPrintRouter(theEnv,logName,"]>");
1053 }
1054 else
1055 {
1056 EnvPrintRouter(theEnv,logName,"[");
1057 EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
1058 EnvPrintRouter(theEnv,logName,"]");
1059 }
1060 }
1061
1062 /***************************************************
1063 NAME : PrintInstanceLongForm
1064 DESCRIPTION : Used by kernel to print
1065 instance addresses
1066 INPUTS : 1) The logical output name
1067 2) A pointer to the instance
1068 RETURNS : Nothing useful
1069 SIDE EFFECTS : Address of instance printed
1070 NOTES : None
1071 ***************************************************/
PrintInstanceLongForm(void * theEnv,const char * logName,void * vins)1072 globle void PrintInstanceLongForm(
1073 void *theEnv,
1074 const char *logName,
1075 void *vins)
1076 {
1077 INSTANCE_TYPE *ins = (INSTANCE_TYPE *) vins;
1078
1079 if (PrintUtilityData(theEnv)->InstanceAddressesToNames)
1080 {
1081 if (ins == &InstanceData(theEnv)->DummyInstance)
1082 EnvPrintRouter(theEnv,logName,"\"<Dummy Instance>\"");
1083 else
1084 {
1085 EnvPrintRouter(theEnv,logName,"[");
1086 EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
1087 EnvPrintRouter(theEnv,logName,"]");
1088 }
1089 }
1090 else
1091 {
1092 if (PrintUtilityData(theEnv)->AddressesToStrings)
1093 EnvPrintRouter(theEnv,logName,"\"");
1094 if (ins == &InstanceData(theEnv)->DummyInstance)
1095 EnvPrintRouter(theEnv,logName,"<Dummy Instance>");
1096 else if (ins->garbage)
1097 {
1098 EnvPrintRouter(theEnv,logName,"<Stale Instance-");
1099 EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
1100 EnvPrintRouter(theEnv,logName,">");
1101 }
1102 else
1103 {
1104 EnvPrintRouter(theEnv,logName,"<Instance-");
1105 EnvPrintRouter(theEnv,logName,ValueToString(GetFullInstanceName(theEnv,ins)));
1106 EnvPrintRouter(theEnv,logName,">");
1107 }
1108 if (PrintUtilityData(theEnv)->AddressesToStrings)
1109 EnvPrintRouter(theEnv,logName,"\"");
1110 }
1111 }
1112
1113 #if DEFRULE_CONSTRUCT
1114
1115 /***************************************************
1116 NAME : DecrementObjectBasisCount
1117 DESCRIPTION : Decrements the basis count of an
1118 object indicating that it is in
1119 use by the partial match of the
1120 currently executing rule
1121 INPUTS : The instance address
1122 RETURNS : Nothing useful
1123 SIDE EFFECTS : Basis count decremented and
1124 basis copy (possibly) deleted
1125 NOTES : When the count goes to zero, the
1126 basis copy of the object (if any)
1127 is deleted.
1128 ***************************************************/
DecrementObjectBasisCount(void * theEnv,void * vins)1129 globle void DecrementObjectBasisCount(
1130 void *theEnv,
1131 void *vins)
1132 {
1133 INSTANCE_TYPE *ins;
1134 long i;
1135
1136 ins = (INSTANCE_TYPE *) vins;
1137 ins->header.busyCount--;
1138 if (ins->header.busyCount == 0)
1139 {
1140 if (ins->garbage)
1141 RemoveInstanceData(theEnv,ins);
1142 if (ins->cls->instanceSlotCount != 0)
1143 {
1144 for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
1145 if (ins->basisSlots[i].value != NULL)
1146 {
1147 if (ins->basisSlots[i].desc->multiple)
1148 MultifieldDeinstall(theEnv,(struct multifield *) ins->basisSlots[i].value);
1149 else
1150 AtomDeinstall(theEnv,(int) ins->basisSlots[i].type,
1151 ins->basisSlots[i].value);
1152 }
1153 rm(theEnv,(void *) ins->basisSlots,
1154 (ins->cls->instanceSlotCount * sizeof(INSTANCE_SLOT)));
1155 ins->basisSlots = NULL;
1156 }
1157 }
1158 }
1159
1160 /***************************************************
1161 NAME : IncrementObjectBasisCount
1162 DESCRIPTION : Increments the basis count of an
1163 object indicating that it is in
1164 use by the partial match of the
1165 currently executing rule
1166
1167 If this the count was zero,
1168 allocate an array of extra
1169 instance slots for use by
1170 slot variables
1171 INPUTS : The instance address
1172 RETURNS : Nothing useful
1173 SIDE EFFECTS : Basis count incremented
1174 NOTES : None
1175 ***************************************************/
IncrementObjectBasisCount(void * theEnv,void * vins)1176 globle void IncrementObjectBasisCount(
1177 void *theEnv,
1178 void *vins)
1179 {
1180 INSTANCE_TYPE *ins;
1181 long i;
1182
1183 ins = (INSTANCE_TYPE *) vins;
1184 if (ins->header.busyCount == 0)
1185 {
1186 if (ins->cls->instanceSlotCount != 0)
1187 {
1188 ins->basisSlots = (INSTANCE_SLOT *)
1189 gm2(theEnv,(sizeof(INSTANCE_SLOT) * ins->cls->instanceSlotCount));
1190 for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
1191 {
1192 ins->basisSlots[i].desc = ins->slotAddresses[i]->desc;
1193 ins->basisSlots[i].value = NULL;
1194 }
1195 }
1196 }
1197 ins->header.busyCount++;
1198 }
1199
1200 /***************************************************
1201 NAME : MatchObjectFunction
1202 DESCRIPTION : Filters an instance through the
1203 object pattern network
1204 Used for incremental resets in
1205 binary loads and run-time modules
1206 INPUTS : The instance
1207 RETURNS : Nothing useful
1208 SIDE EFFECTS : Instance pattern-matched
1209 NOTES : None
1210 ***************************************************/
MatchObjectFunction(void * theEnv,void * vins)1211 globle void MatchObjectFunction(
1212 void *theEnv,
1213 void *vins)
1214 {
1215 ObjectNetworkAction(theEnv,OBJECT_ASSERT,(INSTANCE_TYPE *) vins,-1);
1216 }
1217
1218 /***************************************************
1219 NAME : NetworkSynchronized
1220 DESCRIPTION : Determines if state of instance is
1221 consistent with last push through
1222 pattern-matching network
1223 INPUTS : The instance
1224 RETURNS : TRUE if instance has not
1225 changed since last push through the
1226 Rete network, FALSE otherwise
1227 SIDE EFFECTS : None
1228 NOTES : None
1229 ***************************************************/
NetworkSynchronized(void * theEnv,void * vins)1230 globle intBool NetworkSynchronized(
1231 void *theEnv,
1232 void *vins)
1233 {
1234 #if MAC_XCD
1235 #pragma unused(theEnv)
1236 #endif
1237
1238 return(((INSTANCE_TYPE *) vins)->reteSynchronized);
1239 }
1240
1241 /***************************************************
1242 NAME : InstanceIsDeleted
1243 DESCRIPTION : Determines if an instance has been
1244 deleted
1245 INPUTS : The instance
1246 RETURNS : TRUE if instance has been deleted,
1247 FALSE otherwise
1248 SIDE EFFECTS : None
1249 NOTES : None
1250 ***************************************************/
InstanceIsDeleted(void * theEnv,void * vins)1251 globle intBool InstanceIsDeleted(
1252 void *theEnv,
1253 void *vins)
1254 {
1255 #if MAC_XCD
1256 #pragma unused(theEnv)
1257 #endif
1258
1259 return(((INSTANCE_TYPE *) vins)->garbage);
1260 }
1261 #endif
1262
1263 /* =========================================
1264 *****************************************
1265 INTERNALLY VISIBLE FUNCTIONS
1266 =========================================
1267 ***************************************** */
1268
1269 /*****************************************************
1270 NAME : FindImportedInstance
1271 DESCRIPTION : Searches imported modules for an
1272 instance of the correct name
1273 The imports are searched recursively
1274 in the order of the module definition
1275 INPUTS : 1) The module for which to
1276 search imported modules
1277 2) The currently active module
1278 3) The first instance of the
1279 correct name (cannot be NULL)
1280 RETURNS : An instance of the correct name
1281 imported from another module which
1282 is in scope of the current module
1283 SIDE EFFECTS : None
1284 NOTES : None
1285 *****************************************************/
FindImportedInstance(void * theEnv,struct defmodule * theModule,struct defmodule * currentModule,INSTANCE_TYPE * startInstance)1286 static INSTANCE_TYPE *FindImportedInstance(
1287 void *theEnv,
1288 struct defmodule *theModule,
1289 struct defmodule *currentModule,
1290 INSTANCE_TYPE *startInstance)
1291 {
1292 struct portItem *importList;
1293 INSTANCE_TYPE *ins;
1294
1295 if (theModule->visitedFlag)
1296 return(NULL);
1297 theModule->visitedFlag = TRUE;
1298 importList = theModule->importList;
1299 while (importList != NULL)
1300 {
1301 theModule = (struct defmodule *)
1302 EnvFindDefmodule(theEnv,ValueToString(importList->moduleName));
1303 for (ins = startInstance ;
1304 (ins != NULL) ? (ins->name == startInstance->name) : FALSE ;
1305 ins = ins->nxtHash)
1306 if ((ins->cls->header.whichModule->theModule == theModule) &&
1307 DefclassInScope(theEnv,ins->cls,currentModule))
1308 return(ins);
1309 ins = FindImportedInstance(theEnv,theModule,currentModule,startInstance);
1310 if (ins != NULL)
1311 return(ins);
1312 importList = importList->next;
1313 }
1314
1315 /* ========================================================
1316 Make sure instances of system classes are always visible
1317 ======================================================== */
1318 for (ins = startInstance ;
1319 (ins != NULL) ? (ins->name == startInstance->name) : FALSE ;
1320 ins = ins->nxtHash)
1321 if (ins->cls->system)
1322 return(ins);
1323
1324 return(NULL);
1325 }
1326
1327 #if DEFRULE_CONSTRUCT
1328
1329 /*****************************************************
1330 NAME : NetworkModifyForSharedSlot
1331 DESCRIPTION : Performs a Rete network modify for
1332 all instances which contain a
1333 specific shared slot
1334 INPUTS : 1) The traversal id to use when
1335 recursively entering subclasses
1336 to prevent duplicate examinations
1337 of a class
1338 2) The class
1339 3) The descriptor for the shared slot
1340 RETURNS : Nothing useful
1341 SIDE EFFECTS : Instances which contain the shared
1342 slot are filtered through the
1343 Rete network via a retract/assert
1344 NOTES : Assumes traversal id has been
1345 established
1346 *****************************************************/
NetworkModifyForSharedSlot(void * theEnv,int sharedTraversalID,DEFCLASS * cls,SLOT_DESC * sd)1347 static void NetworkModifyForSharedSlot(
1348 void *theEnv,
1349 int sharedTraversalID,
1350 DEFCLASS *cls,
1351 SLOT_DESC *sd)
1352 {
1353 INSTANCE_TYPE *ins;
1354 long i;
1355
1356 /* ================================================
1357 Make sure we haven't already examined this class
1358 ================================================ */
1359 if (TestTraversalID(cls->traversalRecord,sharedTraversalID))
1360 return;
1361 SetTraversalID(cls->traversalRecord,sharedTraversalID);
1362
1363 /* ===========================================
1364 If the instances of this class contain the
1365 shared slot, send update events to the Rete
1366 network for all of its instances
1367 =========================================== */
1368 if ((sd->slotName->id > cls->maxSlotNameID) ? FALSE :
1369 ((cls->slotNameMap[sd->slotName->id] == 0) ? FALSE :
1370 (cls->instanceTemplate[cls->slotNameMap[sd->slotName->id] - 1] == sd)))
1371 {
1372 for (ins = cls->instanceList ; ins != NULL ; ins = ins->nxtClass)
1373 ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sd->slotName->id);
1374 }
1375
1376 /* ==================================
1377 Check the subclasses of this class
1378 ================================== */
1379 for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
1380 NetworkModifyForSharedSlot(theEnv,sharedTraversalID,cls->directSubclasses.classArray[i],sd);
1381 }
1382
1383 #endif /* DEFRULE_CONSTRUCT */
1384
1385 /*#####################################*/
1386 /* ALLOW_ENVIRONMENT_GLOBALS Functions */
1387 /*#####################################*/
1388
1389 #if ALLOW_ENVIRONMENT_GLOBALS
1390
DecrementInstanceCount(void * vptr)1391 globle void DecrementInstanceCount(
1392 void *vptr)
1393 {
1394 EnvDecrementInstanceCount(GetCurrentEnvironment(),vptr);
1395 }
1396
GetInstancesChanged()1397 globle int GetInstancesChanged()
1398 {
1399 return EnvGetInstancesChanged(GetCurrentEnvironment());
1400 }
1401
IncrementInstanceCount(void * vptr)1402 globle void IncrementInstanceCount(
1403 void *vptr)
1404 {
1405 EnvIncrementInstanceCount(GetCurrentEnvironment(),vptr);
1406 }
1407
SetInstancesChanged(int changed)1408 globle void SetInstancesChanged(
1409 int changed)
1410 {
1411 EnvSetInstancesChanged(GetCurrentEnvironment(),changed);
1412 }
1413
1414 #endif /* ALLOW_ENVIRONMENT_GLOBALS */
1415
1416 #endif /* OBJECT_SYSTEM */
1417
1418
1419