/******************************************************************** NAME : ExpandFuncCall DESCRIPTION : This function is a wrap-around for a normal function call. It preexamines the argument expression list and expands any references to the sequence operator. It builds a copy of the function call expression with these new arguments inserted and evaluates the function call. INPUTS : A data object buffer RETURNS : Nothing useful SIDE EFFECTS : Expressions alloctaed/deallocated Function called and arguments evaluated EvaluationError set on errors NOTES : None *******************************************************************/ globle void ExpandFuncCall( void *theEnv, DATA_OBJECT *result) { EXPRESSION *newargexp,*fcallexp; struct FunctionDefinition *func; /* ====================================================================== Copy the original function call's argument expression list. Look for expand$ function callsexpressions and replace those with the equivalent expressions of the expansions of evaluations of the arguments. ====================================================================== */ newargexp = CopyExpression(theEnv,GetFirstArgument()->argList); ExpandFuncMultifield(theEnv,result,newargexp,&newargexp, (void *) FindFunction(theEnv,"expand$")); /* =================================================================== Build the new function call expression with the expanded arguments. Check the number of arguments, if necessary, and call the thing. =================================================================== */ fcallexp = get_struct(theEnv,expr); fcallexp->type = GetFirstArgument()->type; fcallexp->value = GetFirstArgument()->value; fcallexp->nextArg = NULL; fcallexp->argList = newargexp; if (fcallexp->type == FCALL) { func = (struct FunctionDefinition *) fcallexp->value; if (CheckFunctionArgCount(theEnv,ValueToString(func->callFunctionName), func->restrictions,CountArguments(newargexp)) == FALSE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ReturnExpression(theEnv,fcallexp); return; } } #if DEFFUNCTION_CONSTRUCT else if (fcallexp->type == PCALL) { if (CheckDeffunctionCall(theEnv,fcallexp->value, CountArguments(fcallexp->argList)) == FALSE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); ReturnExpression(theEnv,fcallexp); SetEvaluationError(theEnv,TRUE); return; } } #endif EvaluateExpression(theEnv,fcallexp,result); ReturnExpression(theEnv,fcallexp); }
/************************************************************* NAME : PreviewGeneric DESCRIPTION : Allows the user to see a printout of all the applicable methods for a particular generic function call INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments and evaluating query-functions to determine the set of applicable methods NOTES : H/L Syntax: (preview-generic <func> <args>) *************************************************************/ globle void PreviewGeneric( void *theEnv, EXEC_STATUS) { DEFGENERIC *gfunc; DEFGENERIC *previousGeneric; int oldce; DATA_OBJECT temp; execStatus->EvaluationError = FALSE; if (EnvArgTypeCheck(theEnv,execStatus,"preview-generic",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(theEnv,execStatus,DOToString(temp)); if (gfunc == NULL) { PrintErrorID(theEnv,execStatus,"GENRCFUN",3,FALSE); EnvPrintRouter(theEnv,execStatus,WERROR,"Unable to find generic function "); EnvPrintRouter(theEnv,execStatus,WERROR,DOToString(temp)); EnvPrintRouter(theEnv,execStatus,WERROR," in function preview-generic.\n"); return; } oldce = ExecutingConstruct(theEnv,execStatus); SetExecutingConstruct(theEnv,execStatus,TRUE); previousGeneric = DefgenericData(theEnv,execStatus)->CurrentGeneric; DefgenericData(theEnv,execStatus)->CurrentGeneric = gfunc; execStatus->CurrentEvaluationDepth++; PushProcParameters(theEnv,execStatus,GetFirstArgument()->nextArg, CountArguments(GetFirstArgument()->nextArg), EnvGetDefgenericName(theEnv,execStatus,(void *) gfunc),"generic function", UnboundMethodErr); if (execStatus->EvaluationError) { PopProcParameters(theEnv,execStatus); DefgenericData(theEnv,execStatus)->CurrentGeneric = previousGeneric; execStatus->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,execStatus,oldce); return; } gfunc->busy++; DisplayGenericCore(theEnv,execStatus,gfunc); gfunc->busy--; PopProcParameters(theEnv,execStatus); DefgenericData(theEnv,execStatus)->CurrentGeneric = previousGeneric; execStatus->CurrentEvaluationDepth--; SetExecutingConstruct(theEnv,execStatus,oldce); }
/************************************************************* NAME : PreviewGeneric DESCRIPTION : Allows the user to see a printout of all the applicable methods for a particular generic function call INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments and evaluating query-functions to determine the set of applicable methods NOTES : H/L Syntax: (preview-generic <func> <args>) *************************************************************/ globle void PreviewGeneric() { DEFGENERIC *gfunc; DEFGENERIC *previousGeneric; int oldce; DATA_OBJECT temp; EvaluationError = FALSE; if (ArgTypeCheck("preview-generic",1,SYMBOL,&temp) == FALSE) return; gfunc = LookupDefgenericByMdlOrScope(DOToString(temp)); if (gfunc == NULL) { PrintErrorID("GENRCFUN",3,FALSE); PrintRouter(WERROR,"Unable to find generic function "); PrintRouter(WERROR,DOToString(temp)); PrintRouter(WERROR," in function preview-generic.\n"); return; } oldce = ExecutingConstruct(); SetExecutingConstruct(TRUE); previousGeneric = CurrentGeneric; CurrentGeneric = gfunc; CurrentEvaluationDepth++; PushProcParameters(GetFirstArgument()->nextArg, CountArguments(GetFirstArgument()->nextArg), GetDefgenericName((void *) gfunc),"generic function", UnboundMethodErr); if (EvaluationError) { PopProcParameters(); CurrentGeneric = previousGeneric; CurrentEvaluationDepth--; SetExecutingConstruct(oldce); return; } gfunc->busy++; DisplayGenericCore(gfunc); gfunc->busy--; PopProcParameters(); CurrentGeneric = previousGeneric; CurrentEvaluationDepth--; SetExecutingConstruct(oldce); }
int x86ThreadArchInit(struct x86ArchThread *thread, void *entry, unsigned long *argv, unsigned char priv) { unsigned long *stack; int argc = CountArguments((char **)argv); argv[argc] = 0; // Set last argument + 1 to NULL if(argc < 0) argc = 0; /** @note Following structures are allocated in process' parent: - The process struct; - The process queue. */ thread->kernel_stack_base = (unsigned long)kmalloc_a(KERNEL_STACK_SIZE); if(thread->kernel_stack_base == 0) return -ENOMEM; memset((void *)thread->kernel_stack_base, 0, KERNEL_STACK_SIZE); thread->kernel_stack = thread->kernel_stack_base + KERNEL_STACK_SIZE; // Create kernel stack if(priv == PRIV_USER) { // Apenas aloca memória de user se for preciso thread->stack_base = (unsigned long)umalloc_a(USER_STACK_SIZE); if(thread->stack_base == 0) { kfree((void *)thread->kernel_stack_base); return -ENOMEM; } memset((void *)thread->stack_base, 0, USER_STACK_SIZE); thread->stack = thread->stack_base + USER_STACK_SIZE; // Allocate 4 kilobytes of space for user } else { thread->stack_base = thread->kernel_stack_base; thread->stack = thread->kernel_stack; } stack = (unsigned long*)thread->stack; // Expand down stack // We expect all threads to have this layout: // ThreadMain(int argc, char **argv); // The kernel will not crash if the thread is different (i guess) *--stack = (unsigned long)argv; // Argv *--stack = argc; // Argc *--stack = (unsigned long)&x86ThreadExitEntry; // Pushed by iret if(priv == PRIV_USER) { // User threads have special stack *--stack = 0x23; // SS *--stack = thread->stack - 12; // ESP } *--stack = 0x202; // EFLAGS *--stack = ((priv == PRIV_USER) ? (0x1b) : 0x08); // CS *--stack = (unsigned long)entry; // EIP // Pushed by pusha *--stack = 0; // EDI *--stack = 0; // ESI *--stack = 0; // EBP *--stack = 0; // NULL *--stack = 0; // EBX *--stack = 0; // EDX *--stack = 0; // ECX *--stack = 0; // EAX // Pushed by asm handler *--stack = ((priv == PRIV_USER) ? (0x23) : 0x10); // DS *--stack = ((priv == PRIV_USER) ? (0x23) : 0x10); // ES *--stack = ((priv == PRIV_USER) ? (0x23) : 0x10); // FS *--stack = ((priv == PRIV_USER) ? (0x23) : 0x10); // GS thread->stack = (unsigned long)stack; return ESUCCESS; }
/*********************************************************************************** NAME : GenericDispatch DESCRIPTION : Executes the most specific applicable method INPUTS : 1) The generic function 2) The method to start after in the search for an applicable method (ignored if arg #3 is not NULL). 3) A specific method to call (NULL if want highest precedence method to be called) 4) The generic function argument expressions 5) The caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments Any side-effects of evaluating query functions on method parameter restrictions when determining the core (see warning #1) Any side-effects of actual execution of methods (see warning #2) Caller's buffer set to the result of the generic function call In case of errors, the result is false, otherwise it is the result returned by the most specific method (which can choose to ignore or return the values of more general methods) NOTES : WARNING #1: Query functions on method parameter restrictions should not have side-effects, for they might be evaluated even for methods that aren't applicable to the generic function call. WARNING #2: Side-effects of method execution should not always rely on only being executed once per generic function call. Every time a method calls (shadow-call) the same next-most-specific method is executed. Thus, it is possible for a method to be executed multiple times per generic function call. ***********************************************************************************/ void GenericDispatch( void *theEnv, DEFGENERIC *gfunc, DEFMETHOD *prevmeth, DEFMETHOD *meth, EXPRESSION *params, DATA_OBJECT *result) { DEFGENERIC *previousGeneric; DEFMETHOD *previousMethod; int oldce; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif struct CLIPSBlock gcBlock; result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = false; if (EvaluationData(theEnv)->HaltExecution) return; CLIPSBlockStart(theEnv,&gcBlock); oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,true); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; previousMethod = DefgenericData(theEnv)->CurrentMethod; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; gfunc->busy++; PushProcParameters(theEnv,params,CountArguments(params), EnvGetDefgenericName(theEnv,(void *) gfunc), "generic function",UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { gfunc->busy--; DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; CLIPSBlockEnd(theEnv,&gcBlock,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return; } if (meth != NULL) { if (IsMethodApplicable(theEnv,meth)) { meth->busy++; DefgenericData(theEnv)->CurrentMethod = meth; } else { PrintErrorID(theEnv,"GENRCEXE",4,false); EnvSetEvaluationError(theEnv,true); DefgenericData(theEnv)->CurrentMethod = NULL; EnvPrintRouter(theEnv,WERROR,"Generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR," method #"); PrintLongInteger(theEnv,WERROR,(long long) meth->index); EnvPrintRouter(theEnv,WERROR," is not applicable to the given arguments.\n"); } } else DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth); if (DefgenericData(theEnv)->CurrentMethod != NULL) { #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,BEGIN_TRACE); if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,BEGIN_TRACE); #endif if (DefgenericData(theEnv)->CurrentMethod->system) { EXPRESSION fcall; fcall.type = FCALL; fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value; fcall.nextArg = NULL; fcall.argList = GetProcParamExpressions(theEnv); EvaluateExpression(theEnv,&fcall,result); } else { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &DefgenericData(theEnv)->CurrentMethod->usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule, DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount, result,UnboundMethodErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } DefgenericData(theEnv)->CurrentMethod->busy--; #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,END_TRACE); if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,END_TRACE); #endif } else if (! EvaluationData(theEnv)->EvaluationError) { PrintErrorID(theEnv,"GENRCEXE",1,false); EnvPrintRouter(theEnv,WERROR,"No applicable methods for "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc)); EnvPrintRouter(theEnv,WERROR,".\n"); EnvSetEvaluationError(theEnv,true); } gfunc->busy--; ProcedureFunctionData(theEnv)->ReturnFlag = false; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; CLIPSBlockEnd(theEnv,&gcBlock,result); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); }
/*********************************************************************************** NAME : GenericDispatch DESCRIPTION : Executes the most specific applicable method INPUTS : 1) The generic function 2) The method to start after in the search for an applicable method (ignored if arg #3 is not NULL). 3) A specific method to call (NULL if want highest precedence method to be called) 4) The generic function argument expressions 5) The caller's result value buffer RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of evaluating the generic function arguments Any side-effects of evaluating query functions on method parameter restrictions when determining the core (see warning #1) Any side-effects of actual execution of methods (see warning #2) Caller's buffer set to the result of the generic function call In case of errors, the result is false, otherwise it is the result returned by the most specific method (which can choose to ignore or return the values of more general methods) NOTES : WARNING #1: Query functions on method parameter restrictions should not have side-effects, for they might be evaluated even for methods that aren't applicable to the generic function call. WARNING #2: Side-effects of method execution should not always rely on only being executed once per generic function call. Every time a method calls (shadow-call) the same next-most-specific method is executed. Thus, it is possible for a method to be executed multiple times per generic function call. ***********************************************************************************/ void GenericDispatch( Environment *theEnv, Defgeneric *gfunc, Defmethod *prevmeth, Defmethod *meth, Expression *params, UDFValue *returnValue) { Defgeneric *previousGeneric; Defmethod *previousMethod; bool oldce; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif GCBlock gcb; returnValue->value = FalseSymbol(theEnv); EvaluationData(theEnv)->EvaluationError = false; if (EvaluationData(theEnv)->HaltExecution) return; GCBlockStart(theEnv,&gcb); oldce = ExecutingConstruct(theEnv); SetExecutingConstruct(theEnv,true); previousGeneric = DefgenericData(theEnv)->CurrentGeneric; previousMethod = DefgenericData(theEnv)->CurrentMethod; DefgenericData(theEnv)->CurrentGeneric = gfunc; EvaluationData(theEnv)->CurrentEvaluationDepth++; gfunc->busy++; PushProcParameters(theEnv,params,CountArguments(params), DefgenericName(gfunc), "generic function",UnboundMethodErr); if (EvaluationData(theEnv)->EvaluationError) { gfunc->busy--; DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; GCBlockEndUDF(theEnv,&gcb,returnValue); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); return; } if (meth != NULL) { if (IsMethodApplicable(theEnv,meth)) { meth->busy++; DefgenericData(theEnv)->CurrentMethod = meth; } else { PrintErrorID(theEnv,"GENRCEXE",4,false); SetEvaluationError(theEnv,true); DefgenericData(theEnv)->CurrentMethod = NULL; WriteString(theEnv,STDERR,"Generic function '"); WriteString(theEnv,STDERR,DefgenericName(gfunc)); WriteString(theEnv,STDERR,"' method #"); PrintUnsignedInteger(theEnv,STDERR,meth->index); WriteString(theEnv,STDERR," is not applicable to the given arguments.\n"); } } else DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth); if (DefgenericData(theEnv)->CurrentMethod != NULL) { #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,BEGIN_TRACE); if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,BEGIN_TRACE); #endif if (DefgenericData(theEnv)->CurrentMethod->system) { Expression fcall; fcall.type = FCALL; fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value; fcall.nextArg = NULL; fcall.argList = GetProcParamExpressions(theEnv); EvaluateExpression(theEnv,&fcall,returnValue); } else { #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &DefgenericData(theEnv)->CurrentMethod->header.usrData, ProfileFunctionData(theEnv)->ProfileConstructs); #endif EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule, DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount, returnValue,UnboundMethodErr); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif } DefgenericData(theEnv)->CurrentMethod->busy--; #if DEBUGGING_FUNCTIONS if (DefgenericData(theEnv)->CurrentMethod->trace) WatchMethod(theEnv,END_TRACE); if (DefgenericData(theEnv)->CurrentGeneric->trace) WatchGeneric(theEnv,END_TRACE); #endif } else if (! EvaluationData(theEnv)->EvaluationError) { PrintErrorID(theEnv,"GENRCEXE",1,false); WriteString(theEnv,STDERR,"No applicable methods for '"); WriteString(theEnv,STDERR,DefgenericName(gfunc)); WriteString(theEnv,STDERR,"'.\n"); SetEvaluationError(theEnv,true); } gfunc->busy--; ProcedureFunctionData(theEnv)->ReturnFlag = false; PopProcParameters(theEnv); DefgenericData(theEnv)->CurrentGeneric = previousGeneric; DefgenericData(theEnv)->CurrentMethod = previousMethod; EvaluationData(theEnv)->CurrentEvaluationDepth--; GCBlockEndUDF(theEnv,&gcb,returnValue); CallPeriodicTasks(theEnv); SetExecutingConstruct(theEnv,oldce); }
globle void StoreInMultifield( void *theEnv, DATA_OBJECT *returnValue, EXPRESSION *expptr, int garbageSegment) { DATA_OBJECT val_ptr; DATA_OBJECT *val_arr; struct multifield *theMultifield; struct multifield *orig_ptr; long start, end, i,j, k, argCount; unsigned long seg_size; argCount = CountArguments(expptr); /*=========================================*/ /* If no arguments are given return a NULL */ /* multifield of length zero. */ /*=========================================*/ if (argCount == 0) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L); SetpValue(returnValue,(void *) theMultifield); return; } else { /*========================================*/ /* Get a new segment with length equal to */ /* the total length of all the arguments. */ /*========================================*/ val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount); seg_size = 0; for (i = 1; i <= argCount; i++, expptr = expptr->nextArg) { EvaluateExpression(theEnv,expptr,&val_ptr); if (EvaluationData(theEnv)->EvaluationError) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); if (garbageSegment) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); } else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L); SetpValue(returnValue,(void *) theMultifield); rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount); return; } SetpType(val_arr+i-1,GetType(val_ptr)); if (GetType(val_ptr) == MULTIFIELD) { SetpValue(val_arr+i-1,GetpValue(&val_ptr)); start = GetDOBegin(val_ptr); end = GetDOEnd(val_ptr); } else if (GetType(val_ptr) == RVOID) { SetpValue(val_arr+i-1,GetValue(val_ptr)); start = 1; end = 0; } else { SetpValue(val_arr+i-1,GetValue(val_ptr)); start = end = -1; } seg_size += (unsigned long) (end - start + 1); SetpDOBegin(val_arr+i-1,start); SetpDOEnd(val_arr+i-1,end); } if (garbageSegment) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); } else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size); /*========================================*/ /* Copy each argument into new segment. */ /*========================================*/ for (k = 0, j = 1; k < argCount; k++) { if (GetpType(val_arr+k) == MULTIFIELD) { start = GetpDOBegin(val_arr+k); end = GetpDOEnd(val_arr+k); orig_ptr = (struct multifield *) GetpValue(val_arr+k); for (i = start; i < end + 1; i++, j++) { SetMFType(theMultifield,j,(GetMFType(orig_ptr,i))); SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i))); } } else if (GetpType(val_arr+k) != RVOID) { SetMFType(theMultifield,j,(short) (GetpType(val_arr+k))); SetMFValue(theMultifield,j,(GetpValue(val_arr+k))); j++; } } /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) seg_size); SetpValue(returnValue,(void *) theMultifield); rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount); return; } }
static PAL_Boolean _AddEvents( _In_ FILE * out, _In_ OIEvent * events) { char buf[BUFFER_SIZE]; OIEvent * current = events; while(current) { OIEvent * next = current->next; OIArgument * arg; int ArgCount = CountArguments(current->Argument); int wrote; { int i = 0; char plist1[BUFFER_SIZE]; char plist2[BUFFER_SIZE]; plist1[0] = 0; plist2[0] = 0; arg = current->Argument; while(arg) { char param1[BUFFER_SIZE]; char param2[BUFFER_SIZE]; const char * argType = arg->Type; char * formatString1 = "a%d"; char * formatString2 = formatString1; param1[0] = 0; param2[0] = 0; if (_isTStringType(argType)) { formatString2 = "tcs(a%d)"; } else if (__isStringType(argType)) { formatString2 = "scs(a%d)"; } #if defined(CONFIG_OS_WINDOWS) wrote = sprintf_s(param1, BUFFER_SIZE, formatString1, i); wrote = sprintf_s(param2, BUFFER_SIZE, formatString2, i); #else wrote = sprintf(param1, formatString1, i); wrote = sprintf(param2, formatString2, i); #endif if (wrote >= BUFFER_SIZE) goto error; if (Strcat(plist1, BUFFER_SIZE, param1) == 0) goto error; if (Strcat(plist2, BUFFER_SIZE, param2) == 0) goto error; // add a comma if this is NOT the last argument arg = arg->next; i++; if (arg) { if (Strcat(plist1, BUFFER_SIZE, ", ") == 0) goto error; if (Strcat(plist2, BUFFER_SIZE, ", ") == 0) goto error; } } buf[0] = 0; #if defined(CONFIG_OS_WINDOWS) wrote = sprintf_s(buf, BUFFER_SIZE, (ArgCount == 0)? FILECALLIMPL0 : FILECALLIMPLN, #else wrote = sprintf(buf, (ArgCount == 0)? FILECALLIMPL0 : FILECALLIMPLN, #endif current->Name, plist1, current->Name, plist2, current->Name, plist1, current->Name, plist2); fprintf(out, "%s", buf); } buf[0] = 0; #if defined(CONFIG_OS_WINDOWS) wrote = sprintf_s(buf, BUFFER_SIZE, UseDebugMacro(current->Priority) ? FILEEVENTD : FILEEVENT, ArgCount); #else wrote = sprintf(buf, UseDebugMacro(current->Priority) ? FILEEVENTD : FILEEVENT, ArgCount ); #endif if (wrote >= BUFFER_SIZE) goto error; if (Strcat(buf, BUFFER_SIZE, current->EventId) == 0) goto error; if (Strcat(buf, BUFFER_SIZE, ", ") == 0) goto error; if (Strcat(buf, BUFFER_SIZE, current->Name) == 0) goto error; if (Strcat(buf, BUFFER_SIZE, "_Impl") == 0) goto error; if (Strcat(buf, BUFFER_SIZE, ", ") == 0) goto error; if (Strcat(buf, BUFFER_SIZE, current->Priority) == 0) goto error; if (Strcat(buf, BUFFER_SIZE, ", PAL_T(") == 0) goto error; if (Strcat(buf, BUFFER_SIZE, current->Format) == 0) goto error; if (Strcat(buf, BUFFER_SIZE, ")") == 0) goto error; arg = current->Argument; while(arg) { OIArgument * next = arg->next; if (Strcat(buf, BUFFER_SIZE, ", ") == 0) goto error; if (Strcat(buf, BUFFER_SIZE, arg->Type) == 0) goto error; arg = next; } if (Strcat(buf, BUFFER_SIZE, ")") == 0) goto error; /* buf may contain %d which we need to preserve */ fprintf(out, "%s", buf); fprintf(out, NL); current = next; } return PAL_TRUE; error: OIERROR1("Out of buffer space while generating! Buffer so far was [%s]", buf); return PAL_FALSE; }
/***************************************************** NAME : PerformMessage DESCRIPTION : Calls core framework for a message INPUTS : 1) Caller's result buffer 2) Message argument expressions (including implicit object) 3) Message name RETURNS : Nothing useful SIDE EFFECTS : Any side-effects of message execution and caller's result buffer set NOTES : None *****************************************************/ static void PerformMessage( DATA_OBJECT *result, EXPRESSION *args, SYMBOL_HN *mname) { int oldce; HANDLER_LINK *oldCore; DEFCLASS *cls = NULL; INSTANCE_TYPE *ins = NULL; SYMBOL_HN *oldName; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif result->type = SYMBOL; result->value = FalseSymbol; EvaluationError = FALSE; if (HaltExecution) return; oldce = ExecutingConstruct(); SetExecutingConstruct(TRUE); oldName = CurrentMessageName; CurrentMessageName = mname; CurrentEvaluationDepth++; PushProcParameters(args,CountArguments(args), ValueToString(CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationError) { CurrentEvaluationDepth--; CurrentMessageName = oldName; PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); return; } if (ProcParamArray->type == INSTANCE_ADDRESS) { ins = (INSTANCE_TYPE *) ProcParamArray->value; if (ins->garbage == 1) { StaleInstanceAddress("send",0); SetEvaluationError(TRUE); } else if (DefclassInScope(ins->cls,(struct defmodule *) GetCurrentModule()) == FALSE) NoInstanceError(ValueToString(ins->name),"send"); else { cls = ins->cls; ins->busy++; } } else if (ProcParamArray->type == INSTANCE_NAME) { ins = FindInstanceBySymbol((SYMBOL_HN *) ProcParamArray->value); if (ins == NULL) { PrintErrorID("MSGPASS",2,FALSE); PrintRouter(WERROR,"No such instance "); PrintRouter(WERROR,ValueToString((SYMBOL_HN *) ProcParamArray->value)); PrintRouter(WERROR," in function send.\n"); SetEvaluationError(TRUE); } else { ProcParamArray->value = (void *) ins; ProcParamArray->type = INSTANCE_ADDRESS; cls = ins->cls; ins->busy++; } } else if ((cls = PrimitiveClassMap[ProcParamArray->type]) == NULL) { SystemError("MSGPASS",1); ExitRouter(EXIT_FAILURE); } if (EvaluationError) { PopProcParameters(); CurrentEvaluationDepth--; CurrentMessageName = oldName; PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); return; } oldCore = TopOfCore; TopOfCore = FindApplicableHandlers(cls,mname); if (TopOfCore != NULL) { HANDLER_LINK *oldCurrent,*oldNext; oldCurrent = CurrentCore; oldNext = NextInCore; #if IMPERATIVE_MESSAGE_HANDLERS if (TopOfCore->hnd->type == MAROUND) { CurrentCore = TopOfCore; NextInCore = TopOfCore->nxt; #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,BEGIN_TRACE); if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); if (WatchMessages) WatchMessage(WTRACE,END_TRACE); #endif } else #endif /* IMPERATIVE_MESSAGE_HANDLERS */ { CurrentCore = NULL; NextInCore = TopOfCore; #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,BEGIN_TRACE); #endif CallHandlers(result); #if DEBUGGING_FUNCTIONS if (WatchMessages) WatchMessage(WTRACE,END_TRACE); #endif } DestroyHandlerLinks(TopOfCore); CurrentCore = oldCurrent; NextInCore = oldNext; } TopOfCore = oldCore; ReturnFlag = FALSE; if (ins != NULL) ins->busy--; /* ================================== Restore the original calling frame ================================== */ PopProcParameters(); CurrentEvaluationDepth--; CurrentMessageName = oldName; PropagateReturnValue(result); PeriodicCleanup(FALSE,TRUE); SetExecutingConstruct(oldce); if (EvaluationError) { result->type = SYMBOL; result->value = FalseSymbol; } }
/******************************************************** NAME : CallNextHandler DESCRIPTION : This function allows around-handlers to execute the rest of the core frame. It also allows primary handlers to execute shadowed primaries. The original handler arguments are left intact. INPUTS : The caller's result-value buffer RETURNS : Nothing useful SIDE EFFECTS : The core frame is called and any appropriate changes are made when used in an around handler See CallHandlers() But when call-next-handler is called from a primary, the same shadowed primary is called over and over again for repeated calls to call-next-handler. NOTES : H/L Syntax: (call-next-handler) OR (override-next-handler <arg> ...) ********************************************************/ globle void CallNextHandler( DATA_OBJECT *result) { EXPRESSION args; int overridep; HANDLER_LINK *oldNext,*oldCurrent; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif SetpType(result,SYMBOL); SetpValue(result,FalseSymbol); EvaluationError = FALSE; if (HaltExecution) return; if (NextHandlerAvailable() == FALSE) { PrintErrorID("MSGPASS",1,FALSE); PrintRouter(WERROR,"Shadowed message-handlers not applicable in current context.\n"); SetEvaluationError(TRUE); return; } if (CurrentExpression->value == (void *) FindFunction("override-next-handler")) { overridep = 1; args.type = (short) ProcParamArray[0].type; if (args.type != MULTIFIELD) args.value = (void *) ProcParamArray[0].value; else args.value = (void *) &ProcParamArray[0]; args.nextArg = GetFirstArgument(); args.argList = NULL; PushProcParameters(&args,CountArguments(&args), ValueToString(CurrentMessageName),"message", UnboundHandlerErr); if (EvaluationError) { ReturnFlag = FALSE; return; } } else overridep = 0; oldNext = NextInCore; oldCurrent = CurrentCore; if (CurrentCore->hnd->type == MAROUND) { if (NextInCore->hnd->type == MAROUND) { CurrentCore = NextInCore; NextInCore = NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); #endif } else CallHandlers(result); } else { CurrentCore = NextInCore; NextInCore = NextInCore->nxt; #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE); #endif if (CheckHandlerArgCount()) { #if PROFILING_FUNCTIONS StartProfile(&profileFrame, &CurrentCore->hnd->usrData, ProfileConstructs); #endif EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule, CurrentCore->hnd->actions, CurrentCore->hnd->localVarCount, result,UnboundHandlerErr); #if PROFILING_FUNCTIONS EndProfile(&profileFrame); #endif } #if DEBUGGING_FUNCTIONS if (CurrentCore->hnd->trace) WatchHandler(WTRACE,CurrentCore,END_TRACE); #endif } NextInCore = oldNext; CurrentCore = oldCurrent; if (overridep) PopProcParameters(); ReturnFlag = FALSE; }
globle int CheckExpressionAgainstRestrictions( void *theEnv, struct expr *theExpression, char *restrictions, char *functionName) { char theChar[2]; int i = 0, j = 1; int number1, number2; int argCount; char defaultRestriction, argRestriction; struct expr *argPtr; int theRestriction; theChar[0] = '0'; theChar[1] = '\0'; /*============================================*/ /* If there are no restrictions, then there's */ /* no need to check the function. */ /*============================================*/ if (restrictions == NULL) return(FALSE); /*=========================================*/ /* Count the number of function arguments. */ /*=========================================*/ argCount = CountArguments(theExpression->argList); /*======================================*/ /* Get the minimum number of arguments. */ /*======================================*/ theChar[0] = restrictions[i++]; if (isdigit(theChar[0])) { number1 = atoi(theChar); } else if (theChar[0] == '*') { number1 = -1; } else { return(FALSE); } /*======================================*/ /* Get the maximum number of arguments. */ /*======================================*/ theChar[0] = restrictions[i++]; if (isdigit(theChar[0])) { number2 = atoi(theChar); } else if (theChar[0] == '*') { number2 = 10000; } else { return(FALSE); } /*============================================*/ /* Check for the correct number of arguments. */ /*============================================*/ if (number1 == number2) { if (argCount != number1) { ExpectedCountError(theEnv,functionName,EXACTLY,number1); return(TRUE); } } else if (argCount < number1) { ExpectedCountError(theEnv,functionName,AT_LEAST,number1); return(TRUE); } else if (argCount > number2) { ExpectedCountError(theEnv,functionName,NO_MORE_THAN,number2); return(TRUE); } /*=======================================*/ /* Check for the default argument types. */ /*=======================================*/ defaultRestriction = restrictions[i]; if (defaultRestriction == '\0') { defaultRestriction = 'u'; } else if (defaultRestriction == '*') { defaultRestriction = 'u'; i++; } else { i++; } /*======================*/ /* Check each argument. */ /*======================*/ for (argPtr = theExpression->argList; argPtr != NULL; argPtr = argPtr->nextArg) { argRestriction = restrictions[i]; if (argRestriction == '\0') { argRestriction = defaultRestriction; } else { i++; } if (argRestriction != '*') { theRestriction = (int) argRestriction; } else { theRestriction = (int) defaultRestriction; } if (CheckArgumentAgainstRestriction(theEnv,argPtr,theRestriction)) { ExpectedTypeError1(theEnv,functionName,j,GetArgumentTypeName(theRestriction)); return(TRUE); } j++; } return(FALSE); }
globle struct expr *Function2Parse( void *theEnv, char *logicalName, char *name) { struct FunctionDefinition *theFunction; struct expr *top; #if DEFGENERIC_CONSTRUCT void *gfunc; #endif #if DEFFUNCTION_CONSTRUCT void *dptr; #endif /*=========================================================*/ /* Module specification cannot be used in a function call. */ /*=========================================================*/ if (FindModuleSeparator(name)) { IllegalModuleSpecifierMessage(theEnv); return(NULL); } /*================================*/ /* Has the function been defined? */ /*================================*/ theFunction = FindFunction(theEnv,name); #if DEFGENERIC_CONSTRUCT gfunc = (void *) LookupDefgenericInScope(theEnv,name); #endif #if DEFFUNCTION_CONSTRUCT if ((theFunction == NULL) #if DEFGENERIC_CONSTRUCT && (gfunc == NULL) #endif ) dptr = (void *) LookupDeffunctionInScope(theEnv,name); else dptr = NULL; #endif /*=============================*/ /* Define top level structure. */ /*=============================*/ #if DEFFUNCTION_CONSTRUCT if (dptr != NULL) top = GenConstant(theEnv,PCALL,dptr); else #endif #if DEFGENERIC_CONSTRUCT if (gfunc != NULL) top = GenConstant(theEnv,GCALL,gfunc); else #endif if (theFunction != NULL) top = GenConstant(theEnv,FCALL,theFunction); else { PrintErrorID(theEnv,"EXPRNPSR",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Missing function declaration for "); EnvPrintRouter(theEnv,WERROR,name); EnvPrintRouter(theEnv,WERROR,".\n"); return(NULL); } /*=======================================================*/ /* Check to see if function has its own parsing routine. */ /*=======================================================*/ PushRtnBrkContexts(theEnv); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; #if DEFGENERIC_CONSTRUCT || DEFFUNCTION_CONSTRUCT if (top->type == FCALL) #endif { if (theFunction->parser != NULL) { top = (*theFunction->parser)(theEnv,top,logicalName); PopRtnBrkContexts(theEnv); if (top == NULL) return(NULL); if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } return(top); } } /*========================================*/ /* Default parsing routine for functions. */ /*========================================*/ top = CollectArguments(theEnv,top,logicalName); PopRtnBrkContexts(theEnv); if (top == NULL) return(NULL); if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,"(expansion-call)"), FindFunction(theEnv,"expand$"))) { ReturnExpression(theEnv,top); return(NULL); } /*============================================================*/ /* If the function call uses the sequence expansion operator, */ /* its arguments cannot be checked until runtime. */ /*============================================================*/ if (top->value == (void *) FindFunction(theEnv,"(expansion-call)")) { return(top); } /*============================*/ /* Check for argument errors. */ /*============================*/ if ((top->type == FCALL) && EnvGetStaticConstraintChecking(theEnv)) { if (CheckExpressionAgainstRestrictions(theEnv,top,theFunction->restrictions,name)) { ReturnExpression(theEnv,top); return(NULL); } } #if DEFFUNCTION_CONSTRUCT else if (top->type == PCALL) { if (CheckDeffunctionCall(theEnv,top->value,CountArguments(top->argList)) == FALSE) { ReturnExpression(theEnv,top); return(NULL); } } #endif /*========================*/ /* Return the expression. */ /*========================*/ return(top); }
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); }
/**************************************************** 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); }