The R Project SVN R

Rev

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

Rev 49006 Rev 51256
Line 107... Line 107...
107 
 
 107 
 
108 
 
 108 
 
109 
/* memory tracing */
 109 
/* memory tracing */
110 
/* report when a traced object is duplicated */
 110 
/* report when a traced object is duplicated */
111 
 
 111 
 
112 
SEXP attribute_hidden do_memtrace(SEXP call, SEXP op, SEXP args, SEXP rho)
 112 
SEXP attribute_hidden do_tracemem(SEXP call, SEXP op, SEXP args, SEXP rho)
113 
{
 113 
{
114 
#ifdef R_MEMORY_PROFILING
 114 
#ifdef R_MEMORY_PROFILING
115 
    SEXP object;
 115 
    SEXP object;
116 
    char buffer[20];
 116 
    char buffer[20];
117 
 
 117 
 
Line 141... Line 141...
141 
    return R_NilValue;
 141 
    return R_NilValue;
142 
#endif
 142 
#endif
143 
}
 143 
}
144 
 
 144 
 
145 
 
 145 
 
146 
SEXP attribute_hidden do_memuntrace(SEXP call, SEXP op, SEXP args, SEXP rho)
 146 
SEXP attribute_hidden do_untracemem(SEXP call, SEXP op, SEXP args, SEXP rho)
147 
{
 147 
{
148 
#ifdef R_MEMORY_PROFILING
 148 
#ifdef R_MEMORY_PROFILING
149 
    SEXP object;
 149 
    SEXP object;
150 
 
 150 
 
151 
    checkArity(op, args);
 151 
    checkArity(op, args);
Line 193... Line 193...
193 
    memtrace_stack_dump();
 193 
    memtrace_stack_dump();
194 
}
 194 
}
195 
 
 195 
 
196 
#endif /* R_MEMORY_PROFILING */
 196 
#endif /* R_MEMORY_PROFILING */
197 
 
 197 
 
198 
SEXP attribute_hidden do_memretrace(SEXP call, SEXP op, SEXP args, SEXP rho)
 198 
SEXP attribute_hidden do_retracemem(SEXP call, SEXP op, SEXP args, SEXP rho)
199 
{
 199 
{
200 
#ifdef R_MEMORY_PROFILING
 200 
#ifdef R_MEMORY_PROFILING
201 
    SEXP object, origin, ans;
 201 
    SEXP object, previous, ans, ap, argList;
202 
    char buffer[20];
 202 
    char buffer[20];
203 
 
 203 
 
- 
 
 204 
    PROTECT(ap = list2(R_NilValue, R_NilValue));
204 
    /* checkArity(op, args); */
 205 
    SET_TAG(ap,  install("x"));
- 
 
 206 
    SET_TAG(CDR(ap), install("previous"));
205 
    if(length(args) < 1 || length(args) > 2)
 207 
    PROTECT(argList =  matchArgs(ap, args, call));
206 
	errorcall(call, _("invalid number of arguments"));
 208 
    if(CAR(argList) == R_MissingArg) SETCAR(argList, R_NilValue);
- 
 
 209 
    if(CADR(argList) == R_MissingArg) SETCAR(CDR(argList), R_NilValue);
207 
 
 210 
 
208 
    object = CAR(args);
 211 
    object = CAR(args);
209 
    if (TYPEOF(object) == CLOSXP ||
 212 
    if (TYPEOF(object) == CLOSXP ||
210 
	TYPEOF(object) == BUILTINSXP ||
 213 
	TYPEOF(object) == BUILTINSXP ||
211 
	TYPEOF(object) == SPECIALSXP)
 214 
	TYPEOF(object) == SPECIALSXP)
212 
	errorcall(call, _("argument must not be a function"));
 215 
	errorcall(call, _("argument must not be a function"));
213 
 
 216 
 
214 
    if(length(args) >= 2) {
 - 
 
215 
	origin = CADR(args);
 217 
    previous = CADR(args);
216 
	if(!isString(origin))
 218 
    if(!isNull(previous) && !isString(previous))
217 
	    errorcall(call, _("invalid '%s' argument"), "origin");
 219 
	    errorcall(call, _("invalid '%s' argument"), "previous");
218 
    } else origin = R_NilValue;
 - 
 
219 
 
 220 
 
220 
    if (RTRACE(object)){
 221 
    if (RTRACE(object)){
221 
	snprintf(buffer, 20, "<%p>", (void *) object);
 222 
	snprintf(buffer, 20, "<%p>", (void *) object);
222 
	ans = mkString(buffer);
 223 
	ans = mkString(buffer);
- 
 
 224 
    } else {
- 
 
 225 
	R_Visible = 0;
223 
    } else ans = R_NilValue;
 226 
	ans = R_NilValue;
- 
 
 227 
    }
224 
 
 228 
 
225 
    if (origin != R_NilValue){
 229 
    if (previous != R_NilValue){
226 
	SET_RTRACE(object, 1);
 230 
	SET_RTRACE(object, 1);
227 
	if (R_current_trace_state()) {
 231 
	if (R_current_trace_state()) {
- 
 
 232 
	    /* FIXME: previous will have <0x....> whereas other values are
- 
 
 233 
	       without the < > */
228 
	    Rprintf("tracemem[%s -> %p]: ",
 234 
	    Rprintf("tracemem[%s -> %p]: ",
229 
		    translateChar(STRING_ELT(origin, 0)), (void *) object);
 235 
		    translateChar(STRING_ELT(previous, 0)), (void *) object);
230 
	    memtrace_stack_dump();
 236 
	    memtrace_stack_dump();
231 
	}
 237 
	}
232 
    }
 238 
    }
- 
 
 239 
    UNPROTECT(2);
233 
    return ans;
 240 
    return ans;
234 
#else
 241 
#else
235 
    return R_NilValue;
 242 
    return R_NilValue;
236 
#endif
 243 
#endif
237 
}
 244 
}