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 SEXP
R_getRoutineSymbols(NativeSymbolType type, DllInfo *info)
{
SEXP ans;
int i, num;
R_RegisteredNativeSymbol sym;
DL_FUNC address = NULL;
sym.dll = info;
sym.type =type;
switch(type) {
case R_CALL_SYM: num = info->numCallSymbols;
break;
case R_C_SYM: num = info->numCSymbols;
break;
case R_FORTRAN_SYM: num = info->numFortranSymbols;
break;
case R_EXTERNAL_SYM: num = info->numExternalSymbols;
break;
default:
num = 0;
}
PROTECT(ans = allocVector(VECSXP, num));
for(i = 0; i < num ; i++) {
switch(type) {
case R_CALL_SYM:
sym.symbol.call = &info->CallSymbols[i];
address = sym.symbol.call->fun;
break;
case R_C_SYM:
sym.symbol.c = &info->CSymbols[i];
address = sym.symbol.c->fun;
break;
case R_FORTRAN_SYM:
sym.symbol.fortran = &info->FortranSymbols[i];
address = sym.symbol.fortran->fun;
break;
case R_EXTERNAL_SYM:
sym.symbol.external = &info->ExternalSymbols[i];
address = sym.symbol.external->fun;
break;
default:
continue;
}
SET_VECTOR_ELT(ans, i, createRSymbolObject(NULL, address, &sym, TRUE));/* XXX */
}
setAttrib(ans, R_ClassSymbol, mkString("NativeRoutineList"));
UNPROTECT(1);
return(ans);
}
