Пример #1
0
/*******************************************************
  NAME         : CheckDeffunctionCall
  DESCRIPTION  : Checks the number of arguments
                 passed to a deffunction
  INPUTS       : 1) Deffunction pointer
                 2) The number of arguments
  RETURNS      : TRUE if OK, FALSE otherwise
  SIDE EFFECTS : Message printed on errors
  NOTES        : None
 *******************************************************/
globle int CheckDeffunctionCall(
  void *theEnv,
  void *vdptr,
  int args)
  {
   DEFFUNCTION *dptr;

   if (vdptr == NULL)
     return(FALSE);
   dptr = (DEFFUNCTION *) vdptr;
   if (args < dptr->minNumberOfParameters)
     {
      if (dptr->maxNumberOfParameters == -1)
        ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr),
                           AT_LEAST,dptr->minNumberOfParameters);
      else
        ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr),
                           EXACTLY,dptr->minNumberOfParameters);
      return(FALSE);
     }
   else if ((args > dptr->minNumberOfParameters) &&
            (dptr->maxNumberOfParameters != -1))
     {
      ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr),
                         EXACTLY,dptr->minNumberOfParameters);
      return(FALSE);
     }
   return(TRUE);
  }
Пример #2
0
/***************************************************
  NAME         : RemoveAllDeffunctions
  DESCRIPTION  : Removes all deffunctions
  INPUTS       : None
  RETURNS      : TRUE if all deffunctions
                 removed, FALSE otherwise
  SIDE EFFECTS : Deffunctions removed
  NOTES        : None
 ***************************************************/
static intBool RemoveAllDeffunctions(
  void *theEnv,
  EXEC_STATUS)
  {
   DEFFUNCTION *dptr,*dtmp;
   unsigned oldbusy;
   intBool success = TRUE;

#if BLOAD || BLOAD_AND_BSAVE

   if (Bloaded(theEnv,execStatus) == TRUE)
     return(FALSE);
#endif

   dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL);
   while (dptr != NULL)
     {
      if (dptr->executing > 0)
        {
         DeffunctionDeleteError(theEnv,execStatus,EnvGetDeffunctionName(theEnv,execStatus,(void *) dptr));
         success = FALSE;
        }
      else
        {
         oldbusy = dptr->busy;
         ExpressionDeinstall(theEnv,execStatus,dptr->code);
         dptr->busy = oldbusy;
         ReturnPackedExpression(theEnv,execStatus,dptr->code);
         dptr->code = NULL;
        }
      dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr);
     }

   dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL);
   while (dptr != NULL)
     {
      dtmp = dptr;
      dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr);
      if (dtmp->executing == 0)
        {
         if (dtmp->busy > 0)
           {
            PrintWarningID(theEnv,execStatus,"DFFNXFUN",1,FALSE);
            EnvPrintRouter(theEnv,execStatus,WWARNING,"Deffunction ");
            EnvPrintRouter(theEnv,execStatus,WWARNING,EnvGetDeffunctionName(theEnv,execStatus,(void *) dtmp));
            EnvPrintRouter(theEnv,execStatus,WWARNING," only partially deleted due to usage by other constructs.\n");
            SetDeffunctionPPForm((void *) dtmp,NULL);
            success = FALSE;
           }
         else
           {
            RemoveConstructFromModule(theEnv,execStatus,(struct constructHeader *) dtmp);
            RemoveDeffunction(theEnv,execStatus,dtmp);
           }
        }
     }
   return(success);
  }
Пример #3
0
std::string Function::name( )
{
  if ( m_cobj )
    return EnvGetDeffunctionName( m_environment.cobj(), m_cobj );
  else
    return std::string();
}
Пример #4
0
/***************************************************
  NAME         : SaveDeffunctionHeader
  DESCRIPTION  : Writes a deffunction forward
                 declaration to the save file
  INPUTS       : 1) The deffunction
                 2) The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defffunction header written
  NOTES        : None
 ***************************************************/
