SEXP attribute_hidden
do_getSymbolInfo(SEXP call, SEXP op, SEXP args, SEXP env)
{
const char *package = "", *name;
R_RegisteredNativeSymbol symbol = {R_ANY_SYM, {NULL}, NULL};
SEXP sym = R_NilValue;
DL_FUNC f = NULL;
checkArity(op, args);
SEXP sname = CAR(args), spackage = CADR(args),
withRegistrationInfo = CADDR(args);
name = translateChar(STRING_ELT(sname, 0));
if(length(spackage)) {
if(TYPEOF(spackage) == STRSXP)
package = translateChar(STRING_ELT(spackage, 0));
else if(TYPEOF(spackage) == EXTPTRSXP &&
R_ExternalPtrTag(spackage) == install("DLLInfo")) {
f = R_dlsym((DllInfo *) R_ExternalPtrAddr(spackage), name, &symbol);
package = NULL;
} else
error(_("must pass package name or DllInfo reference"));
}
if(package)
f = R_FindSymbol(name, package, &symbol);
if(f)
sym = createRSymbolObject(sname, f, &symbol,
LOGICAL(withRegistrationInfo)[0]);
return sym;
}
/*
This is the routine associated with the getNativeSymbolInfo()
function and it takes the name of a symbol and optionally an
object identifier (package usually) in which to restrict the search
for this symbol. It resolves the symbol and returns it to the caller
giving the symbol address, the package information (i.e. name and
fully qualified shared object name). If the symbol was explicitly
registered (rather than dynamically resolved by R), then we pass
back that information also, giving the number of arguments it
expects and the interface by which it should be called.
The returned object has class NativeSymbol. If the symbol was
registered, we add a class identifying the interface type
for which it is intended (i.e. .C(), .Call(), etc.)
*/
SEXP attribute_hidden
R_getSymbolInfo(SEXP sname, SEXP spackage, SEXP withRegistrationInfo)
{
const void *vmax = vmaxget();
const char *package, *name;
R_RegisteredNativeSymbol symbol = {R_ANY_SYM, {NULL}, NULL};
SEXP sym = R_NilValue;
DL_FUNC f = NULL;
package = "";
name = translateChar(STRING_ELT(sname, 0));
if(length(spackage)) {
if(TYPEOF(spackage) == STRSXP)
package = translateChar(STRING_ELT(spackage, 0));
else if(TYPEOF(spackage) == EXTPTRSXP &&
R_ExternalPtrTag(spackage) == install("DLLInfo")) {
f = R_dlsym((DllInfo *) R_ExternalPtrAddr(spackage), name, &symbol);
package = NULL;
} else
error(_("must pass package name or DllInfo reference"));
}
if(package)
f = R_FindSymbol(name, package, &symbol);
if(f)
sym = createRSymbolObject(sname, f, &symbol,
LOGICAL(withRegistrationInfo)[0]);
vmaxset(vmax);
return sym;
}
static Rboolean
R_callDLLUnload(DllInfo *dllInfo)
{
char buf[1024];
DllInfoUnloadCall f;
R_RegisteredNativeSymbol symbol;
symbol.type = R_ANY_SYM;
snprintf(buf, 1024, "R_unload_%s", dllInfo->name);
f = (DllInfoUnloadCall) R_dlsym(dllInfo, buf, &symbol);
if(f) f(dllInfo);
return(TRUE);
}
DL_FUNC R_FindSymbol(char const *name, char const *pkg,
R_RegisteredNativeSymbol *symbol)
{
DL_FUNC fcnptr = (DL_FUNC) NULL;
int i, all = (strlen(pkg) == 0), doit;
if(R_osDynSymbol->lookupCachedSymbol)
fcnptr = R_osDynSymbol->lookupCachedSymbol(name, pkg, all);
if(fcnptr) return(fcnptr);
/* The following is not legal ANSI C. */
/* It is only meant to be used in systems supporting */
/* the dlopen() interface, in which systems data and */
/* function pointers _are_ the same size and _can_ */
/* be cast without loss of information. */
for (i = CountDLL - 1; i >= 0; i--) {
doit = all;
if(!doit && !strcmp(pkg, LoadedDLL[i].name)) doit = 2;
if(doit && LoadedDLL[i].forceSymbols) doit = 0;
if(doit) {
fcnptr = R_dlsym(&LoadedDLL[i], name, symbol); /* R_osDynSymbol->dlsym */
if (fcnptr != (DL_FUNC) NULL) {
if(symbol)
symbol->dll = LoadedDLL+i;
#ifdef CACHE_DLL_SYM
if(strlen(pkg) <= 20 && strlen(name) <= 40 && nCPFun < MAX_CACHE
&& (!symbol || !symbol->symbol.c)) {
strcpy(CPFun[nCPFun].pkg, LoadedDLL[i].name);
strcpy(CPFun[nCPFun].name, name);
CPFun[nCPFun++].func = fcnptr;
}
#endif
return fcnptr;
}
}
if(doit > 1) return (DL_FUNC) NULL; /* Only look in the first-matching DLL */
}
return (DL_FUNC) NULL;
}