summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--eval.c38
-rw-r--r--share/txr/stdlib/debugger.tl51
-rw-r--r--unwind.c29
-rw-r--r--unwind.h11
4 files changed, 97 insertions, 32 deletions
diff --git a/eval.c b/eval.c
index bf575c9c..df6b23e1 100644
--- a/eval.c
+++ b/eval.c
@@ -1497,19 +1497,27 @@ val eval_intrinsic_noerr(val form, val env, val *error_p)
static val do_eval(val form, val env, val ctx,
val (*lookup)(val env, val sym))
{
+ uw_frame_t *ev = 0;
+ val ret = nil;
+
+ if (dbg_backtrace) {
+ ev = coerce(uw_frame_t *, alloca(sizeof *ev));
+ uw_push_eval(ev, form, env);
+ }
+
sig_check_fast();
- if (nilp(form)) {
- return nil;
- } else if (symbolp(form)) {
+ if (form && symbolp(form)) {
if (!bindable(form)) {
- return form;
+ ret = form;
} else {
val binding = lookup(env, form);
- if (binding)
- return cdr(binding);
- eval_error(ctx, lit("unbound variable ~s"), form, nao);
- abort();
+ if (binding) {
+ ret = cdr(binding);
+ } else {
+ eval_error(ctx, lit("unbound variable ~s"), form, nao);
+ abort();
+ }
}
} else if (consp(form)) {
val oper = car(form);
@@ -1517,11 +1525,10 @@ static val do_eval(val form, val env, val ctx,
if (entry) {
opfun_t fp = coerce(opfun_t, cptr_get(entry));
- val ret, lfe_save = last_form_evaled;
+ val lfe_save = last_form_evaled;
last_form_evaled = form;
ret = fp(form, env);
last_form_evaled = lfe_save;
- return ret;
} else {
val fbinding = lookup_fun(env, oper);
@@ -1536,7 +1543,7 @@ static val do_eval(val form, val env, val ctx,
val arglist = rest(form);
cnum alen = if3(consp(arglist), c_num(length(arglist)), 0);
cnum argc = max(alen, ARGS_MIN);
- val ret, lfe_save = last_form_evaled;
+ val lfe_save = last_form_evaled;
args_decl(args, argc);
last_form_evaled = form;
@@ -1545,13 +1552,16 @@ static val do_eval(val form, val env, val ctx,
ret = generic_funcall(cdr(fbinding), args);
last_form_evaled = lfe_save;
-
- return ret;
}
}
} else {
- return form;
+ ret = form;
}
+
+ if (ev != 0)
+ uw_pop_frame(ev);
+
+ return ret;
}
val eval(val form, val env, val ctx)
diff --git a/share/txr/stdlib/debugger.tl b/share/txr/stdlib/debugger.tl
index 07cbcfe8..9cd52b61 100644
--- a/share/txr/stdlib/debugger.tl
+++ b/share/txr/stdlib/debugger.tl
@@ -44,26 +44,49 @@
(defun debugger-help ()
(mapdo (ap pprinl `@{@1 15} @3`) %dbg-commands%))
+(defmeth fcall-frame loc (fr))
+
+(defmeth fcall-frame print-trace (fr pr-fr nx-fr prefix)
+ (let* ((fun fr.fun)
+ (args fr.args)
+ (name (if (functionp fun)
+ (func-get-name fun)))
+ (loc nx-fr.(loc))
+ (kind
+ (cond
+ ((interp-fun-p fun) "I")
+ ((vm-fun-p fun) "V")
+ ((functionp fun) "C")
+ (t "O"))))
+ (put-string `@prefix @kind:@(if loc `(@loc):`)`)
+ (prinl ^[,(or name fun) ,*args])))
+
+(defmeth eval-frame loc (fr)
+ (source-loc-str fr.form))
+
+(defmeth eval-frame print-trace (fr pr-fr nx-fr prefix)
+ (when (or (null nx-fr)
+ (and (typep pr-fr 'fcall-frame)
+ (not (interp-fun-p pr-fr.fun))
+ (not (vm-fun-p pr-fr.fun))))
+ (let* ((form fr.form)
+ (sym (if (consp form) (car form)))
+ (loc (source-loc-str form)))
+ (when sym
+ (put-string `@prefix E:@(if loc `(@loc):`)`)
+ (prinl (if (eq sym 'dwim)
+ ^[,(cadr form)]
+ ^(,sym)))))))
+
(defun print-backtrace (: (*stdout* *stdout*) (prefix ""))
(with-resources ((imode (set-indent-mode *stdout* indent-foff)
(set-indent-mode *stdout* imode))
- (depth (set-max-depth *stdout* 4)
+ (depth (set-max-depth *stdout* 2)
(set-max-depth *stdout* depth))
(length (set-max-length *stdout* 10)
(set-max-length *stdout* length)))
- (each ((fr (find-frames-by-mask uw-fcall)))
- (let* ((fun fr.fun)
- (args fr.args)
- (name (if (functionp fun)
- (func-get-name fun)))
- (kind
- (cond
- ((interp-fun-p fun) "I")
- ((vm-fun-p fun) "V")
- ((functionp fun) "C")
- (t "O"))))
- (put-string `@prefix @kind: `)
- (prinl ^[,(or name fun) ,*args])))))
+ (window-map 1 nil (lambda (pr el nx) el.(print-trace pr nx prefix))
+ (find-frames-by-mask (logior uw-fcall uw-eval)))))
(defun debugger ()
(with-disabled-debugging
diff --git a/unwind.c b/unwind.c
index 994fed38..2ea8d2ef 100644
--- a/unwind.c
+++ b/unwind.c
@@ -61,13 +61,13 @@ static uw_frame_t unhandled_ex;
static val unhandled_hook_s, types_s, jump_s, desc_s;
#if CONFIG_DEBUG_SUPPORT
-static val args_s;
+static val args_s, form_s;
#endif
static val sys_cont_s, sys_cont_poison_s;
static val sys_cont_free_s, sys_capture_cont_s;
static val frame_type, catch_frame_type, handle_frame_type;
-static val fcall_frame_type;
+static val fcall_frame_type, eval_frame_type;
static val deferred_warnings, tentative_defs;
@@ -433,6 +433,13 @@ val uw_find_frames_by_mask(val mask_in)
slotset(frame, args_s, args_get_list(acopy));
break;
}
+ case UW_EVAL:
+ {
+ frame = allocate_struct(eval_frame_type);
+ slotset(frame, form_s, fr->el.form);
+ slotset(frame, env_s, fr->el.env);
+ break;
+ }
default:
break;
}
@@ -576,6 +583,16 @@ void uw_push_fcall(uw_frame_t *fr, val fun, struct args *args)
uw_stack = fr;
}
+void uw_push_eval(uw_frame_t *fr, val form, val env)
+{
+ memset(fr, 0, sizeof *fr);
+ fr->el.type = UW_EVAL;
+ fr->el.form = form;
+ fr->el.env = env;
+ fr->el.up = uw_stack;
+ uw_stack = fr;
+}
+
#endif
static val exception_subtypes;
@@ -1134,13 +1151,14 @@ void uw_late_init(void)
protect(&frame_type, &catch_frame_type, &handle_frame_type,
&deferred_warnings, &tentative_defs, convert(val *, 0));
#if CONFIG_DEBUG_SUPPORT
- protect(&fcall_frame_type, convert(val *, 0));
+ protect(&fcall_frame_type, &eval_frame_type, convert(val *, 0));
#endif
types_s = intern(lit("types"), user_package);
jump_s = intern(lit("jump"), user_package);
desc_s = intern(lit("desc"), user_package);
#if CONFIG_DEBUG_SUPPORT
args_s = intern(lit("args"), user_package);
+ form_s = intern(lit("form"), user_package);
#endif
sys_cont_s = intern(lit("cont"), system_package);
sys_cont_poison_s = intern(lit("cont-poison"), system_package);
@@ -1162,6 +1180,10 @@ void uw_late_init(void)
frame_type, nil,
list(fun_s, args_s, nao),
nil, nil, nil, nil);
+ eval_frame_type = make_struct_type(intern(lit("eval-frame"), user_package),
+ frame_type, nil,
+ list(form_s, env_s, nao),
+ nil, nil, nil, nil);
#endif
reg_mac(intern(lit("defex"), user_package), func_n2(me_defex));
reg_var(unhandled_hook_s = intern(lit("*unhandled-hook*"),
@@ -1197,6 +1219,7 @@ void uw_late_init(void)
reg_varl(intern(lit("uw-cont-copy"), user_package), num_fast(1U <<UW_CONT_COPY));
reg_varl(intern(lit("uw-guard"), user_package), num_fast(1U <<UW_GUARD));
reg_varl(intern(lit("uw-fcall"), user_package), num_fast(1U <<UW_FCALL));
+ reg_varl(intern(lit("uw-eval"), user_package), num_fast(1U <<UW_EVAL));
reg_fun(intern(lit("find-frames-by-mask"), user_package), func_n1(uw_find_frames_by_mask));
#endif
uw_register_subtype(continue_s, restart_s);
diff --git a/unwind.h b/unwind.h
index 58e8c5fd..1a122ebd 100644
--- a/unwind.h
+++ b/unwind.h
@@ -30,7 +30,7 @@ typedef enum uw_frtype {
UW_BLOCK, UW_CAPTURED_BLOCK, UW_MENV, UW_CATCH, UW_HANDLE,
UW_CONT_COPY, UW_GUARD,
#if CONFIG_DEBUG_SUPPORT
- UW_FCALL,
+ UW_FCALL, UW_EVAL
#endif
} uw_frtype_t;
@@ -100,6 +100,13 @@ struct uw_fcall {
struct args *args;
};
+struct uw_eval {
+ uw_frame_t *up;
+ uw_frtype_t type;
+ val form;
+ val env;
+};
+
#endif
#if __aarch64__
@@ -118,6 +125,7 @@ union uw_frame {
struct uw_guard gu;
#if CONFIG_DEBUG_SUPPORT
struct uw_fcall fc;
+ struct uw_eval el;
#endif
} UW_FRAME_ALIGN;
@@ -137,6 +145,7 @@ void uw_push_catch(uw_frame_t *, val matches);
void uw_push_handler(uw_frame_t *, val matches, val fun);
#if CONFIG_DEBUG_SUPPORT
void uw_push_fcall(uw_frame_t *, val fun, struct args *args);
+void uw_push_eval(uw_frame_t *, val form, val env);
#endif
noreturn val uw_throw(val sym, val exception);
noreturn val uw_throwv(val sym, struct args *);
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-16 11:19:02 +0000