The R Project SVN R

Rev

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

Rev 67181 Rev 68643
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  R : A Computer Langage for Statistical Data Analysis
 2 
 *  R : A Computer Langage for Statistical Data Analysis
3 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 3 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
4 
 *  Copyright (C) 1998-2014   The R Core Team.
 4 
 *  Copyright (C) 1998-2015   The R Core Team.
5 
 *
 5 
 *
6 
 *  This program is free software; you can redistribute it and/or modify
 6 
 *  This program is free software; you can redistribute it and/or modify
7 
 *  it under the terms of the GNU General Public License as published by
 7 
 *  it under the terms of the GNU General Public License as published by
8 
 *  the Free Software Foundation; either version 2 of the License, or
 8 
 *  the Free Software Foundation; either version 2 of the License, or
9 
 *  (at your option) any later version.
 9 
 *  (at your option) any later version.
Line 38... Line 38...
38 
	SETCAR(args, findFun(s, rho));				\
 38 
	SETCAR(args, findFun(s, rho));				\
39 
	UNPROTECT(1);						\
 39 
	UNPROTECT(1);						\
40 
    }
 40 
    }
41 
    find_char_fun
 41 
    find_char_fun
42 
 
 42 
 
43 
    if (TYPEOF(CAR(args)) != CLOSXP && TYPEOF(CAR(args)) != SPECIALSXP
 43 
    if (TYPEOF(CAR(args)) != CLOSXP &&
- 
 
 44 
	TYPEOF(CAR(args)) != SPECIALSXP &&
44 
         &&  TYPEOF(CAR(args)) != BUILTINSXP )
 45 
	TYPEOF(CAR(args)) != BUILTINSXP)
45 
	errorcall(call, _("argument must be a closure"));
 46 
	errorcall(call, _("argument must be a function"));
46 
    switch(PRIMVAL(op)) {
 47 
    switch(PRIMVAL(op)) {
47 
    case 0: // debug()
 48 
    case 0: // debug()
48 
	SET_RDEBUG(CAR(args), 1);
 49 
	SET_RDEBUG(CAR(args), 1);
49 
	break;
 50 
	break;
50 
    case 1: // undebug()
 51 
    case 1: // undebug()
Line 60... Line 61...
60 
        break;
 61 
        break;
61 
    }
 62 
    }
62 
    return ans;
 63 
    return ans;
63 
}
 64 
}
64 
 
 65 
 
65 
/* primitives .primTrace and .primUntrace */
 66 
/* primitives .primTrace() and .primUntrace() */
66 
SEXP attribute_hidden do_trace(SEXP call, SEXP op, SEXP args, SEXP rho)
 67 
SEXP attribute_hidden do_trace(SEXP call, SEXP op, SEXP args, SEXP rho)
67 
{
 68 
{
68 
    checkArity(op, args);
 69 
    checkArity(op, args);
69 
    check1arg(args, call, "x");
 - 
 
70 
 
 70 
 
71 
    find_char_fun
 71 
    find_char_fun
72 
 
 72 
 
73 
    if (TYPEOF(CAR(args)) != CLOSXP &&
 73 
    if (TYPEOF(CAR(args)) != CLOSXP &&
74 
	TYPEOF(CAR(args)) != BUILTINSXP &&
 74 
	TYPEOF(CAR(args)) != SPECIALSXP &&
75 
	TYPEOF(CAR(args)) != SPECIALSXP)
 75 
	TYPEOF(CAR(args)) != BUILTINSXP)
76 
	    errorcall(call, _("argument must be a function"));
 76 
	    errorcall(call, _("argument must be a function"));
77 
 
 77 
 
78 
    switch(PRIMVAL(op)) {
 78 
    switch(PRIMVAL(op)) {
79 
    case 0:
 79 
    case 0:
80 
	SET_RTRACE(CAR(args), 1);
 80 
	SET_RTRACE(CAR(args), 1);