in source/src/main/inspect.c [77:237]
static void inspect_tree(int pre, SEXP v, int deep, int pvec) {
int a = 0;
pp(pre);
/* the use of %lx is deliberate because I hate the output of %p,
but if this causes portability issues, it could be changed.
SU
It is invalid on 64-bit Windows.
*/
#ifdef _WIN64
Rprintf("@%p %02d %s g%dc%d [", v, TYPEOF(v), typename(v),
v->sxpinfo.gcgen, v->sxpinfo.gccls);
#else
Rprintf("@%lx %02d %s g%dc%d [", (long) v, TYPEOF(v), typename(v),
v->sxpinfo.gcgen, v->sxpinfo.gccls);
#endif
if (OBJECT(v)) { a = 1; Rprintf("OBJ"); }
if (MARK(v)) { if (a) Rprintf(","); Rprintf("MARK"); a = 1; }
#ifndef SWITCH_TO_REFCNT
if (NAMED(v)) { if (a) Rprintf(","); Rprintf("NAM(%d)",NAMED(v)); a = 1; }
#endif
if (REFCNT(v)) { if (a) Rprintf(","); Rprintf("REF(%d)",REFCNT(v)); a = 1; }
if (RDEBUG(v)) { if (a) Rprintf(","); Rprintf("DBG"); a = 1; }
if (RTRACE(v)) { if (a) Rprintf(","); Rprintf("TR"); a = 1; }
if (RSTEP(v)) { if (a) Rprintf(","); Rprintf("STP"); a = 1; }
if (IS_S4_OBJECT(v)) { if (a) Rprintf(","); Rprintf("S4"); a = 1; }
if (TYPEOF(v) == SYMSXP || TYPEOF(v) == LISTSXP) {
if (IS_ACTIVE_BINDING(v)) { if (a) Rprintf(","); Rprintf("AB"); a = 1; }
if (BINDING_IS_LOCKED(v)) { if (a) Rprintf(","); Rprintf("LCK"); a = 1; }
}
if (TYPEOF(v) == ENVSXP) {
if (FRAME_IS_LOCKED(v)) { if (a) Rprintf(","); Rprintf("LCK"); a = 1; }
if (IS_GLOBAL_FRAME(v)) { if (a) Rprintf(","); Rprintf("GL"); a = 1; }
}
if (LEVELS(v)) { if (a) Rprintf(","); Rprintf("gp=0x%x", LEVELS(v)); a = 1; }
if (ATTRIB(v) && ATTRIB(v) != R_NilValue) { if (a) Rprintf(","); Rprintf("ATT"); a = 1; }
Rprintf("] ");
switch (TYPEOF(v)) {
case VECSXP: case STRSXP: case LGLSXP: case INTSXP: case RAWSXP:
case REALSXP: case CPLXSXP: case EXPRSXP:
Rprintf("(len=%ld, tl=%ld)", XLENGTH(v), XTRUELENGTH(v));
}
if (TYPEOF(v) == ENVSXP) /* NOTE: this is not a trivial OP since it involves looking up things
in the environment, so for a low-level debugging we may want to
avoid it .. */
PrintEnvironment(v);
if (TYPEOF(v) == CHARSXP) {
if (IS_BYTES(v)) Rprintf("[bytes] ");
if (IS_LATIN1(v)) Rprintf("[latin1] ");
if (IS_UTF8(v)) Rprintf("[UTF8] ");
if (IS_ASCII(v)) Rprintf("[ASCII] ");
if (IS_CACHED(v)) Rprintf("[cached] ");
Rprintf("\"%s\"", CHAR(v));
}
if (TYPEOF(v) == SYMSXP)
Rprintf("\"%s\"%s", EncodeChar(PRINTNAME(v)), (SYMVALUE(v) == R_UnboundValue) ? "" : " (has value)");
switch (TYPEOF(v)) { /* for native vectors print the first elements in-line */
case LGLSXP:
if (XLENGTH(v) > 0) {
unsigned int i = 0;
while (i < XLENGTH(v) && i < pvec) {
Rprintf("%s%d", (i > 0) ? "," : " ", (int) LOGICAL(v)[i]);
i++;
}
if (i < XLENGTH(v)) Rprintf(",...");
}
break;
case INTSXP:
if (XLENGTH(v) > 0) {
unsigned int i = 0;
while (i < XLENGTH(v) && i < pvec) {
Rprintf("%s%d", (i > 0) ? "," : " ", INTEGER(v)[i]);
i++;
}
if (i < XLENGTH(v)) Rprintf(",...");
}
break;
case RAWSXP:
if (XLENGTH(v) > 0) {
unsigned int i = 0;
while (i < XLENGTH(v) && i < pvec) {
Rprintf("%s%02x", (i > 0) ? "," : " ", (int) ((unsigned char) RAW(v)[i]));
i++;
}
if (i < XLENGTH(v)) Rprintf(",...");
}
break;
case REALSXP:
if (XLENGTH(v) > 0) {
unsigned int i = 0;
while (i < XLENGTH(v) && i < pvec) {
Rprintf("%s%g", (i > 0) ? "," : " ", REAL(v)[i]);
i++;
}
if (i < XLENGTH(v)) Rprintf(",...");
}
break;
}
Rprintf("\n");
if (deep) switch (TYPEOF(v)) {
case VECSXP: case EXPRSXP:
{
unsigned int i = 0;
while (i < XLENGTH(v) && i < pvec) {
inspect_tree(pre+2, VECTOR_ELT(v, i), deep - 1, pvec);
i++;
}
if (i < XLENGTH(v)) { pp(pre+2); Rprintf("...\n"); }
}
break;
case STRSXP:
{
unsigned int i = 0;
while (i < XLENGTH(v) && i < pvec) {
inspect_tree(pre+2, STRING_ELT(v, i), deep - 1, pvec);
i++;
}
if (i < XLENGTH(v)) { pp(pre+2); Rprintf("...\n"); }
}
break;
case LISTSXP: case LANGSXP:
{
SEXP lc = v;
while (lc != R_NilValue) {
if (TAG(lc) && TAG(lc) != R_NilValue) {
pp(pre + 2);
Rprintf("TAG: "); /* TAG should be a one-liner since it's a symbol so we don't put it on an extra line*/
inspect_tree(0, TAG(lc), deep - 1, pvec);
}
inspect_tree(pre + 2, CAR(lc), deep - 1, pvec);
lc = CDR(lc);
}
}
break;
case ENVSXP:
if (FRAME(v) != R_NilValue) {
pp(pre); Rprintf("FRAME:\n");
inspect_tree(pre+2, FRAME(v), deep - 1, pvec);
}
pp(pre); Rprintf("ENCLOS:\n");
inspect_tree(pre+2, ENCLOS(v), 0, pvec);
if (HASHTAB(v) != R_NilValue) {
pp(pre); Rprintf("HASHTAB:\n");
inspect_tree(pre+2, HASHTAB(v), deep - 1, pvec);
}
break;
case CLOSXP:
pp(pre); Rprintf("FORMALS:\n");
inspect_tree(pre+2, FORMALS(v), deep - 1, pvec);
pp(pre); Rprintf("BODY:\n");
inspect_tree(pre+2, BODY(v), deep - 1, pvec);
pp(pre); Rprintf("CLOENV:\n");
inspect_tree(pre+2, CLOENV(v), 0, pvec);
break;
}
if (ATTRIB(v) && ATTRIB(v) != R_NilValue && TYPEOF(v) != CHARSXP) {
pp(pre); Rprintf("ATTRIB:\n"); inspect_tree(pre+2, ATTRIB(v), deep, pvec);
}
}