defins.c

clips源代码

      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
      PPCRAndIndent(theEnv);
      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
      *active = TRUE;
     }
#endif
   if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
     {
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
      PPCRAndIndent(theEnv);
      GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
     }
   return(dname);
  }

/**************************************************************
  NAME         : RemoveDefinstances
  DESCRIPTION  : Deallocates and removes a definstance construct
  INPUTS       : The definstance address
  RETURNS      : Nothing useful
  SIDE EFFECTS : Existing definstance construct deleted
  NOTES        : Assumes busy count of definstance is 0
 **************************************************************/
static void RemoveDefinstances(
  void *theEnv,
  void *vdptr)
  {
   DEFINSTANCES *dptr = (DEFINSTANCES *) vdptr;

   DecrementSymbolCount(theEnv,GetDefinstancesNamePointer((void *) dptr));
   ExpressionDeinstall(theEnv,dptr->mkinstance);
   ReturnPackedExpression(theEnv,dptr->mkinstance);
   SetDefinstancesPPForm((void *) dptr,NULL);
   ClearUserDataList(theEnv,dptr->header.usrData);
   rtn_struct(theEnv,definstances,dptr);
  }

/***************************************************
  NAME         : SaveDefinstances
  DESCRIPTION  : Prints pretty print form of
                   definstances to specified output
  INPUTS       : The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
static void SaveDefinstances(
  void *theEnv,
  void *theModule,
  char *logName)
  {
   SaveConstruct(theEnv,theModule,logName,DefinstancesData(theEnv)->DefinstancesConstruct);
  }

/***************************************************
  NAME         : RemoveAllDefinstances
  DESCRIPTION  : Removes all definstances constructs
  INPUTS       : None
  RETURNS      : TRUE if successful,
                 FALSE otherwise
  SIDE EFFECTS : All definstances deallocated
  NOTES        : None
 ***************************************************/
static intBool RemoveAllDefinstances(
  void *theEnv)
  {
   DEFINSTANCES *dptr,*dhead;
   int success = TRUE;

#if BLOAD || BLOAD_AND_BSAVE

   if (Bloaded(theEnv))
     return(FALSE);
#endif
  dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,NULL);
  while (dhead != NULL)
    {
     dptr = dhead;
     dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,(void *) dhead);
     if (EnvIsDefinstancesDeletable(theEnv,(void *) dptr))
       {
        RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
        RemoveDefinstances(theEnv,(void *) dptr);
       }
     else
       {
        DefinstancesDeleteError(theEnv,EnvGetDefinstancesName(theEnv,(void *) dptr));
        success = FALSE;
       }
    }
   return(success);
  }

/***************************************************
  NAME         : DefinstancesDeleteError
  DESCRIPTION  : Prints an error message for
                 unsuccessful definstances
                 deletion attempts
  INPUTS       : The name of the definstances
  RETURNS      : Nothing useful
  SIDE EFFECTS : Error message printed
  NOTES        : None
 ***************************************************/
static void DefinstancesDeleteError(
  void *theEnv,
  char *dname)
  {
   CantDeleteItemErrorMessage(theEnv,"definstances",dname);
  }

#if DEFRULE_CONSTRUCT

/********************************************************
  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,"definstances",(struct constructHeader *) theDefinstances,
                             DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
   theDefinstances->busy = 0;
   tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"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);
  }

#endif

#endif

#if ! RUN_TIME

/*****************************************************
  NAME         : AllocateModule
  DESCRIPTION  : Creates and initializes a
                 list of definstances for a new module
  INPUTS       : None
  RETURNS      : The new definstances module
  SIDE EFFECTS : Definstances module created
  NOTES        : None
 *****************************************************/
static void *AllocateModule(
  void *theEnv)
  {
   return((void *) get_struct(theEnv,definstancesModule));
  }

/***************************************************
  NAME         : ReturnModule
  DESCRIPTION  : Removes a definstances module and
                 all associated definstances
  INPUTS       : The definstances module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Module and definstances deleted
  NOTES        : None
 ***************************************************/
static void ReturnModule(
  void *theEnv,
  void *theItem)
  {
#if (! BLOAD_ONLY)
   FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefinstancesData(theEnv)->DefinstancesConstruct);
#endif
   rtn_struct(theEnv,definstancesModule,theItem);
  }

/***************************************************
  NAME         : ClearDefinstancesReady
  DESCRIPTION  : Determines if it is safe to
                 remove all definstances
                 Assumes *all* constructs will be
                 deleted
  INPUTS       : None
  RETURNS      : TRUE if all definstances can
                 be deleted, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : Used by (clear) and (bload)
 ***************************************************/
static intBool ClearDefinstancesReady(
  void *theEnv)
  {
   int flagBuffer = TRUE;

   DoForAllConstructs(theEnv,CheckDefinstancesBusy,DefinstancesData(theEnv)->DefinstancesModuleIndex,
                      FALSE,(void *) &flagBuffer);
   return(flagBuffer);
  }

/***************************************************
  NAME         : CheckDefinstancesBusy
  DESCRIPTION  : Determines if a definstances is
                 in use or not
  INPUTS       : 1) The definstances
                 2) A buffer to set to 0 if the
                    the definstances is busy
  RETURNS      : Nothing useful
  SIDE EFFECTS : Buffer set to 0 if definstances
                 busy
  NOTES        : The flag buffer is not modified
                 if definstances is not busy
                 (assumed to be initialized to 1)
 ***************************************************/
#if IBM_TBC
#pragma argsused
#endif
static void CheckDefinstancesBusy(
  void *theEnv,
  struct constructHeader *theDefinstances,
  void *userBuffer)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif

   if (((DEFINSTANCES *) theDefinstances)->busy > 0)
     * (int *) userBuffer = FALSE;
  }

#endif

/***************************************************
  NAME         : ResetDefinstances
  DESCRIPTION  : Calls EvaluateExpression for each of
                   the make-instance calls in all
                   of the definstances constructs
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : All instances in the definstances
                   are evaluated (and created if
                   there are no errors)
                 Any previously existing instances
                 are deleted first.
  NOTES        : None
 ***************************************************/
static void ResetDefinstances(
  void *theEnv)
  {
   DoForAllConstructs(theEnv,ResetDefinstancesAction,DefinstancesData(theEnv)->DefinstancesModuleIndex,TRUE,NULL);
  }

/***************************************************
  NAME         : ResetDefinstancesAction
  DESCRIPTION  : Performs all the make-instance
                 calls in a definstances
  INPUTS       : 1) The definstances
                 2) User data buffer (ignored)
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instances created
  NOTES        : None
 ***************************************************/
#if IBM_TBC
#pragma argsused
#endif
static void ResetDefinstancesAction(
  void *theEnv,
  struct constructHeader *vDefinstances,
  void *userBuffer)
  {
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(userBuffer)
#endif
   DEFINSTANCES *theDefinstances = (DEFINSTANCES *) vDefinstances;
   EXPRESSION *theExp;
   DATA_OBJECT temp;

   SaveCurrentModule(theEnv);
   EnvSetCurrentModule(theEnv,(void *) vDefinstances->whichModule->theModule);
   theDefinstances->busy++;
   for (theExp = theDefinstances->mkinstance ;
        theExp != NULL ;
        theExp = GetNextArgument(theExp))
     {
      EvaluateExpression(theEnv,theExp,&temp);
      if (EvaluationData(theEnv)->HaltExecution ||
          ((GetType(temp) == SYMBOL) &&
           (GetValue(temp) == EnvFalseSymbol(theEnv))))
        {
         RestoreCurrentModule(theEnv);
         theDefinstances->busy--;
         return;
        }
     }
   theDefinstances->busy--;
   RestoreCurrentModule(theEnv);
  }

#endif