static void SaveDeffunctionHeader(
  void *theEnv,
  struct constructHeader *theDeffunction,
  void *userBuffer)
  {
   DEFFUNCTION *dfnxPtr = (DEFFUNCTION *) theDeffunction;
   char *logicalName = (char *) userBuffer;
   register int i;

   if (EnvGetDeffunctionPPForm(theEnv,(void *) dfnxPtr) != NULL)
     {
      EnvPrintRouter(theEnv,logicalName,(char*)"(deffunction ");
      EnvPrintRouter(theEnv,logicalName,EnvDeffunctionModule(theEnv,(void *) dfnxPtr));
      EnvPrintRouter(theEnv,logicalName,(char*)"::");      
      EnvPrintRouter(theEnv,logicalName,EnvGetDeffunctionName(theEnv,(void *) dfnxPtr));
      EnvPrintRouter(theEnv,logicalName,(char*)" (");
      for (i = 0 ; i < dfnxPtr->minNumberOfParameters ; i++)
        {
         EnvPrintRouter(theEnv,logicalName,(char*)"?p");
         PrintLongInteger(theEnv,logicalName,(long long) i);
         if (i != dfnxPtr->minNumberOfParameters-1)
           EnvPrintRouter(theEnv,logicalName,(char*)" ");
        }
      if (dfnxPtr->maxNumberOfParameters == -1)
        {
         if (dfnxPtr->minNumberOfParameters != 0)
           EnvPrintRouter(theEnv,logicalName,(char*)" ");
         EnvPrintRouter(theEnv,logicalName,(char*)"$?wildargs))\n\n");
        }
      else
        EnvPrintRouter(theEnv,logicalName,(char*)"))\n\n");
     }
  }
Пример #5
0
/*******************************************************
  NAME         : UnboundDeffunctionErr
  DESCRIPTION  : Print out a synopis of the currently
                   executing deffunction for unbound
                   variable errors
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Error synopsis printed to WERROR
  NOTES        : None
 *******************************************************/
static void UnboundDeffunctionErr(
  void *theEnv)
  {
   EnvPrintRouter(theEnv,WERROR,"deffunction ");
   EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) DeffunctionData(theEnv)->ExecutingDeffunction));
   EnvPrintRouter(theEnv,WERROR,".\n");
  }
Пример #6
0
/***************************************************
  NAME         : PrintDeffunctionCall
  DESCRIPTION  : PrintExpression() support function
                 for deffunction calls
  INPUTS       : 1) The output logical name
                 2) The deffunction
  RETURNS      : Nothing useful
  SIDE EFFECTS : Call expression printed
  NOTES        : None
 ***************************************************/
static void PrintDeffunctionCall(
  void *theEnv,
  char *logName,
  void *value)
  {
#if DEVELOPER

   EnvPrintRouter(theEnv,logName,(char*)"(");
   EnvPrintRouter(theEnv,logName,EnvGetDeffunctionName(theEnv,value));
   if (GetFirstArgument() != NULL)
     {
      EnvPrintRouter(theEnv,logName,(char*)" ");
      PrintExpression(theEnv,logName,GetFirstArgument());
     }
   EnvPrintRouter(theEnv,logName,(char*)")");
#else
#endif
  }
Пример #7
0
static void PrintDeffunctionCall(
  void *theEnv,
  EXEC_STATUS,
  char *logName,
  void *value)
  {
#if DEVELOPER

   EnvPrintRouter(theEnv,execStatus,logName,"(");
   EnvPrintRouter(theEnv,execStatus,logName,EnvGetDeffunctionName(theEnv,execStatus,value));
   if (GetFirstArgument() != NULL)
     {
      EnvPrintRouter(theEnv,execStatus,logName," ");
      PrintExpression(theEnv,execStatus,logName,GetFirstArgument());
     }
   EnvPrintRouter(theEnv,execStatus,logName,")");
#else
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv,execStatus)
#pragma unused(logName)
#pragma unused(value)
#endif
#endif
  }
