The R Project SVN R

Rev

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

Rev 48288 Rev 48998
Line 40... Line 40...
40 
 
 40 
 
41 
    if (TYPEOF(CAR(args)) != CLOSXP)
 41 
    if (TYPEOF(CAR(args)) != CLOSXP)
42 
	errorcall(call, _("argument must be a closure"));
 42 
	errorcall(call, _("argument must be a closure"));
43 
    switch(PRIMVAL(op)) {
 43 
    switch(PRIMVAL(op)) {
44 
    case 0:
 44 
    case 0:
45 
	SET_DEBUG(CAR(args), 1);
 45 
	SET_RDEBUG(CAR(args), 1);
46 
	break;
 46 
	break;
47 
    case 1:
 47 
    case 1:
48 
	if( DEBUG(CAR(args)) != 1 )
 48 
	if( RDEBUG(CAR(args)) != 1 )
49 
	    warningcall(call, "argument is not being debugged");
 49 
	    warningcall(call, "argument is not being debugged");
50 
	SET_DEBUG(CAR(args), 0);
 50 
	SET_RDEBUG(CAR(args), 0);
51 
	break;
 51 
	break;
52 
    case 2:
 52 
    case 2:
53 
        ans = ScalarLogical(DEBUG(CAR(args)));
 53 
        ans = ScalarLogical(RDEBUG(CAR(args)));
54 
        break;
 54 
        break;
55 
    case 3:
 55 
    case 3:
56 
        SET_STEP(CAR(args), 1);
 56 
        SET_RSTEP(CAR(args), 1);
57 
        break;
 57 
        break;
58 
    }
 58 
    }
59 
    return ans;
 59 
    return ans;
60 
}
 60 
}
61 
 
 61 
 
Line 70... Line 70...
70 
	TYPEOF(CAR(args)) != SPECIALSXP)
 70 
	TYPEOF(CAR(args)) != SPECIALSXP)
71 
	    errorcall(call, _("argument must be a function"));
 71 
	    errorcall(call, _("argument must be a function"));
72 
 
 72 
 
73 
    switch(PRIMVAL(op)) {
 73 
    switch(PRIMVAL(op)) {
74 
    case 0:
 74 
    case 0:
75 
	SET_TRACE(CAR(args), 1);
 75 
	SET_RTRACE(CAR(args), 1);
76 
	break;
 76 
	break;
77 
    case 1:
 77 
    case 1:
78 
	SET_TRACE(CAR(args), 0);
 78 
	SET_RTRACE(CAR(args), 0);
79 
	break;
 79 
	break;
80 
    }
 80 
    }
81 
    return R_NilValue;
 81 
    return R_NilValue;
82 
}
 82 
}
83 
 
 83 
 
Line 130... Line 130...
130 
		  _("'tracemem' is not useful for promise and environment objects"));
 130 
		  _("'tracemem' is not useful for promise and environment objects"));
131 
    if(TYPEOF(object) == EXTPTRSXP || TYPEOF(object) == WEAKREFSXP)
 131 
    if(TYPEOF(object) == EXTPTRSXP || TYPEOF(object) == WEAKREFSXP)
132 
	errorcall(call,
 132 
	errorcall(call,
133 
		  _("'tracemem' is not useful for weak reference or external pointer objects"));
 133 
		  _("'tracemem' is not useful for weak reference or external pointer objects"));
134 
 
 134 
 
135 
    SET_TRACE(object, 1);
 135 
    SET_RTRACE(object, 1);
136 
    snprintf(buffer, 20, "<%p>", (void *) object);
 136 
    snprintf(buffer, 20, "<%p>", (void *) object);
137 
    return mkString(buffer);
 137 
    return mkString(buffer);
138 
#else
 138 
#else
139 
    errorcall(call, _("R was not compiled with support for memory profiling"));
 139 
    errorcall(call, _("R was not compiled with support for memory profiling"));
140 
    return R_NilValue;
 140 
    return R_NilValue;
Line 153... Line 153...
153 
    if (TYPEOF(object) == CLOSXP ||
 153 
    if (TYPEOF(object) == CLOSXP ||
154 
	TYPEOF(object) == BUILTINSXP ||
 154 
	TYPEOF(object) == BUILTINSXP ||
155 
	TYPEOF(object) == SPECIALSXP)
 155 
	TYPEOF(object) == SPECIALSXP)
156 
	errorcall(call, _("argument must not be a function"));
 156 
	errorcall(call, _("argument must not be a function"));
157 
 
 157 
 
158 
    if (TRACE(object))
 158 
    if (RTRACE(object))
159 
	SET_TRACE(object, 0);
 159 
	SET_RTRACE(object, 0);
160 
#else
 160 
#else
161 
    errorcall(call, _("R was not compiled with support for memory profiling"));
 161 
    errorcall(call, _("R was not compiled with support for memory profiling"));
162 
#endif
 162 
#endif
163 
    return R_NilValue;
 163 
    return R_NilValue;
164 
}
 164 
}
Line 214... Line 214...
214 
	origin = CADR(args);
 214 
	origin = CADR(args);
215 
	if(!isString(origin))
 215 
	if(!isString(origin))
216 
	    errorcall(call, _("invalid '%s' argument"), "origin");
 216 
	    errorcall(call, _("invalid '%s' argument"), "origin");
217 
    } else origin = R_NilValue;
 217 
    } else origin = R_NilValue;
218 
 
 218 
 
219 
    if (TRACE(object)){
 219 
    if (RTRACE(object)){
220 
	snprintf(buffer, 20, "<%p>", (void *) object);
 220 
	snprintf(buffer, 20, "<%p>", (void *) object);
221 
	ans = mkString(buffer);
 221 
	ans = mkString(buffer);
222 
    } else ans = R_NilValue;
 222 
    } else ans = R_NilValue;
223 
 
 223 
 
224 
    if (origin != R_NilValue){
 224 
    if (origin != R_NilValue){
225 
	SET_TRACE(object, 1);
 225 
	SET_RTRACE(object, 1);
226 
	if (R_current_trace_state()) {
 226 
	if (R_current_trace_state()) {
227 
	    Rprintf("tracemem[%s -> %p]: ",
 227 
	    Rprintf("tracemem[%s -> %p]: ",
228 
		    translateChar(STRING_ELT(origin, 0)), (void *) object);
 228 
		    translateChar(STRING_ELT(origin, 0)), (void *) object);
229 
	    memtrace_stack_dump();
 229 
	    memtrace_stack_dump();
230 
	}
 230 
	}