Beispiel #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
  }
Beispiel #2
0
/**********************************************************
  NAME         : SetupObjectSystem
  DESCRIPTION  : Initializes all COOL constructs, functions,
                   and data structures
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : COOL initialized
  NOTES        : Order of setup calls is important
 **********************************************************/
globle void SetupObjectSystem(
    void *theEnv)
{
    ENTITY_RECORD defclassEntityRecord = { (char*)"DEFCLASS_PTR", DEFCLASS_PTR,1,0,0,
                                           NULL,NULL,NULL,NULL,NULL,
                                           DecrementDefclassBusyCount,
                                           IncrementDefclassBusyCount,
                                           NULL,NULL,NULL,NULL,NULL
                                         };

    AllocateEnvironmentData(theEnv,DEFCLASS_DATA,sizeof(struct defclassData),NULL);
    AddEnvironmentCleanupFunction(theEnv,(char*)"defclasses",DeallocateDefclassData,-500);

    memcpy(&DefclassData(theEnv)->DefclassEntityRecord,&defclassEntityRecord,sizeof(struct entityRecord));

#if ! RUN_TIME
    DefclassData(theEnv)->ClassDefaultsMode = CONVENIENCE_MODE;
    DefclassData(theEnv)->ISA_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SUPERCLASS_RLN);
    IncrementSymbolCount(DefclassData(theEnv)->ISA_SYMBOL);
    DefclassData(theEnv)->NAME_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,NAME_RLN);
    IncrementSymbolCount(DefclassData(theEnv)->NAME_SYMBOL);
#if DEFRULE_CONSTRUCT
    DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INITIAL_OBJECT_NAME);
    IncrementSymbolCount(DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
#endif
#endif

    SetupDefclasses(theEnv);
    SetupInstances(theEnv);
    SetupMessageHandlers(theEnv);

#if DEFINSTANCES_CONSTRUCT
    SetupDefinstances(theEnv);
#endif

#if INSTANCE_SET_QUERIES
    SetupQuery(theEnv);
#endif

#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
    SetupObjectsBload(theEnv);
#endif

#if CONSTRUCT_COMPILER && (! RUN_TIME)
    SetupObjectsCompiler(theEnv);
#endif

#if DEFRULE_CONSTRUCT
    SetupObjectPatternStuff(theEnv);
#endif
}
Beispiel #3
0
/**************************************************************
  NAME         : NewSlot
  DESCRIPTION  : Allocates and initalizes a new slot structure
  INPUTS       : The symbolic name of the new slot
  RETURNS      : The address of the new slot
  SIDE EFFECTS : None
  NOTES        : Also adds symbols of the form get-<name> and
                   put-<name> for slot accessors
 **************************************************************/
static SLOT_DESC *NewSlot(
  void *theEnv,
  EXEC_STATUS,
  SYMBOL_HN *name)
  {
   SLOT_DESC *slot;

   slot = get_struct(theEnv,execStatus,slotDescriptor);
   slot->dynamicDefault = 1;
   slot->defaultSpecified = 0;
   slot->noDefault = 0;
#if DEFRULE_CONSTRUCT
   slot->reactive = 1;
#endif
   slot->noInherit = 0;
   slot->noWrite = 0;
   slot->initializeOnly = 0;
   slot->shared = 0;
   slot->multiple = 0;
   slot->composite = 0;
   slot->sharedCount = 0;
   slot->publicVisibility = 0;
   slot->createReadAccessor = FALSE;
   slot->createWriteAccessor = FALSE;
   slot->overrideMessageSpecified = 0;
   slot->cls = NULL;
   slot->defaultValue = NULL;
   slot->constraint = GetConstraintRecord(theEnv,execStatus);
   slot->slotName = AddSlotName(theEnv,execStatus,name,0,FALSE);
   slot->overrideMessage = slot->slotName->putHandlerName;
   IncrementSymbolCount(slot->overrideMessage);
   return(slot);
  }
Beispiel #4
0
/***************************************************
  NAME         : UpdateConstructHeader
  DESCRIPTION  : Determines field values for
                 construct header from binary-load
                 buffer
  INPUTS       : 1) The binary-load data for the
                    construct header
                 2) The actual construct header
                 3) The size of a defmodule item for
                    this construct
                 4) The array of all defmodule items
                    for this construct
                 5) The size of this construct
                 6) The array of these constructs
  RETURNS      : Nothing useful
  SIDE EFFECTS : Header values set
  NOTES        : None
 ***************************************************/
LOCALE void UpdateConstructHeader(
  struct bsaveConstructHeader *theBsaveConstruct,
  struct constructHeader *theConstruct,
  int itemModuleSize,
  void *itemModuleArray,
  int itemSize,
  void *itemArray)
  {
   long moduleOffset, itemOffset;

   moduleOffset = itemModuleSize * theBsaveConstruct->whichModule;
   theConstruct->whichModule =
     (struct defmoduleItemHeader *) &((char *) itemModuleArray)[moduleOffset];
   theConstruct->name = SymbolPointer(theBsaveConstruct->name);
   IncrementSymbolCount(theConstruct->name);
   if (theBsaveConstruct->next != -1L)
     {
      itemOffset = itemSize * theBsaveConstruct->next;
      theConstruct->next = (struct constructHeader *) &((char *) itemArray)[itemOffset];
     }
   else
     theConstruct->next = NULL;
   theConstruct->ppForm = NULL;
   theConstruct->bsaveID = 0L;
   theConstruct->usrData = NULL;
  }
Beispiel #5
0
static void UpdateDeftemplateSlot(
  void *theEnv,
  void *buf,
  long obji)
  {
   struct templateSlot *theSlot;
   struct bsaveTemplateSlot *btsPtr;

   btsPtr = (struct bsaveTemplateSlot *) buf;
   theSlot = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji];

   theSlot->slotName = SymbolPointer(btsPtr->slotName);
   IncrementSymbolCount(theSlot->slotName);
   theSlot->defaultList = HashedExpressionPointer(btsPtr->defaultList);
   theSlot->facetList = HashedExpressionPointer(btsPtr->facetList);
   theSlot->constraints = ConstraintPointer(btsPtr->constraints);

   theSlot->multislot = btsPtr->multislot;
   theSlot->noDefault = btsPtr->noDefault;
   theSlot->defaultPresent = btsPtr->defaultPresent;
   theSlot->defaultDynamic = btsPtr->defaultDynamic;

   if (btsPtr->next != -1L)
     { theSlot->next = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji + 1]; }
   else
     { theSlot->next = NULL; }
  }
Beispiel #6
0
globle int DefineFunction2(
  char *name,
  int returnType,
  int (*pointer)(void),
  char *actualName,
  char *restrictions)
  {
   struct FunctionDefinition *newFunction;

   if ( (returnType != 'a') &&
        (returnType != 'b') &&
        (returnType != 'c') &&
        (returnType != 'd') &&
        (returnType != 'f') &&
        (returnType != 'i') &&
        (returnType != 'j') &&
        (returnType != 'k') &&
        (returnType != 'l') &&
        (returnType != 'm') &&
        (returnType != 'n') &&
#if OBJECT_SYSTEM
        (returnType != 'o') &&
#endif
        (returnType != 's') &&
        (returnType != 'u') &&
        (returnType != 'v') &&
#if OBJECT_SYSTEM
        (returnType != 'x') &&
#endif
        (returnType != 'w') )
     { return(0); }

   newFunction = get_struct(FunctionDefinition);
   newFunction->callFunctionName = (SYMBOL_HN *) AddSymbol(name);
   newFunction->returnValueType = (char) returnType;
   newFunction->functionPointer = pointer;
   newFunction->next = GetFunctionList();
   newFunction->actualFunctionName = actualName;
   if (restrictions != NULL)
     {
      if (((int) (strlen(restrictions)) < 2) ? TRUE :
          ((! isdigit(restrictions[0]) && (restrictions[0] != '*')) ||
           (! isdigit(restrictions[1]) && (restrictions[1] != '*'))))
        restrictions = NULL;
     }
   newFunction->restrictions = restrictions;
   newFunction->parser = NULL;
   newFunction->overloadable = TRUE;
   newFunction->sequenceuseok = TRUE;
   newFunction->usrData = NULL;

   IncrementSymbolCount(newFunction->callFunctionName);
   ListOfFunctions = newFunction;
   AddHashFunction(newFunction);

   return(1);
  }
Beispiel #7
0
static void UpdateSlotName(
  void *buf,
  long obji)
  {
   SLOT_NAME *snp;
   BSAVE_SLOT_NAME *bsnp;

   bsnp = (BSAVE_SLOT_NAME *) buf;
   snp = (SLOT_NAME *) &slotNameArray[obji];
   snp->id = bsnp->id;
   snp->name = SymbolPointer(bsnp->name);
   IncrementSymbolCount(snp->name);
   snp->putHandlerName = SymbolPointer(bsnp->putHandlerName);
   IncrementSymbolCount(snp->putHandlerName);
   snp->hashTableIndex = bsnp->hashTableIndex;
   snp->nxt = SlotNameTable[snp->hashTableIndex];
   SlotNameTable[snp->hashTableIndex] = snp;
  }
Beispiel #8
0
globle void InstallDeftemplate(
  void *theEnv,
  struct deftemplate *theDeftemplate)
  {
   struct templateSlot *slotPtr;
   struct expr *tempExpr;

   IncrementSymbolCount(theDeftemplate->header.name);

   for (slotPtr = theDeftemplate->slotList;
        slotPtr != NULL;
        slotPtr = slotPtr->next)
     {
      IncrementSymbolCount(slotPtr->slotName);
      tempExpr = AddHashedExpression(theEnv,slotPtr->defaultList);
      ReturnExpression(theEnv,slotPtr->defaultList);
      slotPtr->defaultList = tempExpr;
      slotPtr->constraints = AddConstraint(theEnv,slotPtr->constraints);
     }
  }
Beispiel #9
0
static void UpdateDefmodule(
  void *theEnv,
  void *buf,
  long obji)
  {
   struct bsaveDefmodule *bdp;
   struct moduleItem *theItem;
   int i;

   bdp = (struct bsaveDefmodule *) buf;
   DefmoduleData(theEnv)->DefmoduleArray[obji].name = SymbolPointer(bdp->name);
   IncrementSymbolCount(DefmoduleData(theEnv)->DefmoduleArray[obji].name);
   if (bdp->next != -1L)
     { DefmoduleData(theEnv)->DefmoduleArray[obji].next = (struct defmodule *) &DefmoduleData(theEnv)->DefmoduleArray[bdp->next]; }
   else
     { DefmoduleData(theEnv)->DefmoduleArray[obji].next = NULL; }

   if (GetNumberOfModuleItems(theEnv) == 0)
     { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = NULL; }
   else
     {
      DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = 
         (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * GetNumberOfModuleItems(theEnv));
     }

   for (i = 0, theItem = GetListOfModuleItems(theEnv);
        (i < GetNumberOfModuleItems(theEnv)) && (theItem != NULL) ;
        i++, theItem = theItem->next)
     {
      if (theItem->bloadModuleReference == NULL)
        { DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] = NULL; }
      else
        {
         DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] =
             (struct defmoduleItemHeader *)
             (*theItem->bloadModuleReference)(theEnv,obji);
        }
     }

   DefmoduleData(theEnv)->DefmoduleArray[obji].ppForm = NULL;

   if (bdp->importList != -1L)
     { DefmoduleData(theEnv)->DefmoduleArray[obji].importList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->importList]; }
   else
     { DefmoduleData(theEnv)->DefmoduleArray[obji].importList = NULL; }

   if (bdp->exportList != -1L)
     { DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->exportList]; }
   else
     { DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = NULL; }
   DefmoduleData(theEnv)->DefmoduleArray[obji].bsaveID = bdp->bsaveID;
  }
Beispiel #10
0
static void UpdatePortItem(
  void *theEnv,
  void *buf,
  long obji)
  {
   struct bsavePortItem *bdp;

   bdp = (struct bsavePortItem *) buf;

   if (bdp->moduleName != -1L)
     {
      DefmoduleData(theEnv)->PortItemArray[obji].moduleName = SymbolPointer(bdp->moduleName);
      IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].moduleName);
     }
   else
     { DefmoduleData(theEnv)->PortItemArray[obji].moduleName = NULL; }

   if (bdp->constructType != -1L)
     {
      DefmoduleData(theEnv)->PortItemArray[obji].constructType = SymbolPointer(bdp->constructType);
      IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructType);
     }
   else
     { DefmoduleData(theEnv)->PortItemArray[obji].constructType = NULL; }

   if (bdp->constructName != -1L)
     {
      DefmoduleData(theEnv)->PortItemArray[obji].constructName = SymbolPointer(bdp->constructName);
      IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructName);
     }
   else
     { DefmoduleData(theEnv)->PortItemArray[obji].constructName = NULL; }

   if (bdp->next != -1L)
     { DefmoduleData(theEnv)->PortItemArray[obji].next = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->next]; }
   else
     { DefmoduleData(theEnv)->PortItemArray[obji].next = NULL; }
  }
Beispiel #11
0
static void UpdateSlot(
  void *buf,
  long obji)
  {
   SLOT_DESC *sp;
   BSAVE_SLOT_DESC *bsp;

   sp = (SLOT_DESC *) &slotArray[obji];
   bsp = (BSAVE_SLOT_DESC *) buf;
   sp->dynamicDefault = bsp->dynamicDefault;
   sp->noDefault = bsp->noDefault;
   sp->shared = bsp->shared;
   sp->multiple = bsp->multiple;
   sp->composite = bsp->composite;
   sp->noInherit = bsp->noInherit;
   sp->noWrite = bsp->noWrite;
   sp->initializeOnly = bsp->initializeOnly;
   sp->reactive = bsp->reactive;
   sp->publicVisibility = bsp->publicVisibility;
   sp->createReadAccessor = bsp->createReadAccessor;
   sp->createWriteAccessor = bsp->createWriteAccessor;
   sp->cls = DefclassPointer(bsp->cls);
   sp->slotName = SlotNamePointer(bsp->slotName);
   sp->overrideMessage = SymbolPointer(bsp->overrideMessage);
   IncrementSymbolCount(sp->overrideMessage);
   if (bsp->defaultValue != -1L)
     {
      if (sp->dynamicDefault)
        sp->defaultValue = (void *) ExpressionPointer(bsp->defaultValue);
      else
        {
         sp->defaultValue = (void *) get_struct(dataObject);
         EvaluateAndStoreInDataObject((int) sp->multiple,ExpressionPointer(bsp->defaultValue),
                                      (DATA_OBJECT *) sp->defaultValue);
         ValueInstall((DATA_OBJECT *) sp->defaultValue);
        }
     }
   else
     sp->defaultValue = NULL;
   sp->constraint = ConstraintPointer(bsp->constraint);
   sp->sharedCount = 0;
   sp->sharedValue.value = NULL;
   sp->bsaveIndex = 0L;
   if (sp->shared)
     {
      sp->sharedValue.desc = sp;
      sp->sharedValue.value = NULL;
     }
  }
