20#define tc_closure_traced tc_sys_1
22static LISP sym_traced = NIL;
23static LISP sym_quote = NIL;
24static LISP sym_begin = NIL;
31static void ct_gc_scan(
LISP ptr);
38 if NCONSP(
body)
return(NIL);
39 if NEQ(CAR(
body),sym_begin)
return(NIL);
41 if NCONSP(
tmp)
return(NIL);
43 if NCONSP(
tmp)
return(NIL);
44 if NEQ(CAR(
tmp),sym_quote)
return(NIL);
46 if NCONSP(
tmp)
return(NIL);
54 code =
fcn->storage_as.closure.code;
55 if NULLP(ltrace_fcn_name(cdr(code)))
56 setcdr(code,cons(sym_begin,
57 cons(cons(sym_quote,cons(
fcn_name,NIL)),
58 cons(cdr(code),NIL))));
59 fcn->type = tc_closure_traced;
61 case tc_closure_traced:
64 err(
"not a closure, cannot trace",
fcn);}
77 case tc_closure_traced:
78 fcn->type = tc_closure;
81 err(
"not a closure, cannot untrace",
fcn);}
86 for(l=
fcns;NNULLP(l);l=cdr(l))
90static void ct_gc_scan(
LISP ptr)
91{CAR(ptr) = gc_relocate(CAR(ptr));
92 CDR(ptr) = gc_relocate(CDR(ptr));}
95{gc_mark(ptr->storage_as.closure.code);
96 return(ptr->storage_as.closure.env);}
99{fput_st(f,
"#<CLOSURE(TRACED) ");
100 lprin1f(car(ptr->storage_as.closure.code),f);
102 lprin1f(cdr(ptr->storage_as.closure.code),f);
107 fcn_name = ltrace_fcn_name(cdr(
ct->storage_as.closure.code));
108 args = leval_args(CDR(*
px),*
penv);
111 for(l=args;NNULLP(l);l=cdr(l))
115 env = extend_env(args,
116 car(
ct->storage_as.closure.code),
117 ct->storage_as.closure.env);
118 result = leval(cdr(
ct->storage_as.closure.code),env);
129 set_gc_hooks(tc_closure_traced,
137 gc_protect_sym(&sym_traced,
"*traced*");
138 setvar(sym_traced,NIL,NIL);
139 gc_protect_sym(&sym_begin,
"begin");
140 gc_protect_sym(&sym_quote,
"quote");
141 set_print_hooks(tc_closure_traced,ct_prin1,NULL);
142 set_eval_hooks(tc_closure_traced,ct_eval);
143 init_fsubr(
"trace",ltrace,
144 "(trace FUNCS ENV)\n\
146 init_lsubr(
"untrace",luntrace,