Пример #8
0
EXPORT void* STDCALL EnvGetDeffunctionName2(void* env, void* ptr)
{
	return EnvGetDeffunctionName(env, ptr);	
}
Пример #9
0
static void OutputConstructsCodeInfo(
  void *theEnv)
  {
#if (! DEFFUNCTION_CONSTRUCT) && (! DEFGENERIC_CONSTRUCT) && (! OBJECT_SYSTEM) && (! DEFRULE_CONSTRUCT)
#pragma unused(theEnv)
#endif
#if DEFFUNCTION_CONSTRUCT
   DEFFUNCTION *theDeffunction;
#endif
#if DEFRULE_CONSTRUCT
   struct defrule *theDefrule;
#endif
#if DEFGENERIC_CONSTRUCT
   DEFGENERIC *theDefgeneric;
   DEFMETHOD *theMethod;
   unsigned methodIndex;
   char methodBuffer[512];
#endif
#if OBJECT_SYSTEM
   DEFCLASS *theDefclass;
   HANDLER *theHandler;
   unsigned handlerIndex;
#endif
#if DEFGENERIC_CONSTRUCT || OBJECT_SYSTEM
   char *prefix, *prefixBefore, *prefixAfter;
#endif
   char *banner;

   banner = "\n*** Deffunctions ***\n\n";

#if DEFFUNCTION_CONSTRUCT
   for (theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL);
        theDeffunction != NULL;
        theDeffunction = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,theDeffunction))
     {
      OutputProfileInfo(theEnv,EnvGetDeffunctionName(theEnv,theDeffunction),
                        (struct constructProfileInfo *) 
                          TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDeffunction->header.usrData),
                        NULL,NULL,NULL,&banner);
     }
#endif

   banner = "\n*** Defgenerics ***\n";
#if DEFGENERIC_CONSTRUCT
   for (theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL);
        theDefgeneric != NULL;
        theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric))
     {
      prefixBefore = "\n";
      prefix = EnvGetDefgenericName(theEnv,theDefgeneric);
      prefixAfter = "\n";

      for (methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,0);
           methodIndex != 0;
           methodIndex = EnvGetNextDefmethod(theEnv,theDefgeneric,methodIndex))
        {
         theMethod = GetDefmethodPointer(theDefgeneric,methodIndex);

         EnvGetDefmethodDescription(theEnv,methodBuffer,510,theDefgeneric,methodIndex);
         if (OutputProfileInfo(theEnv,methodBuffer,
                               (struct constructProfileInfo *) 
                                  TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theMethod->usrData),
                               prefixBefore,prefix,prefixAfter,&banner))
           {
            prefixBefore = NULL; 
            prefix = NULL; 
            prefixAfter = NULL;
           }
        }
     }
#endif

   banner = "\n*** Defclasses ***\n";
#if OBJECT_SYSTEM
   for (theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL);
        theDefclass != NULL;
        theDefclass = (DEFCLASS *) EnvGetNextDefclass(theEnv,theDefclass))
     {
      prefixAfter = "\n";
      prefix = EnvGetDefclassName(theEnv,theDefclass);
      prefixBefore = "\n";
      
      for (handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,0);
           handlerIndex != 0;
           handlerIndex = EnvGetNextDefmessageHandler(theEnv,theDefclass,handlerIndex))
        {
         theHandler = GetDefmessageHandlerPointer(theDefclass,handlerIndex);
         if (OutputProfileInfo(theEnv,EnvGetDefmessageHandlerName(theEnv,theDefclass,handlerIndex),
                               (struct constructProfileInfo *) 
                                  TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,
                               theHandler->usrData),
                               prefixBefore,prefix,prefixAfter,&banner))
           {
            prefixBefore = NULL; 
            prefix = NULL; 
            prefixAfter = NULL;
           }
        }

     }
#endif

   banner = "\n*** Defrules ***\n\n";

#if DEFRULE_CONSTRUCT
   for (theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,NULL);
        theDefrule != NULL;
        theDefrule = (struct defrule *) EnvGetNextDefrule(theEnv,theDefrule))
     {
      OutputProfileInfo(theEnv,EnvGetDefruleName(theEnv,theDefrule),
                        (struct constructProfileInfo *) 
                          TestUserData(ProfileFunctionData(theEnv)->ProfileDataID,theDefrule->header.usrData),
                        NULL,NULL,NULL,&banner);
     }
#endif

  }
Пример #10
0
/************************************************************
  NAME         : ValidDeffunctionName
  DESCRIPTION  : Determines if a new deffunction of the given
                 name can be defined in the current module
  INPUTS       : The new deffunction name
  RETURNS      : TRUE if OK, FALSE otherwise
  SIDE EFFECTS : Error message printed if not OK
  NOTES        : GetConstructNameAndComment() (called before
                 this function) ensures that the deffunction
                 name does not conflict with one from
                 another module
 ************************************************************/