Beispiel #12
0
globle void AtomInstall(
  int type,
  void *vPtr)
  {
   switch (type)
     {
      case SYMBOL:
      case STRING:
#if DEFGLOBAL_CONSTRUCT
      case GBL_VARIABLE:
#endif
#if OBJECT_SYSTEM
      case INSTANCE_NAME:
#endif
        IncrementSymbolCount(vPtr);
        break;

      case FLOAT:
        IncrementFloatCount(vPtr);
        break;

      case INTEGER:
        IncrementIntegerCount(vPtr);
        break;

      case MULTIFIELD:
        MultifieldInstall((struct multifield *) vPtr);
        break;

#if FUZZY_DEFTEMPLATES
      /* fuzzy values have a name which is a symbol */
      case FUZZY_VALUE:
            InstallFuzzyValue(vPtr);
        break;
#endif

      case RVOID:
        break;

      default:
        if (PrimitivesArray[type] == NULL) break;
        if (PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr);
        else if (PrimitivesArray[type]->incrementBusyCount)
          { (*PrimitivesArray[type]->incrementBusyCount)(vPtr); }
        break;
     }
  }
Beispiel #13
0
globle void AtomInstall(
  void *theEnv,
  int type,
  void *vPtr)
  {
   switch (type)
     {
      case SYMBOL:
      case STRING:
#if DEFGLOBAL_CONSTRUCT
      case GBL_VARIABLE:
#endif
#if OBJECT_SYSTEM
      case INSTANCE_NAME:
#endif
        IncrementSymbolCount(vPtr);
        break;

      case FLOAT:
        IncrementFloatCount(vPtr);
        break;

      case INTEGER:
        IncrementIntegerCount(vPtr);
        break;

      case EXTERNAL_ADDRESS:
        IncrementExternalAddressCount(vPtr);
        break;

      case MULTIFIELD:
        MultifieldInstall(theEnv,(struct multifield *) vPtr);
        break;

      case RVOID:
        break;

      default:
        if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break;
        if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr);
        else if (EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount)
          { (*EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount)(theEnv,vPtr); }
        break;
     }
  }
Beispiel #14
0
/*********************************************************
  NAME         : AddSystemClass
  DESCRIPTION  : Performs all necessary allocations
                   for adding a system class
  INPUTS       : 1) The name-string of the system class
                 2) The address of the parent class
                    (NULL if none)
  RETURNS      : The address of the new system class
  SIDE EFFECTS : Allocations performed
  NOTES        : Assumes system-class name is unique
                 Also assumes SINGLE INHERITANCE for
                   system classes to simplify precedence
                   list determination
                 Adds classes to has table but NOT to
                  class list (this is responsibility
                  of caller)
 *********************************************************/
static DEFCLASS *AddSystemClass(
    void *theEnv,
    char *name,
    DEFCLASS *parent)
{
    DEFCLASS *sys;
    long i;
    char defaultScopeMap[1];

    sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name));
    sys->abstract = 1;
#if DEFRULE_CONSTRUCT
    sys->reactive = 0;
#endif
    IncrementSymbolCount(sys->header.name);
    sys->installed = 1;
    sys->system = 1;
    sys->hashTableIndex = HashClass(sys->header.name);

    AddClassLink(theEnv,&sys->allSuperclasses,sys,-1);
    if (parent != NULL)
    {
        AddClassLink(theEnv,&sys->directSuperclasses,parent,-1);
        AddClassLink(theEnv,&parent->directSubclasses,sys,-1);
        AddClassLink(theEnv,&sys->allSuperclasses,parent,-1);
        for (i = 1 ; i < parent->allSuperclasses.classCount ; i++)
            AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1);
    }
    sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex];
    DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys;

    /* =========================================
       Add default scope maps for a system class
       There is only one module (MAIN) so far -
       which has an id of 0
       ========================================= */
    ClearBitString((void *) defaultScopeMap,(int) sizeof(char));
    SetBitMap(defaultScopeMap,0);
#if DEFMODULE_CONSTRUCT
    sys->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char));
    IncrementBitMapCount(sys->scopeMap);
#endif
    return(sys);
}
Beispiel #15
0
/****************************************************
  NAME         : SetupFactQuery
  DESCRIPTION  : Initializes fact query H/L
                   functions and parsers
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Sets up kernel functions and parsers
  NOTES        : None
 ****************************************************/
globle void SetupFactQuery(
  void *theEnv)
  {
   AllocateEnvironmentData(theEnv,FACT_QUERY_DATA,sizeof(struct factQueryData),NULL);

#if RUN_TIME                                                 
   FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
#endif  

#if ! RUN_TIME
   FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,QUERY_DELIMETER_STRING);
   IncrementSymbolCount(FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL);

   EnvDefineFunction2(theEnv,"(query-fact)",'u',
                  PTIEF GetQueryFact,"GetQueryFact",NULL);

   EnvDefineFunction2(theEnv,"(query-fact-slot)",'u',
                  PTIEF GetQueryFactSlot,"GetQueryFactSlot",NULL);

   EnvDefineFunction2(theEnv,"any-factp",'b',PTIEF AnyFacts,"AnyFacts",NULL);
   AddFunctionParser(theEnv,"any-factp",FactParseQueryNoAction);

   EnvDefineFunction2(theEnv,"find-fact",'m',
                  PTIEF QueryFindFact,"QueryFindFact",NULL);
   AddFunctionParser(theEnv,"find-fact",FactParseQueryNoAction);

   EnvDefineFunction2(theEnv,"find-all-facts",'m',
                  PTIEF QueryFindAllFacts,"QueryFindAllFacts",NULL);
   AddFunctionParser(theEnv,"find-all-facts",FactParseQueryNoAction);

   EnvDefineFunction2(theEnv,"do-for-fact",'u',
                  PTIEF QueryDoForFact,"QueryDoForFact",NULL);
   AddFunctionParser(theEnv,"do-for-fact",FactParseQueryAction);

   EnvDefineFunction2(theEnv,"do-for-all-facts",'u',
                  PTIEF QueryDoForAllFacts,"QueryDoForAllFacts",NULL);
   AddFunctionParser(theEnv,"do-for-all-facts",FactParseQueryAction);

   EnvDefineFunction2(theEnv,"delayed-do-for-all-facts",'u',
                  PTIEF DelayedQueryDoForAllFacts,
                  "DelayedQueryDoForAllFacts",NULL);
   AddFunctionParser(theEnv,"delayed-do-for-all-facts",FactParseQueryAction);
#endif
  }
