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); }