static BOOLEAN ValidDeffunctionName(
  void *theEnv,
  char *theDeffunctionName)
  {
   struct constructHeader *theDeffunction;
#if DEFGENERIC_CONSTRUCT
   struct defmodule *theModule;
   struct constructHeader *theDefgeneric;
#endif

   /* ============================================
      A deffunction cannot be named the same as a
      construct type, e.g, defclass, defrule, etc.
      ============================================ */
   if (FindConstruct(theEnv,theDeffunctionName) != NULL)
     {
      PrintErrorID(theEnv,"DFFNXPSR",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n");
      return(FALSE);
     }

   /* ============================================
      A deffunction cannot be named the same as a
      pre-defined system function, e.g, watch,
      list-defrules, etc.
      ============================================ */
   if (FindFunction(theEnv,theDeffunctionName) != NULL)
     {
      PrintErrorID(theEnv,"DFFNXPSR",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n");
      return(FALSE);
     }

#if DEFGENERIC_CONSTRUCT
   /* ============================================
      A deffunction cannot be named the same as a
      generic function (either in this module or
      imported from another)
      ============================================ */
   theDefgeneric =
     (struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName);
   if (theDefgeneric != NULL)
     {
      theModule = GetConstructModuleItem(theDefgeneric)->theModule;
      if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
        {
         PrintErrorID(theEnv,"DFFNXPSR",5,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Defgeneric ");
         EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric));
         EnvPrintRouter(theEnv,WERROR," imported from module ");
         EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule));
         EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n");
         return(FALSE);
        }
      else
        {
         PrintErrorID(theEnv,"DFFNXPSR",3,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n");
        }
      return(FALSE);
     }
#endif

   theDeffunction = (struct constructHeader *) EnvFindDeffunction(theEnv,theDeffunctionName);
   if (theDeffunction != NULL)
     {
      /* ===========================================
         And a deffunction in the current module can
         only be redefined if it is not executing.
         =========================================== */
      if (((DEFFUNCTION *) theDeffunction)->executing)
        {
         PrintErrorID(theEnv,"DFNXPSR",4,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Deffunction ");
         EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction));
         EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n");
         return(FALSE);
        }
     }
   return(TRUE);
  }
Пример #11
0
globle void FuncallFunction(
    void *theEnv,
    DATA_OBJECT *returnValue)
{
    int argCount, i, j;
    DATA_OBJECT theValue;
    FUNCTION_REFERENCE theReference;
    char *name;
    struct multifield *theMultifield;
    struct expr *lastAdd = NULL, *nextAdd, *multiAdd;

    /*==================================*/
    /* Set up the default return value. */
    /*==================================*/

    SetpType(returnValue,SYMBOL);
    SetpValue(returnValue,EnvFalseSymbol(theEnv));

    /*=================================================*/
    /* The funcall function has at least one argument: */
    /* the name of the function being called.          */
    /*=================================================*/

    if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return;

    /*============================================*/
    /* Get the name of the function to be called. */
    /*============================================*/

    if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE)
    {
        return;
    }

    /*====================*/
    /* Find the function. */
    /*====================*/

    name = DOToString(theValue);
    if (! GetFunctionReference(theEnv,name,&theReference))
    {
        ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name");
        return;
    }

    ExpressionInstall(theEnv,&theReference);

    /*======================================*/
    /* Add the arguments to the expression. */
    /*======================================*/

    for (i = 2; i <= argCount; i++)
    {
        EnvRtnUnknown(theEnv,i,&theValue);
        if (GetEvaluationError(theEnv))
        {
            ExpressionDeinstall(theEnv,&theReference);
            return;
        }

        switch(GetType(theValue))
        {
        case MULTIFIELD:
            nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"));

            if (lastAdd == NULL)
            {
                theReference.argList = nextAdd;
            }
            else
            {
                lastAdd->nextArg = nextAdd;
            }
            lastAdd = nextAdd;

            multiAdd = NULL;
            theMultifield = (struct multifield *) GetValue(theValue);
            for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++)
            {
                nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j));
                if (multiAdd == NULL)
                {
                    lastAdd->argList = nextAdd;
                }
                else
                {
                    multiAdd->nextArg = nextAdd;
                }
                multiAdd = nextAdd;
            }

            ExpressionInstall(theEnv,lastAdd);
            break;

        default:
            nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue));
            if (lastAdd == NULL)
            {
                theReference.argList = nextAdd;
            }
            else
            {
                lastAdd->nextArg = nextAdd;
            }
            lastAdd = nextAdd;
            ExpressionInstall(theEnv,lastAdd);
            break;
        }
    }

    /*===========================================================*/
    /* Verify a deffunction has the correct number of arguments. */
    /*===========================================================*/