Beispiel #16
0
static void ClearDeffacts(
  void *theEnv)
  {
#if (! RUN_TIME) && (! BLOAD_ONLY)
   struct expr *stub;
   struct deffacts *newDeffacts;

   /*=====================================*/
   /* Create the data structures for the  */
   /* expression (assert (initial-fact)). */
   /*=====================================*/

   stub = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert"));
   stub->argList = GenConstant(theEnv,DEFTEMPLATE_PTR,EnvFindDeftemplate(theEnv,"initial-fact"));
   ExpressionInstall(theEnv,stub);

   /*=============================================*/
   /* Create a deffacts data structure to contain */
   /* the expression and initialize it.           */
   /*=============================================*/

   newDeffacts = get_struct(theEnv,deffacts);
   newDeffacts->header.whichModule =
      (struct defmoduleItemHeader *) GetDeffactsModuleItem(theEnv,NULL);
   newDeffacts->header.name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact");
   IncrementSymbolCount(newDeffacts->header.name);
   newDeffacts->assertList = PackExpression(theEnv,stub);
   newDeffacts->header.next = NULL;
   newDeffacts->header.ppForm = NULL;
   newDeffacts->header.usrData = NULL;
   ReturnExpression(theEnv,stub);

   /*===========================================*/
   /* Store the deffacts in the current module. */
   /*===========================================*/

   AddConstructToModule(&newDeffacts->header);
#else
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif
  }
Beispiel #17
0
static void UpdateHandler(
  void *buf,
  long obji)
  {
   HANDLER *hnd;
   BSAVE_HANDLER *bhnd;

   hnd = (HANDLER *) &handlerArray[obji];
   bhnd = (BSAVE_HANDLER *) buf;
   hnd->system = bhnd->system;
   hnd->type = bhnd->type;
#if (! IMPERATIVE_MESSAGE_HANDLERS)
   if (hnd->type == MAROUND)
     {
      PrintWarningID("OBJBIN",1,FALSE);
      PrintRouter(WWARNING,"Around message-handlers are not\n");
      PrintRouter(WWARNING,"  supported in this environment.");
     }
#endif
#if (! AUXILIARY_MESSAGE_HANDLERS)
   if ((hnd->type == MBEFORE) || (hnd->type == MAFTER))
     {
      PrintWarningID("OBJBIN",2,FALSE);
      PrintRouter(WWARNING,"Before and after message-handlers are not\n");
      PrintRouter(WWARNING,"  supported in this environment.");
     }
#endif
   hnd->minParams = bhnd->minParams;
   hnd->maxParams = bhnd->maxParams;
   hnd->localVarCount = bhnd->localVarCount;
   hnd->cls = DefclassPointer(bhnd->cls);
   hnd->name = SymbolPointer(bhnd->name);
   IncrementSymbolCount(hnd->name);
   hnd->actions = ExpressionPointer(bhnd->actions);
   hnd->ppForm = NULL;
   hnd->busy = 0;
   hnd->mark = 0;
   hnd->usrData = NULL;
#if DEBUGGING_FUNCTIONS
   hnd->trace = WatchHandlers;
#endif
  }
Beispiel #18
0
/********************************************************
  NAME         : CreateInitialDefinstances
  DESCRIPTION  : Makes the initial-object definstances
                 structure for creating an initial-object
                 which will match default object patterns
                 in defrules
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : initial-object definstances created
  NOTES        : None
 ********************************************************/
static void CreateInitialDefinstances(
  void *theEnv)
  {
   EXPRESSION *tmp;
   DEFINSTANCES *theDefinstances;

   theDefinstances = get_struct(theEnv,definstances);
   InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) theDefinstances,
                             DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
   theDefinstances->busy = 0;
   tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,(char*)"make-instance"));
   tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
   tmp->argList->nextArg =
       GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME));
   theDefinstances->mkinstance = PackExpression(theEnv,tmp);
   ReturnExpression(theEnv,tmp);
   IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances));
   ExpressionInstall(theEnv,theDefinstances->mkinstance);
   AddConstructToModule((struct constructHeader *) theDefinstances);
  }
Beispiel #19
0
/****************************************************
  NAME         : SetupQuery
  DESCRIPTION  : Initializes instance query H/L
                   functions and parsers
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Sets up kernel functions and parsers
  NOTES        : None
 ****************************************************/
globle void SetupQuery(
  void *theEnv,
  EXEC_STATUS)
  {
   AllocateEnvironmentData(theEnv,execStatus,INSTANCE_QUERY_DATA,sizeof(struct instanceQueryData),NULL);

#if ! RUN_TIME
   InstanceQueryData(theEnv,execStatus)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,QUERY_DELIMETER_STRING);
   IncrementSymbolCount(InstanceQueryData(theEnv,execStatus)->QUERY_DELIMETER_SYMBOL);

   EnvDefineFunction2(theEnv,execStatus,"(query-instance)",'o',
                  PTIEF GetQueryInstance,"GetQueryInstance",NULL);

   EnvDefineFunction2(theEnv,execStatus,"(query-instance-slot)",'u',
                  PTIEF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL);

   EnvDefineFunction2(theEnv,execStatus,"any-instancep",'b',PTIEF AnyInstances,"AnyInstances",NULL);
   AddFunctionParser(theEnv,execStatus,"any-instancep",ParseQueryNoAction);

   EnvDefineFunction2(theEnv,execStatus,"find-instance",'m',
                  PTIEF QueryFindInstance,"QueryFindInstance",NULL);
   AddFunctionParser(theEnv,execStatus,"find-instance",ParseQueryNoAction);

   EnvDefineFunction2(theEnv,execStatus,"find-all-instances",'m',
                  PTIEF QueryFindAllInstances,"QueryFindAllInstances",NULL);
   AddFunctionParser(theEnv,execStatus,"find-all-instances",ParseQueryNoAction);

   EnvDefineFunction2(theEnv,execStatus,"do-for-instance",'u',
                  PTIEF QueryDoForInstance,"QueryDoForInstance",NULL);
   AddFunctionParser(theEnv,execStatus,"do-for-instance",ParseQueryAction);

   EnvDefineFunction2(theEnv,execStatus,"do-for-all-instances",'u',
                  PTIEF QueryDoForAllInstances,"QueryDoForAllInstances",NULL);
   AddFunctionParser(theEnv,execStatus,"do-for-all-instances",ParseQueryAction);

   EnvDefineFunction2(theEnv,execStatus,"delayed-do-for-all-instances",'u',
                  PTIEF DelayedQueryDoForAllInstances,
                  "DelayedQueryDoForAllInstances",NULL);
   AddFunctionParser(theEnv,execStatus,"delayed-do-for-all-instances",ParseQueryAction);
#endif
  }
Beispiel #20
0
/******************************************************************************
  NAME         : NewSystemHandler
  DESCRIPTION  : Adds a new system handler for a system class

                 The handler is assumed to be primary and of
                 the form:

                 (defmessage-handler <class> <handler> () (<func>))

  INPUTS       : 1) Name-string of the system class
                 2) Name-string of the system handler
                 3) Name-string of the internal H/L function to implement
                      this handler
                 4) The number of extra arguments (past the instance itself)
                    that the handler willl accept
  RETURNS      : Nothing useful
  SIDE EFFECTS : Creates the new handler and inserts it in the system class's
                   handler array
                 On errors, generate a system error and exits.
  NOTES        : Does not check to see if handler already exists
 *******************************************************************************/
globle void NewSystemHandler(
  void *theEnv,
  EXEC_STATUS,
  char *cname,
  char *mname,
  char *fname,
  int extraargs)
  {
   DEFCLASS *cls;
   HANDLER *hnd;

   cls = LookupDefclassInScope(theEnv,execStatus,cname);
   hnd = InsertHandlerHeader(theEnv,execStatus,cls,(SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,mname),MPRIMARY);
   IncrementSymbolCount(hnd->name);
   hnd->system = 1;
   hnd->minParams = hnd->maxParams = (short) (extraargs + 1);
   hnd->localVarCount = 0;
   hnd->actions = get_struct(theEnv,execStatus,expr);
   hnd->actions->argList = NULL;
   hnd->actions->type = FCALL;
   hnd->actions->value = (void *) FindFunction(theEnv,execStatus,fname);
   hnd->actions->nextArg = NULL;
  }
Beispiel #21
0
/****************************************************
  NAME         : SetupQuery
  DESCRIPTION  : Initializes instance query H/L
                   functions and parsers
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Sets up kernel functions and parsers
  NOTES        : None
 ****************************************************/
globle void SetupQuery()
  {
#if ! RUN_TIME
   QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) AddSymbol(QUERY_DELIMETER_STRING);
   IncrementSymbolCount(QUERY_DELIMETER_SYMBOL);

   DefineFunction2("(query-instance)",'o',
                  PTIF GetQueryInstance,"GetQueryInstance",NULL);

   DefineFunction2("(query-instance-slot)",'u',
                  PTIF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL);

   DefineFunction2("any-instancep",'b',PTIF AnyInstances,"AnyInstances",NULL);
   AddFunctionParser("any-instancep",ParseQueryNoAction);

   DefineFunction2("find-instance",'m',
                  PTIF QueryFindInstance,"QueryFindInstance",NULL);
   AddFunctionParser("find-instance",ParseQueryNoAction);

   DefineFunction2("find-all-instances",'m',
                  PTIF QueryFindAllInstances,"QueryFindAllInstances",NULL);
   AddFunctionParser("find-all-instances",ParseQueryNoAction);

   DefineFunction2("do-for-instance",'u',
                  PTIF QueryDoForInstance,"QueryDoForInstance",NULL);
   AddFunctionParser("do-for-instance",ParseQueryAction);

   DefineFunction2("do-for-all-instances",'u',
                  PTIF QueryDoForAllInstances,"QueryDoForAllInstances",NULL);
   AddFunctionParser("do-for-all-instances",ParseQueryAction);

   DefineFunction2("delayed-do-for-all-instances",'u',
                  PTIF DelayedQueryDoForAllInstances,
                  "DelayedQueryDoForAllInstances",NULL);
   AddFunctionParser("delayed-do-for-all-instances",ParseQueryAction);
#endif
  }
Beispiel #22
0
globle int ParseDeffacts(
  char *readSource)
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(readSource)
#endif

#if (! RUN_TIME) && (! BLOAD_ONLY)
   SYMBOL_HN *deffactsName;
   struct expr *temp;
   struct deffacts *newDeffacts;
   int deffactsError;
   struct token inputToken;

   /*=========================*/
   /* Parsing initialization. */
   /*=========================*/

   deffactsError = FALSE;
   SetPPBufferStatus(ON);

   FlushPPBuffer();
   SetIndentDepth(3);
   SavePPBuffer("(deffacts ");

   /*==========================================================*/
   /* Deffacts can not be added when a binary image is loaded. */
   /*==========================================================*/

#if BLOAD || BLOAD_AND_BSAVE
   if ((Bloaded() == TRUE) && (! CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage("deffacts");
      return(TRUE);
     }
#endif

   /*============================*/
   /* Parse the deffacts header. */
   /*============================*/

   deffactsName = GetConstructNameAndComment(readSource,&inputToken,"deffacts",
                                             FindDeffacts,Undeffacts,"$",TRUE,
                                             TRUE,TRUE);
   if (deffactsName == NULL) { return(TRUE); }

   /*===============================================*/
   /* Parse the list of facts in the deffacts body. */
   /*===============================================*/

   temp = BuildRHSAssert(readSource,&inputToken,&deffactsError,FALSE,FALSE,"deffacts");

   if (deffactsError == TRUE) { return(TRUE); }

   if (ExpressionContainsVariables(temp,FALSE))
     {
      LocalVariableErrorMessage("a deffacts construct");
      ReturnExpression(temp);
      return(TRUE);
     }

   SavePPBuffer("\n");

   /*==============================================*/
   /* If we're only checking syntax, don't add the */
   /* successfully parsed deffacts to the KB.      */
   /*==============================================*/

   if (CheckSyntaxMode)
     {
      ReturnExpression(temp);
      return(FALSE);
     }

   /*==========================*/
   /* Create the new deffacts. */
   /*==========================*/

   ExpressionInstall(temp);
   newDeffacts = get_struct(deffacts);
   newDeffacts->header.name = deffactsName;
   IncrementSymbolCount(deffactsName);
   newDeffacts->assertList = PackExpression(temp);
   newDeffacts->header.whichModule = (struct defmoduleItemHeader *)
                              GetModuleItem(NULL,FindModuleItem("deffacts")->moduleIndex);

   newDeffacts->header.next = NULL;
   newDeffacts->header.usrData = NULL;
   ReturnExpression(temp);

   /*=======================================================*/
   /* Save the pretty print representation of the deffacts. */
   /*=======================================================*/

   if (GetConserveMemory() == TRUE)
     { newDeffacts->header.ppForm = NULL; }
   else
     { newDeffacts->header.ppForm = CopyPPBuffer(); }

   /*=============================================*/
   /* Add the deffacts to the appropriate module. */
   /*=============================================*/

   AddConstructToModule(&newDeffacts->header);

#endif /* (! RUN_TIME) && (! BLOAD_ONLY) */

   /*================================================================*/
   /* Return FALSE to indicate the deffacts was successfully parsed. */
   /*================================================================*/

   return(FALSE);
  }
Beispiel #23
0
globle int ParseDefmodule(
  void *theEnv,
  char *readSource)
  {
   SYMBOL_HN *defmoduleName;
   struct defmodule *newDefmodule;
   struct token inputToken;
   int i;
   struct moduleItem *theItem;
   struct portItem *portSpecs, *nextSpec;
   struct defmoduleItemHeader *theHeader;
   struct callFunctionItem *defineFunctions;
   struct defmodule *redefiningMainModule = NULL;
   int parseError;
   struct portItem *oldImportList = NULL, *oldExportList = NULL;
   short overwrite = FALSE;

   /*================================================*/
   /* Flush the buffer which stores the pretty print */
   /* representation for a module.  Add the already  */
   /* parsed keyword defmodule to this buffer.       */
   /*================================================*/

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defmodule ");

   /*===============================*/
   /* Modules cannot be loaded when */
   /* a binary load is in effect.   */
   /*===============================*/

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defmodule");
      return(TRUE);
     }
