/*************************************************** NAME : SetupMessageHandlers DESCRIPTION : Sets up internal symbols and fucntion definitions pertaining to message-handlers. Also creates system handlers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions and data structures initialized NOTES : Should be called before SetupInstanceModDupCommands() in INSMODDP.C ***************************************************/ globle void SetupMessageHandlers() { InstallPrimitive(&HandlerGetInfo,HANDLER_GET); InstallPrimitive(&HandlerPutInfo,HANDLER_PUT); #if ! RUN_TIME INIT_SYMBOL = (SYMBOL_HN *) AddSymbol(INIT_STRING); IncrementSymbolCount(INIT_SYMBOL); DELETE_SYMBOL = (SYMBOL_HN *) AddSymbol(DELETE_STRING); IncrementSymbolCount(DELETE_SYMBOL); AddClearFunction("defclass",CreateSystemHandlers,-100); #if ! BLOAD_ONLY SELF_SYMBOL = (SYMBOL_HN *) AddSymbol(SELF_STRING); IncrementSymbolCount(SELF_SYMBOL); AddConstruct("defmessage-handler","defmessage-handlers", ParseDefmessageHandler,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL); DefineFunction2("undefmessage-handler",'v',PTIF UndefmessageHandlerCommand, "UndefmessageHandlerCommand","23w"); #endif DefineFunction2("send",'u',PTIF SendCommand,"SendCommand","2*uuw"); #if DEBUGGING_FUNCTIONS DefineFunction2("preview-send",'v',PTIF PreviewSendCommand,"PreviewSendCommand","22w"); DefineFunction2("ppdefmessage-handler",'v',PTIF PPDefmessageHandlerCommand, "PPDefmessageHandlerCommand","23w"); DefineFunction2("list-defmessage-handlers",'v',PTIF ListDefmessageHandlersCommand, "ListDefmessageHandlersCommand","02w"); #endif #if IMPERATIVE_MESSAGE_HANDLERS DefineFunction2("next-handlerp",'b',PTIF NextHandlerAvailable,"NextHandlerAvailable","00"); FuncSeqOvlFlags("next-handlerp",TRUE,FALSE); DefineFunction2("call-next-handler",'u', PTIF CallNextHandler,"CallNextHandler","00"); FuncSeqOvlFlags("call-next-handler",TRUE,FALSE); DefineFunction2("override-next-handler",'u', PTIF CallNextHandler,"CallNextHandler",NULL); FuncSeqOvlFlags("override-next-handler",TRUE,FALSE); #endif DefineFunction2("dynamic-get",'u',PTIF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w"); DefineFunction2("dynamic-put",'u',PTIF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w"); DefineFunction2("get",'u',PTIF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w"); DefineFunction2("put",'u',PTIF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w"); #endif #if DEBUGGING_FUNCTIONS AddWatchItem("messages",0,&WatchMessages,36,NULL,NULL); AddWatchItem("message-handlers",0,&WatchHandlers,35, DefmessageHandlerWatchAccess,DefmessageHandlerWatchPrint); #endif }
/********************************************************** NAME : SetupObjectSystem DESCRIPTION : Initializes all COOL constructs, functions, and data structures INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : COOL initialized NOTES : Order of setup calls is important **********************************************************/ globle void SetupObjectSystem( void *theEnv) { ENTITY_RECORD defclassEntityRecord = { (char*)"DEFCLASS_PTR", DEFCLASS_PTR,1,0,0, NULL,NULL,NULL,NULL,NULL, DecrementDefclassBusyCount, IncrementDefclassBusyCount, NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,DEFCLASS_DATA,sizeof(struct defclassData),NULL); AddEnvironmentCleanupFunction(theEnv,(char*)"defclasses",DeallocateDefclassData,-500); memcpy(&DefclassData(theEnv)->DefclassEntityRecord,&defclassEntityRecord,sizeof(struct entityRecord)); #if ! RUN_TIME DefclassData(theEnv)->ClassDefaultsMode = CONVENIENCE_MODE; DefclassData(theEnv)->ISA_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SUPERCLASS_RLN); IncrementSymbolCount(DefclassData(theEnv)->ISA_SYMBOL); DefclassData(theEnv)->NAME_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,NAME_RLN); IncrementSymbolCount(DefclassData(theEnv)->NAME_SYMBOL); #if DEFRULE_CONSTRUCT DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INITIAL_OBJECT_NAME); IncrementSymbolCount(DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); #endif #endif SetupDefclasses(theEnv); SetupInstances(theEnv); SetupMessageHandlers(theEnv); #if DEFINSTANCES_CONSTRUCT SetupDefinstances(theEnv); #endif #if INSTANCE_SET_QUERIES SetupQuery(theEnv); #endif #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY SetupObjectsBload(theEnv); #endif #if CONSTRUCT_COMPILER && (! RUN_TIME) SetupObjectsCompiler(theEnv); #endif #if DEFRULE_CONSTRUCT SetupObjectPatternStuff(theEnv); #endif }
/************************************************************** NAME : NewSlot DESCRIPTION : Allocates and initalizes a new slot structure INPUTS : The symbolic name of the new slot RETURNS : The address of the new slot SIDE EFFECTS : None NOTES : Also adds symbols of the form get-<name> and put-<name> for slot accessors **************************************************************/ static SLOT_DESC *NewSlot( void *theEnv, EXEC_STATUS, SYMBOL_HN *name) { SLOT_DESC *slot; slot = get_struct(theEnv,execStatus,slotDescriptor); slot->dynamicDefault = 1; slot->defaultSpecified = 0; slot->noDefault = 0; #if DEFRULE_CONSTRUCT slot->reactive = 1; #endif slot->noInherit = 0; slot->noWrite = 0; slot->initializeOnly = 0; slot->shared = 0; slot->multiple = 0; slot->composite = 0; slot->sharedCount = 0; slot->publicVisibility = 0; slot->createReadAccessor = FALSE; slot->createWriteAccessor = FALSE; slot->overrideMessageSpecified = 0; slot->cls = NULL; slot->defaultValue = NULL; slot->constraint = GetConstraintRecord(theEnv,execStatus); slot->slotName = AddSlotName(theEnv,execStatus,name,0,FALSE); slot->overrideMessage = slot->slotName->putHandlerName; IncrementSymbolCount(slot->overrideMessage); return(slot); }
/*************************************************** NAME : UpdateConstructHeader DESCRIPTION : Determines field values for construct header from binary-load buffer INPUTS : 1) The binary-load data for the construct header 2) The actual construct header 3) The size of a defmodule item for this construct 4) The array of all defmodule items for this construct 5) The size of this construct 6) The array of these constructs RETURNS : Nothing useful SIDE EFFECTS : Header values set NOTES : None ***************************************************/ LOCALE void UpdateConstructHeader( struct bsaveConstructHeader *theBsaveConstruct, struct constructHeader *theConstruct, int itemModuleSize, void *itemModuleArray, int itemSize, void *itemArray) { long moduleOffset, itemOffset; moduleOffset = itemModuleSize * theBsaveConstruct->whichModule; theConstruct->whichModule = (struct defmoduleItemHeader *) &((char *) itemModuleArray)[moduleOffset]; theConstruct->name = SymbolPointer(theBsaveConstruct->name); IncrementSymbolCount(theConstruct->name); if (theBsaveConstruct->next != -1L) { itemOffset = itemSize * theBsaveConstruct->next; theConstruct->next = (struct constructHeader *) &((char *) itemArray)[itemOffset]; } else theConstruct->next = NULL; theConstruct->ppForm = NULL; theConstruct->bsaveID = 0L; theConstruct->usrData = NULL; }
static void UpdateDeftemplateSlot( void *theEnv, void *buf, long obji) { struct templateSlot *theSlot; struct bsaveTemplateSlot *btsPtr; btsPtr = (struct bsaveTemplateSlot *) buf; theSlot = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji]; theSlot->slotName = SymbolPointer(btsPtr->slotName); IncrementSymbolCount(theSlot->slotName); theSlot->defaultList = HashedExpressionPointer(btsPtr->defaultList); theSlot->facetList = HashedExpressionPointer(btsPtr->facetList); theSlot->constraints = ConstraintPointer(btsPtr->constraints); theSlot->multislot = btsPtr->multislot; theSlot->noDefault = btsPtr->noDefault; theSlot->defaultPresent = btsPtr->defaultPresent; theSlot->defaultDynamic = btsPtr->defaultDynamic; if (btsPtr->next != -1L) { theSlot->next = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji + 1]; } else { theSlot->next = NULL; } }
globle int DefineFunction2( char *name, int returnType, int (*pointer)(void), char *actualName, char *restrictions) { struct FunctionDefinition *newFunction; if ( (returnType != 'a') && (returnType != 'b') && (returnType != 'c') && (returnType != 'd') && (returnType != 'f') && (returnType != 'i') && (returnType != 'j') && (returnType != 'k') && (returnType != 'l') && (returnType != 'm') && (returnType != 'n') && #if OBJECT_SYSTEM (returnType != 'o') && #endif (returnType != 's') && (returnType != 'u') && (returnType != 'v') && #if OBJECT_SYSTEM (returnType != 'x') && #endif (returnType != 'w') ) { return(0); } newFunction = get_struct(FunctionDefinition); newFunction->callFunctionName = (SYMBOL_HN *) AddSymbol(name); newFunction->returnValueType = (char) returnType; newFunction->functionPointer = pointer; newFunction->next = GetFunctionList(); newFunction->actualFunctionName = actualName; if (restrictions != NULL) { if (((int) (strlen(restrictions)) < 2) ? TRUE : ((! isdigit(restrictions[0]) && (restrictions[0] != '*')) || (! isdigit(restrictions[1]) && (restrictions[1] != '*')))) restrictions = NULL; } newFunction->restrictions = restrictions; newFunction->parser = NULL; newFunction->overloadable = TRUE; newFunction->sequenceuseok = TRUE; newFunction->usrData = NULL; IncrementSymbolCount(newFunction->callFunctionName); ListOfFunctions = newFunction; AddHashFunction(newFunction); return(1); }
static void UpdateSlotName( void *buf, long obji) { SLOT_NAME *snp; BSAVE_SLOT_NAME *bsnp; bsnp = (BSAVE_SLOT_NAME *) buf; snp = (SLOT_NAME *) &slotNameArray[obji]; snp->id = bsnp->id; snp->name = SymbolPointer(bsnp->name); IncrementSymbolCount(snp->name); snp->putHandlerName = SymbolPointer(bsnp->putHandlerName); IncrementSymbolCount(snp->putHandlerName); snp->hashTableIndex = bsnp->hashTableIndex; snp->nxt = SlotNameTable[snp->hashTableIndex]; SlotNameTable[snp->hashTableIndex] = snp; }
globle void InstallDeftemplate( void *theEnv, struct deftemplate *theDeftemplate) { struct templateSlot *slotPtr; struct expr *tempExpr; IncrementSymbolCount(theDeftemplate->header.name); for (slotPtr = theDeftemplate->slotList; slotPtr != NULL; slotPtr = slotPtr->next) { IncrementSymbolCount(slotPtr->slotName); tempExpr = AddHashedExpression(theEnv,slotPtr->defaultList); ReturnExpression(theEnv,slotPtr->defaultList); slotPtr->defaultList = tempExpr; slotPtr->constraints = AddConstraint(theEnv,slotPtr->constraints); } }
static void UpdateDefmodule( void *theEnv, void *buf, long obji) { struct bsaveDefmodule *bdp; struct moduleItem *theItem; int i; bdp = (struct bsaveDefmodule *) buf; DefmoduleData(theEnv)->DefmoduleArray[obji].name = SymbolPointer(bdp->name); IncrementSymbolCount(DefmoduleData(theEnv)->DefmoduleArray[obji].name); if (bdp->next != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].next = (struct defmodule *) &DefmoduleData(theEnv)->DefmoduleArray[bdp->next]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].next = NULL; } if (GetNumberOfModuleItems(theEnv) == 0) { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = NULL; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * GetNumberOfModuleItems(theEnv)); } for (i = 0, theItem = GetListOfModuleItems(theEnv); (i < GetNumberOfModuleItems(theEnv)) && (theItem != NULL) ; i++, theItem = theItem->next) { if (theItem->bloadModuleReference == NULL) { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] = NULL; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] = (struct defmoduleItemHeader *) (*theItem->bloadModuleReference)(theEnv,obji); } } DefmoduleData(theEnv)->DefmoduleArray[obji].ppForm = NULL; if (bdp->importList != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].importList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->importList]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].importList = NULL; } if (bdp->exportList != -1L) { DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->exportList]; } else { DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = NULL; } DefmoduleData(theEnv)->DefmoduleArray[obji].bsaveID = bdp->bsaveID; }
static void UpdatePortItem( void *theEnv, void *buf, long obji) { struct bsavePortItem *bdp; bdp = (struct bsavePortItem *) buf; if (bdp->moduleName != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].moduleName = SymbolPointer(bdp->moduleName); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].moduleName); } else { DefmoduleData(theEnv)->PortItemArray[obji].moduleName = NULL; } if (bdp->constructType != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].constructType = SymbolPointer(bdp->constructType); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructType); } else { DefmoduleData(theEnv)->PortItemArray[obji].constructType = NULL; } if (bdp->constructName != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].constructName = SymbolPointer(bdp->constructName); IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructName); } else { DefmoduleData(theEnv)->PortItemArray[obji].constructName = NULL; } if (bdp->next != -1L) { DefmoduleData(theEnv)->PortItemArray[obji].next = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->next]; } else { DefmoduleData(theEnv)->PortItemArray[obji].next = NULL; } }
static void UpdateSlot( void *buf, long obji) { SLOT_DESC *sp; BSAVE_SLOT_DESC *bsp; sp = (SLOT_DESC *) &slotArray[obji]; bsp = (BSAVE_SLOT_DESC *) buf; sp->dynamicDefault = bsp->dynamicDefault; sp->noDefault = bsp->noDefault; sp->shared = bsp->shared; sp->multiple = bsp->multiple; sp->composite = bsp->composite; sp->noInherit = bsp->noInherit; sp->noWrite = bsp->noWrite; sp->initializeOnly = bsp->initializeOnly; sp->reactive = bsp->reactive; sp->publicVisibility = bsp->publicVisibility; sp->createReadAccessor = bsp->createReadAccessor; sp->createWriteAccessor = bsp->createWriteAccessor; sp->cls = DefclassPointer(bsp->cls); sp->slotName = SlotNamePointer(bsp->slotName); sp->overrideMessage = SymbolPointer(bsp->overrideMessage); IncrementSymbolCount(sp->overrideMessage); if (bsp->defaultValue != -1L) { if (sp->dynamicDefault) sp->defaultValue = (void *) ExpressionPointer(bsp->defaultValue); else { sp->defaultValue = (void *) get_struct(dataObject); EvaluateAndStoreInDataObject((int) sp->multiple,ExpressionPointer(bsp->defaultValue), (DATA_OBJECT *) sp->defaultValue); ValueInstall((DATA_OBJECT *) sp->defaultValue); } } else sp->defaultValue = NULL; sp->constraint = ConstraintPointer(bsp->constraint); sp->sharedCount = 0; sp->sharedValue.value = NULL; sp->bsaveIndex = 0L; if (sp->shared) { sp->sharedValue.desc = sp; sp->sharedValue.value = NULL; } }
globle void AtomInstall( int type, void *vPtr) { switch (type) { case SYMBOL: case STRING: #if DEFGLOBAL_CONSTRUCT case GBL_VARIABLE: #endif #if OBJECT_SYSTEM case INSTANCE_NAME: #endif IncrementSymbolCount(vPtr); break; case FLOAT: IncrementFloatCount(vPtr); break; case INTEGER: IncrementIntegerCount(vPtr); break; case MULTIFIELD: MultifieldInstall((struct multifield *) vPtr); break; #if FUZZY_DEFTEMPLATES /* fuzzy values have a name which is a symbol */ case FUZZY_VALUE: InstallFuzzyValue(vPtr); break; #endif case RVOID: break; default: if (PrimitivesArray[type] == NULL) break; if (PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr); else if (PrimitivesArray[type]->incrementBusyCount) { (*PrimitivesArray[type]->incrementBusyCount)(vPtr); } break; } }
globle void AtomInstall( void *theEnv, int type, void *vPtr) { switch (type) { case SYMBOL: case STRING: #if DEFGLOBAL_CONSTRUCT case GBL_VARIABLE: #endif #if OBJECT_SYSTEM case INSTANCE_NAME: #endif IncrementSymbolCount(vPtr); break; case FLOAT: IncrementFloatCount(vPtr); break; case INTEGER: IncrementIntegerCount(vPtr); break; case EXTERNAL_ADDRESS: IncrementExternalAddressCount(vPtr); break; case MULTIFIELD: MultifieldInstall(theEnv,(struct multifield *) vPtr); break; case RVOID: break; default: if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break; if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr); else if (EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount) { (*EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount)(theEnv,vPtr); } break; } }
/********************************************************* NAME : AddSystemClass DESCRIPTION : Performs all necessary allocations for adding a system class INPUTS : 1) The name-string of the system class 2) The address of the parent class (NULL if none) RETURNS : The address of the new system class SIDE EFFECTS : Allocations performed NOTES : Assumes system-class name is unique Also assumes SINGLE INHERITANCE for system classes to simplify precedence list determination Adds classes to has table but NOT to class list (this is responsibility of caller) *********************************************************/ static DEFCLASS *AddSystemClass( void *theEnv, char *name, DEFCLASS *parent) { DEFCLASS *sys; long i; char defaultScopeMap[1]; sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name)); sys->abstract = 1; #if DEFRULE_CONSTRUCT sys->reactive = 0; #endif IncrementSymbolCount(sys->header.name); sys->installed = 1; sys->system = 1; sys->hashTableIndex = HashClass(sys->header.name); AddClassLink(theEnv,&sys->allSuperclasses,sys,-1); if (parent != NULL) { AddClassLink(theEnv,&sys->directSuperclasses,parent,-1); AddClassLink(theEnv,&parent->directSubclasses,sys,-1); AddClassLink(theEnv,&sys->allSuperclasses,parent,-1); for (i = 1 ; i < parent->allSuperclasses.classCount ; i++) AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1); } sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex]; DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys; /* ========================================= Add default scope maps for a system class There is only one module (MAIN) so far - which has an id of 0 ========================================= */ ClearBitString((void *) defaultScopeMap,(int) sizeof(char)); SetBitMap(defaultScopeMap,0); #if DEFMODULE_CONSTRUCT sys->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char)); IncrementBitMapCount(sys->scopeMap); #endif return(sys); }
/**************************************************** NAME : SetupFactQuery DESCRIPTION : Initializes fact query H/L functions and parsers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Sets up kernel functions and parsers NOTES : None ****************************************************/ globle void SetupFactQuery( void *theEnv) { AllocateEnvironmentData(theEnv,FACT_QUERY_DATA,sizeof(struct factQueryData),NULL); #if RUN_TIME FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING); #endif #if ! RUN_TIME FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,QUERY_DELIMETER_STRING); IncrementSymbolCount(FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL); EnvDefineFunction2(theEnv,"(query-fact)",'u', PTIEF GetQueryFact,"GetQueryFact",NULL); EnvDefineFunction2(theEnv,"(query-fact-slot)",'u', PTIEF GetQueryFactSlot,"GetQueryFactSlot",NULL); EnvDefineFunction2(theEnv,"any-factp",'b',PTIEF AnyFacts,"AnyFacts",NULL); AddFunctionParser(theEnv,"any-factp",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"find-fact",'m', PTIEF QueryFindFact,"QueryFindFact",NULL); AddFunctionParser(theEnv,"find-fact",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"find-all-facts",'m', PTIEF QueryFindAllFacts,"QueryFindAllFacts",NULL); AddFunctionParser(theEnv,"find-all-facts",FactParseQueryNoAction); EnvDefineFunction2(theEnv,"do-for-fact",'u', PTIEF QueryDoForFact,"QueryDoForFact",NULL); AddFunctionParser(theEnv,"do-for-fact",FactParseQueryAction); EnvDefineFunction2(theEnv,"do-for-all-facts",'u', PTIEF QueryDoForAllFacts,"QueryDoForAllFacts",NULL); AddFunctionParser(theEnv,"do-for-all-facts",FactParseQueryAction); EnvDefineFunction2(theEnv,"delayed-do-for-all-facts",'u', PTIEF DelayedQueryDoForAllFacts, "DelayedQueryDoForAllFacts",NULL); AddFunctionParser(theEnv,"delayed-do-for-all-facts",FactParseQueryAction); #endif }
static void ClearDeffacts( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) struct expr *stub; struct deffacts *newDeffacts; /*=====================================*/ /* Create the data structures for the */ /* expression (assert (initial-fact)). */ /*=====================================*/ stub = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert")); stub->argList = GenConstant(theEnv,DEFTEMPLATE_PTR,EnvFindDeftemplate(theEnv,"initial-fact")); ExpressionInstall(theEnv,stub); /*=============================================*/ /* Create a deffacts data structure to contain */ /* the expression and initialize it. */ /*=============================================*/ newDeffacts = get_struct(theEnv,deffacts); newDeffacts->header.whichModule = (struct defmoduleItemHeader *) GetDeffactsModuleItem(theEnv,NULL); newDeffacts->header.name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"); IncrementSymbolCount(newDeffacts->header.name); newDeffacts->assertList = PackExpression(theEnv,stub); newDeffacts->header.next = NULL; newDeffacts->header.ppForm = NULL; newDeffacts->header.usrData = NULL; ReturnExpression(theEnv,stub); /*===========================================*/ /* Store the deffacts in the current module. */ /*===========================================*/ AddConstructToModule(&newDeffacts->header); #else #if MAC_MCW || WIN_MCW || MAC_XCD #pragma unused(theEnv) #endif #endif }
static void UpdateHandler( void *buf, long obji) { HANDLER *hnd; BSAVE_HANDLER *bhnd; hnd = (HANDLER *) &handlerArray[obji]; bhnd = (BSAVE_HANDLER *) buf; hnd->system = bhnd->system; hnd->type = bhnd->type; #if (! IMPERATIVE_MESSAGE_HANDLERS) if (hnd->type == MAROUND) { PrintWarningID("OBJBIN",1,FALSE); PrintRouter(WWARNING,"Around message-handlers are not\n"); PrintRouter(WWARNING," supported in this environment."); } #endif #if (! AUXILIARY_MESSAGE_HANDLERS) if ((hnd->type == MBEFORE) || (hnd->type == MAFTER)) { PrintWarningID("OBJBIN",2,FALSE); PrintRouter(WWARNING,"Before and after message-handlers are not\n"); PrintRouter(WWARNING," supported in this environment."); } #endif hnd->minParams = bhnd->minParams; hnd->maxParams = bhnd->maxParams; hnd->localVarCount = bhnd->localVarCount; hnd->cls = DefclassPointer(bhnd->cls); hnd->name = SymbolPointer(bhnd->name); IncrementSymbolCount(hnd->name); hnd->actions = ExpressionPointer(bhnd->actions); hnd->ppForm = NULL; hnd->busy = 0; hnd->mark = 0; hnd->usrData = NULL; #if DEBUGGING_FUNCTIONS hnd->trace = WatchHandlers; #endif }
/******************************************************** NAME : CreateInitialDefinstances DESCRIPTION : Makes the initial-object definstances structure for creating an initial-object which will match default object patterns in defrules INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : initial-object definstances created NOTES : None ********************************************************/ static void CreateInitialDefinstances( void *theEnv) { EXPRESSION *tmp; DEFINSTANCES *theDefinstances; theDefinstances = get_struct(theEnv,definstances); InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) theDefinstances, DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); theDefinstances->busy = 0; tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,(char*)"make-instance")); tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); tmp->argList->nextArg = GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME)); theDefinstances->mkinstance = PackExpression(theEnv,tmp); ReturnExpression(theEnv,tmp); IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances)); ExpressionInstall(theEnv,theDefinstances->mkinstance); AddConstructToModule((struct constructHeader *) theDefinstances); }
/**************************************************** NAME : SetupQuery DESCRIPTION : Initializes instance query H/L functions and parsers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Sets up kernel functions and parsers NOTES : None ****************************************************/ globle void SetupQuery( void *theEnv, EXEC_STATUS) { AllocateEnvironmentData(theEnv,execStatus,INSTANCE_QUERY_DATA,sizeof(struct instanceQueryData),NULL); #if ! RUN_TIME InstanceQueryData(theEnv,execStatus)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,QUERY_DELIMETER_STRING); IncrementSymbolCount(InstanceQueryData(theEnv,execStatus)->QUERY_DELIMETER_SYMBOL); EnvDefineFunction2(theEnv,execStatus,"(query-instance)",'o', PTIEF GetQueryInstance,"GetQueryInstance",NULL); EnvDefineFunction2(theEnv,execStatus,"(query-instance-slot)",'u', PTIEF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL); EnvDefineFunction2(theEnv,execStatus,"any-instancep",'b',PTIEF AnyInstances,"AnyInstances",NULL); AddFunctionParser(theEnv,execStatus,"any-instancep",ParseQueryNoAction); EnvDefineFunction2(theEnv,execStatus,"find-instance",'m', PTIEF QueryFindInstance,"QueryFindInstance",NULL); AddFunctionParser(theEnv,execStatus,"find-instance",ParseQueryNoAction); EnvDefineFunction2(theEnv,execStatus,"find-all-instances",'m', PTIEF QueryFindAllInstances,"QueryFindAllInstances",NULL); AddFunctionParser(theEnv,execStatus,"find-all-instances",ParseQueryNoAction); EnvDefineFunction2(theEnv,execStatus,"do-for-instance",'u', PTIEF QueryDoForInstance,"QueryDoForInstance",NULL); AddFunctionParser(theEnv,execStatus,"do-for-instance",ParseQueryAction); EnvDefineFunction2(theEnv,execStatus,"do-for-all-instances",'u', PTIEF QueryDoForAllInstances,"QueryDoForAllInstances",NULL); AddFunctionParser(theEnv,execStatus,"do-for-all-instances",ParseQueryAction); EnvDefineFunction2(theEnv,execStatus,"delayed-do-for-all-instances",'u', PTIEF DelayedQueryDoForAllInstances, "DelayedQueryDoForAllInstances",NULL); AddFunctionParser(theEnv,execStatus,"delayed-do-for-all-instances",ParseQueryAction); #endif }
/****************************************************************************** NAME : NewSystemHandler DESCRIPTION : Adds a new system handler for a system class The handler is assumed to be primary and of the form: (defmessage-handler <class> <handler> () (<func>)) INPUTS : 1) Name-string of the system class 2) Name-string of the system handler 3) Name-string of the internal H/L function to implement this handler 4) The number of extra arguments (past the instance itself) that the handler willl accept RETURNS : Nothing useful SIDE EFFECTS : Creates the new handler and inserts it in the system class's handler array On errors, generate a system error and exits. NOTES : Does not check to see if handler already exists *******************************************************************************/ globle void NewSystemHandler( void *theEnv, EXEC_STATUS, char *cname, char *mname, char *fname, int extraargs) { DEFCLASS *cls; HANDLER *hnd; cls = LookupDefclassInScope(theEnv,execStatus,cname); hnd = InsertHandlerHeader(theEnv,execStatus,cls,(SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,mname),MPRIMARY); IncrementSymbolCount(hnd->name); hnd->system = 1; hnd->minParams = hnd->maxParams = (short) (extraargs + 1); hnd->localVarCount = 0; hnd->actions = get_struct(theEnv,execStatus,expr); hnd->actions->argList = NULL; hnd->actions->type = FCALL; hnd->actions->value = (void *) FindFunction(theEnv,execStatus,fname); hnd->actions->nextArg = NULL; }
/**************************************************** NAME : SetupQuery DESCRIPTION : Initializes instance query H/L functions and parsers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Sets up kernel functions and parsers NOTES : None ****************************************************/ globle void SetupQuery() { #if ! RUN_TIME QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) AddSymbol(QUERY_DELIMETER_STRING); IncrementSymbolCount(QUERY_DELIMETER_SYMBOL); DefineFunction2("(query-instance)",'o', PTIF GetQueryInstance,"GetQueryInstance",NULL); DefineFunction2("(query-instance-slot)",'u', PTIF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL); DefineFunction2("any-instancep",'b',PTIF AnyInstances,"AnyInstances",NULL); AddFunctionParser("any-instancep",ParseQueryNoAction); DefineFunction2("find-instance",'m', PTIF QueryFindInstance,"QueryFindInstance",NULL); AddFunctionParser("find-instance",ParseQueryNoAction); DefineFunction2("find-all-instances",'m', PTIF QueryFindAllInstances,"QueryFindAllInstances",NULL); AddFunctionParser("find-all-instances",ParseQueryNoAction); DefineFunction2("do-for-instance",'u', PTIF QueryDoForInstance,"QueryDoForInstance",NULL); AddFunctionParser("do-for-instance",ParseQueryAction); DefineFunction2("do-for-all-instances",'u', PTIF QueryDoForAllInstances,"QueryDoForAllInstances",NULL); AddFunctionParser("do-for-all-instances",ParseQueryAction); DefineFunction2("delayed-do-for-all-instances",'u', PTIF DelayedQueryDoForAllInstances, "DelayedQueryDoForAllInstances",NULL); AddFunctionParser("delayed-do-for-all-instances",ParseQueryAction); #endif }
globle int ParseDeffacts( char *readSource) { #if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY) #pragma unused(readSource) #endif #if (! RUN_TIME) && (! BLOAD_ONLY) SYMBOL_HN *deffactsName; struct expr *temp; struct deffacts *newDeffacts; int deffactsError; struct token inputToken; /*=========================*/ /* Parsing initialization. */ /*=========================*/ deffactsError = FALSE; SetPPBufferStatus(ON); FlushPPBuffer(); SetIndentDepth(3); SavePPBuffer("(deffacts "); /*==========================================================*/ /* Deffacts can not be added when a binary image is loaded. */ /*==========================================================*/ #if BLOAD || BLOAD_AND_BSAVE if ((Bloaded() == TRUE) && (! CheckSyntaxMode)) { CannotLoadWithBloadMessage("deffacts"); return(TRUE); } #endif /*============================*/ /* Parse the deffacts header. */ /*============================*/ deffactsName = GetConstructNameAndComment(readSource,&inputToken,"deffacts", FindDeffacts,Undeffacts,"$",TRUE, TRUE,TRUE); if (deffactsName == NULL) { return(TRUE); } /*===============================================*/ /* Parse the list of facts in the deffacts body. */ /*===============================================*/ temp = BuildRHSAssert(readSource,&inputToken,&deffactsError,FALSE,FALSE,"deffacts"); if (deffactsError == TRUE) { return(TRUE); } if (ExpressionContainsVariables(temp,FALSE)) { LocalVariableErrorMessage("a deffacts construct"); ReturnExpression(temp); return(TRUE); } SavePPBuffer("\n"); /*==============================================*/ /* If we're only checking syntax, don't add the */ /* successfully parsed deffacts to the KB. */ /*==============================================*/ if (CheckSyntaxMode) { ReturnExpression(temp); return(FALSE); } /*==========================*/ /* Create the new deffacts. */ /*==========================*/ ExpressionInstall(temp); newDeffacts = get_struct(deffacts); newDeffacts->header.name = deffactsName; IncrementSymbolCount(deffactsName); newDeffacts->assertList = PackExpression(temp); newDeffacts->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(NULL,FindModuleItem("deffacts")->moduleIndex); newDeffacts->header.next = NULL; newDeffacts->header.usrData = NULL; ReturnExpression(temp); /*=======================================================*/ /* Save the pretty print representation of the deffacts. */ /*=======================================================*/ if (GetConserveMemory() == TRUE) { newDeffacts->header.ppForm = NULL; } else { newDeffacts->header.ppForm = CopyPPBuffer(); } /*=============================================*/ /* Add the deffacts to the appropriate module. */ /*=============================================*/ AddConstructToModule(&newDeffacts->header); #endif /* (! RUN_TIME) && (! BLOAD_ONLY) */ /*================================================================*/ /* Return FALSE to indicate the deffacts was successfully parsed. */ /*================================================================*/ return(FALSE); }
globle int ParseDefmodule( void *theEnv, char *readSource) { SYMBOL_HN *defmoduleName; struct defmodule *newDefmodule; struct token inputToken; int i; struct moduleItem *theItem; struct portItem *portSpecs, *nextSpec; struct defmoduleItemHeader *theHeader; struct callFunctionItem *defineFunctions; struct defmodule *redefiningMainModule = NULL; int parseError; struct portItem *oldImportList = NULL, *oldExportList = NULL; short overwrite = FALSE; /*================================================*/ /* Flush the buffer which stores the pretty print */ /* representation for a module. Add the already */ /* parsed keyword defmodule to this buffer. */ /*================================================*/ SetPPBufferStatus(theEnv,ON); FlushPPBuffer(theEnv); SetIndentDepth(theEnv,3); SavePPBuffer(theEnv,"(defmodule "); /*===============================*/ /* Modules cannot be loaded when */ /* a binary load is in effect. */ /*===============================*/ #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode)) { CannotLoadWithBloadMessage(theEnv,"defmodule"); return(TRUE); } #endif /*=====================================================*/ /* Parse the name and comment fields of the defmodule. */ /* Remove the defmodule if it already exists. */ /*=====================================================*/ defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule", EnvFindDefmodule,DeleteDefmodule,"+", TRUE,TRUE,FALSE); if (defmoduleName == NULL) { return(TRUE); } if (strcmp(ValueToString(defmoduleName),"MAIN") == 0) { redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); } /*==============================================*/ /* Create the defmodule structure if necessary. */ /*==============================================*/ if (redefiningMainModule == NULL) { newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName)); if (newDefmodule) { overwrite = TRUE; } else { newDefmodule = get_struct(theEnv,defmodule); newDefmodule->name = defmoduleName; newDefmodule->usrData = NULL; newDefmodule->next = NULL; } } else { overwrite = TRUE; newDefmodule = redefiningMainModule; } if (overwrite) { oldImportList = newDefmodule->importList; oldExportList = newDefmodule->exportList; } newDefmodule->importList = NULL; newDefmodule->exportList = NULL; /*===================================*/ /* Finish parsing the defmodule (its */ /* import/export specifications). */ /*===================================*/ parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule); /*====================================*/ /* Check for import/export conflicts. */ /*====================================*/ if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule); /*======================================================*/ /* If an error occured in parsing or an import conflict */ /* was detected, abort the definition of the defmodule. */ /* If we're only checking syntax, then we want to exit */ /* at this point as well. */ /*======================================================*/ if (parseError || ConstructData(theEnv)->CheckSyntaxMode) { while (newDefmodule->importList != NULL) { nextSpec = newDefmodule->importList->next; rtn_struct(theEnv,portItem,newDefmodule->importList); newDefmodule->importList = nextSpec; } while (newDefmodule->exportList != NULL) { nextSpec = newDefmodule->exportList->next; rtn_struct(theEnv,portItem,newDefmodule->exportList); newDefmodule->exportList = nextSpec; } if ((redefiningMainModule == NULL) && (! overwrite)) { rtn_struct(theEnv,defmodule,newDefmodule); } if (overwrite) { newDefmodule->importList = oldImportList; newDefmodule->exportList = oldExportList; } if (parseError) return(TRUE); return(FALSE); } /*===============================================*/ /* Increment the symbol table counts for symbols */ /* used in the defmodule data structures. */ /*===============================================*/ if (redefiningMainModule == NULL) { IncrementSymbolCount(newDefmodule->name); } else { if ((newDefmodule->importList != NULL) || (newDefmodule->exportList != NULL)) { DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; } } for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next) { if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName); if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType); if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName); } for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next) { if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName); if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType); if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName); } /*====================================================*/ /* Allocate storage for the module's construct lists. */ /*====================================================*/ if (redefiningMainModule != NULL) { /* Do nothing */ } else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL; else { newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems); for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems; (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL); i++, theItem = theItem->next) { if (theItem->allocateFunction == NULL) { newDefmodule->itemsArray[i] = NULL; } else { newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *) (*theItem->allocateFunction)(theEnv); theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i]; theHeader->theModule = newDefmodule; theHeader->firstItem = NULL; theHeader->lastItem = NULL; } } } /*=======================================*/ /* Save the pretty print representation. */ /*=======================================*/ SavePPBuffer(theEnv,"\n"); if (EnvGetConserveMemory(theEnv) == TRUE) { newDefmodule->ppForm = NULL; } else { newDefmodule->ppForm = CopyPPBuffer(theEnv); } /*==============================================*/ /* Add the defmodule to the list of defmodules. */ /*==============================================*/ if (redefiningMainModule == NULL) { if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule; else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule; DefmoduleData(theEnv)->LastDefmodule = newDefmodule; newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++; } EnvSetCurrentModule(theEnv,(void *) newDefmodule); /*=========================================*/ /* Call any functions required by other */ /* constructs when a new module is defined */ /*=========================================*/ for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions; defineFunctions != NULL; defineFunctions = defineFunctions->next) { (* (void (*)(void *)) defineFunctions->func)(theEnv); } /*===============================================*/ /* Defmodule successfully parsed with no errors. */ /*===============================================*/ return(FALSE); }
globle void CreateMainModule( void *theEnv) { struct defmodule *newDefmodule; struct moduleItem *theItem; int i; struct defmoduleItemHeader *theHeader; /*=======================================*/ /* Allocate the defmodule data structure */ /* and name it the MAIN module. */ /*=======================================*/ newDefmodule = get_struct(theEnv,defmodule); newDefmodule->name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"MAIN"); IncrementSymbolCount(newDefmodule->name); newDefmodule->next = NULL; newDefmodule->ppForm = NULL; newDefmodule->importList = NULL; newDefmodule->exportList = NULL; newDefmodule->bsaveID = 0L; newDefmodule->usrData = NULL; /*==================================*/ /* Initialize the array for storing */ /* the module's construct lists. */ /*==================================*/ if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL; else { newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems); for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems; (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL); i++, theItem = theItem->next) { if (theItem->allocateFunction == NULL) { newDefmodule->itemsArray[i] = NULL; } else { newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *) (*theItem->allocateFunction)(theEnv); theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i]; theHeader->theModule = newDefmodule; theHeader->firstItem = NULL; theHeader->lastItem = NULL; } } } /*=======================================*/ /* Add the module to the list of modules */ /* and make it the current module. */ /*=======================================*/ #if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT SetNumberOfDefmodules(theEnv,1L); #endif DefmoduleData(theEnv)->LastDefmodule = newDefmodule; DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule; EnvSetCurrentModule(theEnv,(void *) newDefmodule); }
/**************************************************** NAME : AddDeffunction DESCRIPTION : Adds a deffunction to the list of deffunctions INPUTS : 1) The symbolic name 2) The action expressions 3) The minimum number of arguments 4) The maximum number of arguments (can be -1) 5) The number of local variables 6) A flag indicating if this is a header call so that the deffunction can be recursively called RETURNS : The new deffunction (NULL on errors) SIDE EFFECTS : Deffunction structures allocated NOTES : Assumes deffunction is not executing ****************************************************/ static DEFFUNCTION *AddDeffunction( void *theEnv, SYMBOL_HN *name, EXPRESSION *actions, int min, int max, int lvars, int headerp) { DEFFUNCTION *dfuncPtr; unsigned oldbusy; #if DEBUGGING_FUNCTIONS unsigned DFHadWatch = FALSE; #endif /*===============================================================*/ /* If the deffunction doesn't exist, create a new structure to */ /* contain it and add it to the List of deffunctions. Otherwise, */ /* use the existing structure and remove the pretty print form */ /* and interpretive code. */ /*===============================================================*/ dfuncPtr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(name)); if (dfuncPtr == NULL) { dfuncPtr = get_struct(theEnv,deffunctionStruct); InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name); IncrementSymbolCount(name); dfuncPtr->code = NULL; dfuncPtr->minNumberOfParameters = min; dfuncPtr->maxNumberOfParameters = max; dfuncPtr->numberOfLocalVars = lvars; dfuncPtr->busy = 0; dfuncPtr->executing = 0; } else { #if DEBUGGING_FUNCTIONS DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr); #endif dfuncPtr->minNumberOfParameters = min; dfuncPtr->maxNumberOfParameters = max; dfuncPtr->numberOfLocalVars = lvars; oldbusy = dfuncPtr->busy; ExpressionDeinstall(theEnv,dfuncPtr->code); dfuncPtr->busy = oldbusy; ReturnPackedExpression(theEnv,dfuncPtr->code); dfuncPtr->code = NULL; SetDeffunctionPPForm((void *) dfuncPtr,NULL); /* ======================================= Remove the deffunction from the list so that it can be added at the end ======================================= */ RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr); } AddConstructToModule((struct constructHeader *) dfuncPtr); /* ================================== Install the new interpretive code. ================================== */ if (actions != NULL) { /* =============================== If a deffunction is recursive, do not increment its busy count based on self-references =============================== */ oldbusy = dfuncPtr->busy; ExpressionInstall(theEnv,actions); dfuncPtr->busy = oldbusy; dfuncPtr->code = actions; } /* =============================================================== Install the pretty print form if memory is not being conserved. =============================================================== */ #if DEBUGGING_FUNCTIONS EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr); if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE)) SetDeffunctionPPForm((void *) dfuncPtr,CopyPPBuffer(theEnv)); #endif return(dfuncPtr); }
globle int DefineFunction3( void *theEnv, const char *name, int returnType, int (*pointer)(void *), const char *actualName, const char *restrictions, intBool environmentAware, void *context) { struct FunctionDefinition *newFunction; if ( (returnType != 'a') && (returnType != 'b') && (returnType != 'c') && (returnType != 'd') && (returnType != 'f') && (returnType != 'g') && (returnType != 'i') && (returnType != 'j') && (returnType != 'k') && (returnType != 'l') && (returnType != 'm') && (returnType != 'n') && #if OBJECT_SYSTEM (returnType != 'o') && #endif (returnType != 's') && (returnType != 'u') && (returnType != 'v') && #if OBJECT_SYSTEM (returnType != 'x') && #endif (returnType != 'w') ) { return(0); } newFunction = FindFunction(theEnv,name); if (newFunction == NULL) { newFunction = get_struct(theEnv,FunctionDefinition); newFunction->callFunctionName = (SYMBOL_HN *) EnvAddSymbol(theEnv,name); IncrementSymbolCount(newFunction->callFunctionName); newFunction->next = GetFunctionList(theEnv); ExternalFunctionData(theEnv)->ListOfFunctions = newFunction; AddHashFunction(theEnv,newFunction); } newFunction->returnValueType = (char) returnType; newFunction->functionPointer = (int (*)(void)) pointer; newFunction->actualFunctionName = actualName; if (restrictions != NULL) { if (((int) (strlen(restrictions)) < 2) ? TRUE : ((! isdigit(restrictions[0]) && (restrictions[0] != '*')) || (! isdigit(restrictions[1]) && (restrictions[1] != '*')))) restrictions = NULL; } newFunction->restrictions = restrictions; newFunction->parser = NULL; newFunction->overloadable = TRUE; newFunction->sequenceuseok = TRUE; newFunction->environmentAware = (short) environmentAware; newFunction->usrData = NULL; newFunction->context = context; return(1); }
/*************************************************** NAME : SetupMessageHandlers DESCRIPTION : Sets up internal symbols and fucntion definitions pertaining to message-handlers. Also creates system handlers INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Functions and data structures initialized NOTES : Should be called before SetupInstanceModDupCommands() in INSMODDP.C ***************************************************/ globle void SetupMessageHandlers( void *theEnv) { ENTITY_RECORD handlerGetInfo = { "HANDLER_GET", HANDLER_GET,0,1,1, PrintHandlerSlotGetFunction, PrintHandlerSlotGetFunction,NULL, HandlerSlotGetFunction, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }, handlerPutInfo = { "HANDLER_PUT", HANDLER_PUT,0,1,1, PrintHandlerSlotPutFunction, PrintHandlerSlotPutFunction,NULL, HandlerSlotPutFunction, NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL }; AllocateEnvironmentData(theEnv,MESSAGE_HANDLER_DATA,sizeof(struct messageHandlerData),DeallocateMessageHandlerData); memcpy(&MessageHandlerData(theEnv)->HandlerGetInfo,&handlerGetInfo,sizeof(struct entityRecord)); memcpy(&MessageHandlerData(theEnv)->HandlerPutInfo,&handlerPutInfo,sizeof(struct entityRecord)); MessageHandlerData(theEnv)->hndquals[0] = "around"; MessageHandlerData(theEnv)->hndquals[1] = "before"; MessageHandlerData(theEnv)->hndquals[2] = "primary"; MessageHandlerData(theEnv)->hndquals[3] = "after"; InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerGetInfo,HANDLER_GET); InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerPutInfo,HANDLER_PUT); #if ! RUN_TIME MessageHandlerData(theEnv)->INIT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INIT_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->INIT_SYMBOL); MessageHandlerData(theEnv)->DELETE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,DELETE_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->DELETE_SYMBOL); MessageHandlerData(theEnv)->CREATE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,CREATE_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->CREATE_SYMBOL); EnvAddClearFunction(theEnv,"defclass",CreateSystemHandlers,-100); #if ! BLOAD_ONLY MessageHandlerData(theEnv)->SELF_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SELF_STRING); IncrementSymbolCount(MessageHandlerData(theEnv)->SELF_SYMBOL); AddConstruct(theEnv,"defmessage-handler","defmessage-handlers", ParseDefmessageHandler,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL); EnvDefineFunction2(theEnv,"undefmessage-handler",'v',PTIEF UndefmessageHandlerCommand, "UndefmessageHandlerCommand","23w"); #endif EnvDefineFunction2(theEnv,"send",'u',PTIEF SendCommand,"SendCommand","2*uuw"); #if DEBUGGING_FUNCTIONS EnvDefineFunction2(theEnv,"preview-send",'v',PTIEF PreviewSendCommand,"PreviewSendCommand","22w"); EnvDefineFunction2(theEnv,"ppdefmessage-handler",'v',PTIEF PPDefmessageHandlerCommand, "PPDefmessageHandlerCommand","23w"); EnvDefineFunction2(theEnv,"list-defmessage-handlers",'v',PTIEF ListDefmessageHandlersCommand, "ListDefmessageHandlersCommand","02w"); #endif EnvDefineFunction2(theEnv,"next-handlerp",'b',PTIEF NextHandlerAvailable,"NextHandlerAvailable","00"); FuncSeqOvlFlags(theEnv,"next-handlerp",TRUE,FALSE); EnvDefineFunction2(theEnv,"call-next-handler",'u', PTIEF CallNextHandler,"CallNextHandler","00"); FuncSeqOvlFlags(theEnv,"call-next-handler",TRUE,FALSE); EnvDefineFunction2(theEnv,"override-next-handler",'u', PTIEF CallNextHandler,"CallNextHandler",NULL); FuncSeqOvlFlags(theEnv,"override-next-handler",TRUE,FALSE); EnvDefineFunction2(theEnv,"dynamic-get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w"); EnvDefineFunction2(theEnv,"dynamic-put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w"); EnvDefineFunction2(theEnv,"get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w"); EnvDefineFunction2(theEnv,"put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w"); #endif #if DEBUGGING_FUNCTIONS AddWatchItem(theEnv,"messages",0,&MessageHandlerData(theEnv)->WatchMessages,36,NULL,NULL); AddWatchItem(theEnv,"message-handlers",0,&MessageHandlerData(theEnv)->WatchHandlers,35, DefmessageHandlerWatchAccess,DefmessageHandlerWatchPrint); #endif }
static void AddDefglobal( void *theEnv, SYMBOL_HN *name, DATA_OBJECT_PTR vPtr, struct expr *ePtr) { struct defglobal *defglobalPtr; intBool newGlobal = FALSE; #if DEBUGGING_FUNCTIONS int GlobalHadWatch = FALSE; #endif /*========================================================*/ /* If the defglobal is already defined, then use the old */ /* data structure and substitute new values. If it hasn't */ /* been defined, then create a new data structure. */ /*========================================================*/ defglobalPtr = QFindDefglobal(theEnv,name); if (defglobalPtr == NULL) { newGlobal = TRUE; defglobalPtr = get_struct(theEnv,defglobal); } else { DeinstallConstructHeader(theEnv,&defglobalPtr->header); #if DEBUGGING_FUNCTIONS GlobalHadWatch = defglobalPtr->watch; #endif } /*===========================================*/ /* Remove the old values from the defglobal. */ /*===========================================*/ if (newGlobal == FALSE) { ValueDeinstall(theEnv,&defglobalPtr->current); if (defglobalPtr->current.type == MULTIFIELD) { ReturnMultifield(theEnv,(struct multifield *) defglobalPtr->current.value); } RemoveHashedExpression(theEnv,defglobalPtr->initial); } /*=======================================*/ /* Copy the new values to the defglobal. */ /*=======================================*/ defglobalPtr->current.type = vPtr->type; if (vPtr->type != MULTIFIELD) defglobalPtr->current.value = vPtr->value; else DuplicateMultifield(theEnv,&defglobalPtr->current,vPtr); ValueInstall(theEnv,&defglobalPtr->current); defglobalPtr->initial = AddHashedExpression(theEnv,ePtr); ReturnExpression(theEnv,ePtr); DefglobalData(theEnv)->ChangeToGlobals = TRUE; /*=================================*/ /* Restore the old watch value to */ /* the defglobal if redefined. */ /*=================================*/ #if DEBUGGING_FUNCTIONS defglobalPtr->watch = GlobalHadWatch ? TRUE : WatchGlobals; #endif /*======================================*/ /* Save the name and pretty print form. */ /*======================================*/ defglobalPtr->header.name = name; defglobalPtr->header.usrData = NULL; IncrementSymbolCount(name); SavePPBuffer(theEnv,"\n"); if (EnvGetConserveMemory(theEnv) == TRUE) { defglobalPtr->header.ppForm = NULL; } else { defglobalPtr->header.ppForm = CopyPPBuffer(theEnv); } defglobalPtr->inScope = TRUE; /*=============================================*/ /* If the defglobal was redefined, we're done. */ /*=============================================*/ if (newGlobal == FALSE) return; /*===================================*/ /* Copy the defglobal variable name. */ /*===================================*/ defglobalPtr->busyCount = 0; defglobalPtr->header.whichModule = (struct defmoduleItemHeader *) GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex); /*=============================================*/ /* Add the defglobal to the list of defglobals */ /* for the current module. */ /*=============================================*/ AddConstructToModule(&defglobalPtr->header); }
static void StrOrSymCatFunction( void *theEnv, DATA_OBJECT_PTR returnValue, unsigned short returnType) { DATA_OBJECT theArg; int numArgs, i, total, j; char *theString; SYMBOL_HN **arrayOfStrings; SYMBOL_HN *hashPtr; char *functionName; /*============================================*/ /* Determine the calling function name. */ /* Store the null string or the symbol nil as */ /* the return value in the event of an error. */ /*============================================*/ SetpType(returnValue,returnType); if (returnType == STRING) { functionName = "str-cat"; SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"")); } else { functionName = "sym-cat"; SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"nil")); } /*===============================================*/ /* Determine the number of arguments as create a */ /* string array which is large enough to store */ /* the string representation of each argument. */ /*===============================================*/ numArgs = EnvRtnArgCount(theEnv); arrayOfStrings = (SYMBOL_HN **) gm1(theEnv,(int) sizeof(SYMBOL_HN *) * numArgs); for (i = 0; i < numArgs; i++) { arrayOfStrings[i] = NULL; } /*=============================================*/ /* Evaluate each argument and store its string */ /* representation in the string array. */ /*=============================================*/ total = 1; for (i = 1 ; i <= numArgs ; i++) { EnvRtnUnknown(theEnv,i,&theArg); switch(GetType(theArg)) { case STRING: #if OBJECT_SYSTEM case INSTANCE_NAME: #endif case SYMBOL: hashPtr = (SYMBOL_HN *) GetValue(theArg); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; case FLOAT: hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,FloatToString(theEnv,ValueToDouble(GetValue(theArg)))); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; case INTEGER: hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,LongIntegerToString(theEnv,ValueToLong(GetValue(theArg)))); arrayOfStrings[i-1] = hashPtr; IncrementSymbolCount(hashPtr); break; default: ExpectedTypeError1(theEnv,functionName,i,"string, instance name, symbol, float, or integer"); SetEvaluationError(theEnv,TRUE); break; } if (EvaluationData(theEnv)->EvaluationError) { for (i = 0; i < numArgs; i++) { if (arrayOfStrings[i] != NULL) { DecrementSymbolCount(theEnv,arrayOfStrings[i]); } } rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs); return; } total += (int) strlen(ValueToString(arrayOfStrings[i - 1])); } /*=========================================================*/ /* Allocate the memory to store the concatenated string or */ /* symbol, then copy the values in the string array to the */ /* memory just allocated. */ /*=========================================================*/ theString = (char *) gm2(theEnv,(sizeof(char) * total)); j = 0; for (i = 0 ; i < numArgs ; i++) { sprintf(&theString[j],"%s",ValueToString(arrayOfStrings[i])); j += (int) strlen(ValueToString(arrayOfStrings[i])); } /*=========================================*/ /* Return the concatenated value and clean */ /* up the temporary memory used. */ /*=========================================*/ SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,theString)); rm(theEnv,theString,sizeof(char) * total); for (i = 0; i < numArgs; i++) { if (arrayOfStrings[i] != NULL) { DecrementSymbolCount(theEnv,arrayOfStrings[i]); } } rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs); }
static void InitializeKeywords( void *theEnv) { #if (! RUN_TIME) && WINDOW_INTERFACE void *ts; /*====================*/ /* construct keywords */ /*====================*/ ts = EnvAddSymbol(theEnv,"defrule"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defglobal"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deftemplate"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffacts"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffunction"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defmethod"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defgeneric"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defclass"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"defmessage-handler"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"definstances"); IncrementSymbolCount(ts); /*=======================*/ /* set-strategy keywords */ /*=======================*/ ts = EnvAddSymbol(theEnv,"depth"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"breadth"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"lex"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"mea"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"simplicity"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"complexity"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"random"); IncrementSymbolCount(ts); /*==================================*/ /* set-salience-evaluation keywords */ /*==================================*/ ts = EnvAddSymbol(theEnv,"when-defined"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"when-activated"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"every-cycle"); IncrementSymbolCount(ts); /*======================*/ /* deftemplate keywords */ /*======================*/ ts = EnvAddSymbol(theEnv,"field"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"multifield"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"default"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"type"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-symbols"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-strings"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-numbers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-integers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-floats"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-values"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"min-number-of-elements"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"max-number-of-elements"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"NONE"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"VARIABLE"); IncrementSymbolCount(ts); /*==================*/ /* defrule keywords */ /*==================*/ ts = EnvAddSymbol(theEnv,"declare"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"salience"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"test"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"or"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"and"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"not"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"logical"); IncrementSymbolCount(ts); /*===============*/ /* COOL keywords */ /*===============*/ ts = EnvAddSymbol(theEnv,"is-a"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"role"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"abstract"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"concrete"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"pattern-match"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"reactive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"non-reactive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"slot"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"field"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"multiple"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"single"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"storage"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"shared"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"local"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"access"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"write"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read-only"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"read-write"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"initialize-only"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"propagation"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"inherit"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"no-inherit"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"source"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"composite"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"exclusive"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-lexemes"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"allowed-instances"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"around"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"before"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"primary"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"after"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"of"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"self"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"visibility"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"override-message"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"private"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"public"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"create-accessor"); IncrementSymbolCount(ts); /*================*/ /* watch keywords */ /*================*/ ts = EnvAddSymbol(theEnv,"compilations"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"deffunctions"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"globals"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"rules"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"activations"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"statistics"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"facts"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"generic-functions"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"methods"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"instances"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"slots"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"messages"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"message-handlers"); IncrementSymbolCount(ts); ts = EnvAddSymbol(theEnv,"focus"); IncrementSymbolCount(ts); #else #if MAC_XCD #pragma unused(theEnv) #endif #endif }