#if DEFFUNCTION_CONSTRUCT
    if (theReference.type == PCALL)
    {
        if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE)
        {
            PrintErrorID(theEnv,"MISCFUN",4,FALSE);
            EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction ");
            EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value));
            EnvPrintRouter(theEnv,WERROR,"\n");
            ExpressionDeinstall(theEnv,&theReference);
            ReturnExpression(theEnv,theReference.argList);
            return;
        }
    }
#endif

    /*======================*/
    /* Call the expression. */
    /*======================*/

    EvaluateExpression(theEnv,&theReference,returnValue);

    /*========================================*/
    /* Return the expression data structures. */
    /*========================================*/

    ExpressionDeinstall(theEnv,&theReference);
    ReturnExpression(theEnv,theReference.argList);
}
Пример #12
0
globle const char *GetDeffunctionName(
  void *theDeffunction)
  {
   return EnvGetDeffunctionName(GetCurrentEnvironment(),theDeffunction);
  }
Пример #13
0
/****************************************************
  NAME         : CallDeffunction
  DESCRIPTION  : Executes the body of a deffunction
  INPUTS       : 1) The deffunction
                 2) Argument expressions
                 3) Data object buffer to hold result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Deffunction executed and result
                 stored in data object buffer
  NOTES        : Used in EvaluateExpression(theEnv,)
 ****************************************************/
globle void CallDeffunction(
  void *theEnv,
  DEFFUNCTION *dptr,
  EXPRESSION *args,
  DATA_OBJECT *result)
  {
   int oldce;
   DEFFUNCTION *previouslyExecutingDeffunction;
   struct garbageFrame newGarbageFrame;
   struct garbageFrame *oldGarbageFrame;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);
   EvaluationData(theEnv)->EvaluationError = FALSE;
   if (EvaluationData(theEnv)->HaltExecution)
     return;
     
   oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
   memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
   newGarbageFrame.priorFrame = oldGarbageFrame;
   UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;

   oldce = ExecutingConstruct(theEnv);
   SetExecutingConstruct(theEnv,TRUE);
   previouslyExecutingDeffunction = DeffunctionData(theEnv)->ExecutingDeffunction;
   DeffunctionData(theEnv)->ExecutingDeffunction = dptr;
   EvaluationData(theEnv)->CurrentEvaluationDepth++;
   dptr->executing++;
   PushProcParameters(theEnv,args,CountArguments(args),EnvGetDeffunctionName(theEnv,(void *) dptr),
                      "deffunction",UnboundDeffunctionErr);
   if (EvaluationData(theEnv)->EvaluationError)
     {
      dptr->executing--;
      DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction;
      EvaluationData(theEnv)->CurrentEvaluationDepth--;
      
      RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result);
      CallPeriodicTasks(theEnv);

      SetExecutingConstruct(theEnv,oldce);
      return;
     }

#if DEBUGGING_FUNCTIONS
   if (dptr->trace)
     WatchDeffunction(theEnv,BEGIN_TRACE);
#endif

#if PROFILING_FUNCTIONS
   StartProfile(theEnv,&profileFrame,
                &dptr->header.usrData,
                ProfileFunctionData(theEnv)->ProfileConstructs);
#endif

   EvaluateProcActions(theEnv,dptr->header.whichModule->theModule,
                       dptr->code,dptr->numberOfLocalVars,
                       result,UnboundDeffunctionErr);

#if PROFILING_FUNCTIONS
    EndProfile(theEnv,&profileFrame);
#endif

#if DEBUGGING_FUNCTIONS
   if (dptr->trace)
     WatchDeffunction(theEnv,END_TRACE);
#endif
   ProcedureFunctionData(theEnv)->ReturnFlag = FALSE;

   dptr->executing--;
   PopProcParameters(theEnv);
   DeffunctionData(theEnv)->ExecutingDeffunction = previouslyExecutingDeffunction;
   EvaluationData(theEnv)->CurrentEvaluationDepth--;
   
   RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,result);
   CallPeriodicTasks(theEnv);
   
   SetExecutingConstruct(theEnv,oldce);
  }