Commit 6ef6eb67 authored by Radford Neal's avatar Radford Neal

more mods for compressed pointers. Now compiles with warnings, but won't run

parent 636ddf77
......@@ -11,7 +11,9 @@
\subsection{INTRODUCTION}{
\itemize{
\item pqR now uses a new garbage collector. Previously deprecated
SETLENGTH is now eliminated.
SETLENGTH is now eliminated. Passing non-vectors as SEXP
args with .C is now tricky (see dotcode.c). Disabled call_R
and call_S (unused?).
}}
}
......
......@@ -1341,7 +1341,7 @@ Rboolean R_HiddenFile(const char *);
double R_FileMtime(const char *);
/* environment cell access */
typedef struct R_varloc_st *R_varloc_t;
typedef SEXP R_varloc_t;
R_varloc_t R_findVarLocInFrame(SEXP, SEXP);
SEXP R_GetVarLocValue(R_varloc_t);
SEXP R_GetVarLocSymbol(R_varloc_t);
......
......@@ -63,7 +63,7 @@ struct Rconn {
Rboolean EOF_signalled;
Rboolean UTF8out;
void *id;
void *ex_ptr;
SEXP ex_ptr;
void *private;
};
......
......@@ -929,7 +929,8 @@ struct R_local_protect {
#define R_local_protect_start R_high_frequency_globals.local_protect_start
#define CHK_IS_SEXP(v) if (0) ((v)->sxpinfo) /* cause error if v not a SEXP */
#define CHK_IS_SEXP(v) \
if (0) (UNCOMPRESSED_PTR(v)->sxpinfo) /* try to get error if v not a SEXP */
#define BEGIN_PROTECT0() \
do { \
......
......@@ -921,7 +921,7 @@ static SEXP setDflt(SEXP arg, SEXP dflt)
static SEXP do_switch(SEXP call, SEXP op, SEXP args, SEXP rho)
{
int argval, nargs = length(args);
SEXP x, y, z, w, ans, dflt = NULL;
SEXP x, y, z, w, ans, dflt = R_NoObject;
if (nargs < 1) errorcall(call, _("'EXPR' is missing"));
check1arg(args, call, "EXPR");
......@@ -962,7 +962,7 @@ static SEXP do_switch(SEXP call, SEXP op, SEXP args, SEXP rho)
} else
dflt = setDflt(y, dflt);
}
if (dflt) {
if (dflt != R_NoObject) {
ans = eval(dflt, rho);
UNPROTECT(2);
return ans;
......
......@@ -134,7 +134,7 @@ typedef long long int _lli_t;
#define NSINKS 21
static Rconnection Connections[NCONNECTIONS];
static SEXP OutTextData;
static SEXP OutTextData = R_NoObject;
static int R_SinkNumber;
static int SinkCons[NSINKS], SinkConsClose[NSINKS], R_SinkSplit[NSINKS];
......@@ -515,7 +515,7 @@ void init_con(Rconnection new, const char *description, int enc,
current_id = (void *)((size_t) current_id+1);
if(!current_id) current_id = (void *) 1;
new->id = current_id;
new->ex_ptr = NULL;
new->ex_ptr = R_NoObject;
}
/* ------------------- file connections --------------------- */
......@@ -2607,7 +2607,7 @@ static void outtext_close(Rconnection con)
int idx = ConnIndex(con);
SEXP tmp, env = VECTOR_ELT(OutTextData, idx);
if(this->namesymbol &&
if(this->namesymbol != R_NoObject &&
findVarInFrame3(env, this->namesymbol, FALSE) != R_UnboundValue)
R_unLockBinding(this->namesymbol, env);
if(strlen(this->lastline) > 0) {
......@@ -2729,7 +2729,7 @@ static void outtext_init(Rconnection con, SEXP stext, const char *mode, int idx)
SEXP val;
if(stext == R_NilValue) {
this->namesymbol = NULL;
this->namesymbol = R_NoObject;
/* create variable pointed to by con->description */
val = allocVector(STRSXP, 0);
R_PreserveObject(val);
......@@ -2838,7 +2838,7 @@ static SEXP do_textconnection(SEXP call, SEXP op, SEXP args, SEXP env)
error(_("invalid '%s' argument"), "text");
con = Connections[ncon] = newtext(desc, stext, type);
} else if (strncmp(open, "w", 1) == 0 || strncmp(open, "a", 1) == 0) {
if (OutTextData == NULL) {
if (OutTextData == R_NoObject) {
OutTextData = allocVector(VECSXP, NCONNECTIONS);
R_PreserveObject(OutTextData);
}
......
......@@ -52,21 +52,30 @@
#include <complex.h>
/* Header for a constant. */
#if USE_COMPRESSED_POINTERS
#define CPTR_FIELD(index,offset) /* nothing */
#define LENGTH1 /* nothing */
#define NILATTRIB /* nothing */
#else
#define CPTR_FIELD(index,offset) .cptr = SGGC_CPTR_VAL(index,offset),
#define LENGTH1 .length = 1,
#define NILATTRIB .attrib = R_NilValue,
#endif
/* Header for a constant. */
#define CONST_HEADER(typ,index,offset) \
CPTR_FIELD(index,offset) \
.sxpinfo = { .nmcnt = 7, .type = typ, }, \
.attrib = R_NilValue,
NILATTRIB \
.sxpinfo = { .nmcnt = 7, .type = typ, } \
/* Definition of the R_NilValue constant, whose address when cast to SEXP is
R_NilValue. */
R_CONST SEXPREC R_NilValue_const = { \
CONST_HEADER(NILSXP,R_SGGC_NIL_INDEX,0)
CONST_HEADER(NILSXP,R_SGGC_NIL_INDEX,0),
.u = { .listsxp =
{ .carval = R_NilValue, .cdrval = R_NilValue, .tagval = R_NilValue }
}
......@@ -77,9 +86,14 @@ R_CONST SEXPREC R_NilValue_const = { \
These are not actually constant, since the data they contain is changed,
but are allocated similarly. */
#if USE_COMPRESSED_POINTERS
#define SCALAR_BOX(typ,offset) { \
CONST_HEADER(typ,R_SGGC_STATIC_BOXES_INDEX,offset) \
.length = 1 }
CONST_HEADER(typ,R_SGGC_STATIC_BOXES_INDEX,offset) }
#else
#define SCALAR_BOX(typ,offset) { \
CONST_HEADER(typ,R_SGGC_STATIC_BOXES_INDEX,offset), \
LENGTH1 }
#endif
VECTOR_SEXPREC_C R_ScalarBox_space[4] = {
SCALAR_BOX(INTSXP,0),
......@@ -94,7 +108,7 @@ VECTOR_SEXPREC_C R_ScalarBox_space[4] = {
R_CONST SEXPREC R_env_consts[1] = {
{
CONST_HEADER(ENVSXP,R_SGGC_ENV_INDEX,0)
CONST_HEADER(ENVSXP,R_SGGC_ENV_INDEX,0),
.u = { .envsxp =
{ .frame = R_NilValue, .enclos = R_NilValue, .hashtab = R_NilValue }
}
......@@ -107,7 +121,7 @@ R_CONST SEXPREC R_env_consts[1] = {
R_CONST SYM_SEXPREC R_sym_consts[1] = {
{
CONST_HEADER(SYMSXP,R_SGGC_SYM_INDEX,0)
CONST_HEADER(SYMSXP,R_SGGC_SYM_INDEX,0),
.symsxp = { .pname = R_NilValue,
.value = R_UnboundValue,
.internal = R_NilValue,
......@@ -120,33 +134,33 @@ R_CONST SYM_SEXPREC R_sym_consts[1] = {
/* Logical, integer, and real constants. */
#define LOGICAL_CONST(v,offset) { \
CONST_HEADER(LGLSXP,R_SGGC_NUM_INDEX,offset) \
.length = 1, \
CONST_HEADER(LGLSXP,R_SGGC_NUM_INDEX,offset), \
LENGTH1 \
.data = { .i = v } \
}
#define INTEGER_CONST(v,offset) { \
CONST_HEADER(INTSXP,R_SGGC_NUM_INDEX,offset) \
.length = 1, \
CONST_HEADER(INTSXP,R_SGGC_NUM_INDEX,offset), \
LENGTH1 \
.data = { .i = v } \
}
#define REAL_CONST(v,offset) { \
CONST_HEADER(REALSXP,R_SGGC_NUM_INDEX,offset) \
.length = 1, \
CONST_HEADER(REALSXP,R_SGGC_NUM_INDEX,offset), \
LENGTH1 \
.data = { .d = v } \
}
#ifdef WORDS_BIGENDIAN
#define REAL_NA_CONST(offset) { \
CONST_HEADER(REALSXP,R_SGGC_NUM_INDEX,offset) \
.length = 1, \
CONST_HEADER(REALSXP,R_SGGC_NUM_INDEX,offset), \
LENGTH1 \
.data = { .w = { 0x7ff00000, 1954 } } \
}
#else
#define REAL_NA_CONST(offset) { \
CONST_HEADER(REALSXP,R_SGGC_NUM_INDEX,offset) \
.length = 1, \
CONST_HEADER(REALSXP,R_SGGC_NUM_INDEX,offset), \
LENGTH1 \
.data = { .w = { 1954, 0x7ff00000 } } \
}
#endif
......@@ -172,7 +186,7 @@ R_CONST VECTOR_SEXPREC_C R_ScalarNumerical_consts[R_N_NUM_CONSTS] = {
/* 1-element pairlist constants. */
#define LIST1_CONST(car,offset) { \
CONST_HEADER(LISTSXP,R_SGGC_LIST1_INDEX,offset) \
CONST_HEADER(LISTSXP,R_SGGC_LIST1_INDEX,offset), \
.u = { .listsxp = \
{ .carval = car, .cdrval = R_NilValue, .tagval = R_NilValue } \
} \
......@@ -220,13 +234,56 @@ SEXP attribute_hidden MaybeConstList1(SEXP car)
/* Initialize constants (and static boxes). */
#if USE_COMPRESSED_POINTERS
static const SEXP nilattrib[SGGC_CHUNKS_IN_SMALL_SEGMENT] = {
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue,
R_NilValue, R_NilValue, R_NilValue, R_NilValue
};
static const R_len_t length0[SGGC_CHUNKS_IN_SMALL_SEGMENT] = {
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
};
static const R_len_t length1[SGGC_CHUNKS_IN_SMALL_SEGMENT] = {
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
};
#endif
void Rf_constant_init(void)
{
/* R_NilValue (= R NULL). */
sggc_constant (R_type_to_sggc_type[NILSXP],
R_type_to_sggc_type[NILSXP]+SGGC_N_TYPES,
1, (char *) &R_NilValue_const);
1, (char *) &R_NilValue_const
#if USE_COMPRESSED_POINTERS
, (char *) length0, (char *) nilattrib
#endif
);
/* Static boxes. Uses same segment for integers and reals. */
......@@ -234,19 +291,31 @@ void Rf_constant_init(void)
sggc_constant (R_type_to_sggc_type[INTSXP],
R_type_to_sggc_type[INTSXP]+SGGC_N_TYPES,
4, (char *) R_ScalarBox_space);
4, (char *) R_ScalarBox_space
#if USE_COMPRESSED_POINTERS
, (char *) length1, (char *) nilattrib
#endif
);
/* Environment constant. */
sggc_constant (R_type_to_sggc_type[ENVSXP],
R_type_to_sggc_type[ENVSXP]+SGGC_N_TYPES,
1, (char *) R_env_consts);
1, (char *) R_env_consts
#if USE_COMPRESSED_POINTERS
, (char *) length1, (char *) nilattrib
#endif
);
/* Symbol constant. */
sggc_constant (R_type_to_sggc_type[SYMSXP],
R_type_to_sggc_type[SYMSXP]+2*SGGC_N_TYPES,
1, (char *) R_sym_consts);
1, (char *) R_sym_consts
#if USE_COMPRESSED_POINTERS
, (char *) length1, (char *) nilattrib
#endif
);
/* Numerical/logical constants. All use same segment. */
......@@ -255,14 +324,22 @@ void Rf_constant_init(void)
sggc_constant (R_type_to_sggc_type[LGLSXP],
R_type_to_sggc_type[LGLSXP]+SGGC_N_TYPES,
R_N_NUM_CONSTS, (char *) R_ScalarNumerical_consts);
R_N_NUM_CONSTS, (char *) R_ScalarNumerical_consts
#if USE_COMPRESSED_POINTERS
, (char *) length1, (char *) nilattrib
#endif
);
/* Pairlists of length 1. */
sggc_constant (R_type_to_sggc_type[LISTSXP],
R_type_to_sggc_type[LISTSXP]+SGGC_N_TYPES,
sizeof R_List1_consts / sizeof R_List1_consts[0],
(char *) R_List1_consts);
(char *) R_List1_consts
#if USE_COMPRESSED_POINTERS
, (char *) length1, (char *) nilattrib
#endif
);
}
......
......@@ -779,7 +779,7 @@ R_tryEval(SEXP e, SEXP env, int *ErrorOccurred)
ProtectedEvalData data;
data.expression = e;
data.val = NULL;
data.val = R_NoObject;
data.env = env;
ok = R_ToplevelExec(protectedEval, &data);
......@@ -787,7 +787,7 @@ R_tryEval(SEXP e, SEXP env, int *ErrorOccurred)
*ErrorOccurred = (ok == FALSE);
}
if (ok == FALSE)
data.val = NULL;
data.val = R_NoObject;
else
UNPROTECT(1);
......
......@@ -202,7 +202,7 @@ static SEXP deparse1WithCutoff(SEXP call, Rboolean abbrev, int cutoff,
Rboolean need_ellipses = FALSE;
LocalParseData localData =
{0, 0, 0, 0, /*startline = */TRUE, 0,
NULL,
R_NoObject,
/*DeparseBuffer=*/{NULL, 0, BUFSIZE},
DEFAULT_Cutoff, FALSE, 0, TRUE, FALSE, INT_MAX, TRUE, 0};
localData.cutoff = cutoff;
......@@ -798,7 +798,7 @@ static void deparse2buff(SEXP s, LocalParseData *d)
d->opts = localOpts;
if (d->opts & DELAYPROMISES) print2buff(">", d);
} else {
PROTECT(s = eval(s, NULL)); /* eval uses env of promise */
PROTECT(s = eval(s, R_NilValue)); /* eval uses env of promise */
deparse2buff(s, d);
UNPROTECT(1);
}
......
......@@ -267,7 +267,10 @@ resolveNativeRoutine(SEXP args, DL_FUNC *fun, R_RegisteredNativeSymbol *symbol,
DllReference dll;
/* Null string for DLLname is shorthand for 'all' in R_FindSymbol, but
should never be supplied */
dll.DLLname[0] = 0; dll.dll = NULL; dll.obj = NULL; dll.type = NOT_DEFINED;
dll.DLLname[0] = 0;
dll.dll = NULL;
dll.obj = R_NoObject;
dll.type = NOT_DEFINED;
op = CAR(args); // value of .NAME =
......@@ -450,7 +453,7 @@ SEXP attribute_hidden do_External(SEXP call, SEXP op, SEXP args, SEXP env)
#ifdef __cplusplus
typedef SEXP (*VarFun)(...);
#else
typedef DL_FUNC VarFun;
typedef SEXP (*VarFun)();
#endif
/* .Call(name, <args>) */
......@@ -462,8 +465,9 @@ SEXP attribute_hidden do_dotcall(SEXP call, SEXP op, SEXP args, SEXP env)
RCNTXT cntxt;
beginbuiltincontext (&cntxt, call);
DL_FUNC ofun = NULL;
VarFun fun = NULL;
DL_FUNC fun0;
SEXP (*ofun)(void);
VarFun fun;
SEXP retval, pargs;
R_RegisteredNativeSymbol symbol = {R_CALL_SYM, {NULL}, NULL};
int nargs, i;
......@@ -477,7 +481,9 @@ SEXP attribute_hidden do_dotcall(SEXP call, SEXP op, SEXP args, SEXP env)
errorcall(call, _("too many arguments in foreign function call"));
PROTECT(spa.pkg);
resolveNativeRoutine(args, &ofun, &symbol, spa.pkg, buf, call, env);
resolveNativeRoutine(args, &fun0, &symbol, spa.pkg, buf, call, env);
ofun = (SEXP (*)(void)) fun0;
fun = (VarFun) fun0;
args = CDR(args);
UNPROTECT(1);
......@@ -493,7 +499,6 @@ SEXP attribute_hidden do_dotcall(SEXP call, SEXP op, SEXP args, SEXP env)
nargs, symbol.symbol.call->numArgs, buf);
}
fun = (VarFun) ofun;
switch (nargs) {
case 0:
retval = (SEXP)ofun();
......@@ -1262,7 +1267,7 @@ R_FindNativeSymbolFromDLL(char *name, DllReference *dll,
DllInfo *info;
DL_FUNC fun = NULL;
if(dll->obj == NULL) {
if(dll->obj == R_NoObject) {
/* Rprintf("\nsearching for %s\n", name); */
if (env != R_NilValue) {
SEXP e;
......@@ -1308,29 +1313,35 @@ R_FindNativeSymbolFromDLL(char *name, DllReference *dll,
If it is called directly, the function to call may be specified by the
dotCode_fun variable. If deferred, the function to call must be stored
in the rawfun operand, which is NULL otherwise.
in the rawfun operand, which is R_NoObject otherwise.
If the output, ans1, is not NULL, it is the sole result of the
If the output, ans1, is not R_NoObject, it is the sole result of the
computation, with the arguments in args being ignored after the
call (they may or may not have changed). If ans1 is NULL, this
call (they may or may not have changed). If ans1 is R_NoObject, this
task procedure must be called directly, not deferred, and the
contents of args is updated to be returned as the result (or perhaps
the procedure is called for its side effects). Updating args may
involve memory allocation, not allowed for a deferred task, as some
arguments may need to be converted to an appropriate form.
The args operand will be a vector list (VECSXP) containing pointers to
the arguments of the function to be called. For arguments that are
atomic vectors or vector lists, the function called is passed the DATAPTR
for the vector (unless this argument is marked as an out-of-the-box scalar,
see below), except that zero-length arguments are passed as a pointer
to a block of 20 zero bytes (to suppress errors from some badly-written
packages). For other argument types, the function is passed the SEXP
for the operand itself. If this task procedure is deferred, the arguments,
other than ans1, must all either be unshared (NAMEDCNT of zero) or be
guaranteed to never change (NAMEDCNT at its maximum), since the helpers
"in use" mechanism will not work for such objects that are inside the operand
passed.
The args operand will be a vector list (VECSXP) containing pointers
to the arguments of the function to be called. For arguments that
are atomic vectors or vector lists, the function called is passed
the DATAPTR for the vector (unless this argument is marked as an
out-of-the-box scalar, see below), except that zero-length
arguments are passed as a pointer to a block of 20 zero bytes (to
suppress errors from some badly-written packages). For other
argument types, the function is passed the SEXP for the operand
itself. This is rather tricky if compressed pointers are being
used - the function called must recevie the SEXP as a void *
pointer, and cast it to uintptr_t and then to SEXP, which will work
when SEXP is either a compressed an uncompressed pointer.
If this task procedure is deferred, the arguments, other than ans1,
must all either be unshared (NAMEDCNT of zero) or be guaranteed to
never change (NAMEDCNT at its maximum), since the helpers "in use"
mechanism will not work for such objects that are inside the
operand passed.
A string argument needing converstion back to an R string is recognized
as such by ATTRIB being a RAWSXP (not a pairlist), with ATTRIB pointing
......@@ -1349,7 +1360,7 @@ R_FindNativeSymbolFromDLL(char *name, DllReference *dll,
first 64 arguments are scalars that should be stored "out of their
boxes" - copied to a local variable before the call, and if necessary
copied back after the call. Any arguments past the first 64 are never
treated as out-of-the-box scalars. If ans1 is not NULL, it must not
treated as out-of-the-box scalars. If ans1 is not R_NoObject, it must not
be marked as an out-of-the-box scalar (even if it is of length one).
The variable dotCode_spa_dup is consulted for the value of DUP (but only
......@@ -1383,7 +1394,7 @@ void task_dotCode (helpers_op_t scalars, SEXP ans1, SEXP rawfun, SEXP args)
to get it from the rawfun operand, otherwise it's faster from a variable
set by the caller. */
VarFun fun = rawfun!=NULL ? * (VarFun *) RAW(rawfun) : dotCode_fun;
VarFun fun = rawfun!=R_NoObject ? * (VarFun *) RAW(rawfun) : dotCode_fun;
helpers_op_t sc;
int na;
......@@ -1406,7 +1417,7 @@ void task_dotCode (helpers_op_t scalars, SEXP ans1, SEXP rawfun, SEXP args)
else if (isVectorAtomic(arg) || TYPEOF(arg) == VECSXP)
cargs[na] = LENGTH(arg)==0 ? (void *) zeros : (void *) DATAPTR(arg);
else
cargs[na] = (void *) arg;
cargs[na] = (void *) (uintptr_t) arg;
}
switch (nargs) {
......@@ -2005,7 +2016,7 @@ void task_dotCode (helpers_op_t scalars, SEXP ans1, SEXP rawfun, SEXP args)
/* Handle case where ans1 is the only result (any change to other
arguments ignored). */
if (ans1) {
if (ans1 != R_NoObject) {
/* Make sure a logical answer has valid values. Doesn't write if
unnecessary, since this may be faster. */
......@@ -2407,7 +2418,7 @@ SEXP attribute_hidden do_dotCode (SEXP call, SEXP op, SEXP args, SEXP env,
if (!return_one_named || helpers_not_multithreading_now)
spa.helper = 0;
SEXP ans1 = return_one_named ? VECTOR_ELT(ans,last_pos) : NULL;
SEXP ans1 = return_one_named ? VECTOR_ELT(ans,last_pos) : R_NoObject;
if (spa.helper) {
/* Ensure arguments won't change while task is not complete (the
......@@ -2423,14 +2434,14 @@ SEXP attribute_hidden do_dotCode (SEXP call, SEXP op, SEXP args, SEXP env,
}
else {
dotCode_spa_dup = spa.dup;
task_dotCode (scalars, ans1, NULL, ans);
task_dotCode (scalars, ans1, R_NoObject, ans);
}
/* Either return just the one named element, ans1, as a pairlist,
or the whole vector list of updated arguments. We handle attaching
names to the whole vector, and attributes to each element. */
if (return_one_named) {
if (return_one_named != R_NoObject) {
if (ans1 != last_arg) DUPLICATE_ATTRIB(ans1, last_arg);
ans = cons_with_tag (ans1, R_NilValue, last_tag);
}
......@@ -2498,9 +2509,13 @@ static int string2type(char *s)
}
/* This is entirely legacy, with no known users (Mar 2012).
So we freeze the code involved.
So we freeze the code involved (as much as possible).
NOW DISABLED.
*/
#if 0
static void *RObjToCPtr2(SEXP s)
{
int n;
......@@ -2546,7 +2561,7 @@ static void *RObjToCPtr2(SEXP s)
return (void*) lptr;
break;
default:
return (void*) s;
return (void*) UNCOMPRESSED_PTR(s);
}
}
......@@ -2638,6 +2653,8 @@ void call_S(char *func, long nargs, void **arguments, char **modes,
call_R(func, nargs, arguments, modes, lengths, names, nres, results);
}
#endif
/* FUNTAB entries defined in this source file. See names.c for documentation. */
attribute_hidden FUNTAB R_FunTab_dotcode[] =
......
......@@ -904,7 +904,7 @@ static SEXP findVarLocInFrame(SEXP rho, SEXP symbol, Rboolean *canCache)
R_varloc_t R_findVarLocInFrame(SEXP rho, SEXP symbol)
{
SEXP binding = findVarLocInFrame(rho, symbol, NULL);
return binding == R_NilValue ? NULL : (R_varloc_t) binding;
return binding == R_NilValue ? R_NoObject : (R_varloc_t) binding;
}
SEXP R_GetVarLocValue(R_varloc_t vl)
......
......@@ -356,21 +356,21 @@ void attribute_hidden wait_until_arguments_computed (SEXP args)
if (helpers_tasks == 0) return;
wait_for = NULL;
wait_for = R_NoObject;
for (a = args; a != R_NilValue; a = CDR(a)) {
SEXP this_arg = CAR(a);
if (helpers_is_being_computed(this_arg)) {
if (wait_for == NULL)
if (wait_for == R_NoObject)
wait_for = this_arg;
else {
helpers_wait_until_not_being_computed2 (wait_for, this_arg);
wait_for = NULL;
wait_for = R_NoObject;
}
}
}
if (wait_for != NULL)
if (wait_for != R_NoObject)
helpers_wait_until_not_being_computed (wait_for);
}
......@@ -593,7 +593,7 @@ SEXP attribute_hidden Rf_evalv2(SEXP e, SEXP rho, int variant)
if (TYPEOF(op) == CLOSXP) {
PROTECT(op);
res = applyClosure_v (e, op, promiseArgs(args,rho), rho,
NULL, variant);
R_NoObject, variant);
UNPROTECT(1);
}
else {
......@@ -1266,7 +1266,7 @@ SEXP R_execMethod(SEXP op, SEXP rho)
R_varloc_t loc;
int missing;
loc = R_findVarLocInFrame(rho,symbol);
if(loc == NULL)
if (loc == R_NoObject)
error(_("could not find symbol \"%s\" in environment of the generic function"),
CHAR(PRINTNAME(symbol)));
missing = R_GetVarLocMISSING(loc);
......@@ -1997,7 +1997,7 @@ static SEXP evalseq(SEXP expr, SEXP rho, int forcelocal, R_varloc_t tmploc)
static void tmp_cleanup(void *data)
{
(void) RemoveVariable (R_TmpvalSymbol, (SEXP) data);
(void) RemoveVariable (R_TmpvalSymbol, (SEXP) (uintptr_t) data);
}
/* Main entry point for complex assignments; rhs has already been evaluated. */
......@@ -2051,7 +2051,7 @@ static void applydefine (SEXP call, SEXP op, SEXP expr, SEXP rhs, SEXP rho)
begincontext(&cntxt, CTXT_CCODE, call, R_BaseEnv, R_BaseEnv,
R_NilValue, R_NilValue);
cntxt.cend = &tmp_cleanup;
cntxt.cenddata = rho;
cntxt.cenddata = (void *) (uintptr_t) rho; /* DUBIOUS ??? */
/* Do a partial evaluation down through the LHS. */
lhs = evalseq(CADR(expr), rho,
......
......@@ -251,15 +251,21 @@ static SEXP R_weak_refs = R_NilValue;
#define READY_TO_FINALIZE_MASK 1
#define SET_READY_TO_FINALIZE(s) ((s)->sxpinfo.gp |= READY_TO_FINALIZE_MASK)
#define CLEAR_READY_TO_FINALIZE(s) ((s)->sxpinfo.gp &= ~READY_TO_FINALIZE_MASK)
#define IS_READY_TO_FINALIZE(s) ((s)->sxpinfo.gp & READY_TO_FINALIZE_MASK)
#define SET_READY_TO_FINALIZE(s) \
(UNCOMPRESSED_PTR(s)->sxpinfo.gp |= READY_TO_FINALIZE_MASK)
#define CLEAR_READY_TO_FINALIZE(s) \
(UNCOMPRESSED_PTR(s)->sxpinfo.gp &= ~READY_TO_FINALIZE_MASK)
#define IS_READY_TO_FINALIZE(s) \
(UNCOMPRESSED_PTR(s)->sxpinfo.gp & READY_TO_FINALIZE_MASK)
#define FINALIZE_ON_EXIT_MASK 2
#define SET_FINALIZE_ON_EXIT(s) ((s)->sxpinfo.gp |= FINALIZE_ON_EXIT_MASK)
#define CLEAR_FINALIZE_ON_EXIT(s) ((s)->sxpinfo.gp &= ~FINALIZE_ON_EXIT_MASK)
#define FINALIZE_ON_EXIT(s) ((s)->sxpinfo.gp & FINALIZE_ON_EXIT_MASK)
#define SET_FINALIZE_ON_EXIT(s) \
(UNCOMPRESSED_PTR(s)->sxpinfo.gp |= FINALIZE_ON_EXIT_MASK)
#define CLEAR_FINALIZE_ON_EXIT(s) \
(UNCOMPRESSED_PTR(s)->sxpinfo.gp &= ~FINALIZE_ON_EXIT_MASK)
#define FINALIZE_ON_EXIT(s) \
(UNCOMPRESSED_PTR(s)->sxpinfo.gp & FINALIZE_ON_EXIT_MASK)
#define WEAKREF_SIZE 4
#define WEAKREF_KEY(w) VECTOR_ELT(w, 0)
......@@ -1064,7 +1070,10 @@ static SEXP alloc_vec (SEXPTYPE type, R_len_t length)
}
SEXP r = SEXP_PTR (cp);
#if !USE_COMPRESSED_POINTERS
r->cptr = cp;
#endif
TYPEOF(r) = type;
ATTRIB(r) = R_NilValue;
LENGTH(r) = length;
......@@ -1118,7 +1127,7 @@ char *R_alloc(size_t nelem, int eltsize)
dsize/1024.0/1024.0/1024.0);
s = allocVector(RAWSXP, size + 1);
#endif
ATTRIB(s) = R_VStack == NULL ? R_NilValue : R_VStack;
ATTRIB(s) = R_VStack == R_NoObject ? R_NilValue : R_VStack;
R_VStack = s;
return (char *)DATAPTR(s);
}
......@@ -1248,7 +1257,7 @@ SEXP attribute_hidden mkPROMISE(SEXP expr, SEXP rho)
SET_NAMEDCNT_MAX(expr);
/* SET_NAMEDCNT_1(s); */
s->u.promsxp.value = R_UnboundValue;
UNCOMPRESSED_PTR(s)->u.promsxp.value = R_UnboundValue;
PRCODE(s) = Rf_chk_valid_SEXP(expr);
PRENV(s) = Rf_chk_valid_SEXP(rho);
PRSEEN(s) = 0;
......@@ -1269,10 +1278,10 @@ SEXP attribute_hidden mkPRIMSXP(int offset, int eval)
{
SEXP result;
SEXPTYPE type = eval ? BUILTINSXP : SPECIALSXP;
static SEXP PrimCache = NULL;
static SEXP PrimCache = R_NoObject;
static int FunTabSize = 0;
if (PrimCache == NULL) {
if (PrimCache == R_NoObject) {
/* compute the number of entires in R_FunTab */
while (R_FunTab[FunTabSize].name)
FunTabSize++;
......@@ -1366,9 +1375,9 @@ SEXP attribute_hidden mkSYMSXP(SEXP name, SEXP value)
SYMVALUE(c) = value;
INTERNAL(c) = R_NilValue;
NEXTSYM_PTR(c) = R_NilValue;
LASTSYMENV(c) = NULL;
LASTSYMBINDING(c) = NULL;
LASTSYMENVNOTFOUND(c) = NULL;
LASTSYMENV(c) = R_NoObject;
LASTSYMBINDING(c) = R_NoObject;
LASTSYMENVNOTFOUND(c) = R_NoObject;
SET_DDVAL(c, isDDName(name));
UNPROTECT(2);
return c;
......@@ -1712,7 +1721,7 @@ R_NORETURN void attribute_hidden Rf_protect_error (void)
SEXP protect(SEXP s)
{
if (s != NULL && TYPEOF(s) == NILSXP && s != R_NilValue) abort();
if (s != R_NoObject && TYPEOF(s) == NILSXP && s != R_NilValue) abort();
return PROTECT (Rf_chk_valid_SEXP(s));
}
......@@ -1722,17 +1731,17 @@ SEXP protect(SEXP s)
void Rf_protect2 (SEXP s1, SEXP s2)