Exemplo n.º 1
0
/***************************************************
  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
  }
Exemplo n.º 2
0
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);
  }
Exemplo n.º 3
0
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);
  }
Exemplo n.º 4
0
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);
  }
Exemplo n.º 5
0
/***************************************************
  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

  }
Exemplo n.º 6
0
/***************************************************
  NAME         : InstallObjectPrimitives
  DESCRIPTION  : Installs all the entity records
                 associated with object pattern
                 matching operations
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Primitive operations installed
  NOTES        : None
 ***************************************************/
globle void InstallObjectPrimitives(
    void *theEnv)
{
    struct entityRecord objectGVInfo1 = { "OBJ_GET_SLOT_JNVAR1", OBJ_GET_SLOT_JNVAR1,0,1,0,
        PrintObjectGetVarJN1,
        PrintObjectGetVarJN1,NULL,
        ObjectGetVarJNFunction1,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord objectGVInfo2 = { "OBJ_GET_SLOT_JNVAR2", OBJ_GET_SLOT_JNVAR2,0,1,0,
        PrintObjectGetVarJN2,
        PrintObjectGetVarJN2,NULL,
        ObjectGetVarJNFunction2,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord objectGVPNInfo1 = { "OBJ_GET_SLOT_PNVAR1", OBJ_GET_SLOT_PNVAR1,0,1,0,
        PrintObjectGetVarPN1,
        PrintObjectGetVarPN1,NULL,
        ObjectGetVarPNFunction1,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord objectGVPNInfo2 = { "OBJ_GET_SLOT_PNVAR2", OBJ_GET_SLOT_PNVAR2,0,1,0,
        PrintObjectGetVarPN2,
        PrintObjectGetVarPN2,NULL,
        ObjectGetVarPNFunction2,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord objectCmpConstantInfo = { "OBJ_PN_CONSTANT", OBJ_PN_CONSTANT,0,1,1,
        PrintObjectCmpConstant,
        PrintObjectCmpConstant,NULL,
        ObjectCmpConstantFunction,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord lengthTestInfo = { "OBJ_SLOT_LENGTH", OBJ_SLOT_LENGTH,0,1,0,
        PrintSlotLengthTest,
        PrintSlotLengthTest,NULL,
        SlotLengthTestFunction,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord pNSimpleCompareInfo1 = { "OBJ_PN_CMP1", OBJ_PN_CMP1,0,1,1,
        PrintPNSimpleCompareFunction1,
        PrintPNSimpleCompareFunction1,NULL,
        PNSimpleCompareFunction1,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord pNSimpleCompareInfo2 = { "OBJ_PN_CMP2", OBJ_PN_CMP2,0,1,1,
        PrintPNSimpleCompareFunction2,
        PrintPNSimpleCompareFunction2,NULL,
        PNSimpleCompareFunction2,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord pNSimpleCompareInfo3 = { "OBJ_PN_CMP3", OBJ_PN_CMP3,0,1,1,
        PrintPNSimpleCompareFunction3,
        PrintPNSimpleCompareFunction3,NULL,
        PNSimpleCompareFunction3,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord jNSimpleCompareInfo1 = { "OBJ_JN_CMP1", OBJ_JN_CMP1,0,1,1,
        PrintJNSimpleCompareFunction1,
        PrintJNSimpleCompareFunction1,NULL,
        JNSimpleCompareFunction1,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord jNSimpleCompareInfo2 = { "OBJ_JN_CMP2", OBJ_JN_CMP2,0,1,1,
        PrintJNSimpleCompareFunction2,
        PrintJNSimpleCompareFunction2,NULL,
        JNSimpleCompareFunction2,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    struct entityRecord jNSimpleCompareInfo3 = { "OBJ_JN_CMP3", OBJ_JN_CMP3,0,1,1,
        PrintJNSimpleCompareFunction3,
        PrintJNSimpleCompareFunction3,NULL,
        JNSimpleCompareFunction3,
        NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL
    };

    AllocateEnvironmentData(theEnv,OBJECT_RETE_DATA,sizeof(struct objectReteData),DeallocateObjectReteData);
    ObjectReteData(theEnv)->CurrentObjectSlotLength = 1;

    memcpy(&ObjectReteData(theEnv)->ObjectGVInfo1,&objectGVInfo1,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->ObjectGVInfo2,&objectGVInfo2,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->ObjectGVPNInfo1,&objectGVPNInfo1,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->ObjectGVPNInfo2,&objectGVPNInfo2,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->ObjectCmpConstantInfo,&objectCmpConstantInfo,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->LengthTestInfo,&lengthTestInfo,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo1,&pNSimpleCompareInfo1,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo2,&pNSimpleCompareInfo2,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->PNSimpleCompareInfo3,&pNSimpleCompareInfo3,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo1,&jNSimpleCompareInfo1,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo2,&jNSimpleCompareInfo2,sizeof(struct entityRecord));
    memcpy(&ObjectReteData(theEnv)->JNSimpleCompareInfo3,&jNSimpleCompareInfo3,sizeof(struct entityRecord));

    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVInfo1,OBJ_GET_SLOT_JNVAR1);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVInfo2,OBJ_GET_SLOT_JNVAR2);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVPNInfo1,OBJ_GET_SLOT_PNVAR1);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectGVPNInfo2,OBJ_GET_SLOT_PNVAR2);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->ObjectCmpConstantInfo,OBJ_PN_CONSTANT);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->LengthTestInfo,OBJ_SLOT_LENGTH);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo1,OBJ_PN_CMP1);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo2,OBJ_PN_CMP2);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->PNSimpleCompareInfo3,OBJ_PN_CMP3);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo1,OBJ_JN_CMP1);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo2,OBJ_JN_CMP2);
    InstallPrimitive(theEnv,&ObjectReteData(theEnv)->JNSimpleCompareInfo3,OBJ_JN_CMP3);
}
Exemplo n.º 7
0
globle void InitializeFactReteFunctions()
  {
#if DEFRULE_CONSTRUCT
   InstallPrimitive((ENTITY_RECORD_PTR) &FactInfo,FACT_ADDRESS);
   InstallPrimitive(&FactJNGV1Info,FACT_JN_VAR1);
   InstallPrimitive(&FactJNGV2Info,FACT_JN_VAR2);
   InstallPrimitive(&FactJNGV3Info,FACT_JN_VAR3);
   InstallPrimitive(&FactPNGV1Info,FACT_PN_VAR1);
   InstallPrimitive(&FactPNGV2Info,FACT_PN_VAR2);
   InstallPrimitive(&FactPNGV3Info,FACT_PN_VAR3);
   InstallPrimitive(&FactJNCV1Info,FACT_JN_CMP1);
   InstallPrimitive(&FactJNCV2Info,FACT_JN_CMP2);
   InstallPrimitive(&FactPNCV1Info,FACT_PN_CMP1);
   InstallPrimitive(&FactStoreMFInfo,FACT_STORE_MULTIFIELD);
   InstallPrimitive(&FactSlotLengthInfo,FACT_SLOT_LENGTH);
   InstallPrimitive(&FactPNConstant1Info,FACT_PN_CONSTANT1);
   InstallPrimitive(&FactPNConstant2Info,FACT_PN_CONSTANT2);
#if FUZZY_DEFTEMPLATES
   InstallPrimitive(&FactPNFuzzyValue,SCALL_PN_FUZZY_VALUE);
#endif

#endif
  }
Exemplo n.º 8
0
/***************************************************
  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
  }
Exemplo n.º 9
0
/*********************************************************
  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
}