/*
================
idProgram::CompileFunction
================
*/
const function_t *idProgram::CompileFunction( const char *functionName, const char *text ) {
bool result;
result = CompileText( functionName, text, false );
if ( g_disasm.GetBool() ) {
Disassemble();
}
if ( !result ) {
gameLocal.Error( "Compile failed." );
}
return FindFunction( functionName );
}
int GetFunction(ScriptValue *s, ScriptValue *o, ObjectValue *&obj) {
int function;
if (o->type != SCRIPT_OBJECT) {
function = FindFunction(s->stringVal->value);
obj = 0;
}
else {
obj = o->objectVal;
function = types[obj->type].FindFunction(s->stringVal);
if (function < 0) return function;
function = types[obj->type].functs[function].functionID;
obj->AddRef();
}
return function;
}
globle void ExpectedTypeError2(
void *theEnv,
char *functionName,
int whichArg)
{
struct FunctionDefinition *theFunction;
char *theType;
theFunction = FindFunction(theEnv,functionName);
if (theFunction == NULL) return;
theType = GetArgumentTypeName(GetNthRestriction(theFunction,whichArg));
ExpectedTypeError1(theEnv,functionName,whichArg,theType);
}
globle int RemoveFunctionParser(
char *functionName)
{
struct FunctionDefinition *fdPtr;
fdPtr = FindFunction(functionName);
if (fdPtr == NULL)
{
PrintRouter(WERROR,"Function parsers can only be removed from existing functions.\n");
return(0);
}
fdPtr->parser = NULL;
return(1);
}
/********************************************************
NAME : AddImplicitMethods
DESCRIPTION : Adds a method(s) for a generic function
for an overloaded system function
INPUTS : A pointer to a gneeric function
RETURNS : Nothing useful
SIDE EFFECTS : Method added
NOTES : Method marked as system
Assumes no other methods already present
********************************************************/
globle void AddImplicitMethods(
void *theEnv,
DEFGENERIC *gfunc)
{
struct FunctionDefinition *sysfunc;
EXPRESSION action;
sysfunc = FindFunction(theEnv,ValueToString(gfunc->header.name));
if (sysfunc == NULL)
return;
action.type = FCALL;
action.value = (void *) sysfunc;
action.nextArg = NULL;
action.argList = NULL;
FormMethodsFromRestrictions(theEnv,gfunc,sysfunc->restrictions,&action);
}
void FunctionTable::UpdateBuiltinFunction(const string & name, void * newInitFunction)
{
//Find the function
int funcIndex = FindFunction(name);
//Assign the function pointer
if(funcIndex != -1)
{
functionTable[funcIndex].origionalInternalPtr = newInitFunction;
}
else
{
LOGERR(("UpdateBuiltinFunction - Unknown built-in function? %s", name.c_str()));
}
}
//---------------------------------------------------------------------------
void AddFunction(AnsiString func_name, void *DELEGATE, JSContext *ctx = 0, JSObject *obj = 0) {
FunctionTypes *ft = FindFunction(func_name, ctx, obj);
bool created = false;
if (!ft) {
ft = new FunctionTypes;
created = true;
}
ft->func_name = func_name;
ft->DELEGATE = DELEGATE;
ft->ctx = ctx;
ft->obj = obj;
if (created) {
functions.push_back(ft);
}
}
void ExpectedTypeError2(
Environment *theEnv,
const char *functionName,
unsigned int whichArg)
{
unsigned theRestriction;
struct functionDefinition *theFunction;
theFunction = FindFunction(theEnv,functionName);
if (theFunction == NULL) return;
theRestriction = GetNthRestriction(theEnv,theFunction,whichArg);
ExpectedTypeError0(theEnv,functionName,whichArg);
PrintTypesString(theEnv,STDERR,theRestriction,true);
}
int RemoveFunctionParser(
void *theEnv,
const char *functionName)
{
struct FunctionDefinition *fdPtr;
fdPtr = FindFunction(theEnv,functionName);
if (fdPtr == NULL)
{
EnvPrintRouter(theEnv,WERROR,"Function parsers can only be removed from existing functions.\n");
return(0);
}
fdPtr->parser = NULL;
return(1);
}
HRESULT StackFrame::GetLanguageName( BSTR* langName )
{
_ASSERT( langName != NULL );
HRESULT hr = S_OK;
hr = FindFunction();
if ( FAILED( hr ) )
return hr;
// if a function was found for our address, then it has a language
// we'll assume it's D for now
*langName = SysAllocString( L"D" );
if ( *langName == NULL )
return E_OUTOFMEMORY;
return S_OK;
}
globle int FuncSeqOvlFlags(
char *functionName,
int seqp,
int ovlp)
{
struct FunctionDefinition *fdPtr;
fdPtr = FindFunction(functionName);
if (fdPtr == NULL)
{
PrintRouter(WERROR,"Only existing functions can be marked as using sequence expansion arguments/overloadable or not.\n");
return(FALSE);
}
fdPtr->sequenceuseok = (short) (seqp ? TRUE : FALSE);
fdPtr->overloadable = (short) (ovlp ? TRUE : FALSE);
return(TRUE);
}
globle struct expr *FunctionReferenceExpression(
void *theEnv,
const char *name)
{
#if DEFGENERIC_CONSTRUCT
void *gfunc;
#endif
#if DEFFUNCTION_CONSTRUCT
void *dptr;
#endif
struct FunctionDefinition *fptr;
/*=====================================================*/
/* Check to see if the function call is a deffunction. */
/*=====================================================*/
#if DEFFUNCTION_CONSTRUCT
if ((dptr = (void *) LookupDeffunctionInScope(theEnv,name)) != NULL)
{ return(GenConstant(theEnv,PCALL,dptr)); }
#endif
/*====================================================*/
/* Check to see if the function call is a defgeneric. */
/*====================================================*/
#if DEFGENERIC_CONSTRUCT
if ((gfunc = (void *) LookupDefgenericInScope(theEnv,name)) != NULL)
{ return(GenConstant(theEnv,GCALL,gfunc)); }
#endif
/*======================================*/
/* Check to see if the function call is */
/* a system or user defined function. */
/*======================================*/
if ((fptr = FindFunction(theEnv,name)) != NULL)
{ return(GenConstant(theEnv,FCALL,fptr)); }
/*===================================================*/
/* The specified function name is not a deffunction, */
/* defgeneric, or user/system defined function. */
/*===================================================*/
return(NULL);
}
bool FuncSeqOvlFlags(
void *theEnv,
const char *functionName,
bool seqp,
bool ovlp)
{
struct FunctionDefinition *fdPtr;
fdPtr = FindFunction(theEnv,functionName);
if (fdPtr == NULL)
{
EnvPrintRouter(theEnv,WERROR,"Only existing functions can be marked as using sequence expansion arguments/overloadable or not.\n");
return(false);
}
fdPtr->sequenceuseok = (short) (seqp ? true : false);
fdPtr->overloadable = (short) (ovlp ? true : false);
return(true);
}
globle int AddFunctionParser(
char *functionName,
struct expr *(*fpPtr)(struct expr *,char *))
{
struct FunctionDefinition *fdPtr;
fdPtr = FindFunction(functionName);
if (fdPtr == NULL)
{
PrintRouter(WERROR,"Function parsers can only be added for existing functions.\n");
return(0);
}
fdPtr->restrictions = NULL;
fdPtr->parser = fpPtr;
fdPtr->overloadable = FALSE;
return(1);
}
/********************************************************************
NAME : GetFunctionRestrictions
DESCRIPTION : Gets DefineFunction2() restriction list for function
INPUTS : None
RETURNS : A string containing the function restriction codes
SIDE EFFECTS : EvaluationError set on errors
NOTES : None
********************************************************************/
globle void *GetFunctionRestrictions(
void *theEnv)
{
DATA_OBJECT temp;
struct FunctionDefinition *fptr;
if (EnvArgTypeCheck(theEnv,"get-function-restrictions",1,SYMBOL,&temp) == FALSE)
return((SYMBOL_HN *) EnvAddSymbol(theEnv,""));
fptr = FindFunction(theEnv,DOToString(temp));
if (fptr == NULL)
{
CantFindItemErrorMessage(theEnv,"function",DOToString(temp));
SetEvaluationError(theEnv,TRUE);
return((SYMBOL_HN *) EnvAddSymbol(theEnv,""));
}
if (fptr->restrictions == NULL)
return((SYMBOL_HN *) EnvAddSymbol(theEnv,"0**"));
return((SYMBOL_HN *) EnvAddSymbol(theEnv,fptr->restrictions));
}
int AddFunctionParser(
void *theEnv,
const char *functionName,
struct expr *(*fpPtr)(void *,struct expr *,const char *))
{
struct FunctionDefinition *fdPtr;
fdPtr = FindFunction(theEnv,functionName);
if (fdPtr == NULL)
{
EnvPrintRouter(theEnv,WERROR,"Function parsers can only be added for existing functions.\n");
return(0);
}
fdPtr->restrictions = NULL;
fdPtr->parser = fpPtr;
fdPtr->overloadable = false;
return(1);
}
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
}
void FKCHandler_CallDelegate::Compile(FKismetFunctionContext& Context, UEdGraphNode* Node)
{
check(Node);
const UEdGraphSchema_K2* K2Schema = GetDefault<UEdGraphSchema_K2>();
const UFunction* SignatureFunction = FindFunction(Context, Node);
if(!SignatureFunction)
{
CompilerContext.MessageLog.Error(*LOCTEXT("CallDelegateNoSignature_Error", "Cannot find signature function for @@").ToString(), Node);
return;
}
if(SignatureFunction->HasMetaData(FBlueprintMetadata::MD_DefaultToSelf))
{
CompilerContext.MessageLog.Error(
*FString::Printf(
*LOCTEXT("CallDelegateWrongMeta_Error", "Signature function should not have %s metadata. @@").ToString(),
*FBlueprintMetadata::MD_DefaultToSelf.ToString()),
Node);
return;
}
if(SignatureFunction->HasMetaData(FBlueprintMetadata::MD_WorldContext))
{
CompilerContext.MessageLog.Error(
*FString::Printf(
*LOCTEXT("CallDelegateWrongMeta_Error", "Signature function should not have %s metadata. @@").ToString(),
*FBlueprintMetadata::MD_WorldContext.ToString()),
Node);
return;
}
if(SignatureFunction->HasMetaData(FBlueprintMetadata::MD_AutoCreateRefTerm))
{
CompilerContext.MessageLog.Error(
*FString::Printf(
*LOCTEXT("CallDelegateWrongMeta_Error", "Signature function should not have %s metadata. @@").ToString(),
*FBlueprintMetadata::MD_AutoCreateRefTerm.ToString()),
Node);
return;
}
FKCHandler_CallFunction::Compile(Context, Node);
}
/********************************************************
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);
}
Rlist *NewExpArgs(const FnCall *fp, const Promise *pp)
{
int len;
Rval rval;
Rlist *newargs = NULL;
FnCall *subfp;
const FnCallType *fn = FindFunction(fp->name);
len = RlistLen(fp->args);
if (!fn->varargs)
{
if (len != FnNumArgs(fn))
{
CfOut(cf_error, "", "Arguments to function %s(.) do not tally. Expect %d not %d",
fp->name, FnNumArgs(fn), len);
PromiseRef(cf_error, pp);
exit(1);
}
}
for (const Rlist *rp = fp->args; rp != NULL; rp = rp->next)
{
switch (rp->type)
{
case CF_FNCALL:
subfp = (FnCall *) rp->item;
rval = EvaluateFunctionCall(subfp, pp).rval;
break;
default:
rval = ExpandPrivateRval(CONTEXTID, (Rval) {rp->item, rp->type});
break;
}
CfDebug("EXPARG: %s.%s\n", CONTEXTID, (char *) rval.item);
AppendRlist(&newargs, rval.item, rval.rtype);
DeleteRvalItem(rval);
}
return newargs;
}
int IsBuiltinFnCall(Rval rval)
{
FnCall *fp;
if (rval.rtype != CF_FNCALL)
{
return false;
}
fp = (FnCall *) rval.item;
if (FindFunction(fp->name))
{
CfDebug("%s is a builtin function\n", fp->name);
return true;
}
else
{
return false;
}
}
/******************************************************************************
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;
}
globle struct expr *ConvertValueToExpression(
DATA_OBJECT *theValue)
{
long i;
struct expr *head = NULL, *last = NULL, *newItem;
if (GetpType(theValue) != MULTIFIELD)
{ return(GenConstant(GetpType(theValue),GetpValue(theValue))); }
for (i = GetpDOBegin(theValue); i <= GetpDOEnd(theValue); i++)
{
newItem = GenConstant(GetMFType(GetpValue(theValue),i),
GetMFValue(GetpValue(theValue),i));
if (last == NULL) head = newItem;
else last->nextArg = newItem;
last = newItem;
}
if (head == NULL)
return(GenConstant(FCALL,(void *) FindFunction("create$")));
return(head);
}
enum cfdatatype FunctionReturnType(const char *name)
{
const FnCallType *fn = FindFunction(name);
return fn ? fn->dtype : cf_notype;
}
globle struct expr *BuildRHSAssert(
char *logicalName,
struct token *theToken,
int *error,
int atLeastOne,
int readFirstParen,
char *whereParsed)
{
struct expr *lastOne, *nextOne, *assertList, *stub;
*error = FALSE;
/*===============================================================*/
/* If the first parenthesis of the RHS fact pattern has not been */
/* read yet, then get the next token. If a right parenthesis is */
/* encountered then exit (however, set the error return value if */
/* at least one fact was expected). */
/*===============================================================*/
if (readFirstParen == FALSE)
{
if (theToken->type == RPAREN)
{
if (atLeastOne)
{
*error = TRUE;
SyntaxErrorMessage(whereParsed);
}
return(NULL);
}
}
/*================================================*/
/* Parse the facts until no more are encountered. */
/*================================================*/
lastOne = assertList = NULL;
while ((nextOne = GetRHSPattern(logicalName,theToken,
error,FALSE,readFirstParen,
TRUE,RPAREN)) != NULL)
{
PPCRAndIndent();
stub = GenConstant(FCALL,(void *) FindFunction("assert"));
stub->argList = nextOne;
nextOne = stub;
if (lastOne == NULL)
{ assertList = nextOne; }
else
{ lastOne->nextArg = nextOne; }
lastOne = nextOne;
readFirstParen = TRUE;
}
/*======================================================*/
/* If an error was detected while parsing, then return. */
/*======================================================*/
if (*error)
{
ReturnExpression(assertList);
return(NULL);
}
/*======================================*/
/* Fix the pretty print representation. */
/*======================================*/
if (theToken->type == RPAREN)
{
PPBackup();
PPBackup();
SavePPBuffer(")");
}
/*==============================================================*/
/* If no facts are being asserted then return NULL. In addition */
/* if at least one fact was required, then signal an error. */
/*==============================================================*/
if (assertList == NULL)
{
if (atLeastOne)
{
*error = TRUE;
SyntaxErrorMessage(whereParsed);
}
return(NULL);
}
/*===============================================*/
/* If more than one fact is being asserted, then */
/* wrap the assert commands within a progn call. */
/*===============================================*/
if (assertList->nextArg != NULL)
{
stub = GenConstant(FCALL,(void *) FindFunction("progn"));
stub->argList = assertList;
assertList = stub;
}
/*==========================================================*/
/* Return the expression for asserting the specified facts. */
/*==========================================================*/
return(assertList);
}
//
// Get the functions for the given PID/TID/MODULE
// If PID is -1, get functions from all the PIDs
// If TID is -1 get functions from all the PIDS
//
bool GetFunctionInfoList(CpuProfileReader& profileReader,
ProcessIdType pid,
ThreadIdType tid,
CpuProfileModule& module,
const gtString& moduleFilePath,
gtUInt64 flags, // ignore-system-modules, separate-by-core, etc
gtUInt64 coreMask,
FunctionInfoList& funcInfoList,
FunctionIdxMap& funcIdxMap)
{
GT_UNREFERENCED_PARAMETER(coreMask);
GT_UNREFERENCED_PARAMETER(moduleFilePath);
FunctionInfo funcInfo;
gtVector<gtUInt64> totalDataVector;
bool ignoreSysModule = ((flags & SAMPLE_IGNORE_SYSTEM_MODULES) == SAMPLE_IGNORE_SYSTEM_MODULES) ? true : false;
bool sepByCore = ((flags & SAMPLE_SEPARATE_BY_CORE) == SAMPLE_SEPARATE_BY_CORE) ? true : false;
bool groupByModule = ((flags & SAMPLE_GROUP_BY_MODULE) == SAMPLE_GROUP_BY_MODULE) ? true : false;
// TODO: - group by thread
bool groupByThread = ((flags & SAMPLE_GROUP_BY_THREAD) == SAMPLE_GROUP_BY_THREAD) ? true : false;
gtUInt32 numCores = profileReader.getProfileInfo()->m_numCpus;
gtUInt32 dataSize = (sepByCore) ? (numCores * profileReader.getProfileInfo()->m_numEvents)
: profileReader.getProfileInfo()->m_numEvents;
if (!ignoreSysModule || !module.isSystemModule())
{
// For each function
AddrFunctionMultMap::iterator fit = module.getBeginFunction();
AddrFunctionMultMap::iterator fEnd = module.getEndFunction();
for (; fit != fEnd; ++fit)
{
CpuProfileFunction& function = fit->second;
// For each sample
AptAggregatedSampleMap::const_iterator sit = function.getBeginSample();
AptAggregatedSampleMap::const_iterator sEnd = function.getEndSample();
gtString funcName;
CpuProfileFunction* pFunc = &function;
for (; sit != sEnd; ++sit)
{
const AptKey& aptKey = sit->first;
gtVAddr sampAddr = aptKey.m_addr;
bool rc = false;
ProcessIdType sampPid = (groupByModule) ? static_cast<ProcessIdType>(-1) : aptKey.m_pid;
ThreadIdType sampTid = (groupByThread) ? aptKey.m_tid : static_cast<ThreadIdType>(-1);
if (sampPid != pid)
{
continue;
}
if (sampTid != tid)
{
continue;
}
funcName.makeEmpty();
switch (module.m_modType)
{
// Normal PE module:
case CpuProfileModule::UNMANAGEDPE:
if (module.isUnchartedFunction(function))
{
sampAddr += module.getBaseAddr();
// Find the name of the function
rc = GetFunctionName(&module, sampAddr, funcName, &pFunc);
if (rc)
{
sampAddr = pFunc->getBaseAddr();
}
}
else
{
funcName = pFunc->getFuncName(); // FIXME, if the func name is empty ?
sampAddr = pFunc->getBaseAddr();
}
break;
case CpuProfileModule::JAVAMODULE:
case CpuProfileModule::MANAGEDPE:
// For now, Putting this specific check for Java/CLR
// At some point, need to re-structure this function to properly handle all module type
// For Java/CLR, func name/addr info is already present and just need to set in outer loop (for each func)
// Probably the better is to define separate functions for each module type like in old GUI code
sampAddr = function.getBaseAddr();
funcName = function.getFuncName();
break;
case CpuProfileModule::UNKNOWNMODULE:
case CpuProfileModule::UNKNOWNKERNELSAMPLES:
// TODO: Handle Unknown Kernel Samples and Unknown Module here
// Convert the "No symbol" to a wide char:
break;
default:
break;
}
// Find the function in the unique
FunctionInfo* pFuncInfo = &funcInfo;
bool isNewFunc = false;
// Check whether the new function is already there in the funcInfoList
pFuncInfo = FindFunction(funcInfoList, funcIdxMap, sampAddr, pid, tid);
if (nullptr == pFuncInfo)
{
pFuncInfo = &funcInfo;
funcInfo.m_baseAddress = sampAddr;
funcInfo.m_functionName = funcName;
funcInfo.m_pModule = &module;
funcInfo.m_dataVector.clear();
funcInfo.m_pid = pid;
funcInfo.m_tid = tid;
funcInfo.m_dataVector.resize(dataSize);
isNewFunc = true;
}
totalDataVector.resize(dataSize);
// Aggregate the samples..
// Get the EventToIndexMap - which is required to aggregate the samples
EventToIndexMap evtToIdxMap;
GetEventToIndexMap(profileReader, evtToIdxMap);
AggregateSamples(profileReader,
(*sit).second,
pFuncInfo->m_dataVector,
totalDataVector,
evtToIdxMap,
sepByCore);
if (isNewFunc)
{
funcInfoList.push_back(funcInfo);
funcIdxMap.insert({ sampAddr, funcInfoList.size() - 1 });
}
} // AptAggregatedSampleMap
} // AddrFunctionMultMap
}
return true;
}
/************************************************************
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);
}
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);
}
/****************************************************************************
NAME : ParseSimpleInstance
DESCRIPTION : Parses instances from file for load-instances
into an EXPRESSION forms that
can later be evaluated with EvaluateExpression(theEnv,)
INPUTS : 1) The address of the top node of the expression
containing the make-instance function call
2) The logical name of the input source
RETURNS : The address of the modified expression, or NULL
if there is an error
SIDE EFFECTS : The expression is enhanced to include all
aspects of the make-instance call
(slot-overrides etc.)
The "top" expression is deleted on errors.
NOTES : The name, class, values etc. must be constants.
This function parses a make-instance call into
an expression of the following form :
(make-instance <instance> of <class> <slot-override>*)
where <slot-override> ::= (<slot-name> <expression>+)
goes to -->
make-instance
|
V
<instance-name>-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
****************************************************************************/
globle EXPRESSION *ParseSimpleInstance(
void *theEnv,
EXPRESSION *top,
const char *readSource)
{
EXPRESSION *theExp,*vals = NULL,*vbot,*tval;
unsigned short type;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != INSTANCE_NAME) &&
(GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL))
goto MakeInstanceError;
if ((GetType(DefclassData(theEnv)->ObjectParseToken) == SYMBOL) &&
(strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) == 0))
{
top->argList = GenConstant(theEnv,FCALL,
(void *) FindFunction(theEnv,"gensym*"));
}
else
{
top->argList = GenConstant(theEnv,INSTANCE_NAME,
(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0))
goto MakeInstanceError;
}
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
goto MakeInstanceError;
top->argList->nextArg =
GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
theExp = top->argList->nextArg;
if (ReplaceClassNameWithReference(theEnv,theExp) == FALSE)
goto MakeInstanceError;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)
{
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
goto SlotOverrideError;
theExp->nextArg = GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
theExp->nextArg->nextArg = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv));
theExp = theExp->nextArg->nextArg;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
vbot = NULL;
while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
type = GetType(DefclassData(theEnv)->ObjectParseToken);
if (type == LPAREN)
{
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(ValueToString(DefclassData(theEnv)->ObjectParseToken.value),"create$") != 0))
goto SlotOverrideError;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
goto SlotOverrideError;
tval = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"));
}
else
{
if ((type != SYMBOL) && (type != STRING) &&
(type != FLOAT) && (type != INTEGER) && (type != INSTANCE_NAME))
goto SlotOverrideError;
tval = GenConstant(theEnv,type,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
}
if (vals == NULL)
vals = tval;
else
vbot->nextArg = tval;
vbot = tval;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
theExp->argList = vals;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
vals = NULL;
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
goto SlotOverrideError;
return(top);
MakeInstanceError:
SyntaxErrorMessage(theEnv,"make-instance");
SetEvaluationError(theEnv,TRUE);
ReturnExpression(theEnv,top);
return(NULL);
SlotOverrideError:
SyntaxErrorMessage(theEnv,"slot-override");
SetEvaluationError(theEnv,TRUE);
ReturnExpression(theEnv,top);
ReturnExpression(theEnv,vals);
return(NULL);
}
/*************************************************************************************
NAME : ParseInitializeInstance
DESCRIPTION : Parses initialize-instance and make-instance function
calls into an EXPRESSION form that
can later be evaluated with EvaluateExpression(theEnv,)
INPUTS : 1) The address of the top node of the expression
containing the initialize-instance function call
2) The logical name of the input source
RETURNS : The address of the modified expression, or NULL
if there is an error
SIDE EFFECTS : The expression is enhanced to include all
aspects of the initialize-instance call
(slot-overrides etc.)
The "top" expression is deleted on errors.
NOTES : This function parses a initialize-instance call into
an expression of the following form :
(initialize-instance <instance-name> <slot-override>*)
where <slot-override> ::= (<slot-name> <expression>+)
goes to -->
initialize-instance
|
V
<instance or name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(make-instance <instance> of <class> <slot-override>*)
goes to -->
make-instance
|
V
<instance-name>-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(make-instance of <class> <slot-override>*)
goes to -->
make-instance
|
V
(gensym*)-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(modify-instance <instance> <slot-override>*)
goes to -->
modify-instance
|
V
<instance or name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(duplicate-instance <instance> [to <new-name>] <slot-override>*)
goes to -->
duplicate-instance
|
V
<instance or name>-><new-name>-><slot-name>-><dummy-node>...
OR |
(gensym*) V
<value-expression>...
*************************************************************************************/
globle EXPRESSION *ParseInitializeInstance(
void *theEnv,
EXPRESSION *top,
const char *readSource)
{
int error,fcalltype,readclass;
if ((top->value == (void *) FindFunction(theEnv,"make-instance")) ||
(top->value == (void *) FindFunction(theEnv,"active-make-instance")))
fcalltype = MAKE_TYPE;
else if ((top->value == (void *) FindFunction(theEnv,"initialize-instance")) ||
(top->value == (void *) FindFunction(theEnv,"active-initialize-instance")))
fcalltype = INITIALIZE_TYPE;
else if ((top->value == (void *) FindFunction(theEnv,"modify-instance")) ||
(top->value == (void *) FindFunction(theEnv,"active-modify-instance")) ||
(top->value == (void *) FindFunction(theEnv,"message-modify-instance")) ||
(top->value == (void *) FindFunction(theEnv,"active-message-modify-instance")))
fcalltype = MODIFY_TYPE;
else
fcalltype = DUPLICATE_TYPE;
IncrementIndentDepth(theEnv,3);
error = FALSE;
if (top->type == UNKNOWN_VALUE)
top->type = FCALL;
else
SavePPBuffer(theEnv," ");
top->argList = ArgumentParse(theEnv,readSource,&error);
if (error)
goto ParseInitializeInstanceError;
else if (top->argList == NULL)
{
SyntaxErrorMessage(theEnv,"instance");
goto ParseInitializeInstanceError;
}
SavePPBuffer(theEnv," ");
if (fcalltype == MAKE_TYPE)
{
/* ======================================
Handle the case of anonymous instances
where the name was not specified
====================================== */
if ((top->argList->type != SYMBOL) ? FALSE :
(strcmp(ValueToString(top->argList->value),CLASS_RLN) == 0))
{
top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
if (error == TRUE)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage(theEnv,"instance class");
goto ParseInitializeInstanceError;
}
if ((top->argList->nextArg->type != SYMBOL) ? TRUE :
(strcmp(ValueToString(top->argList->nextArg->value),CLASS_RLN) != 0))
{
top->argList->type = FCALL;
top->argList->value = (void *) FindFunction(theEnv,"gensym*");
readclass = FALSE;
}
else
readclass = TRUE;
}
else
{
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0))
{
SyntaxErrorMessage(theEnv,"make-instance");
goto ParseInitializeInstanceError;
}
SavePPBuffer(theEnv," ");
readclass = TRUE;
}
if (readclass)
{
top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
if (error)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage(theEnv,"instance class");
goto ParseInitializeInstanceError;
}
}
/* ==============================================
If the class name is a constant, go ahead and
look it up now and replace it with the pointer
============================================== */
if (ReplaceClassNameWithReference(theEnv,top->argList->nextArg) == FALSE)
goto ParseInitializeInstanceError;
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
top->argList->nextArg->nextArg =
ParseSlotOverrides(theEnv,readSource,&error);
}
else
{
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (fcalltype == DUPLICATE_TYPE)
{
if ((DefclassData(theEnv)->ObjectParseToken.type != SYMBOL) ? FALSE :
(strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DUPLICATE_NAME_REF) == 0))
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
SavePPBuffer(theEnv," ");
top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
if (error)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage(theEnv,"instance name");
goto ParseInitializeInstanceError;
}
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
else
top->argList->nextArg = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"gensym*"));
top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error);
}
else
top->argList->nextArg = ParseSlotOverrides(theEnv,readSource,&error);
}
if (error)
goto ParseInitializeInstanceError;
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
SyntaxErrorMessage(theEnv,"slot-override");
goto ParseInitializeInstanceError;
}
DecrementIndentDepth(theEnv,3);
return(top);
ParseInitializeInstanceError:
SetEvaluationError(theEnv,TRUE);
ReturnExpression(theEnv,top);
DecrementIndentDepth(theEnv,3);
return(NULL);
}