globle void DeftemplateBasicCommands(
void *theEnv)
{
#if ! DEFFACTS_CONSTRUCT
EnvAddResetFunction(theEnv,(char*)"deftemplate",ResetDeftemplates,0);
#endif
EnvAddClearFunction(theEnv,(char*)"deftemplate",ClearDeftemplates,0);
AddSaveFunction(theEnv,(char*)"deftemplate",SaveDeftemplates,10);
#if ! RUN_TIME
EnvDefineFunction2(theEnv,(char*)"get-deftemplate-list",'m',PTIEF GetDeftemplateListFunction,(char*)"GetDeftemplateListFunction",(char*)"01w");
EnvDefineFunction2(theEnv,(char*)"undeftemplate",'v',PTIEF UndeftemplateCommand,(char*)"UndeftemplateCommand",(char*)"11w");
EnvDefineFunction2(theEnv,(char*)"deftemplate-module",'w',PTIEF DeftemplateModuleFunction,(char*)"DeftemplateModuleFunction",(char*)"11w");
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,(char*)"list-deftemplates",'v', PTIEF ListDeftemplatesCommand,(char*)"ListDeftemplatesCommand",(char*)"01w");
EnvDefineFunction2(theEnv,(char*)"ppdeftemplate",'v',PTIEF PPDeftemplateCommand,(char*)"PPDeftemplateCommand",(char*)"11w");
#endif
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
DeftemplateBinarySetup(theEnv);
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DeftemplateCompilerSetup(theEnv);
#endif
#endif
}
globle void InitializeAgenda(
void *theEnv)
{
AllocateEnvironmentData(theEnv,AGENDA_DATA,sizeof(struct agendaData),NULL);
AgendaData(theEnv)->SalienceEvaluation = WHEN_DEFINED;
AgendaData(theEnv)->Strategy = DEFAULT_STRATEGY;
EnvAddClearFunction(theEnv,(char*)"agenda",AgendaClearFunction,0);
#if DEBUGGING_FUNCTIONS
AddWatchItem(theEnv,(char*)"activations",1,&AgendaData(theEnv)->WatchActivations,40,DefruleWatchAccess,DefruleWatchPrint);
#endif
#if ! RUN_TIME
EnvDefineFunction2(theEnv,(char*)"refresh", 'v', PTIEF RefreshCommand, (char*)"RefreshCommand", (char*)"11w");
EnvDefineFunction2(theEnv,(char*)"refresh-agenda",'v',
PTIEF RefreshAgendaCommand,
(char*)"RefreshAgendaCommand",
(char*)"01w");
EnvDefineFunction2(theEnv,(char*)"get-salience-evaluation",'w',
PTIEF GetSalienceEvaluationCommand,
(char*)"GetSalienceEvaluationCommand",
(char*)"00");
EnvDefineFunction2(theEnv,(char*)"set-salience-evaluation",'w',
PTIEF SetSalienceEvaluationCommand,
(char*)"SetSalienceEvaluationCommand",
(char*)"11w");
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,(char*)"agenda", 'v', PTIEF AgendaCommand, (char*)"AgendaCommand", (char*)"01w");
#endif
#endif
}
globle void DefruleBasicCommands(
void *theEnv)
{
EnvAddResetFunction(theEnv,"defrule",ResetDefrules,70);
AddSaveFunction(theEnv,"defrule",SaveDefrules,0);
#if (! RUN_TIME)
AddClearReadyFunction(theEnv,"defrule",ClearDefrulesReady,0);
EnvAddClearFunction(theEnv,"defrule",ClearDefrules,0);
#endif
#if DEBUGGING_FUNCTIONS
AddWatchItem(theEnv,"rules",0,&DefruleData(theEnv)->WatchRules,70,DefruleWatchAccess,DefruleWatchPrint);
#endif
#if ! RUN_TIME
EnvDefineFunction2(theEnv,"get-defrule-list",'m',PTIEF GetDefruleListFunction,"GetDefruleListFunction","01w");
EnvDefineFunction2(theEnv,"undefrule",'v',PTIEF UndefruleCommand,"UndefruleCommand","11w");
EnvDefineFunction2(theEnv,"defrule-module",'w',PTIEF DefruleModuleFunction,"DefruleModuleFunction","11w");
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,"rules",'v', PTIEF ListDefrulesCommand,"ListDefrulesCommand","01w");
EnvDefineFunction2(theEnv,"list-defrules",'v', PTIEF ListDefrulesCommand,"ListDefrulesCommand","01w");
EnvDefineFunction2(theEnv,"ppdefrule",'v',PTIEF PPDefruleCommand,"PPDefruleCommand","11w");
#endif
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
DefruleBinarySetup(theEnv);
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DefruleCompilerSetup(theEnv);
#endif
#endif
}
globle void ConstructProfilingFunctionDefinitions(
void *theEnv)
{
struct userDataRecord profileDataInfo = { 0, CreateProfileData, DeleteProfileData };
AllocateEnvironmentData(theEnv,PROFLFUN_DATA,sizeof(struct profileFunctionData),NULL);
memcpy(&ProfileFunctionData(theEnv)->ProfileDataInfo,&profileDataInfo,sizeof(struct userDataRecord));
ProfileFunctionData(theEnv)->LastProfileInfo = NO_PROFILE;
ProfileFunctionData(theEnv)->PercentThreshold = 0.0;
ProfileFunctionData(theEnv)->OutputString = OUTPUT_STRING;
#if ! RUN_TIME
EnvDefineFunction2(theEnv,"profile",'v', PTIEF ProfileCommand,"ProfileCommand","11w");
EnvDefineFunction2(theEnv,"profile-info",'v', PTIEF ProfileInfoCommand,"ProfileInfoCommand","01w");
EnvDefineFunction2(theEnv,"profile-reset",'v', PTIEF ProfileResetCommand,"ProfileResetCommand","00");
EnvDefineFunction2(theEnv,"set-profile-percent-threshold",'d',
PTIEF SetProfilePercentThresholdCommand,
"SetProfilePercentThresholdCommand","11n");
EnvDefineFunction2(theEnv,"get-profile-percent-threshold",'d',
PTIEF GetProfilePercentThresholdCommand,
"GetProfilePercentThresholdCommand","00");
ProfileFunctionData(theEnv)->ProfileDataID = InstallUserDataRecord(theEnv,&ProfileFunctionData(theEnv)->ProfileDataInfo);
EnvAddClearFunction(theEnv,"profile",ProfileClearFunction,0);
#endif
}
globle void DefmoduleBasicCommands(
void *theEnv)
{
EnvAddClearFunction(theEnv,"defmodule",ClearDefmodules,2000);
#if DEFMODULE_CONSTRUCT
AddSaveFunction(theEnv,"defmodule",SaveDefmodules,1100);
#if ! RUN_TIME
EnvDefineFunction2(theEnv,"get-defmodule-list",'m',PTIEF EnvGetDefmoduleList,"EnvGetDefmoduleList","00");
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,"list-defmodules",'v', PTIEF ListDefmodulesCommand,"ListDefmodulesCommand","00");
EnvDefineFunction2(theEnv,"ppdefmodule",'v',PTIEF PPDefmoduleCommand,"PPDefmoduleCommand","11w");
#endif
#endif
#endif
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
DefmoduleBinarySetup(theEnv);
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DefmoduleCompilerSetup(theEnv);
#endif
}
void DefmoduleBasicCommands(
void *theEnv)
{
EnvAddClearFunction(theEnv,"defmodule",ClearDefmodules,2000);
#if DEFMODULE_CONSTRUCT
AddSaveFunction(theEnv,"defmodule",SaveDefmodules,1100);
#if ! RUN_TIME
EnvAddUDF(theEnv,"get-defmodule-list","m", EnvGetDefmoduleListFunction,"EnvGetDefmoduleListFunction",0,0,NULL,NULL);
#if DEBUGGING_FUNCTIONS
EnvAddUDF(theEnv,"list-defmodules","v", ListDefmodulesCommand,"ListDefmodulesCommand",0,0,NULL,NULL);
EnvAddUDF(theEnv,"ppdefmodule","v",PPDefmoduleCommand,"PPDefmoduleCommand",1,1,"y",NULL);
#endif
#endif
#endif
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
DefmoduleBinarySetup(theEnv);
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DefmoduleCompilerSetup(theEnv);
#endif
}
globle void DeffactsBasicCommands(
void *theEnv)
{
EnvAddResetFunction(theEnv,"deffacts",ResetDeffacts,0);
EnvAddClearFunction(theEnv,"deffacts",ClearDeffacts,0);
AddSaveFunction(theEnv,"deffacts",SaveDeffacts,10);
#if ! RUN_TIME
EnvDefineFunction2(theEnv,"get-deffacts-list",'m',PTIEF GetDeffactsListFunction,"GetDeffactsListFunction","01w");
EnvDefineFunction2(theEnv,"undeffacts",'v',PTIEF UndeffactsCommand,"UndeffactsCommand","11w");
EnvDefineFunction2(theEnv,"deffacts-module",'w',PTIEF DeffactsModuleFunction,"DeffactsModuleFunction","11w");
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,"list-deffacts",'v', PTIEF ListDeffactsCommand,"ListDeffactsCommand","01w");
EnvDefineFunction2(theEnv,"ppdeffacts",'v',PTIEF PPDeffactsCommand,"PPDeffactsCommand","11w");
#endif
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
DeffactsBinarySetup(theEnv);
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DeffactsCompilerSetup(theEnv);
#endif
#endif
}
globle void ProceduralFunctionDefinitions(
void *theEnv)
{
AllocateEnvironmentData(theEnv,PRCDRFUN_DATA,sizeof(struct procedureFunctionData),DeallocateProceduralFunctionData);
#if ! RUN_TIME
EnvDefineFunction2(theEnv,"if", 'u', PTIEF IfFunction, "IfFunction", NULL);
EnvDefineFunction2(theEnv,"while", 'u', PTIEF WhileFunction, "WhileFunction", NULL);
EnvDefineFunction2(theEnv,"loop-for-count",'u', PTIEF LoopForCountFunction, "LoopForCountFunction", NULL);
EnvDefineFunction2(theEnv,"(get-loop-count)",'g', PTIEF GetLoopCount, "GetLoopCount", NULL);
EnvDefineFunction2(theEnv,"bind", 'u', PTIEF BindFunction, "BindFunction", NULL);
EnvDefineFunction2(theEnv,"progn", 'u', PTIEF PrognFunction, "PrognFunction", NULL);
EnvDefineFunction2(theEnv,"return", 'u', PTIEF ReturnFunction, "ReturnFunction",NULL);
EnvDefineFunction2(theEnv,"break", 'v', PTIEF BreakFunction, "BreakFunction",NULL);
EnvDefineFunction2(theEnv,"switch", 'u', PTIEF SwitchFunction, "SwitchFunction",NULL);
ProceduralFunctionParsers(theEnv);
FuncSeqOvlFlags(theEnv,"progn",FALSE,FALSE);
FuncSeqOvlFlags(theEnv,"if",FALSE,FALSE);
FuncSeqOvlFlags(theEnv,"while",FALSE,FALSE);
FuncSeqOvlFlags(theEnv,"loop-for-count",FALSE,FALSE);
FuncSeqOvlFlags(theEnv,"return",FALSE,FALSE);
FuncSeqOvlFlags(theEnv,"switch",FALSE,FALSE);
#endif
EnvAddResetFunction(theEnv,"bind",FlushBindList,0);
EnvAddClearFunction(theEnv,"bind",FlushBindList,0);
}
void DefruleBasicCommands(
void *theEnv)
{
EnvAddResetFunction(theEnv,"defrule",ResetDefrules,70);
EnvAddResetFunction(theEnv,"defrule",ResetDefrulesPrime,10);
AddSaveFunction(theEnv,"defrule",SaveDefrules,0);
#if (! RUN_TIME)
AddClearReadyFunction(theEnv,"defrule",ClearDefrulesReady,0);
EnvAddClearFunction(theEnv,"defrule",ClearDefrules,0);
#endif
#if DEBUGGING_FUNCTIONS
AddWatchItem(theEnv,"rules",0,&DefruleData(theEnv)->WatchRules,70,DefruleWatchAccess,DefruleWatchPrint);
#endif
#if ! RUN_TIME
EnvAddUDF(theEnv,"get-defrule-list","m", GetDefruleListFunction,"GetDefruleListFunction",0,1,"y",NULL);
EnvAddUDF(theEnv,"undefrule","v", UndefruleCommand,"UndefruleCommand",1,1,"y",NULL);
EnvAddUDF(theEnv,"defrule-module","y", DefruleModuleFunction,"DefruleModuleFunction",1,1,"y",NULL);
#if DEBUGGING_FUNCTIONS
EnvAddUDF(theEnv,"rules","v", ListDefrulesCommand,"ListDefrulesCommand",0,1,"y",NULL);
EnvAddUDF(theEnv,"list-defrules","v", ListDefrulesCommand,"ListDefrulesCommand",0,1,"y",NULL);
EnvAddUDF(theEnv,"ppdefrule","v", PPDefruleCommand,"PPDefruleCommand",1,1,"y",NULL);
#endif
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
DefruleBinarySetup(theEnv);
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DefruleCompilerSetup(theEnv);
#endif
#endif
}
/***************************************************
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
}
/*********************************************************
NAME : SetupDefclasses
DESCRIPTION : Initializes Class Hash Table,
Function Parsers, and Data Structures
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS :
NOTES : None
*********************************************************/
static void SetupDefclasses(
void *theEnv)
{
InstallPrimitive(theEnv,&DefclassData(theEnv)->DefclassEntityRecord,DEFCLASS_PTR);
DefclassData(theEnv)->DefclassModuleIndex =
RegisterModuleItem(theEnv,(char*)"defclass",
#if (! RUN_TIME)
AllocateModule,ReturnModule,
#else
NULL,NULL,
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
BloadDefclassModuleReference,
#else
NULL,
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DefclassCModuleReference,
#else
NULL,
#endif
EnvFindDefclass);
DefclassData(theEnv)->DefclassConstruct = AddConstruct(theEnv,(char*)"defclass",(char*)"defclasses",
#if (! BLOAD_ONLY) && (! RUN_TIME)
ParseDefclass,
#else
NULL,
#endif
EnvFindDefclass,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDefclass,
SetNextConstruct,EnvIsDefclassDeletable,
EnvUndefclass,
#if (! RUN_TIME)
RemoveDefclass
#else
NULL
#endif
);
AddClearReadyFunction(theEnv,(char*)"defclass",InstancesPurge,0);
#if ! RUN_TIME
EnvAddClearFunction(theEnv,(char*)"defclass",CreateSystemClasses,0);
InitializeClasses(theEnv);
#if ! BLOAD_ONLY
#if DEFMODULE_CONSTRUCT
AddPortConstructItem(theEnv,(char*)"defclass",SYMBOL);
AddAfterModuleDefinedFunction(theEnv,(char*)"defclass",UpdateDefclassesScope,0);
#endif
EnvDefineFunction2(theEnv,(char*)"undefclass",'v',PTIEF UndefclassCommand,(char*)"UndefclassCommand",(char*)"11w");
AddSaveFunction(theEnv,(char*)"defclass",SaveDefclasses,10);
#endif
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,(char*)"list-defclasses",'v',PTIEF ListDefclassesCommand,(char*)"ListDefclassesCommand",(char*)"01");
EnvDefineFunction2(theEnv,(char*)"ppdefclass",'v',PTIEF PPDefclassCommand,(char*)"PPDefclassCommand",(char*)"11w");
EnvDefineFunction2(theEnv,(char*)"describe-class",'v',PTIEF DescribeClassCommand,(char*)"DescribeClassCommand",(char*)"11w");
EnvDefineFunction2(theEnv,(char*)"browse-classes",'v',PTIEF BrowseClassesCommand,(char*)"BrowseClassesCommand",(char*)"01w");
#endif
EnvDefineFunction2(theEnv,(char*)"get-defclass-list",'m',PTIEF GetDefclassListFunction,
(char*)"GetDefclassListFunction",(char*)"01");
EnvDefineFunction2(theEnv,(char*)"superclassp",'b',PTIEF SuperclassPCommand,(char*)"SuperclassPCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"subclassp",'b',PTIEF SubclassPCommand,(char*)"SubclassPCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"class-existp",'b',PTIEF ClassExistPCommand,(char*)"ClassExistPCommand",(char*)"11w");
EnvDefineFunction2(theEnv,(char*)"message-handler-existp",'b',
PTIEF MessageHandlerExistPCommand,(char*)"MessageHandlerExistPCommand",(char*)"23w");
EnvDefineFunction2(theEnv,(char*)"class-abstractp",'b',PTIEF ClassAbstractPCommand,(char*)"ClassAbstractPCommand",(char*)"11w");
#if DEFRULE_CONSTRUCT
EnvDefineFunction2(theEnv,(char*)"class-reactivep",'b',PTIEF ClassReactivePCommand,(char*)"ClassReactivePCommand",(char*)"11w");
#endif
EnvDefineFunction2(theEnv,(char*)"class-slots",'m',PTIEF ClassSlotsCommand,(char*)"ClassSlotsCommand",(char*)"12w");
EnvDefineFunction2(theEnv,(char*)"class-superclasses",'m',
PTIEF ClassSuperclassesCommand,(char*)"ClassSuperclassesCommand",(char*)"12w");
EnvDefineFunction2(theEnv,(char*)"class-subclasses",'m',
PTIEF ClassSubclassesCommand,(char*)"ClassSubclassesCommand",(char*)"12w");
EnvDefineFunction2(theEnv,(char*)"get-defmessage-handler-list",'m',
PTIEF GetDefmessageHandlersListCmd,(char*)"GetDefmessageHandlersListCmd",(char*)"02w");
EnvDefineFunction2(theEnv,(char*)"slot-existp",'b',PTIEF SlotExistPCommand,(char*)"SlotExistPCommand",(char*)"23w");
EnvDefineFunction2(theEnv,(char*)"slot-facets",'m',PTIEF SlotFacetsCommand,(char*)"SlotFacetsCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-sources",'m',PTIEF SlotSourcesCommand,(char*)"SlotSourcesCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-types",'m',PTIEF SlotTypesCommand,(char*)"SlotTypesCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-allowed-values",'m',PTIEF SlotAllowedValuesCommand,(char*)"SlotAllowedValuesCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-allowed-classes",'m',PTIEF SlotAllowedClassesCommand,(char*)"SlotAllowedClassesCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-range",'m',PTIEF SlotRangeCommand,(char*)"SlotRangeCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-cardinality",'m',PTIEF SlotCardinalityCommand,(char*)"SlotCardinalityCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-writablep",'b',PTIEF SlotWritablePCommand,(char*)"SlotWritablePCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-initablep",'b',PTIEF SlotInitablePCommand,(char*)"SlotInitablePCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-publicp",'b',PTIEF SlotPublicPCommand,(char*)"SlotPublicPCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-direct-accessp",'b',PTIEF SlotDirectAccessPCommand,
(char*)"SlotDirectAccessPCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"slot-default-value",'u',PTIEF SlotDefaultValueCommand,
(char*)"SlotDefaultValueCommand",(char*)"22w");
EnvDefineFunction2(theEnv,(char*)"defclass-module",'w',PTIEF GetDefclassModuleCommand,
(char*)"GetDefclassModuleCommand",(char*)"11w");
EnvDefineFunction2(theEnv,(char*)"get-class-defaults-mode", 'w', PTIEF GetClassDefaultsModeCommand, (char*)"GetClassDefaultsModeCommand", (char*)"00");
EnvDefineFunction2(theEnv,(char*)"set-class-defaults-mode", 'w', PTIEF SetClassDefaultsModeCommand, (char*)"SetClassDefaultsModeCommand", (char*)"11w");
#endif
#if DEBUGGING_FUNCTIONS
AddWatchItem(theEnv,(char*)"instances",0,&DefclassData(theEnv)->WatchInstances,75,DefclassWatchAccess,DefclassWatchPrint);
AddWatchItem(theEnv,(char*)"slots",1,&DefclassData(theEnv)->WatchSlots,74,DefclassWatchAccess,DefclassWatchPrint);
#endif
}
globle int EnvBload(
void *theEnv,
char *fileName)
{
long numberOfFunctions;
unsigned long space;
int error;
char IDbuffer[20];
char constructBuffer[CONSTRUCT_HEADER_SIZE];
struct BinaryItem *biPtr;
struct callFunctionItem *bfPtr;
/*================*/
/* Open the file. */
/*================*/
if (GenOpenReadBinary(theEnv,"bload",fileName) == 0) return(FALSE);
/*=====================================*/
/* Determine if this is a binary file. */
/*=====================================*/
GenReadBinary(theEnv,IDbuffer,(unsigned long) strlen(BloadData(theEnv)->BinaryPrefixID) + 1);
if (strcmp(IDbuffer,BloadData(theEnv)->BinaryPrefixID) != 0)
{
PrintErrorID(theEnv,"BLOAD",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"File ");
EnvPrintRouter(theEnv,WERROR,fileName);
EnvPrintRouter(theEnv,WERROR," is not a binary construct file.\n");
GenCloseBinary(theEnv);
return(FALSE);
}
/*=======================================*/
/* Determine if it's a binary file using */
/* a format from a different version. */
/*=======================================*/
GenReadBinary(theEnv,IDbuffer,(unsigned long) strlen(BloadData(theEnv)->BinaryVersionID) + 1);
if (strcmp(IDbuffer,BloadData(theEnv)->BinaryVersionID) != 0)
{
PrintErrorID(theEnv,"BLOAD",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"File ");
EnvPrintRouter(theEnv,WERROR,fileName);
EnvPrintRouter(theEnv,WERROR," is an incompatible binary construct file.\n");
GenCloseBinary(theEnv);
return(FALSE);
}
/*====================*/
/* Clear environment. */
/*====================*/
if (BloadData(theEnv)->BloadActive)
{
if (ClearBload(theEnv) == FALSE)
{
GenCloseBinary(theEnv);
return(FALSE);
}
}
/*=================================*/
/* Determine if the KB environment */
/* was successfully cleared. */
/*=================================*/
if (ClearReady(theEnv) == FALSE)
{
GenCloseBinary(theEnv);
EnvPrintRouter(theEnv,WERROR,"The ");
EnvPrintRouter(theEnv,WERROR,APPLICATION_NAME);
EnvPrintRouter(theEnv,WERROR," environment could not be cleared.\n");
EnvPrintRouter(theEnv,WERROR,"Binary load cannot continue.\n");
return(FALSE);
}
/*==================================*/
/* Call the list of functions to be */
/* executed before a bload occurs. */
/*==================================*/
for (bfPtr = BloadData(theEnv)->BeforeBloadFunctions;
bfPtr != NULL;
bfPtr = bfPtr->next)
{
if (bfPtr->environmentAware)
{ (*bfPtr->func)(theEnv); }
else
{ (* (void (*)(void)) bfPtr->func)(); }
}
/*====================================================*/
/* Read in the functions needed by this binary image. */
/*====================================================*/
BloadData(theEnv)->FunctionArray = ReadNeededFunctions(theEnv,&numberOfFunctions,&error);
if (error)
{
GenCloseBinary(theEnv);
AbortBload(theEnv);
return(FALSE);
}
/*================================================*/
/* Read in the atoms needed by this binary image. */
/*================================================*/
ReadNeededAtomicValues(theEnv);
/*===========================================*/
/* Determine the number of expressions to be */
/* read and allocate the appropriate space */
/*===========================================*/
AllocateExpressions(theEnv);
/*==========================================================*/
/* Read in the memory requirements of the constructs stored */
/* in this binary image and allocate the necessary space */
/*==========================================================*/
for (GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE);
strncmp(constructBuffer,BloadData(theEnv)->BinaryPrefixID,CONSTRUCT_HEADER_SIZE) != 0;
GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE))
{
intBool found;
/*================================================*/
/* Search for the construct type in the list of */
/* binary items. If found, allocate the storage */
/* needed by the construct for this binary image. */
/*================================================*/
found = FALSE;
for (biPtr = BsaveData(theEnv)->ListOfBinaryItems;
biPtr != NULL;
biPtr = biPtr->next)
{
if (strncmp(biPtr->name,constructBuffer,CONSTRUCT_HEADER_SIZE) == 0)
{
if (biPtr->bloadStorageFunction != NULL)
{
(*biPtr->bloadStorageFunction)(theEnv);
found = TRUE;
}
break;
}
}
/*==========================================*/
/* If the construct type wasn't found, skip */
/* the storage binary load information for */
/* this construct. */
/*==========================================*/
if (! found)
{
GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long));
GetSeekCurBinary(theEnv,(long) space);
if (space != 0)
{
EnvPrintRouter(theEnv,WDIALOG,"\nSkipping ");
EnvPrintRouter(theEnv,WDIALOG,constructBuffer);
EnvPrintRouter(theEnv,WDIALOG," constructs because of unavailibility\n");
}
}
}
/*======================================*/
/* Refresh the pointers in expressions. */
/*======================================*/
RefreshExpressions(theEnv);
/*==========================*/
/* Read in the constraints. */
/*==========================*/
ReadNeededConstraints(theEnv);
/*======================================================*/
/* Read in the constructs stored in this binary image. */
/*======================================================*/
for (GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE);
strncmp(constructBuffer,BloadData(theEnv)->BinaryPrefixID,CONSTRUCT_HEADER_SIZE) != 0;
GenReadBinary(theEnv,constructBuffer,(unsigned long) CONSTRUCT_HEADER_SIZE))
{
intBool found;
/*==================================================*/
/* Search for the function to load the construct */
/* into the previously allocated storage. If found, */
/* call the function to load the construct. */
/*==================================================*/
found = FALSE;
for (biPtr = BsaveData(theEnv)->ListOfBinaryItems;
biPtr != NULL;
biPtr = biPtr->next)
{
if (strncmp(biPtr->name,constructBuffer,CONSTRUCT_HEADER_SIZE) == 0)
{
if (biPtr->bloadFunction != NULL)
{
(*biPtr->bloadFunction)(theEnv);
found = TRUE;
}
break;
}
}
/*==========================================*/
/* If the construct type wasn't found, skip */
/* the binary data for this construct. */
/*==========================================*/
if (! found)
{
GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long));
GetSeekCurBinary(theEnv,(long) space);
}
}
/*=================*/
/* Close the file. */
/*=================*/
GenCloseBinary(theEnv);
/*========================================*/
/* Free up temporary storage used for the */
/* function and atomic value information. */
/*========================================*/
if (BloadData(theEnv)->FunctionArray != NULL)
{
genlongfree(theEnv,(void *) BloadData(theEnv)->FunctionArray,
(unsigned long) sizeof(struct FunctionDefinition *) * numberOfFunctions);
}
FreeAtomicValueStorage(theEnv);
/*==================================*/
/* Call the list of functions to be */
/* executed after a bload occurs. */
/*==================================*/
for (bfPtr = BloadData(theEnv)->AfterBloadFunctions;
bfPtr != NULL;
bfPtr = bfPtr->next)
{
if (bfPtr->environmentAware)
{ (*bfPtr->func)(theEnv); }
else
{ (* (void (*)(void)) bfPtr->func)(); }
}
/*=======================================*/
/* Add a clear function to remove binary */
/* load when a clear command is issued. */
/*=======================================*/
BloadData(theEnv)->BloadActive = TRUE;
EnvAddClearFunction(theEnv,"bload",(void (*)(void *)) ClearBload,10000);
/*=============================*/
/* Return TRUE to indicate the */
/* binary load was successful. */
/*=============================*/
return(TRUE);
}
/***************************************************
NAME : SetupDefinstances
DESCRIPTION : Adds the definstance support routines
to the Kernel
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Appropriate function lists modified
NOTES : None
***************************************************/
globle void SetupDefinstances(
void *theEnv)
{
AllocateEnvironmentData(theEnv,DEFINSTANCES_DATA,sizeof(struct definstancesData),DeallocateDefinstancesData);
DefinstancesData(theEnv)->DefinstancesModuleIndex =
RegisterModuleItem(theEnv,(char*)"definstances",
#if (! RUN_TIME)
AllocateModule,ReturnModule,
#else
NULL,NULL,
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
BloadDefinstancesModuleRef,
#else
NULL,
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DefinstancesCModuleReference,
#else
NULL,
#endif
EnvFindDefinstances);
DefinstancesData(theEnv)->DefinstancesConstruct =
AddConstruct(theEnv,(char*)"definstances",(char*)"definstances",
#if (! BLOAD_ONLY) && (! RUN_TIME)
ParseDefinstances,
#else
NULL,
#endif
EnvFindDefinstances,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDefinstances,SetNextConstruct,
EnvIsDefinstancesDeletable,EnvUndefinstances,
#if (! BLOAD_ONLY) && (! RUN_TIME)
RemoveDefinstances
#else
NULL
#endif
);
#if ! RUN_TIME
AddClearReadyFunction(theEnv,(char*)"definstances",ClearDefinstancesReady,0);
#if ! BLOAD_ONLY
EnvDefineFunction2(theEnv,(char*)"undefinstances",'v',PTIEF UndefinstancesCommand,(char*)"UndefinstancesCommand",(char*)"11w");
AddSaveFunction(theEnv,(char*)"definstances",SaveDefinstances,0);
#if DEFRULE_CONSTRUCT
EnvAddClearFunction(theEnv,(char*)"definstances",CreateInitialDefinstances,-1000);
#endif
#endif
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,(char*)"ppdefinstances",'v',PTIEF PPDefinstancesCommand ,(char*)"PPDefinstancesCommand",(char*)"11w");
EnvDefineFunction2(theEnv,(char*)"list-definstances",'v',PTIEF ListDefinstancesCommand,(char*)"ListDefinstancesCommand",(char*)"01");
#endif
EnvDefineFunction2(theEnv,(char*)"get-definstances-list",'m',PTIEF GetDefinstancesListFunction,
(char*)"GetDefinstancesListFunction",(char*)"01");
EnvDefineFunction2(theEnv,(char*)"definstances-module",'w',PTIEF GetDefinstancesModuleCommand,
(char*)"GetDefinstancesModuleCommand",(char*)"11w");
#endif
EnvAddResetFunction(theEnv,(char*)"definstances",(void (*)(void *)) ResetDefinstances,0);
#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
SetupDefinstancesBload(theEnv);
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
SetupDefinstancesCompiler(theEnv);
#endif
}
