The R Project SVN R

Rev

Rev 65019 | Rev 66468 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 65019 Rev 66131
Line 78... Line 78...
78 
 
 78 
 
79 
static SEXP naokfind(SEXP args, int * len, int *naok, int *dup,
 79 
static SEXP naokfind(SEXP args, int * len, int *naok, int *dup,
80 
		     DllReference *dll);
 80 
		     DllReference *dll);
81 
static SEXP pkgtrim(SEXP args, DllReference *dll);
 81 
static SEXP pkgtrim(SEXP args, DllReference *dll);
82 
 
 82 
 
- 
 
 83 
static R_INLINE Rboolean isNativeSymbolInfo(SEXP op)
- 
 
 84 
{
- 
 
 85 
    /* was: inherits(op, "NativeSymbolInfo")
- 
 
 86 
     * inherits() is slow because of string comparisons, so use
- 
 
 87 
     * structural check instead. */
- 
 
 88 
    return (TYPEOF(op) == VECSXP &&
- 
 
 89 
	    LENGTH(op) >= 2 &&
- 
 
 90 
	    TYPEOF(VECTOR_ELT(op, 1)) == EXTPTRSXP);
- 
 
 91 
}
- 
 
 92 
 
83 
/*
 93 
/*
84 
  Called from resolveNativeRoutine (and itself).
 94 
  Called from resolveNativeRoutine (and itself).
85 
 
 95 
 
86 
  Checks whether the specified object correctly identifies a native routine.
 96 
  Checks whether the specified object correctly identifies a native routine.
87 
  op is the supplied value for .NAME.  This can be
 97 
  op is the supplied value for .NAME.  This can be
Line 99... Line 109...
99 
		   R_RegisteredNativeSymbol *symbol, char *buf)
 109 
		   R_RegisteredNativeSymbol *symbol, char *buf)
100 
{
 110 
{
101 
    if (isValidString(op)) return;
 111 
    if (isValidString(op)) return;
102 
 
 112 
 
103 
    if(TYPEOF(op) == EXTPTRSXP) {
 113 
    if(TYPEOF(op) == EXTPTRSXP) {
- 
 
 114 
	static SEXP native_symbol = NULL;
- 
 
 115 
	static SEXP registered_native_symbol = NULL;
- 
 
 116 
	if (native_symbol == NULL) {
- 
 
 117 
	    native_symbol = install("native symbol");
- 
 
 118 
	    registered_native_symbol = install("registered native symbol");
- 
 
 119 
	}
104 
	char *p = NULL;
 120 
	char *p = NULL;
105 
	if(R_ExternalPtrTag(op) == install("native symbol"))
 121 
	if(R_ExternalPtrTag(op) == native_symbol)
106 
	   *fun = R_ExternalPtrAddrFn(op);
 122 
	   *fun = R_ExternalPtrAddrFn(op);
107 
	else if(R_ExternalPtrTag(op) == install("registered native symbol")) {
 123 
	else if(R_ExternalPtrTag(op) == registered_native_symbol) {
108 
	   R_RegisteredNativeSymbol *tmp;
 124 
	   R_RegisteredNativeSymbol *tmp;
109 
	   tmp = (R_RegisteredNativeSymbol *) R_ExternalPtrAddr(op);
 125 
	   tmp = (R_RegisteredNativeSymbol *) R_ExternalPtrAddr(op);
110 
	   if(tmp) {
 126 
	   if(tmp) {
111 
	      if(symbol->type != R_ANY_SYM && symbol->type != tmp->type)
 127 
	      if(symbol->type != R_ANY_SYM && symbol->type != tmp->type)
112 
		 errorcall(call, _("NULL value passed as symbol address"));
 128 
		 errorcall(call, _("NULL value passed as symbol address"));
Line 148... Line 164...
148 
	    memcpy(buf, p, strlen(p)+1);
 164 
	    memcpy(buf, p, strlen(p)+1);
149 
	}
 165 
	}
150 
 
 166 
 
151 
	return;
 167 
	return;
152 
    }
 168 
    }
153 
    else if(inherits(op, "NativeSymbolInfo")) {
 169 
    else if(isNativeSymbolInfo(op)) {
154 
	checkValidSymbolId(VECTOR_ELT(op, 1), call, fun, symbol, buf);
 170 
	checkValidSymbolId(VECTOR_ELT(op, 1), call, fun, symbol, buf);
155 
	return;
 171 
	return;
156 
    }
 172 
    }
157 
 
 173 
 
158 
    errorcall(call,
 174 
    errorcall(call,