#endif

   /*=====================================================*/
   /* Parse the name and comment fields of the defmodule. */
   /* Remove the defmodule if it already exists.          */
   /*=====================================================*/

   defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule",
                                              EnvFindDefmodule,DeleteDefmodule,"+",
                                              TRUE,TRUE,FALSE);
   if (defmoduleName == NULL) { return(TRUE); }

   if (strcmp(ValueToString(defmoduleName),"MAIN") == 0)
     { redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); }

   /*==============================================*/
   /* Create the defmodule structure if necessary. */
   /*==============================================*/

   if (redefiningMainModule == NULL)
     {
      newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName));
      if (newDefmodule)
        { overwrite = TRUE; }
      else
        {
         newDefmodule = get_struct(theEnv,defmodule);
         newDefmodule->name = defmoduleName;
         newDefmodule->usrData = NULL;
         newDefmodule->next = NULL;
        }
     }
   else
     {
      overwrite = TRUE;
      newDefmodule = redefiningMainModule;
     }

   if (overwrite)
     {
      oldImportList = newDefmodule->importList;
      oldExportList = newDefmodule->exportList;
     }

   newDefmodule->importList = NULL;
   newDefmodule->exportList = NULL;

   /*===================================*/
   /* Finish parsing the defmodule (its */
   /* import/export specifications).    */
   /*===================================*/

   parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule);

   /*====================================*/
   /* Check for import/export conflicts. */
   /*====================================*/

   if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule);

   /*======================================================*/
   /* If an error occured in parsing or an import conflict */
   /* was detected, abort the definition of the defmodule. */
   /* If we're only checking syntax, then we want to exit  */
   /* at this point as well.                               */
   /*======================================================*/

   if (parseError || ConstructData(theEnv)->CheckSyntaxMode)
     {
      while (newDefmodule->importList != NULL)
        {
         nextSpec = newDefmodule->importList->next;
         rtn_struct(theEnv,portItem,newDefmodule->importList);
         newDefmodule->importList = nextSpec;
        }

      while (newDefmodule->exportList != NULL)
        {
         nextSpec = newDefmodule->exportList->next;
         rtn_struct(theEnv,portItem,newDefmodule->exportList);
         newDefmodule->exportList = nextSpec;
        }

      if ((redefiningMainModule == NULL) && (! overwrite))
        { rtn_struct(theEnv,defmodule,newDefmodule); }

      if (overwrite)
        {
         newDefmodule->importList = oldImportList;
         newDefmodule->exportList = oldExportList;
        }

      if (parseError) return(TRUE);
      return(FALSE);
     }

   /*===============================================*/
   /* Increment the symbol table counts for symbols */
   /* used in the defmodule data structures.        */
   /*===============================================*/

   if (redefiningMainModule == NULL)
     { IncrementSymbolCount(newDefmodule->name); }
   else
     {
      if ((newDefmodule->importList != NULL) ||
          (newDefmodule->exportList != NULL))
        { DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; }
     }

   for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next)
     {
      if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
      if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
      if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
     }

   for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next)
     {
      if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
      if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
      if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
     }

   /*====================================================*/
   /* Allocate storage for the module's construct lists. */
   /*====================================================*/

   if (redefiningMainModule != NULL) { /* Do nothing */ }
   else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
   else
     {
      newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
      for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
           (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
           i++, theItem = theItem->next)
        {
         if (theItem->allocateFunction == NULL)
           { newDefmodule->itemsArray[i] = NULL; }
         else
           {
            newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
                                          (*theItem->allocateFunction)(theEnv);
            theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
            theHeader->theModule = newDefmodule;
            theHeader->firstItem = NULL;
            theHeader->lastItem = NULL;
           }
        }
     }

   /*=======================================*/
   /* Save the pretty print representation. */
   /*=======================================*/

   SavePPBuffer(theEnv,"\n");

   if (EnvGetConserveMemory(theEnv) == TRUE)
     { newDefmodule->ppForm = NULL; }
   else
     { newDefmodule->ppForm = CopyPPBuffer(theEnv); }

   /*==============================================*/
   /* Add the defmodule to the list of defmodules. */
   /*==============================================*/

   if (redefiningMainModule == NULL)
     {
      if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
      else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule;
      DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
      newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++;
     }

   EnvSetCurrentModule(theEnv,(void *) newDefmodule);

   /*=========================================*/
   /* Call any functions required by other    */
   /* constructs when a new module is defined */
   /*=========================================*/

   for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions;
        defineFunctions != NULL;
        defineFunctions = defineFunctions->next)
     { (* (void (*)(void *)) defineFunctions->func)(theEnv); }

   /*===============================================*/
   /* Defmodule successfully parsed with no errors. */
   /*===============================================*/

   return(FALSE);
  }
Beispiel #24
0
globle void CreateMainModule(
  void *theEnv)
  {
   struct defmodule *newDefmodule;
   struct moduleItem *theItem;
   int i;
   struct defmoduleItemHeader *theHeader;

   /*=======================================*/
   /* Allocate the defmodule data structure */
   /* and name it the MAIN module.          */
   /*=======================================*/

   newDefmodule = get_struct(theEnv,defmodule);
   newDefmodule->name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"MAIN");
   IncrementSymbolCount(newDefmodule->name);
   newDefmodule->next = NULL;
   newDefmodule->ppForm = NULL;
   newDefmodule->importList = NULL;
   newDefmodule->exportList = NULL;
   newDefmodule->bsaveID = 0L;
   newDefmodule->usrData = NULL;

   /*==================================*/
   /* Initialize the array for storing */
   /* the module's construct lists.    */
   /*==================================*/

   if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
   else
     {
      newDefmodule->itemsArray = (struct defmoduleItemHeader **)
                                 gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
      for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
           (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
           i++, theItem = theItem->next)
        {
         if (theItem->allocateFunction == NULL)
           { newDefmodule->itemsArray[i] = NULL; }
         else
           {
            newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
                                          (*theItem->allocateFunction)(theEnv);
            theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
            theHeader->theModule = newDefmodule;
            theHeader->firstItem = NULL;
            theHeader->lastItem = NULL;
           }
        }
     }

   /*=======================================*/
   /* Add the module to the list of modules */
   /* and make it the current module.       */
   /*=======================================*/

#if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT
   SetNumberOfDefmodules(theEnv,1L);
#endif

   DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
   DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
   EnvSetCurrentModule(theEnv,(void *) newDefmodule);
  }
/****************************************************
  NAME         : AddDeffunction
  DESCRIPTION  : Adds a deffunction to the list of
                 deffunctions
  INPUTS       : 1) The symbolic name
                 2) The action expressions
                 3) The minimum number of arguments
                 4) The maximum number of arguments
                    (can be -1)
                 5) The number of local variables
                 6) A flag indicating if this is
                    a header call so that the
                    deffunction can be recursively
                    called
  RETURNS      : The new deffunction (NULL on errors)
  SIDE EFFECTS : Deffunction structures allocated
  NOTES        : Assumes deffunction is not executing
 ****************************************************/
static DEFFUNCTION *AddDeffunction(
  void *theEnv,
  SYMBOL_HN *name,
  EXPRESSION *actions,
  int min,
  int max,
  int lvars,
  int headerp)
  {
   DEFFUNCTION *dfuncPtr;
   unsigned oldbusy;
#if DEBUGGING_FUNCTIONS
   unsigned DFHadWatch = FALSE;
#endif

   /*===============================================================*/
   /* If the deffunction doesn't exist, create a new structure to   */
   /* contain it and add it to the List of deffunctions. Otherwise, */
   /* use the existing structure and remove the pretty print form   */
   /* and interpretive code.                                        */
   /*===============================================================*/
   dfuncPtr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(name));
   if (dfuncPtr == NULL)
     {
      dfuncPtr = get_struct(theEnv,deffunctionStruct);
      InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name);
      IncrementSymbolCount(name);
      dfuncPtr->code = NULL;
      dfuncPtr->minNumberOfParameters = min;
      dfuncPtr->maxNumberOfParameters = max;
      dfuncPtr->numberOfLocalVars = lvars;
      dfuncPtr->busy = 0;
      dfuncPtr->executing = 0;
     }
   else
     {
#if DEBUGGING_FUNCTIONS
      DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr);
#endif
      dfuncPtr->minNumberOfParameters = min;
      dfuncPtr->maxNumberOfParameters = max;
      dfuncPtr->numberOfLocalVars = lvars;
      oldbusy = dfuncPtr->busy;
      ExpressionDeinstall(theEnv,dfuncPtr->code);
      dfuncPtr->busy = oldbusy;
      ReturnPackedExpression(theEnv,dfuncPtr->code);
      dfuncPtr->code = NULL;
      SetDeffunctionPPForm((void *) dfuncPtr,NULL);

      /* =======================================
         Remove the deffunction from the list so
         that it can be added at the end
         ======================================= */
      RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr);
     }

   AddConstructToModule((struct constructHeader *) dfuncPtr);

   /* ==================================
      Install the new interpretive code.
      ================================== */

   if (actions != NULL)
     {
      /* ===============================
         If a deffunction is recursive,
         do not increment its busy count
         based on self-references
         =============================== */
      oldbusy = dfuncPtr->busy;
      ExpressionInstall(theEnv,actions);
      dfuncPtr->busy = oldbusy;
      dfuncPtr->code = actions;
     }

   /* ===============================================================
      Install the pretty print form if memory is not being conserved.
      =============================================================== */

#if DEBUGGING_FUNCTIONS
   EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr);
   if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE))
     SetDeffunctionPPForm((void *) dfuncPtr,CopyPPBuffer(theEnv));
#endif
   return(dfuncPtr);
  }
Beispiel #26
0
globle int DefineFunction3(
  void *theEnv,
  const char *name,
  int returnType,
  int (*pointer)(void *),
  const char *actualName,
  const char *restrictions,
  intBool environmentAware,
  void *context)
  {
   struct FunctionDefinition *newFunction;

   if ( (returnType != 'a') &&
        (returnType != 'b') &&
        (returnType != 'c') &&
        (returnType != 'd') &&
        (returnType != 'f') &&
        (returnType != 'g') &&
        (returnType != 'i') &&
        (returnType != 'j') &&
        (returnType != 'k') &&
        (returnType != 'l') &&
        (returnType != 'm') &&
        (returnType != 'n') &&
#if OBJECT_SYSTEM
        (returnType != 'o') &&
#endif
        (returnType != 's') &&
        (returnType != 'u') &&
        (returnType != 'v') &&
#if OBJECT_SYSTEM
        (returnType != 'x') &&
#endif
        (returnType != 'w') )
     { return(0); }

   newFunction = FindFunction(theEnv,name);
   if (newFunction == NULL)
     {
      newFunction = get_struct(theEnv,FunctionDefinition);
      newFunction->callFunctionName = (SYMBOL_HN *) EnvAddSymbol(theEnv,name);
      IncrementSymbolCount(newFunction->callFunctionName);
      newFunction->next = GetFunctionList(theEnv);
      ExternalFunctionData(theEnv)->ListOfFunctions = newFunction;
      AddHashFunction(theEnv,newFunction);
     }
     
   newFunction->returnValueType = (char) returnType;
   newFunction->functionPointer = (int (*)(void)) pointer;
   newFunction->actualFunctionName = actualName;
   if (restrictions != NULL)
     {
      if (((int) (strlen(restrictions)) < 2) ? TRUE :
          ((! isdigit(restrictions[0]) && (restrictions[0] != '*')) ||
           (! isdigit(restrictions[1]) && (restrictions[1] != '*'))))
        restrictions = NULL;
     }
   newFunction->restrictions = restrictions;
   newFunction->parser = NULL;
   newFunction->overloadable = TRUE;
   newFunction->sequenceuseok = TRUE;
   newFunction->environmentAware = (short) environmentAware;
   newFunction->usrData = NULL;
   newFunction->context = context;

   return(1);
  }
Beispiel #27
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
  }
Beispiel #28
0
static void AddDefglobal(
  void *theEnv,
  SYMBOL_HN *name,
  DATA_OBJECT_PTR vPtr,
  struct expr *ePtr)
  {
   struct defglobal *defglobalPtr;
   intBool newGlobal = FALSE;
#if DEBUGGING_FUNCTIONS
   int GlobalHadWatch = FALSE;
#endif

   /*========================================================*/
   /* If the defglobal is already defined, then use the old  */
   /* data structure and substitute new values. If it hasn't */
   /* been defined, then create a new data structure.        */
   /*========================================================*/

   defglobalPtr = QFindDefglobal(theEnv,name);
   if (defglobalPtr == NULL)
     {
      newGlobal = TRUE;
      defglobalPtr = get_struct(theEnv,defglobal);
     }
   else
     {
      DeinstallConstructHeader(theEnv,&defglobalPtr->header);
#if DEBUGGING_FUNCTIONS
      GlobalHadWatch = defglobalPtr->watch;
#endif
     }

   /*===========================================*/
   /* Remove the old values from the defglobal. */
   /*===========================================*/

   if (newGlobal == FALSE)
     {
      ValueDeinstall(theEnv,&defglobalPtr->current);
      if (defglobalPtr->current.type == MULTIFIELD)
        { ReturnMultifield(theEnv,(struct multifield *) defglobalPtr->current.value); }

      RemoveHashedExpression(theEnv,defglobalPtr->initial);
     }

   /*=======================================*/
   /* Copy the new values to the defglobal. */
   /*=======================================*/

   defglobalPtr->current.type = vPtr->type;
   if (vPtr->type != MULTIFIELD) defglobalPtr->current.value = vPtr->value;
   else DuplicateMultifield(theEnv,&defglobalPtr->current,vPtr);
   ValueInstall(theEnv,&defglobalPtr->current);

   defglobalPtr->initial = AddHashedExpression(theEnv,ePtr);
   ReturnExpression(theEnv,ePtr);
   DefglobalData(theEnv)->ChangeToGlobals = TRUE;

   /*=================================*/
   /* Restore the old watch value to  */
   /* the defglobal if redefined.     */
   /*=================================*/

#if DEBUGGING_FUNCTIONS
   defglobalPtr->watch = GlobalHadWatch ? TRUE : WatchGlobals;
#endif

   /*======================================*/
   /* Save the name and pretty print form. */
   /*======================================*/

   defglobalPtr->header.name = name;
   defglobalPtr->header.usrData = NULL;
   IncrementSymbolCount(name);

   SavePPBuffer(theEnv,"\n");
   if (EnvGetConserveMemory(theEnv) == TRUE)
     { defglobalPtr->header.ppForm = NULL; }
   else
     { defglobalPtr->header.ppForm = CopyPPBuffer(theEnv); }

   defglobalPtr->inScope = TRUE;

   /*=============================================*/
   /* If the defglobal was redefined, we're done. */
   /*=============================================*/

   if (newGlobal == FALSE) return;

   /*===================================*/
   /* Copy the defglobal variable name. */
   /*===================================*/

   defglobalPtr->busyCount = 0;
   defglobalPtr->header.whichModule = (struct defmoduleItemHeader *)
                               GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex);

   /*=============================================*/
   /* Add the defglobal to the list of defglobals */
   /* for the current module.                     */
   /*=============================================*/

   AddConstructToModule(&defglobalPtr->header);
  }
Beispiel #29
0
static void StrOrSymCatFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue,
  unsigned short returnType)
  {
   DATA_OBJECT theArg;
   int numArgs, i, total, j;
   char *theString;
   SYMBOL_HN **arrayOfStrings;
   SYMBOL_HN *hashPtr;
   char *functionName;

   /*============================================*/
   /* Determine the calling function name.       */
   /* Store the null string or the symbol nil as */
   /* the return value in the event of an error. */
   /*============================================*/

   SetpType(returnValue,returnType);
   if (returnType == STRING)
     {
      functionName = "str-cat";
      SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));
     }
   else
     {
      functionName = "sym-cat";
      SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"nil"));
     }

   /*===============================================*/
   /* Determine the number of arguments as create a */
   /* string array which is large enough to store   */
   /* the string representation of each argument.   */
   /*===============================================*/

   numArgs = EnvRtnArgCount(theEnv);
   arrayOfStrings = (SYMBOL_HN **) gm1(theEnv,(int) sizeof(SYMBOL_HN *) * numArgs);
   for (i = 0; i < numArgs; i++)
     { arrayOfStrings[i] = NULL; }

   /*=============================================*/
   /* Evaluate each argument and store its string */
   /* representation in the string array.         */
   /*=============================================*/

   total = 1;
   for (i = 1 ; i <= numArgs ; i++)
     {
      EnvRtnUnknown(theEnv,i,&theArg);

      switch(GetType(theArg))
        {
         case STRING:
#if OBJECT_SYSTEM
         case INSTANCE_NAME:
#endif
         case SYMBOL:
           hashPtr = (SYMBOL_HN *) GetValue(theArg);
           arrayOfStrings[i-1] = hashPtr;
           IncrementSymbolCount(hashPtr);
           break;

         case FLOAT:
           hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,FloatToString(theEnv,ValueToDouble(GetValue(theArg))));
           arrayOfStrings[i-1] = hashPtr;
           IncrementSymbolCount(hashPtr);
           break;

         case INTEGER:
           hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,LongIntegerToString(theEnv,ValueToLong(GetValue(theArg))));
           arrayOfStrings[i-1] = hashPtr;
           IncrementSymbolCount(hashPtr);
           break;

         default:
           ExpectedTypeError1(theEnv,functionName,i,"string, instance name, symbol, float, or integer");
           SetEvaluationError(theEnv,TRUE);
           break;
        }

      if (EvaluationData(theEnv)->EvaluationError)
        {
         for (i = 0; i < numArgs; i++)
           {
            if (arrayOfStrings[i] != NULL)
              { DecrementSymbolCount(theEnv,arrayOfStrings[i]); }
           }

         rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs);
         return;
        }

      total += (int) strlen(ValueToString(arrayOfStrings[i - 1]));
     }

   /*=========================================================*/
   /* Allocate the memory to store the concatenated string or */
   /* symbol, then copy the values in the string array to the */
   /* memory just allocated.                                  */
   /*=========================================================*/

   theString = (char *) gm2(theEnv,(sizeof(char) * total));

   j = 0;
   for (i = 0 ; i < numArgs ; i++)
     {
      sprintf(&theString[j],"%s",ValueToString(arrayOfStrings[i]));
      j += (int) strlen(ValueToString(arrayOfStrings[i]));
     }

   /*=========================================*/
   /* Return the concatenated value and clean */
   /* up the temporary memory used.           */
   /*=========================================*/

   SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,theString));
   rm(theEnv,theString,sizeof(char) * total);

   for (i = 0; i < numArgs; i++)
     {
      if (arrayOfStrings[i] != NULL)
        { DecrementSymbolCount(theEnv,arrayOfStrings[i]); }
     }

   rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs);
  }
Beispiel #30
0
static void InitializeKeywords(
  void *theEnv)
  {
#if (! RUN_TIME) && WINDOW_INTERFACE
   void *ts;

   /*====================*/
   /* construct keywords */
   /*====================*/

   ts = EnvAddSymbol(theEnv,"defrule");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"defglobal");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"deftemplate");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"deffacts");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"deffunction");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"defmethod");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"defgeneric");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"defclass");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"defmessage-handler");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"definstances");
   IncrementSymbolCount(ts);

   /*=======================*/
   /* set-strategy keywords */
   /*=======================*/

   ts = EnvAddSymbol(theEnv,"depth");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"breadth");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"lex");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"mea");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"simplicity");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"complexity");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"random");
   IncrementSymbolCount(ts);

   /*==================================*/
   /* set-salience-evaluation keywords */
   /*==================================*/

   ts = EnvAddSymbol(theEnv,"when-defined");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"when-activated");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"every-cycle");
   IncrementSymbolCount(ts);

   /*======================*/
   /* deftemplate keywords */
   /*======================*/

   ts = EnvAddSymbol(theEnv,"field");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"multifield");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"default");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"type");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"allowed-symbols");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"allowed-strings");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"allowed-numbers");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"allowed-integers");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"allowed-floats");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"allowed-values");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"min-number-of-elements");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"max-number-of-elements");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"NONE");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"VARIABLE");
   IncrementSymbolCount(ts);

   /*==================*/
   /* defrule keywords */
   /*==================*/

   ts = EnvAddSymbol(theEnv,"declare");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"salience");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"test");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"or");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"and");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"not");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"logical");
   IncrementSymbolCount(ts);

   /*===============*/
   /* COOL keywords */
   /*===============*/

   ts = EnvAddSymbol(theEnv,"is-a");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"role");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"abstract");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"concrete");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"pattern-match");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"reactive");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"non-reactive");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"slot");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"field");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"multiple");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"single");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"storage");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"shared");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"local");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"access");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"read");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"write");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"read-only");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"read-write");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"initialize-only");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"propagation");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"inherit");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"no-inherit");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"source");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"composite");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"exclusive");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"allowed-lexemes");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"allowed-instances");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"around");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"before");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"primary");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"after");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"of");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"self");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"visibility");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"override-message");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"private");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"public");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"create-accessor");
   IncrementSymbolCount(ts);

   /*================*/
   /* watch keywords */
   /*================*/

   ts = EnvAddSymbol(theEnv,"compilations");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"deffunctions");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"globals");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"rules");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"activations");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"statistics");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"facts");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"generic-functions");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"methods");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"instances");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"slots");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"messages");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"message-handlers");
   IncrementSymbolCount(ts);
   ts = EnvAddSymbol(theEnv,"focus");
   IncrementSymbolCount(ts);
#else
#if MAC_XCD
#pragma unused(theEnv)
#endif
#endif
  }