spv_result_t Function::RegisterLoopMerge(uint32_t merge_id,
uint32_t continue_id) {
RegisterBlock(merge_id, false);
RegisterBlock(continue_id, false);
BasicBlock& merge_block = blocks_.at(merge_id);
BasicBlock& continue_target_block = blocks_.at(continue_id);
assert(current_block_ &&
"RegisterLoopMerge must be called when called within a block");
current_block_->set_type(kBlockTypeLoop);
merge_block.set_type(kBlockTypeMerge);
continue_target_block.set_type(kBlockTypeContinue);
Construct& loop_construct =
AddConstruct({ConstructType::kLoop, current_block_, &merge_block});
Construct& continue_construct =
AddConstruct({ConstructType::kContinue, &continue_target_block});
continue_construct.set_corresponding_constructs({&loop_construct});
loop_construct.set_corresponding_constructs({&continue_construct});
merge_block_header_[&merge_block] = current_block_;
if (continue_target_headers_.find(&continue_target_block) ==
continue_target_headers_.end()) {
continue_target_headers_[&continue_target_block] = {current_block_};
} else {
continue_target_headers_[&continue_target_block].push_back(current_block_);
}
return SPV_SUCCESS;
}
globle void InitializeDefrules()
{
InitializeEngine();
InitializeAgenda();
InitializeDefruleModules();
AddReservedPatternSymbol("and",NULL);
AddReservedPatternSymbol("not",NULL);
AddReservedPatternSymbol("or",NULL);
AddReservedPatternSymbol("test",NULL);
AddReservedPatternSymbol("logical",NULL);
AddReservedPatternSymbol("exists",NULL);
AddReservedPatternSymbol("forall",NULL);
DefruleBasicCommands();
DefruleCommands();
DefruleConstruct =
AddConstruct("defrule","defrules",
ParseDefrule,FindDefrule,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,GetNextDefrule,SetNextConstruct,
IsDefruleDeletable,Undefrule,ReturnDefrule);
}
globle void InitializeDeftemplates(
void *theEnv)
{
globle struct entityRecord deftemplatePtrRecord = { "DEFTEMPLATE_PTR",
DEFTEMPLATE_PTR,1,0,0,
NULL,
NULL,NULL,
NULL,
NULL,
DecrementDeftemplateBusyCount,
IncrementDeftemplateBusyCount,
NULL,NULL,NULL,NULL };
AllocateEnvironmentData(theEnv,DEFTEMPLATE_DATA,sizeof(struct deftemplateData),DeallocateDeftemplateData);
memcpy(&DeftemplateData(theEnv)->DeftemplatePtrRecord,&deftemplatePtrRecord,sizeof(struct entityRecord));
InitializeFacts(theEnv);
InitializeDeftemplateModules(theEnv);
DeftemplateBasicCommands(theEnv);
DeftemplateFunctions(theEnv);
DeftemplateData(theEnv)->DeftemplateConstruct =
AddConstruct(theEnv,"deftemplate","deftemplates",ParseDeftemplate,EnvFindDeftemplate,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDeftemplate,SetNextConstruct,
EnvIsDeftemplateDeletable,EnvUndeftemplate,ReturnDeftemplate);
InstallPrimitive(theEnv,(ENTITY_RECORD_PTR) &DeftemplateData(theEnv)->DeftemplatePtrRecord,DEFTEMPLATE_PTR);
}
globle void InitializeDefrules(
void *theEnv)
{
AllocateEnvironmentData(theEnv,DEFRULE_DATA,sizeof(struct defruleData),DeallocateDefruleData);
InitializeEngine(theEnv);
InitializeAgenda(theEnv);
InitializePatterns(theEnv);
InitializeDefruleModules(theEnv);
AddReservedPatternSymbol(theEnv,"and",NULL);
AddReservedPatternSymbol(theEnv,"not",NULL);
AddReservedPatternSymbol(theEnv,"or",NULL);
AddReservedPatternSymbol(theEnv,"test",NULL);
AddReservedPatternSymbol(theEnv,"logical",NULL);
AddReservedPatternSymbol(theEnv,"exists",NULL);
AddReservedPatternSymbol(theEnv,"forall",NULL);
DefruleBasicCommands(theEnv);
DefruleCommands(theEnv);
DefruleData(theEnv)->DefruleConstruct =
AddConstruct(theEnv,"defrule","defrules",
ParseDefrule,EnvFindDefrule,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDefrule,SetNextConstruct,
EnvIsDefruleDeletable,EnvUndefrule,ReturnDefrule);
}
/***************************************************
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
}
spv_result_t Function::RegisterSelectionMerge(uint32_t merge_id) {
RegisterBlock(merge_id, false);
BasicBlock& merge_block = blocks_.at(merge_id);
current_block_->set_type(kBlockTypeHeader);
merge_block.set_type(kBlockTypeMerge);
AddConstruct({ConstructType::kSelection, current_block(), &merge_block});
return SPV_SUCCESS;
}
globle void InitializeDeffacts(
void *theEnv)
{
AllocateEnvironmentData(theEnv,DEFFACTS_DATA,sizeof(struct deffactsData),DeallocateDeffactsData);
InitializeDeffactsModules(theEnv);
DeffactsBasicCommands(theEnv);
DeffactsData(theEnv)->DeffactsConstruct =
AddConstruct(theEnv,"deffacts","deffacts",ParseDeffacts,EnvFindDeffacts,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDeffacts,SetNextConstruct,
EnvIsDeffactsDeletable,EnvUndeffacts,ReturnDeffacts);
}
void InitializeDefglobals(
Environment *theEnv)
{
struct entityRecord globalInfo = { "GBL_VARIABLE", GBL_VARIABLE,0,0,0,
NULL,
NULL,
NULL,
(EntityEvaluationFunction *) EntityGetDefglobalValue,
NULL,NULL,
NULL,NULL,NULL,NULL,NULL,NULL };
struct entityRecord defglobalPtrRecord = { "DEFGLOBAL_PTR", DEFGLOBAL_PTR,0,0,0,
NULL,NULL,NULL,
(EntityEvaluationFunction *) QGetDefglobalUDFValue,
NULL,
(EntityBusyCountFunction *) DecrementDefglobalBusyCount,
(EntityBusyCountFunction *) IncrementDefglobalBusyCount,
NULL,NULL,NULL,NULL,NULL };
AllocateEnvironmentData(theEnv,DEFGLOBAL_DATA,sizeof(struct defglobalData),DeallocateDefglobalData);
memcpy(&DefglobalData(theEnv)->GlobalInfo,&globalInfo,sizeof(struct entityRecord));
memcpy(&DefglobalData(theEnv)->DefglobalPtrRecord,&defglobalPtrRecord,sizeof(struct entityRecord));
DefglobalData(theEnv)->ResetGlobals = true;
DefglobalData(theEnv)->LastModuleIndex = -1;
InstallPrimitive(theEnv,&DefglobalData(theEnv)->GlobalInfo,GBL_VARIABLE);
InstallPrimitive(theEnv,&DefglobalData(theEnv)->GlobalInfo,MF_GBL_VARIABLE);
InstallPrimitive(theEnv,&DefglobalData(theEnv)->DefglobalPtrRecord,DEFGLOBAL_PTR);
InitializeDefglobalModules(theEnv);
DefglobalBasicCommands(theEnv);
DefglobalCommandDefinitions(theEnv);
DefglobalData(theEnv)->DefglobalConstruct =
AddConstruct(theEnv,"defglobal","defglobals",ParseDefglobal,
(FindConstructFunction *) FindDefglobal,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,
(GetNextConstructFunction *) GetNextDefglobal,
SetNextConstruct,
(IsConstructDeletableFunction *) DefglobalIsDeletable,
(DeleteConstructFunction *) Undefglobal,
(FreeConstructFunction *) ReturnDefglobal);
}
void InitializeDefrules(
Environment *theEnv)
{
unsigned long i;
AllocateEnvironmentData(theEnv,DEFRULE_DATA,sizeof(struct defruleData),DeallocateDefruleData);
InitializeEngine(theEnv);
InitializeAgenda(theEnv);
InitializePatterns(theEnv);
InitializeDefruleModules(theEnv);
AddReservedPatternSymbol(theEnv,"and",NULL);
AddReservedPatternSymbol(theEnv,"not",NULL);
AddReservedPatternSymbol(theEnv,"or",NULL);
AddReservedPatternSymbol(theEnv,"test",NULL);
AddReservedPatternSymbol(theEnv,"logical",NULL);
AddReservedPatternSymbol(theEnv,"exists",NULL);
AddReservedPatternSymbol(theEnv,"forall",NULL);
DefruleBasicCommands(theEnv);
DefruleCommands(theEnv);
DefruleData(theEnv)->DefruleConstruct =
AddConstruct(theEnv,"defrule","defrules",
ParseDefrule,
(FindConstructFunction *) FindDefrule,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,
(GetNextConstructFunction *) GetNextDefrule,
SetNextConstruct,
(IsConstructDeletableFunction *) DefruleIsDeletable,
(DeleteConstructFunction *) Undefrule,
(FreeConstructFunction *) ReturnDefrule);
DefruleData(theEnv)->AlphaMemoryTable = (ALPHA_MEMORY_HASH **)
gm2(theEnv,sizeof (ALPHA_MEMORY_HASH *) * ALPHA_MEMORY_HASH_SIZE);
for (i = 0; i < ALPHA_MEMORY_HASH_SIZE; i++) DefruleData(theEnv)->AlphaMemoryTable[i] = NULL;
DefruleData(theEnv)->BetaMemoryResizingFlag = true;
DefruleData(theEnv)->RightPrimeJoins = NULL;
DefruleData(theEnv)->LeftPrimeJoins = NULL;
}
void InitializeDefmodules(
Environment *theEnv)
{
DefmoduleBasicCommands(theEnv);
#if (! RUN_TIME)
CreateMainModule(theEnv,NULL);
#endif
#if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY)
AddConstruct(theEnv,"defmodule","defmodules",ParseDefmodule,NULL,NULL,NULL,NULL,
NULL,NULL,NULL,NULL,NULL);
#endif
#if (! RUN_TIME) && DEFMODULE_CONSTRUCT
AddUDF(theEnv,"get-current-module","y",0,0,NULL,GetCurrentModuleCommand,"GetCurrentModuleCommand",NULL);
AddUDF(theEnv,"set-current-module","y",1,1,"y",SetCurrentModuleCommand,"SetCurrentModuleCommand",NULL);
#endif
}
void InitializeDeffacts(
Environment *theEnv)
{
AllocateEnvironmentData(theEnv,DEFFACTS_DATA,sizeof(struct deffactsData),DeallocateDeffactsData);
InitializeDeffactsModules(theEnv);
DeffactsBasicCommands(theEnv);
DeffactsData(theEnv)->DeffactsConstruct =
AddConstruct(theEnv,"deffacts","deffacts",ParseDeffacts,
(FindConstructFunction *) FindDeffacts,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,
(GetNextConstructFunction *) GetNextDeffacts,
SetNextConstruct,
(IsConstructDeletableFunction *) DeffactsIsDeletable,
(DeleteConstructFunction *) Undeffacts,
(FreeConstructFunction *) ReturnDeffacts);
}
globle void InitializeDefglobals(
void *theEnv)
{
struct entityRecord globalInfo = { "GBL_VARIABLE", GBL_VARIABLE,0,0,0,
NULL,
NULL,
NULL,
GetDefglobalValue2,
NULL,NULL,
NULL,NULL,NULL };
struct entityRecord defglobalPtrRecord = { "DEFGLOBAL_PTR", DEFGLOBAL_PTR,0,0,0,
NULL,NULL,NULL,
QGetDefglobalValue,
NULL,
DecrementDefglobalBusyCount,
IncrementDefglobalBusyCount,
NULL,NULL,NULL,NULL };
AllocateEnvironmentData(theEnv,DEFGLOBAL_DATA,sizeof(struct defglobalData),DeallocateDefglobalData);
memcpy(&DefglobalData(theEnv)->GlobalInfo,&globalInfo,sizeof(struct entityRecord));
memcpy(&DefglobalData(theEnv)->DefglobalPtrRecord,&defglobalPtrRecord,sizeof(struct entityRecord));
DefglobalData(theEnv)->ResetGlobals = TRUE;
DefglobalData(theEnv)->LastModuleIndex = -1;
InstallPrimitive(theEnv,&DefglobalData(theEnv)->GlobalInfo,GBL_VARIABLE);
InstallPrimitive(theEnv,&DefglobalData(theEnv)->DefglobalPtrRecord,DEFGLOBAL_PTR);
InitializeDefglobalModules(theEnv);
DefglobalBasicCommands(theEnv);
DefglobalCommandDefinitions(theEnv);
DefglobalData(theEnv)->DefglobalConstruct =
AddConstruct(theEnv,"defglobal","defglobals",ParseDefglobal,EnvFindDefglobal,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDefglobal,SetNextConstruct,
EnvIsDefglobalDeletable,EnvUndefglobal,ReturnDefglobal);
}
globle void InitializeDefrules(
void *theEnv)
{
unsigned long i;
AllocateEnvironmentData(theEnv,DEFRULE_DATA,sizeof(struct defruleData),DeallocateDefruleData);
InitializeEngine(theEnv);
InitializeAgenda(theEnv);
InitializePatterns(theEnv);
InitializeDefruleModules(theEnv);
AddReservedPatternSymbol(theEnv,(char*)"and",NULL);
AddReservedPatternSymbol(theEnv,(char*)"not",NULL);
AddReservedPatternSymbol(theEnv,(char*)"or",NULL);
AddReservedPatternSymbol(theEnv,(char*)"test",NULL);
AddReservedPatternSymbol(theEnv,(char*)"logical",NULL);
AddReservedPatternSymbol(theEnv,(char*)"exists",NULL);
AddReservedPatternSymbol(theEnv,(char*)"forall",NULL);
DefruleBasicCommands(theEnv);
DefruleCommands(theEnv);
DefruleData(theEnv)->DefruleConstruct =
AddConstruct(theEnv,(char*)"defrule",(char*)"defrules",
ParseDefrule,EnvFindDefrule,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDefrule,SetNextConstruct,
EnvIsDefruleDeletable,EnvUndefrule,ReturnDefrule);
DefruleData(theEnv)->AlphaMemoryTable = (ALPHA_MEMORY_HASH **)
gm3(theEnv,sizeof (ALPHA_MEMORY_HASH *) * ALPHA_MEMORY_HASH_SIZE);
for (i = 0; i < ALPHA_MEMORY_HASH_SIZE; i++) DefruleData(theEnv)->AlphaMemoryTable[i] = NULL;
DefruleData(theEnv)->BetaMemoryResizingFlag = TRUE;
DefruleData(theEnv)->RightPrimeJoins = NULL;
DefruleData(theEnv)->LeftPrimeJoins = NULL;
}
globle void InitializeDefmodules(
void *theEnv)
{
DefmoduleBasicCommands(theEnv);
#if (! RUN_TIME)
CreateMainModule(theEnv);
#endif
#if DEFMODULE_CONSTRUCT && (! RUN_TIME) && (! BLOAD_ONLY)
AddConstruct(theEnv,"defmodule","defmodules",ParseDefmodule,NULL,NULL,NULL,NULL,
NULL,NULL,NULL,NULL,NULL);
#endif
#if (! RUN_TIME) && DEFMODULE_CONSTRUCT
EnvDefineFunction2(theEnv,"get-current-module", 'w',
PTIEF GetCurrentModuleCommand,
"GetCurrentModuleCommand", "00");
EnvDefineFunction2(theEnv,"set-current-module", 'w',
PTIEF SetCurrentModuleCommand,
"SetCurrentModuleCommand", "11w");
#endif
}
/***************************************************
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
}
/***************************************************
NAME : SetupDeffunctions
DESCRIPTION : Initializes parsers and access
functions for deffunctions
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Deffunction environment initialized
NOTES : None
***************************************************/
globle void SetupDeffunctions(
void *theEnv)
{
ENTITY_RECORD deffunctionEntityRecord =
{ (char*)"PCALL", PCALL,0,0,1,
PrintDeffunctionCall,PrintDeffunctionCall,
NULL,EvaluateDeffunctionCall,NULL,
DecrementDeffunctionBusyCount,IncrementDeffunctionBusyCount,
NULL,NULL,NULL,NULL,NULL };
AllocateEnvironmentData(theEnv,DEFFUNCTION_DATA,sizeof(struct deffunctionData),DeallocateDeffunctionData);
memcpy(&DeffunctionData(theEnv)->DeffunctionEntityRecord,&deffunctionEntityRecord,sizeof(struct entityRecord));
InstallPrimitive(theEnv,&DeffunctionData(theEnv)->DeffunctionEntityRecord,PCALL);
DeffunctionData(theEnv)->DeffunctionModuleIndex =
RegisterModuleItem(theEnv,(char*)"deffunction",
#if (! RUN_TIME)
AllocateModule,ReturnModule,
#else
NULL,NULL,
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
BloadDeffunctionModuleReference,
#else
NULL,
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DeffunctionCModuleReference,
#else
NULL,
#endif
EnvFindDeffunction);
DeffunctionData(theEnv)->DeffunctionConstruct = AddConstruct(theEnv,(char*)"deffunction",(char*)"deffunctions",
#if (! BLOAD_ONLY) && (! RUN_TIME)
ParseDeffunction,
#else
NULL,
#endif
EnvFindDeffunction,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDeffunction,
SetNextConstruct,EnvIsDeffunctionDeletable,
EnvUndeffunction,
#if (! BLOAD_ONLY) && (! RUN_TIME)
RemoveDeffunction
#else
NULL
#endif
);
#if ! RUN_TIME
AddClearReadyFunction(theEnv,(char*)"deffunction",ClearDeffunctionsReady,0);
#if ! BLOAD_ONLY
#if DEFMODULE_CONSTRUCT
AddPortConstructItem(theEnv,(char*)"deffunction",SYMBOL);
#endif
AddSaveFunction(theEnv,(char*)"deffunction-headers",SaveDeffunctionHeaders,1000);
AddSaveFunction(theEnv,(char*)"deffunctions",SaveDeffunctions,0);
EnvDefineFunction2(theEnv,(char*)"undeffunction",'v',PTIEF UndeffunctionCommand,(char*)"UndeffunctionCommand",(char*)"11w");
#endif
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,(char*)"list-deffunctions",'v',PTIEF ListDeffunctionsCommand,(char*)"ListDeffunctionsCommand",(char*)"01");
EnvDefineFunction2(theEnv,(char*)"ppdeffunction",'v',PTIEF PPDeffunctionCommand,(char*)"PPDeffunctionCommand",(char*)"11w");
#endif
EnvDefineFunction2(theEnv,(char*)"get-deffunction-list",'m',PTIEF GetDeffunctionListFunction,
(char*)"GetDeffunctionListFunction",(char*)"01");
EnvDefineFunction2(theEnv,(char*)"deffunction-module",'w',PTIEF GetDeffunctionModuleCommand,
(char*)"GetDeffunctionModuleCommand",(char*)"11w");
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
SetupDeffunctionsBload(theEnv);
#endif
#if CONSTRUCT_COMPILER
SetupDeffunctionCompiler(theEnv);
#endif
#endif
#if DEBUGGING_FUNCTIONS
AddWatchItem(theEnv,(char*)"deffunctions",0,&DeffunctionData(theEnv)->WatchDeffunctions,32,
DeffunctionWatchAccess,DeffunctionWatchPrint);
#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
}
/***************************************************
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
}
