Commit 37889fc8 authored by Radford Neal's avatar Radford Neal

put printname back in symbol structure, lots of related changes

parent 17da785e
Puts back the lastsymenvnotfound feature, since symbits don't
replace it entirely due to environemnts with too many symbols.
Puts printname back in symbol (not symbol table hash entry), as
not having it there slowed some operations.
Also uses symbits for more environments, including hashed ones.
......@@ -30,8 +30,6 @@ typedef int lphash_hash_t; /* Character/symbol hash as stored in symbol
typedef struct {
lphash_entry_t entry; /* SEXP32 pointer to symbol object */
lphash_hash_t hash; /* Character/symbol hash */
unsigned pname; /* Compressed pointer to print name */
unsigned padding;
} lphash_bucket_t;
#define LPHASH_NO_ENTRY 0 /* R_NoObject */
......
......@@ -115,6 +115,7 @@ sggc_nchunks_t Rf_nchunks (int type /* SEXPTYPE */, unsigned length);
/* All:
length in auxiliary information 1 (may be shared read-only constant)
attrib in auxiliary information 2
no room in symbol for hash (uses hash from printname)
Cons-type: Vector:
info, car info, truelength
......@@ -124,8 +125,8 @@ sggc_nchunks_t Rf_nchunks (int type /* SEXPTYPE */, unsigned length);
Symbol: Primitive: Environment: External pointer:
info, lastbinding info, padding info, frame info, unused/shift
value, hash C-function enclos, hashtab prot, tag
lastenv, lastenf fast-C-function hashlen, pad external ptr(+pad)
value, pname C-function enclos, hashtab prot, tag
lastenv, lastenf fast-C-function hashlen, tcnts external ptr(+pad)
symbits 64 bits of info envsymbits padding
= 32 bytes padding if 32-bit = 32 bytes = 32 bytes
(2 chunks) = 32 bytes (2 chunks) (2 chunks)
......@@ -221,11 +222,11 @@ sggc_nchunks_t Rf_nchunks (int type /* SEXPTYPE */, unsigned length);
Symbol: Primitive: Environment: External pointer:
info, cptr info, cptr info, cptr info, cptr
attrib attrib attrib attrib
length, tunecnts2 length, padding length, tunecnts length, padding
length, tunecnts length, padding length, padding length, padding
lastbinding C-function frame external ptr
value fast-C-function enclos prot
hash, lastenv 64 bits of info hashtab tag
tunecnts, lastenf = 48 bytes hashlen, pad = 48 bytes
pname, lastenv 64 bits of info hashtab tag
hash, lastenf = 48 bytes hashlen, tcnts = 48 bytes
symbits (3 chunks) envsymbits (3 chunks)
= 64 bytes = 64 bytes
(4 chunks) (4 chunks)
......@@ -306,8 +307,8 @@ sggc_nchunks_t Rf_nchunks (int type /* SEXPTYPE */, unsigned length);
info, cptr info, cptr info, cptr info, cptr
lastbinding C-function frame external ptr
value fast-C-function enlcos prot
hash, lastenv 64 bits of info hashtab tag
tunecnts, lastenf = 32 bytes hashlen, pad = 32 bytes
pname, lastenv 64 bits of info hashtab tag
hash, lastenf = 32 bytes hashlen, tcnts = 32 bytes
symbits (2 chunks) envsymbits (2 chunks)
= 48 bytes = 48 bytes
(3 chunks) (3 chunks)
......@@ -389,8 +390,8 @@ sggc_nchunks_t Rf_nchunks (int type /* SEXPTYPE */, unsigned length);
info, cptr info, cptr info, cptr info, cptr
attrib, length attrib, length attrib, length attrib, length
lastbinding, value C-function, fastfun frame, enclos prot, tag
hash, lastenv 64 bits of info hashtab, tcnts xptr, padding
tunecnts, lastenf = 32 bytes hashlen, pad = 32 bytes
pname, lastenv 64 bits of info hashtab,hashlen xptr, padding
hash, lastenf = 32 bytes tcnts, padding = 32 bytes
symbits (2 chunks) envsymbits (2 chunks)
= 48 bytes = 48 bytes
(3 chunks) (3 chunks)
......
......@@ -189,7 +189,12 @@ extern0 SEXP R_UnderscoreString; /* "_", as a CHARSXP */
#define SET_HASHSLOTSUSED(x,v) SET_TRUELENGTH(x,v)
#define IS_HASHED(x) (HASHTAB(x) != R_NilValue)
#if SYM_HASH_IN_SYM
#define SYM_HASH(x) (((SYM_SEXPREC*)UPTR_FROM_SEXP(x))->sym_hash)
#else
#define SYM_HASH(x) CHAR_HASH(PRINTNAME(x))
#endif
#define CHAR_HASH(x) TRUELENGTH(x)
/* Test whether this is a constant object (defined in const-objs.c). */
......
......@@ -181,6 +181,7 @@ typedef SEXP SEXP32;
#define R_NoObject32 R_NoObject
#define CPTR_FROM_SEXP(x) (x)
#define CPTR_FROM_SEXP32(x) (x)
#define UPTR_FROM_SEXP(x) ((SEXPREC *) SGGC_DATA(x))
#define SEXP_FROM_CPTR(x) (x)
......@@ -191,11 +192,13 @@ typedef struct VECTOR_SEXPREC *VECSEXP;
#if SIZEOF_CHAR_P == 4
typedef SEXP SEXP32;
#define CPTR_FROM_SEXP32(x) CPTR_FROM_SEXP(x)
#define SEXP32_FROM_SEXP(x) (x)
#define SEXP_FROM_SEXP32(x) (x)
#define R_NoObject32 R_NoObject
#else
typedef sggc_cptr_t SEXP32;
#define CPTR_FROM_SEXP32(x) (x)
#define SEXP32_FROM_SEXP(x) CPTR_FROM_SEXP(x)
#define SEXP_FROM_SEXP32(x) SEXP_FROM_CPTR(x)
#define R_NoObject32 SGGC_NO_OBJECT
......@@ -322,27 +325,23 @@ typedef struct SEXPREC {
/* Version of SEXPREC used for environments. */
#if USE_AUX_FOR_ATTRIB
#define USE_ENV_TUNECNTS 0 /* Must be kept as 0 */
#else
#define USE_ENV_TUNECNTS 0 /* May be 0 or 1 - normally 0 to avoid slowdown */
#endif
typedef uint64_t R_symbits_t;
typedef struct ENV_SEXPREC {
SEXPREC_HEADER;
#if !USE_COMPRESSED_POINTERS && SIZEOF_CHAR_P == 8 && !USE_AUX_FOR_ATTRIB
uint32_t env_tunecnt;
int32_t padding;
#endif
SEXP frame;
SEXP enclos;
SEXP hashtab;
#if !USE_COMPRESSED_POINTERS && SIZEOF_CHAR_P == 4
uint32_t env_tunecnt;
#endif
int32_t hashlen;
uint32_t env_tunecnt;
#if !USE_COMPRESSED_POINTERS && SIZEOF_CHAR_P == 4
int32_t padding;
#endif
R_symbits_t envsymbits;
} ENV_SEXPREC, *ENVSEXP;
......@@ -382,29 +381,35 @@ typedef struct PRIM_SEXPREC {
/* Version of SEXPREC used for symbols. */
#if USE_COMPRESSED_POINTERS
#define USE_SYM_TUNECNTS 0 /* Must be kept as 0 */
#else
#if !USE_COMPRESSED_POINTERS && SIZEOF_CHAR_P == 8 && !USE_AUX_FOR_ATTRIB
#define USE_SYM_TUNECNTS 0 /* May be 0 or 1 - normally 0 to avoid slowdown */
#else
#define USE_SYM_TUNECNTS 0 /* Must be kept as 0 */
#endif
#if USE_COMPRESSED_POINTERS || SIZEOF_CHAR_P != 8 || USE_AUX_FOR_ATTRIB
#if 1 /* currently no space for this */
#define USE_SYM_TUNECNTS2 0 /* Must be kept as 0 */
#else
#define USE_SYM_TUNECNTS2 0 /* May be 0 or 1 - normally 0 to avoid slowdown */
#endif
#if USE_COMPRESSED_POINTERS
#define SYM_HASH_IN_SYM 0 /* No room for it */
#else
#define SYM_HASH_IN_SYM 1
#endif
typedef struct SYM_SEXPREC {
SEXPREC_HEADER;
#if !USE_COMPRESSED_POINTERS && SIZEOF_CHAR_P == 8 && !USE_AUX_FOR_ATTRIB
uint32_t sym_tunecnt2;
uint32_t sym_tunecnt;
#endif
SEXP lastbinding;
SEXP value;
int32_t sym_hash;
SEXP32 pname;
SEXP32 lastenv;
#if !USE_COMPRESSED_POINTERS
uint32_t sym_tunecnt;
#if SYM_HASH_IN_SYM
uint32_t sym_hash;
#endif
SEXP32 lastenvnotfound;
R_symbits_t symbits;
......@@ -848,6 +853,8 @@ static inline void UNSET_S4_OBJECT_inline (SEXP x) {
#define SET_RSTEP(x,v) (UPTR_FROM_SEXP(x)->sxpinfo.rstep=(v))
/* Symbol Access Macros */
#define PRINTNAME(x) \
NOT_LVALUE(SEXP_FROM_SEXP32(((SYMSEXP) UPTR_FROM_SEXP(x))->pname))
#define SYMVALUE(x) NOT_LVALUE(((SYMSEXP) UPTR_FROM_SEXP(x))->value)
#define LASTSYMENV(x) (((SYMSEXP) UPTR_FROM_SEXP(x))->lastenv)
#define LASTSYMBINDING(x) (((SYMSEXP) UPTR_FROM_SEXP(x))->lastbinding)
......@@ -978,6 +985,7 @@ SEXP (SYMVALUE)(SEXP x);
SEXP (INTERNAL)(SEXP x);
int (DDVAL)(SEXP x);
void (SET_DDVAL)(SEXP x, int v);
void SET_PRINTNAME(SEXP x, SEXP v);
void SET_SYMVALUE(SEXP x, SEXP v);
void SET_INTERNAL(SEXP x, SEXP v);
......
......@@ -533,19 +533,7 @@ attribute_hidden void (SET_PRIMOFFSET)(SEXP x, int v) { SET_PRIMOFFSET(x, v); }
/* Symbol Accessors */
SEXP (PRINTNAME)(SEXP x)
{
Rf_chk_valid_SEXP(x);
lphash_bucket_t *bucket
= lphash_entry_lookup (R_lphashSymTbl, SYM_HASH(x), SEXP32_FROM_SEXP(x));
if (bucket == NULL)
return x == R_MissingUnder ? R_UnderscoreString : R_BlankString;
else
return SEXP_FROM_CPTR(bucket->pname);
}
SEXP (PRINTNAME)(SEXP x) { return Rf_chk_valid_SEXP(PRINTNAME(Rf_chk_valid_SEXP(x))); }
SEXP (SYMVALUE)(SEXP x) { return Rf_chk_valid_SEXP(SYMVALUE(Rf_chk_valid_SEXP(x))); }
SEXP (INTERNAL)(SEXP x) { return Rf_chk_valid_SEXP(INTERNAL(Rf_chk_valid_SEXP(x))); }
int (DDVAL)(SEXP x) { return DDVAL(Rf_chk_valid_SEXP(x)); }
......@@ -561,7 +549,7 @@ void (SET_SYMVALUE)(SEXP x, SEXP v)
}
void (SET_INTERNAL)(SEXP x, SEXP v)
{
/* No old-to-new check is needed, since primatives are uncollected. */
/* No old-to-new check is needed, since primitives are uncollected. */
sggc_cptr_t s = CPTR_FROM_SEXP(x);
if (TYPEOF(v)!=BUILTINSXP && TYPEOF(v)!=SPECIALSXP) abort();
......
......@@ -144,6 +144,7 @@ R_CONST ENV_SEXPREC R_env_consts[1] = {
SYM_SEXPREC R_sym_consts[1] = {
{
CONST_HEADER(SYMSXP,R_SGGC_SYM_INDEX,0),
.pname = SGGC_CPTR_VAL(R_SGGC_NIL_INDEX,0),
.value = R_UnboundValue,
.symbits = 0 /* all 0s, so will always look for this */
} /* (and presumably not find it) */
......
......@@ -589,8 +589,14 @@ void sggc_find_root_ptrs (void)
symbol kind. We have to scan the symbol table specially because
we need to clear LASTSYMENV and LASTENVNOTFOUND. Plus it's
faster to mark / follow the pointers with special code here.
So we don't need old-to-new processing when setting fields. */
So we don't need old-to-new processing when setting fields.
Marking printnames is not necessary for correctness, since they
won't be freed anyway, but this may perhaps be faster for full
collections than almost freeing many of them and then backing
out in free_charsxp. */
int level = gc_next_level;
sggc_cptr_t nxt;
for (nxt = sggc_first_uncollected_of_kind(SGGC_SYM_KIND);
......@@ -601,28 +607,15 @@ void sggc_find_root_ptrs (void)
LASTENVNOTFOUND(s) = R_NoObject32;
if (SYMVALUE(s) != R_UnboundValue) LOOK_AT(SYMVALUE(s));
if (ATTRIB_W(s) != R_NilValue) LOOK_AT(ATTRIB_W(s));
}
/* Perhaps scan printnames in symbol table. Not necessary for
correctness, since they won't be freed anyway, but this may
perhaps be faster for full collections than almost freeing many
of them and then backing out in free_charsxp. */
if (gc_next_level >= MIN_PRINTNAME_SCAN_LEVEL) {
for (lphash_bucket_t *b = lphash_first_bucket(R_lphashSymTbl);
b != NULL;
b = lphash_next_bucket(R_lphashSymTbl,b)) {
sggc_mark (b->pname);
}
if (level >= MIN_PRINTNAME_SCAN_LEVEL)
sggc_mark(CPTR_FROM_SEXP32(((SYMSEXP)UPTR_FROM_SEXP(s))->pname));
}
/* Forward other roots. */
static SEXP *root_vars[] = {
&NA_STRING, /* Builtin constants */
&R_BlankString,
&R_BlankScalarString,
&R_UnderscoreString,
&R_BlankScalarString, /* Will also protect R_BlankString */
&R_print.na_string, /* Printing defaults - very kludgy! */
&R_print.na_string_noquote,
......@@ -1690,10 +1683,17 @@ SEXP attribute_hidden mkSYMSXP(SEXP name, SEXP value)
c = alloc_sym();
UNPROTECT(2);
SET_SYMVALUE (c, value);
((SYMSEXP)UPTR_FROM_SEXP(c))->pname = SEXP32_FROM_SEXP(name);
IS_PRINTNAME(name) = 1;
# if SYM_HASH_IN_SYM
SYM_HASH(c) = CHAR_HASH(name);
# endif
SYMVALUE(c) = value;
LASTSYMENV(c) = R_NoObject32;
LASTENVNOTFOUND(c) = R_NoObject32;
LASTSYMBINDING(c) = R_NoObject;
SYMBITS(c) = 0; /* all 0s to disable feature if not set later */
# if USE_SYM_TUNECNTS
......
......@@ -693,22 +693,25 @@ void InitNames()
SetupBuiltins();
/* The SYMSXP objects below are not in the symbol table. Their
printnames are determined specially by PRINTNAME. */
/* R_BlankString */
R_BlankString = mkChar("");
R_BlankScalarString = ScalarString(R_BlankString);
SET_NAMEDCNT_MAX(R_BlankScalarString);
/* The SYMSXP objects below are not in the symbol table. */
/* R_MissingArg */
R_MissingArg = mkSYMSXP(R_NilValue,R_NilValue);
R_MissingArg = mkSYMSXP(R_BlankString,R_NilValue);
SET_SYMVALUE(R_MissingArg, R_MissingArg);
/* R_MissingUnder */
R_MissingUnder = mkSYMSXP(R_NilValue,R_NilValue);
SET_SYMVALUE(R_MissingUnder, R_MissingArg);
R_UnderscoreString = mkChar("_");
R_MissingUnder = mkSYMSXP(R_UnderscoreString,R_MissingArg);
/* R_RestartToken */
R_RestartToken = mkSYMSXP(R_NilValue,R_NilValue);
R_RestartToken = mkSYMSXP(R_BlankString,R_NilValue);
SET_SYMVALUE(R_RestartToken, R_RestartToken);
/* String constants (CHARSXP values) */
/* Note: we don't want NA_STRING to be in the CHARSXP cache, so that
mkChar("NA") is distinct from NA_STRING */
......@@ -717,12 +720,6 @@ void InitNames()
strcpy(CHAR_RW(NA_STRING), "NA");
SET_CACHED(NA_STRING); /* Mark it */
R_print.na_string = NA_STRING;
/* R_BlankString */
R_BlankString = mkChar("");
R_BlankScalarString = ScalarString(R_BlankString);
SET_NAMEDCNT_MAX(R_BlankScalarString);
/* R_UnderscoreString */
R_UnderscoreString = mkChar("_");
/* Set up a set of globals so that a symbol table search can be
avoided when matching something like dim or dimnames. */
......@@ -747,7 +744,6 @@ static SEXP install_with_hashcode (char *name, int hashcode)
if (bucket != NULL)
return SEXP_FROM_SEXP32 (bucket->entry);
/* Create a new symbol node and link it into the table. */
if (strlen(name) > MAXIDSIZE)
error(_("variable names are limited to %d bytes"), MAXIDSIZE);
......@@ -756,13 +752,7 @@ static SEXP install_with_hashcode (char *name, int hashcode)
if (bucket == NULL)
R_Suicide("couldn't allocate memory to expand symbol table");
SEXP pname = mkChar(name);
IS_PRINTNAME(pname) = 1;
bucket->pname = CPTR_FROM_SEXP(pname);
SEXP sym = SEXP_FROM_SEXP32(bucket->entry);
SYM_HASH(sym) = CHAR_HASH(pname);
/* Set up symbits. May be fiddled to try to improve performance.
Currently, the low 14 bits of symbits are reserved for special and
......
......@@ -1842,6 +1842,8 @@ SEXP attribute_hidden R_subset3_dflt(SEXP x, SEXP input, SEXP name, SEXP call,
cinp = input==R_NilValue ? CHAR(PRINTNAME(name)) : translateChar(input);
havematch = 0;
for (y = x ; y != R_NilValue ; y = CDR(y)) {
if (TAG(y) == R_NilValue)
continue;
ctarg = CHAR(PRINTNAME(TAG(y)));
mtch = ep_match_strings(ctarg, cinp);
if (mtch>0) /* exact */ {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment