Commit d4929aa9 authored by Radford Neal's avatar Radford Neal

First version released on github

parent 9ea54f65
......@@ -151,7 +151,11 @@ users, such as cleanups of source code.
21)
22)
o PROTECT, UNPROTECT, etc. were made mostly macros in most of the files
in src/main. This applies only to files that include Defn.h
after defining the symbol USE_FAST_PROTECT_MACROS.
With these macros, code of the form v = PROTECT(...) must be replaced
by PROTECT(v = ...). This change speeds up numerous operations.
23)
......
PROTECT, UNPROTECT, etc. have been made mostly macros in most of the
files in src/main. This applies only to files that include Defn.h
after defining the symbol USE_FAST_PROTECT_MACROS. If this is
defined, macros PROTECT2 and PROTECT3 for protecting two or three
objects at once are also defined.
This change speeds up numerous operations.
......@@ -1304,6 +1304,52 @@ extern void *alloca(size_t);
# endif
#endif
/* Enable this by defining USE_FAST_PROTECT_MACROS before including Defn.h.
Redefines PROTECT, UNPROTECT, PROTECT_WITH_INDEX, and REPROTECT for speed,
as is possible because the required variables are defined above. The
macros below call procedure in memory.c for error handling. PROTECT_PTR is
not redefined, since it contains a significant amount of code.
Defining USE_FAST_PROTECT_MACROS in source files outside src/main may
cause problems at link time. */
#ifdef USE_FAST_PROTECT_MACROS
extern SEXP Rf_protect_error (void); /* SEXP only so it will work with "?" */
extern void Rf_unprotect_error (void);
#undef PROTECT
#define PROTECT(s) \
( R_PPStackTop < R_PPStackSize ? R_PPStack[R_PPStackTop++] = (s) \
: Rf_protect_error() )
#undef PROTECT2
#define PROTECT2(s1,s2) \
( R_PPStackTop+1 < R_PPStackSize ? (R_PPStack[R_PPStackTop++] = (s1), \
R_PPStack[R_PPStackTop++] = (s2)) \
: Rf_protect_error() )
#undef PROTECT3
#define PROTECT3(s1,s2,s3) \
( R_PPStackTop+2 < R_PPStackSize ? (R_PPStack[R_PPStackTop++] = (s1), \
R_PPStack[R_PPStackTop++] = (s2), \
R_PPStack[R_PPStackTop++] = (s3)) \
: Rf_protect_error() )
#undef UNPROTECT
#define UNPROTECT(n) \
( R_PPStackTop >= (n) ? (void) (R_PPStackTop -= (n)) \
: Rf_unprotect_error() )
#undef PROTECT_WITH_INDEX
#define PROTECT_WITH_INDEX(x,i) \
( (*(i) = R_PPStackTop), PROTECT(x) )
#undef REPROTECT
#define REPROTECT(x,i) \
( (void) (R_PPStack[i] = x) )
#endif
#endif /* DEFN_H_ */
/*
*- Local Variables:
......
......@@ -506,8 +506,10 @@ void (SET_HASHVALUE)(SEXP x, int v);
#define isByteCode(x) (TYPEOF(x)==BCODESXP)
/* Pointer Protection and Unprotection */
#define PROTECT(s) Rf_protect(s)
#define UNPROTECT(n) Rf_unprotect(n)
#define PROTECT(s) Rf_protect(s)
#define PROTECT2(s1,s2) Rf_protect2(s) /* BEWARE! All args evaluated */
#define PROTECT3(s1,s2,s3) Rf_protect3(s) /* before any are protected */
#define UNPROTECT(n) Rf_unprotect(n)
#define UNPROTECT_PTR(s) Rf_unprotect_ptr(s)
/* We sometimes need to coerce a protected value and place the new
......@@ -661,6 +663,8 @@ Rboolean Rf_pmatch(SEXP, SEXP, Rboolean);
Rboolean Rf_psmatch(const char *, const char *, Rboolean);
void Rf_PrintValue(SEXP);
SEXP Rf_protect(SEXP);
void Rf_protect2(SEXP, SEXP);
void Rf_protect3(SEXP, SEXP, SEXP);
SEXP Rf_setAttrib(SEXP, SEXP, SEXP);
void Rf_setSVector(SEXP*, int, SEXP);
void Rf_set_elements_to_NA_or_NULL(SEXP, int, int);
......@@ -676,7 +680,7 @@ SEXP Rf_type2str(SEXPTYPE);
void Rf_unprotect(int);
void Rf_unprotect_ptr(SEXP);
void R_ProtectWithIndex(SEXP, PROTECT_INDEX *);
SEXP R_ProtectWithIndex(SEXP, PROTECT_INDEX *);
void R_Reprotect(SEXP, PROTECT_INDEX);
SEXP R_tryEval(SEXP, SEXP, int *);
SEXP R_tryEvalSilent(SEXP, SEXP, int *);
......
......@@ -29,6 +29,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <R_ext/RConverters.h>
......
......@@ -29,6 +29,7 @@
#include <string.h>
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <R_ext/RStartup.h>
......@@ -80,7 +81,7 @@ do_commandArgs(SEXP call, SEXP op, SEXP args, SEXP env)
SEXP vals;
/* need protection as mkChar allocates */
vals = PROTECT(allocVector(STRSXP, NumCommandLineArgs));
PROTECT(vals = allocVector(STRSXP, NumCommandLineArgs));
for(i = 0; i < NumCommandLineArgs; i++)
SET_STRING_ELT(vals, i, mkChar(CommandLineArgs[i]));
UNPROTECT(1);
......
......@@ -29,6 +29,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
#include <R_ext/Random.h>
......
......@@ -90,6 +90,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <string.h>
......
......@@ -34,6 +34,7 @@
#endif
#include <stdlib.h> /* for setenv or putenv */
#define USE_FAST_PROTECT_MACROS
#include <Defn.h> /* for PATH_MAX */
#include <Rinterface.h>
#include <Fileio.h>
......
......@@ -32,6 +32,7 @@
# include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
/* This is remapped */
#undef pmatch
......
......@@ -27,6 +27,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
/* .Internal(lapply(X, FUN)) */
......
......@@ -33,6 +33,7 @@
/* for definition of "struct exception" in math.h */
# define __LIBM_PRIVATE
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h" /*-> Arith.h -> math.h */
#ifdef __OpenBSD__
# undef __LIBM_PRIVATE
......
......@@ -29,6 +29,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Rmath.h>
#include <R_ext/RS.h> /* for Calloc/Free */
......
......@@ -28,6 +28,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Rmath.h>
......@@ -1532,7 +1533,7 @@ SEXP R_do_slot(SEXP obj, SEXP name) {
TYPEOF(obj) == VECSXP) /* needed for namedList class */
return value;
if(isSymbol(name) ) {
input = PROTECT(ScalarString(PRINTNAME(name)));
PROTECT(input = ScalarString(PRINTNAME(name)));
classString = getAttrib(obj, R_ClassSymbol);
if(isNull(classString)) {
UNPROTECT(1);
......
......@@ -31,6 +31,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Graphics.h>
#include <Colors.h>
......
......@@ -31,6 +31,7 @@
# include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#define imax2(x, y) ((x < y) ? y : x)
......
......@@ -29,6 +29,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <Print.h>
......
......@@ -74,6 +74,7 @@ abbreviate chartr make.names strtrim tolower toupper give error.
# include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <errno.h>
......
......@@ -29,6 +29,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h> /*-- Maybe modularize into own Coerce.h ..*/
#include <float.h> /* for DBL_DIG */
#define R_MSG_mode _("invalid 'mode' argument")
......
......@@ -30,6 +30,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Graphics.h> /* for dpptr */
#include <Colors.h>
......
......@@ -63,6 +63,7 @@
#undef HAVE_CPOW
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h> /* -> ../include/R_ext/Complex.h */
#include <Rmath.h>
#include <R_ext/Applic.h> /* R_cpoly */
......
......@@ -79,6 +79,9 @@
# include <config.h>
#endif
/* Don't enable this, since: (1) many instances, but not time critical,
and (2) PROTECT is used as a function here */
/* #define USE_FAST_PROTECT_MACROS */
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <Fileio.h>
......
......@@ -113,6 +113,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include <Defn.h>
......
......@@ -28,6 +28,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Rmath.h>
......
......@@ -28,6 +28,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
static SEXP cumsum(SEXP x, SEXP s)
......
......@@ -116,6 +116,7 @@ extern time_t mktime (struct tm*);
#endif
#include <stdlib.h> /* for setenv or putenv */
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
/* The glibc in RH8.0 was broken and assumed that dates before
......
......@@ -27,6 +27,7 @@
# include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <Rconnections.h>
......
......@@ -28,6 +28,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include <Defn.h>
......
......@@ -95,6 +95,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <float.h> /* for DBL_DIG */
......
......@@ -32,6 +32,8 @@
#include <config.h>
#endif
/* Don't enable this, since many instances, but probably not time critical */
/* #define USE_FAST_PROTECT_MACROS */
#include "Defn.h"
static SEXP ParenSymbol;
......
......@@ -37,6 +37,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Graphics.h>
#include <GraphicsBase.h> /* registerBase */
......
......@@ -29,6 +29,7 @@
# include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <ctype.h> /* for tolower */
......
......@@ -31,6 +31,7 @@
#define HAVE_BZIP2
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Fileio.h> /* for R_fopen */
#include "unzip.h"
......
......@@ -29,6 +29,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
......
......@@ -29,6 +29,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
#include <R_ext/RS.h> /* S4 bit */
......
......@@ -27,6 +27,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <R_ext/GraphicsEngine.h>
#include <R_ext/Applic.h> /* pretty0() */
......
......@@ -92,6 +92,7 @@
# include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include "Defn.h"
#include <R_ext/Callbacks.h>
......
......@@ -27,6 +27,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include <Defn.h>
/* -> Errormsg.h */
......
......@@ -31,6 +31,7 @@
# include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <Rinterface.h>
......
......@@ -45,6 +45,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <float.h> /* for DBL_EPSILON */
#include <Rmath.h>
......
......@@ -31,6 +31,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
#include <R_ext/Applic.h>
......
......@@ -31,6 +31,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Rmath.h>
#include <R_ext/GraphicsEngine.h>
......
......@@ -35,6 +35,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
int R_fgetc(FILE *fp)
......
......@@ -102,6 +102,8 @@
#include <config.h>
#endif
/* Don't enable this, since many instances, but not time critical */
/* #define USE_FAST_PROTECT_MACROS */
#include "IOStuff.h" /*-> Defn.h */
#include "Fileio.h"
#include "Parse.h"
......
......@@ -23,6 +23,8 @@
#include <config.h>
#endif
/* Don't enable this, since many instances, but not time critical */
/* #define USE_FAST_PROTECT_MACROS */
#include "IOStuff.h" /*-> Defn.h */
#include "Fileio.h"
#include "Parse.h"
......
......@@ -99,6 +99,8 @@
#include <config.h>
#endif
/* Don't enable this, since many instances, but not time critical */
/* #define USE_FAST_PROTECT_MACROS */
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <Parse.h>
......
......@@ -23,6 +23,8 @@
#include <config.h>
#endif
/* Don't enable this, since many instances, but not time critical */
/* #define USE_FAST_PROTECT_MACROS */
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <Parse.h>
......
......@@ -34,6 +34,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <float.h> /* for DBL_EPSILON etc */
#include <Graphics.h>
......
......@@ -59,6 +59,7 @@ strsplit grep [g]sub [g]regexpr
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <R_ext/RS.h> /* for Calloc/Free */
#include <ctype.h>
......@@ -1111,7 +1112,7 @@ SEXP attribute_hidden do_grepraw(SEXP call, SEXP op, SEXP args, SEXP env)
/* if there are more matches than in the buffer,
we actually need to get them first */
if (nmatches > MAX_MATCHES_MINIBUF) {
mvec = PROTECT(allocVector(INTSXP, nmatches));
PROTECT(mvec = allocVector(INTSXP, nmatches));
fmatches = INTEGER(mvec);
memcpy(fmatches, matches, sizeof(matches));
nmatches = MAX_MATCHES_MINIBUF;
......@@ -1126,7 +1127,7 @@ SEXP attribute_hidden do_grepraw(SEXP call, SEXP op, SEXP args, SEXP env)
}
/* there are always nmatches + 1 pieces (unlike strsplit) */
ans = PROTECT(allocVector(VECSXP, nmatches + 1));
PROTECT(ans = allocVector(VECSXP, nmatches + 1));
/* add all pieces before matches */
for (i = 0; i < nmatches; i++) {
R_size_t elt_size = fmatches[i] - 1 - pos;
......@@ -1149,7 +1150,7 @@ SEXP attribute_hidden do_grepraw(SEXP call, SEXP op, SEXP args, SEXP env)
/* value=TRUE is pathetic for fixed=TRUE without
invert as it is just rep(pat, nmatches) */
ans = PROTECT(allocVector(VECSXP, nmatches));
PROTECT(ans = allocVector(VECSXP, nmatches));
for (i = 0; i < nmatches; i++)
SET_VECTOR_ELT(ans, i, pat);
UNPROTECT(1);
......@@ -1215,7 +1216,7 @@ SEXP attribute_hidden do_grepraw(SEXP call, SEXP op, SEXP args, SEXP env)
to allow use on big binary strings with many matches (it could be done
by re-allocating a temp buffer but I chose sequential allocations to
reduce possible fragmentation) */
res_head = res_tail = PROTECT(list1(allocVector(INTSXP, res_alloc)));
PROTECT(res_head = res_tail = list1(allocVector(INTSXP, res_alloc)));
res_val = INTEGER(CAR(res_tail));
res_ptr = 0;
while (1) {
......@@ -1255,7 +1256,7 @@ SEXP attribute_hidden do_grepraw(SEXP call, SEXP op, SEXP args, SEXP env)
R_size_t entry = 0, cptr = 0, clen = (CDR(res_head) == R_NilValue) ? res_ptr : LENGTH(vec);
R_size_t inv_start = 0; /* 0-based start position of the pieces for invert */
res_val = INTEGER(vec);
ans = PROTECT(allocVector(VECSXP, invert ? (nmatches + 1) : nmatches));
PROTECT(ans = allocVector(VECSXP, invert ? (nmatches + 1) : nmatches));
while (entry < nmatches) {
if (invert) { /* for invert=TRUE store the current piece up to the match */
SEXP rvec = allocVector(RAWSXP, res_val[cptr] - 1 - inv_start);
......
......@@ -27,6 +27,7 @@
#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
/* -> Rinternals.h which exports R_compute_identical() */
......
......@@ -28,5 +28,6 @@
#endif
#define COMPILING_R 1 /* for Rinlinedfuns.h included via Defn.h */
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#undef COMPILING_R
......@@ -34,6 +34,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#define SHOW_PAIRLIST_NODES 1 /* Should some details of all nodes in
......
......@@ -27,6 +27,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Rconnections.h>
#include <Rdynpriv.h>
......
......@@ -27,6 +27,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
#include <Rdynpriv.h>
#include <Rmodules/Rlapack.h>
......
......@@ -36,6 +36,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
/* Utility functions moved to Rinlinedfuns.h */
......
......@@ -28,6 +28,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
......
......@@ -36,6 +36,7 @@
#include <string.h>
#define __MAIN__
#define USE_FAST_PROTECT_MACROS
#define R_USE_SIGNALS 1
#include "Defn.h"
#include "Rinterface.h"
......
......@@ -27,6 +27,7 @@
# include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include <Defn.h>
......@@ -38,7 +39,8 @@ do_mapply(SEXP f, SEXP varyingArgs, SEXP constantArgs, SEXP rho)
SEXP vnames, fcall = R_NilValue, mindex, nindex, tmp1, tmp2, ans;
m = length(varyingArgs);
vnames = PROTECT(getAttrib(varyingArgs, R_NamesSymbol));
PROTECT(vnames = getAttrib(varyingArgs, R_NamesSymbol));
named = vnames != R_NilValue;
lengths = (int *) R_alloc(m, sizeof(int));
......@@ -53,8 +55,8 @@ do_mapply(SEXP f, SEXP varyingArgs, SEXP constantArgs, SEXP rho)
counters = (int *) R_alloc(m, sizeof(int));
for(i = 0; i < m; counters[i++] = 0);
mindex = PROTECT(allocVector(VECSXP, m));
nindex = PROTECT(allocVector(VECSXP, m));
PROTECT(mindex = allocVector(VECSXP, m));
PROTECT(nindex = allocVector(VECSXP, m));
/* build a call like
f(dots[[1]][[4]], dots[[2]][[4]], dots[[3]][[4]], d=7)
......
......@@ -66,6 +66,7 @@
#include <config.h>
#endif
#define USE_FAST_PROTECT_MACROS
#include "Defn.h"
/* This is a horrible kludge used in logic.c and in summary.c (where
......
......@@ -81,6 +81,7 @@
#define VALGRIND_LEVEL 0
#endif
#define USE_FAST_PROTECT_MACROS /* MUST be defined in this module! */
#define R_USE_SIGNALS 1
#include <Defn.h>
#include <R_ext/GraphicsEngine.h> /* GEDevDesc, GEgetDevice */
......@@ -2761,17 +2762,22 @@ SEXP attribute_hidden do_memoryprofile(SEXP call, SEXP op, SEXP args, SEXP env)
return ans;
}
/* "protect" push a single argument onto R_PPStack */
/* "protect" push a single argument onto R_PPStack.
/* In handling a stack overflow we have to be careful not to use
In handling a stack overflow we have to be careful not to use
PROTECT. error("protect(): stack overflow") would call deparse1,
which uses PROTECT and segfaults.*/
which uses PROTECT and segfaults.
/* However, the traceback creation in the normal error handler also
However, the traceback creation in the normal error handler also
does a PROTECT, as does the jumping code, at least if there are
cleanup expressions to handle on the way out. So for the moment
we'll allocate a slightly larger PP stack and only enable the added
red zone during handling of a stack overflow error. LT */
red zone during handling of a stack overflow error. LT
The PROTECT, UNPROTECT, PROTECT_WITH_INDEX, and REPROTECT macros at
the end of Defn.h do these things without procedure call overhead, and
are used here to define these functions, to keep the code in sync.
*/
static void reset_pp_stack(void *data)
{
......@@ -2779,40 +2785,59 @@ static void reset_pp_stack(void *data)
R_PPStackSize = *poldpps;
}
SEXP attribute_hidden Rf_protect_error (void) /* SEXP only so it will work */
{ /* with "?" in macros in Defn.h */
RCNTXT cntxt;
R_size_t oldpps = R_PPStackSize;
begincontext(&cntxt, CTXT_CCODE, R_NilValue, R_BaseEnv, R_BaseEnv,
R_NilValue, R_NilValue);
cntxt.cend = &reset_pp_stack;
cntxt.cenddata = &oldpps;
if (R_PPStackSize < R_RealPPStackSize)
R_PPStackSize = R_RealPPStackSize;
errorcall(R_NilValue, _("protect(): protection stack overflow"));
endcontext(&cntxt); /* not reached */
return R_NilValue;
}
SEXP protect(SEXP s)