/***************************************************
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
}
globle void FactCommandDefinitions(
void *theEnv)
{
#if ! RUN_TIME
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,(char*)"facts", 'v', PTIEF FactsCommand, (char*)"FactsCommand", (char*)"*4iu");
#endif
EnvDefineFunction(theEnv,(char*)"assert", 'u', PTIEF AssertCommand, (char*)"AssertCommand");
EnvDefineFunction2(theEnv,(char*)"retract", 'v', PTIEF RetractCommand, (char*)"RetractCommand",(char*)"1*z");
EnvDefineFunction2(theEnv,(char*)"assert-string", 'u', PTIEF AssertStringFunction, (char*)"AssertStringFunction", (char*)"11s");
EnvDefineFunction2(theEnv,(char*)"str-assert", 'u', PTIEF AssertStringFunction, (char*)"AssertStringFunction", (char*)"11s");
EnvDefineFunction2(theEnv,(char*)"get-fact-duplication",'b',
GetFactDuplicationCommand,(char*)"GetFactDuplicationCommand", (char*)"00");
EnvDefineFunction2(theEnv,(char*)"set-fact-duplication",'b',
SetFactDuplicationCommand,(char*)"SetFactDuplicationCommand", (char*)"11");
EnvDefineFunction2(theEnv,(char*)"save-facts", 'b', PTIEF SaveFactsCommand, (char*)"SaveFactsCommand", (char*)"1*wk");
EnvDefineFunction2(theEnv,(char*)"load-facts", 'b', PTIEF LoadFactsCommand, (char*)"LoadFactsCommand", (char*)"11k");
EnvDefineFunction2(theEnv,(char*)"fact-index", 'g', PTIEF FactIndexFunction,(char*)"FactIndexFunction", (char*)"11y");
AddFunctionParser(theEnv,(char*)"assert",AssertParse);
FuncSeqOvlFlags(theEnv,(char*)"assert",FALSE,FALSE);
#else
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif
}
globle void FactCommandDefinitions(
void *theEnv)
{
#if ! RUN_TIME
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,"facts", 'v', PTIEF FactsCommand, "FactsCommand", "*4iu");
#endif
//madianyi Begin
EnvDefineFunction(theEnv,"update", 'u', PTIEF UpdateCommand, "UpdateCommand");
//madianyi End
EnvDefineFunction(theEnv,"assert", 'u', PTIEF AssertCommand, "AssertCommand");
EnvDefineFunction2(theEnv,"retract", 'v', PTIEF RetractCommand, "RetractCommand","1*z");
EnvDefineFunction2(theEnv,"assert-string", 'u', PTIEF AssertStringFunction, "AssertStringFunction", "11s");
EnvDefineFunction2(theEnv,"str-assert", 'u', PTIEF AssertStringFunction, "AssertStringFunction", "11s");
EnvDefineFunction2(theEnv,"get-fact-duplication",'b',
GetFactDuplicationCommand,"GetFactDuplicationCommand", "00");
EnvDefineFunction2(theEnv,"set-fact-duplication",'b',
SetFactDuplicationCommand,"SetFactDuplicationCommand", "11");
EnvDefineFunction2(theEnv,"save-facts", 'b', PTIEF SaveFactsCommand, "SaveFactsCommand", "1*wk");
EnvDefineFunction2(theEnv,"load-facts", 'b', PTIEF LoadFactsCommand, "LoadFactsCommand", "11k");
EnvDefineFunction2(theEnv,"fact-index", 'g', PTIEF FactIndexFunction,"FactIndexFunction", "11y");
AddFunctionParser(theEnv,"assert",AssertParse);
FuncSeqOvlFlags(theEnv,"assert",FALSE,FALSE);
#else
#if MAC_XCD
#pragma unused(theEnv)
#endif
#endif
}
globle void DeftemplateFunctions(
void *theEnv)
{
#if ! RUN_TIME
EnvDefineFunction(theEnv,"modify",'u', PTIEF ModifyCommand,"ModifyCommand");
EnvDefineFunction(theEnv,"duplicate",'u', PTIEF DuplicateCommand,"DuplicateCommand");
#if (! BLOAD_ONLY)
AddFunctionParser(theEnv,"modify",ModifyParse);
AddFunctionParser(theEnv,"duplicate",DuplicateParse);
#endif
FuncSeqOvlFlags(theEnv,"modify",FALSE,FALSE);
FuncSeqOvlFlags(theEnv,"duplicate",FALSE,FALSE);
#else
#if MAC_MCW || IBM_MCW
#pragma unused(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);
}
globle void MiscFunctionDefinitions(
void *theEnv)
{
AllocateEnvironmentData(theEnv,MISCFUN_DATA,sizeof(struct miscFunctionData),NULL);
MiscFunctionData(theEnv)->GensymNumber = 1;
#if ! RUN_TIME
EnvDefineFunction2(theEnv,"gensym", 'w', PTIEF GensymFunction, "GensymFunction", "00");
EnvDefineFunction2(theEnv,"gensym*", 'w', PTIEF GensymStarFunction, "GensymStarFunction", "00");
EnvDefineFunction2(theEnv,"setgen", 'l', PTIEF SetgenFunction, "SetgenFunction", "11i");
EnvDefineFunction2(theEnv,"system", 'v', PTIEF gensystem, "gensystem", "1*k");
EnvDefineFunction2(theEnv,"length", 'l', PTIEF LengthFunction, "LengthFunction", "11q");
EnvDefineFunction2(theEnv,"length$", 'l', PTIEF LengthFunction, "LengthFunction", "11q");
EnvDefineFunction2(theEnv,"time", 'd', PTIEF TimeFunction, "TimeFunction", "00");
EnvDefineFunction2(theEnv,"random", 'l', PTIEF RandomFunction, "RandomFunction", "02i");
EnvDefineFunction2(theEnv,"seed", 'v', PTIEF SeedFunction, "SeedFunction", "11i");
EnvDefineFunction2(theEnv,"conserve-mem", 'v', PTIEF ConserveMemCommand, "ConserveMemCommand", "11w");
EnvDefineFunction2(theEnv,"release-mem", 'l', PTIEF ReleaseMemCommand, "ReleaseMemCommand", "00");
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,"mem-used", 'l', PTIEF MemUsedCommand, "MemUsedCommand", "00");
EnvDefineFunction2(theEnv,"mem-requests", 'l', PTIEF MemRequestsCommand, "MemRequestsCommand", "00");
#endif
EnvDefineFunction2(theEnv,"options", 'v', PTIEF OptionsCommand, "OptionsCommand", "00");
EnvDefineFunction2(theEnv,"(expansion-call)", 'u', PTIEF ExpandFuncCall, "ExpandFuncCall",NULL);
EnvDefineFunction2(theEnv,"expand$",'u', PTIEF DummyExpandFuncMultifield,
"DummyExpandFuncMultifield","11m");
FuncSeqOvlFlags(theEnv,"expand$",FALSE,FALSE);
EnvDefineFunction2(theEnv,"(set-evaluation-error)",
'w', PTIEF CauseEvaluationError,"CauseEvaluationError",NULL);
EnvDefineFunction2(theEnv,"set-sequence-operator-recognition",
'b', PTIEF SetSORCommand,"SetSORCommand","11w");
EnvDefineFunction2(theEnv,"get-sequence-operator-recognition",'b',
PTIEF EnvGetSequenceOperatorRecognition,"EnvGetSequenceOperatorRecognition","00");
EnvDefineFunction2(theEnv,"get-function-restrictions",'s',
PTIEF GetFunctionRestrictions,"GetFunctionRestrictions","11w");
EnvDefineFunction2(theEnv,"create$", 'm', PTIEF CreateFunction, "CreateFunction", NULL);
EnvDefineFunction2(theEnv,"mv-append", 'm', PTIEF CreateFunction, "CreateFunction", NULL);
EnvDefineFunction2(theEnv,"apropos", 'v', PTIEF AproposCommand, "AproposCommand", "11w");
EnvDefineFunction2(theEnv,"get-function-list", 'm', PTIEF GetFunctionListFunction, "GetFunctionListFunction", "00");
EnvDefineFunction2(theEnv,"funcall",'u', PTIEF FuncallFunction,"FuncallFunction","1**k");
EnvDefineFunction2(theEnv,"timer",'d', PTIEF TimerFunction,"TimerFunction","**");
#endif
}
globle void ProceduralFunctionDefinitions()
{
DefineFunction2("if", 'u', PTIF IfFunction, "IfFunction", NULL);
DefineFunction2("while", 'u', PTIF WhileFunction, "WhileFunction", NULL);
DefineFunction2("loop-for-count",'u', PTIF LoopForCountFunction, "LoopForCountFunction", NULL);
DefineFunction2("(get-loop-count)",'l', PTIF GetLoopCount, "GetLoopCount", NULL);
DefineFunction2("bind", 'u', PTIF BindFunction, "BindFunction", NULL);
DefineFunction2("progn", 'u', PTIF PrognFunction, "PrognFunction", NULL);
DefineFunction2("return", 'u', PTIF ReturnFunction, "ReturnFunction",NULL);
DefineFunction2("break", 'v', PTIF BreakFunction, "BreakFunction",NULL);
DefineFunction2("switch", 'u', PTIF SwitchFunction, "SwitchFunction",NULL);
ProceduralFunctionParsers();
FuncSeqOvlFlags("progn",FALSE,FALSE);
FuncSeqOvlFlags("if",FALSE,FALSE);
FuncSeqOvlFlags("while",FALSE,FALSE);
FuncSeqOvlFlags("loop-for-count",FALSE,FALSE);
FuncSeqOvlFlags("return",FALSE,FALSE);
FuncSeqOvlFlags("switch",FALSE,FALSE);
}
/***************************************************
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
}
