📄 inscom.c
字号:
/*******************************************************/
/* "C" Language Integrated Production System */
/* */
/* CLIPS Version 6.24 05/17/06 */
/* */
/* INSTANCE COMMAND MODULE */
/*******************************************************/
/*************************************************************/
/* Purpose: Kernel Interface Commands for Instances */
/* */
/* Principal Programmer(s): */
/* Brian L. Donnell */
/* */
/* Contributing Programmer(s): */
/* */
/* Revision History: */
/* 6.23: Correction for FalseSymbol/TrueSymbol. DR0859 */
/* */
/* Corrected compilation errors for files */
/* generated by constructs-to-c. DR0861 */
/* */
/* 6.24: Loading a binary instance file from a run-time */
/* program caused a bus error. DR0866 */
/* */
/* Removed LOGICAL_DEPENDENCIES compilation flag. */
/* */
/* Converted INSTANCE_PATTERN_MATCHING to */
/* DEFRULE_CONSTRUCT. */
/* */
/* Renamed BOOLEAN macro type to intBool. */
/* */
/*************************************************************/
/* =========================================
*****************************************
EXTERNAL DEFINITIONS
=========================================
***************************************** */
#include "setup.h"
#if OBJECT_SYSTEM
#include "argacces.h"
#include "classcom.h"
#include "classfun.h"
#include "classinf.h"
#include "envrnmnt.h"
#include "exprnpsr.h"
#include "evaluatn.h"
#include "insfile.h"
#include "insfun.h"
#include "insmngr.h"
#include "insmoddp.h"
#include "insmult.h"
#include "inspsr.h"
#include "lgcldpnd.h"
#include "memalloc.h"
#include "msgcom.h"
#include "msgfun.h"
#include "router.h"
#include "strngrtr.h"
#include "sysdep.h"
#include "utility.h"
#include "commline.h"
#define _INSCOM_SOURCE_
#include "inscom.h"
/* =========================================
*****************************************
CONSTANTS
=========================================
***************************************** */
#define ALL_QUALIFIER "inherit"
/* =========================================
*****************************************
INTERNALLY VISIBLE FUNCTION HEADERS
=========================================
***************************************** */
#if DEBUGGING_FUNCTIONS
static long ListInstancesInModule(void *,int,char *,char *,intBool,intBool);
static long TabulateInstances(void *,int,char *,DEFCLASS *,intBool,intBool);
#endif
static void PrintInstance(void *,char *,INSTANCE_TYPE *,char *);
static INSTANCE_SLOT *FindISlotByName(void *,INSTANCE_TYPE *,char *);
static void DeallocateInstanceData(void *);
/* =========================================
*****************************************
EXTERNALLY VISIBLE FUNCTIONS
=========================================
***************************************** */
/*********************************************************
NAME : SetupInstances
DESCRIPTION : Initializes instance Hash Table,
Function Parsers, and Data Structures
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : None
*********************************************************/
globle void SetupInstances(
void *theEnv)
{
struct patternEntityRecord instanceInfo = { { "INSTANCE_ADDRESS",
INSTANCE_ADDRESS,0,0,0,
PrintInstanceName,
PrintInstanceLongForm,
EnvUnmakeInstance,
NULL,
EnvGetNextInstance,
EnvDecrementInstanceCount,
EnvIncrementInstanceCount,
NULL,NULL,NULL,NULL
},
#if DEFRULE_CONSTRUCT && OBJECT_SYSTEM
DecrementObjectBasisCount,
IncrementObjectBasisCount,
MatchObjectFunction,
NetworkSynchronized
#else
NULL,NULL,NULL,NULL
#endif
};
INSTANCE_TYPE dummyInstance = { { NULL }, NULL,NULL, 0, 1 };
AllocateEnvironmentData(theEnv,INSTANCE_DATA,sizeof(struct instanceData),DeallocateInstanceData);
InstanceData(theEnv)->MkInsMsgPass = TRUE;
memcpy(&InstanceData(theEnv)->InstanceInfo,&instanceInfo,sizeof(struct patternEntityRecord));
dummyInstance.header.theInfo = &InstanceData(theEnv)->InstanceInfo;
memcpy(&InstanceData(theEnv)->DummyInstance,&dummyInstance,sizeof(INSTANCE_TYPE));
InitializeInstanceTable(theEnv);
InstallPrimitive(theEnv,(struct entityRecord *) &InstanceData(theEnv)->InstanceInfo,INSTANCE_ADDRESS);
#if ! RUN_TIME
#if DEFRULE_CONSTRUCT && OBJECT_SYSTEM
EnvDefineFunction2(theEnv,"initialize-instance",'u',
PTIEF InactiveInitializeInstance,"InactiveInitializeInstance",NULL);
EnvDefineFunction2(theEnv,"active-initialize-instance",'u',
PTIEF InitializeInstanceCommand,"InitializeInstanceCommand",NULL);
AddFunctionParser(theEnv,"active-initialize-instance",ParseInitializeInstance);
EnvDefineFunction2(theEnv,"make-instance",'u',PTIEF InactiveMakeInstance,"InactiveMakeInstance",NULL);
EnvDefineFunction2(theEnv,"active-make-instance",'u',PTIEF MakeInstanceCommand,"MakeInstanceCommand",NULL);
AddFunctionParser(theEnv,"active-make-instance",ParseInitializeInstance);
#else
EnvDefineFunction2(theEnv,"initialize-instance",'u',
PTIEF InitializeInstanceCommand,"InitializeInstanceCommand",NULL);
EnvDefineFunction2(theEnv,"make-instance",'u',PTIEF MakeInstanceCommand,"MakeInstanceCommand",NULL);
#endif
AddFunctionParser(theEnv,"initialize-instance",ParseInitializeInstance);
AddFunctionParser(theEnv,"make-instance",ParseInitializeInstance);
EnvDefineFunction2(theEnv,"init-slots",'u',PTIEF InitSlotsCommand,"InitSlotsCommand","00");
EnvDefineFunction2(theEnv,"delete-instance",'b',PTIEF DeleteInstanceCommand,
"DeleteInstanceCommand","00");
EnvDefineFunction2(theEnv,"(create-instance)",'b',PTIEF CreateInstanceHandler,
"CreateInstanceHandler","00");
EnvDefineFunction2(theEnv,"unmake-instance",'b',PTIEF UnmakeInstanceCommand,
"UnmakeInstanceCommand","1*e");
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,"instances",'v',PTIEF InstancesCommand,"InstancesCommand","*3w");
EnvDefineFunction2(theEnv,"ppinstance",'v',PTIEF PPInstanceCommand,"PPInstanceCommand","00");
#endif
EnvDefineFunction2(theEnv,"symbol-to-instance-name",'u',
PTIEF SymbolToInstanceName,"SymbolToInstanceName","11w");
EnvDefineFunction2(theEnv,"instance-name-to-symbol",'w',
PTIEF InstanceNameToSymbol,"InstanceNameToSymbol","11p");
EnvDefineFunction2(theEnv,"instance-address",'u',PTIEF InstanceAddressCommand,
"InstanceAddressCommand","12eep");
EnvDefineFunction2(theEnv,"instance-addressp",'b',PTIEF InstanceAddressPCommand,
"InstanceAddressPCommand","11");
EnvDefineFunction2(theEnv,"instance-namep",'b',PTIEF InstanceNamePCommand,
"InstanceNamePCommand","11");
EnvDefineFunction2(theEnv,"instance-name",'u',PTIEF InstanceNameCommand,
"InstanceNameCommand","11e");
EnvDefineFunction2(theEnv,"instancep",'b',PTIEF InstancePCommand,"InstancePCommand","11");
EnvDefineFunction2(theEnv,"instance-existp",'b',PTIEF InstanceExistPCommand,
"InstanceExistPCommand","11e");
EnvDefineFunction2(theEnv,"class",'u',PTIEF ClassCommand,"ClassCommand","11");
SetupInstanceModDupCommands(theEnv);
/* SetupInstanceFileCommands(theEnv); DR0866 */
SetupInstanceMultifieldCommands(theEnv);
#endif
SetupInstanceFileCommands(theEnv); /* DR0866 */
AddCleanupFunction(theEnv,"instances",CleanupInstances,0);
EnvAddResetFunction(theEnv,"instances",DestroyAllInstances,60);
}
/***************************************/
/* DeallocateInstanceData: Deallocates */
/* environment data for instances. */
/***************************************/
static void DeallocateInstanceData(
void *theEnv)
{
INSTANCE_TYPE *tmpIPtr, *nextIPtr;
register unsigned i;
INSTANCE_SLOT *sp;
IGARBAGE *tmpGPtr, *nextGPtr;
struct patternMatch *theMatch, *tmpMatch;
/*=================================*/
/* Remove the instance hash table. */
/*=================================*/
rm(theEnv,InstanceData(theEnv)->InstanceTable,
(int) (sizeof(INSTANCE_TYPE *) * INSTANCE_TABLE_HASH_SIZE));
/*=======================*/
/* Return all instances. */
/*=======================*/
tmpIPtr = InstanceData(theEnv)->InstanceList;
while (tmpIPtr != NULL)
{
nextIPtr = tmpIPtr->nxtList;
theMatch = (struct patternMatch *) tmpIPtr->partialMatchList;
while (theMatch != NULL)
{
tmpMatch = theMatch->next;
rtn_struct(theEnv,patternMatch,theMatch);
theMatch = tmpMatch;
}
#if DEFRULE_CONSTRUCT
ReturnEntityDependencies(theEnv,(struct patternEntity *) tmpIPtr);
#endif
for (i = 0 ; i < tmpIPtr->cls->instanceSlotCount ; i++)
{
sp = tmpIPtr->slotAddresses[i];
if ((sp == &sp->desc->sharedValue) ?
(--sp->desc->sharedCount == 0) : TRUE)
{
if (sp->desc->multiple)
{ ReturnMultifield(theEnv,(MULTIFIELD_PTR) sp->value); }
}
}
if (tmpIPtr->cls->instanceSlotCount != 0)
{
rm(theEnv,(void *) tmpIPtr->slotAddresses,
(tmpIPtr->cls->instanceSlotCount * sizeof(INSTANCE_SLOT *)));
if (tmpIPtr->cls->localInstanceSlotCount != 0)
{
rm(theEnv,(void *) tmpIPtr->slots,
(tmpIPtr->cls->localInstanceSlotCount * sizeof(INSTANCE_SLOT)));
}
}
rtn_struct(theEnv,instance,tmpIPtr);
tmpIPtr = nextIPtr;
}
/*===============================*/
/* Get rid of garbage instances. */
/*===============================*/
tmpGPtr = InstanceData(theEnv)->InstanceGarbageList;
while (tmpGPtr != NULL)
{
nextGPtr = tmpGPtr->nxt;
rtn_struct(theEnv,instance,tmpGPtr->ins);
rtn_struct(theEnv,igarbage,tmpGPtr);
tmpGPtr = nextGPtr;
}
}
/*******************************************************************
NAME : EnvDeleteInstance
DESCRIPTION : DIRECTLY removes a named instance from the
hash table and its class's
instance list
INPUTS : The instance address (NULL to delete all instances)
RETURNS : 1 if successful, 0 otherwise
SIDE EFFECTS : Instance is deallocated
NOTES : C interface for deleting instances
*******************************************************************/
globle intBool EnvDeleteInstance(
void *theEnv,
void *iptr)
{
INSTANCE_TYPE *ins,*itmp;
int success = 1;
if (iptr != NULL)
return(QuashInstance(theEnv,(INSTANCE_TYPE *) iptr));
ins = InstanceData(theEnv)->InstanceList;
while (ins != NULL)
{
itmp = ins;
ins = ins->nxtList;
if (QuashInstance(theEnv,(INSTANCE_TYPE *) itmp) == 0)
success = 0;
}
if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
(EvaluationData(theEnv)->CurrentExpression == NULL))
{ PeriodicCleanup(theEnv,TRUE,FALSE); }
return(success);
}
/*******************************************************************
NAME : EnvUnmakeInstance
DESCRIPTION : Removes a named instance via message-passing
INPUTS : The instance address (NULL to delete all instances)
RETURNS : 1 if successful, 0 otherwise
SIDE EFFECTS : Instance is deallocated
NOTES : C interface for deleting instances
*******************************************************************/
globle intBool EnvUnmakeInstance(
void *theEnv,
void *iptr)
{
INSTANCE_TYPE *ins;
int success = 1,svmaintain;
svmaintain = InstanceData(theEnv)->MaintainGarbageInstances;
InstanceData(theEnv)->MaintainGarbageInstances = TRUE;
ins = (INSTANCE_TYPE *) iptr;
if (ins != NULL)
{
if (ins->garbage)
success = 0;
else
{
DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL);
if (ins->garbage == 0)
success = 0;
}
}
else
{
ins = InstanceData(theEnv)->InstanceList;
while (ins != NULL)
{
DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL);
if (ins->garbage == 0)
success = 0;
ins = ins->nxtList;
while ((ins != NULL) ? ins->garbage : FALSE)
ins = ins->nxtList;
}
}
InstanceData(theEnv)->MaintainGarbageInstances = svmaintain;
CleanupInstances(theEnv);
if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
(EvaluationData(theEnv)->CurrentExpression == NULL))
{ PeriodicCleanup(theEnv,TRUE,FALSE); }
return(success);
}
#if DEBUGGING_FUNCTIONS
/*******************************************************************
NAME : InstancesCommand
DESCRIPTION : Lists all instances associated
with a particular class
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : H/L Syntax : (instances [<class-name> [inherit]])
*******************************************************************/
globle void InstancesCommand(
void *theEnv)
{
int argno, inheritFlag = FALSE;
void *theDefmodule;
char *className = NULL;
DATA_OBJECT temp;
theDefmodule = (void *) EnvGetCurrentModule(theEnv);
argno = EnvRtnArgCount(theEnv);
if (argno > 0)
{
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -