diff options
| -rw-r--r-- | eval.c | 18 | ||||
| -rw-r--r-- | parser.c | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/asm.tl | 12 | ||||
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 9 | ||||
| -rw-r--r-- | share/txr/stdlib/except.tl | 4 | ||||
| -rw-r--r-- | unwind.c | 12 | ||||
| -rw-r--r-- | unwind.h | 11 | ||||
| -rw-r--r-- | vm.c | 3 |
8 files changed, 49 insertions, 22 deletions
@@ -2595,17 +2595,19 @@ static val op_dwim(val form, val env) static val op_catch(val form, val env) { - val catch_syms = second(form); - val try_form = third(form); + val args = cdr(form); + val catch_syms = pop(&args); + val try_form = pop(&args); + val desc = pop(&args); + val catches = args; val result = nil; - uw_catch_begin (catch_syms, exsym, exvals); + uw_catch_begin_w_desc (catch_syms, exsym, exvals, desc); result = eval(try_form, env, try_form); uw_catch(exsym, exvals) { args_decl(args, ARGS_MIN); - val catches = rest(rest(rest(form))); val iter; args_add(args, exsym); @@ -4437,19 +4439,23 @@ static val expand_catch(val form, val menv) val sym = pop(&args); val catch_syms = pop(&args); val try_form = pop(&args); + val desc = pop(&args); val catch_clauses = args; val try_form_ex = expand(try_form, menv); + val desc_ex = expand(desc, menv); val catch_clauses_ex = rlcp(mapcar(curry_12_1(func_n2(expand_catch_clause), menv), catch_clauses), catch_clauses); - if (try_form_ex == try_form && catch_clauses_ex == catch_clauses) + if (try_form_ex == try_form && desc_ex == desc && + catch_clauses_ex == catch_clauses) return form; return rlcp(cons(sym, cons(catch_syms, - cons(try_form_ex, catch_clauses_ex))), form); + cons(try_form_ex, + cons(desc_ex, catch_clauses_ex)))), form); } static val expand_list_of_form_lists(val lofl, val menv, val ss_hash) @@ -645,7 +645,7 @@ static val read_file_common(val self, val stream, val error_stream, val compiled if (compiled && first) { val major = car(form); - if (lt(major, one) || gt(major, four)) + if (lt(major, one) || gt(major, num_fast(5))) uw_throwf(error_s, lit("cannot load ~s: version number mismatch"), stream, nao); diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl index 75d84471..b270c4bf 100644 --- a/share/txr/stdlib/asm.tl +++ b/share/txr/stdlib/asm.tl @@ -653,11 +653,12 @@ (defopcode op-catch catch auto (:method asm (me asm syntax) - me.(chk-arg-count 4 syntax) - (tree-bind (sym args catch-syms dst) asm.(parse-args me syntax '(d d r l)) + me.(chk-arg-count 5 syntax) + (tree-bind (sym args catch-syms desc dst) + asm.(parse-args me syntax '(d d r r l)) asm.(put-insn me.code (ash dst -16) (logtrunc dst 16)) asm.(put-pair sym args) - asm.(put-pair 0 catch-syms))) + asm.(put-pair desc catch-syms))) (:method backpatch (me asm at dst) asm.(put-insn me.code (ash dst -16) (logtrunc dst 16))) @@ -665,9 +666,10 @@ (:method dis (me asm high16 low16) (let ((dst (logior (ash high16 16) low16))) (tree-bind (sym args) asm.(get-pair) - (let ((catch-syms (cadr asm.(get-pair)))) + (tree-bind (desc catch-syms) asm.(get-pair) ^(,me.symbol ,(operand-to-sym sym) ,(operand-to-sym args) - ,(operand-to-sym catch-syms) ,dst)))))) + ,(operand-to-sym catch-syms) + ,(operand-to-sym desc) ,dst)))))) (defopcode op-handle handle auto (:method asm (me asm syntax) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 3d906866..eea91b62 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -658,12 +658,13 @@ (uni ffrag.ffuns bfrag.ffuns)))))) (defmeth compiler comp-catch (me oreg env form) - (mac-param-bind form (op symbols try-expr . clauses) form + (mac-param-bind form (op symbols try-expr desc-expr . clauses) form (with-gensyms (ex-sym-var ex-args-var) (let* ((nenv (new env up env co me)) (esvb (cdar nenv.(extend-var ex-sym-var))) (eavb (cdar nenv.(extend-var ex-args-var))) (tfrag me.(compile oreg env try-expr)) + (dfrag me.(compile oreg env desc-expr)) (lhand (gensym "l")) (lhend (gensym "l")) (treg me.(alloc-treg)) @@ -691,7 +692,9 @@ me.(free-treg treg) (new (frag tfrag.oreg ^((frame ,nenv.lev ,nenv.v-cntr) - (catch ,esvb.loc ,eavb.loc ,me.(get-dreg symbols) ,lhand) + ,*dfrag.code + (catch ,esvb.loc ,eavb.loc + ,me.(get-dreg symbols) ,dfrag.oreg ,lhand) ,*tfrag.code (jmp ,lhend) ,lhand @@ -1580,7 +1583,7 @@ (defvarl %big-endian% (equal (ffi-put 1 (ffi uint32)) #b'00000001')) -(defvarl %tlo-ver% ^(4 0 ,%big-endian%)) +(defvarl %tlo-ver% ^(5 0 ,%big-endian%)) (defvarl %package-manip% '(make-package delete-package use-package unuse-package diff --git a/share/txr/stdlib/except.tl b/share/txr/stdlib/except.tl index 83506232..a2cc684c 100644 --- a/share/txr/stdlib/except.tl +++ b/share/txr/stdlib/except.tl @@ -35,11 +35,11 @@ e nil form) ^(,type (,(gensym) ,*args-ex) ,*body-ex))) catch-clauses))) - ^(sys:catch ,catch-syms ,try-form ,*sys-catch-clauses))) + ^(sys:catch ,catch-syms ,try-form nil ,*sys-catch-clauses))) (defmacro catch* (try-form . catch-clauses) (let ((catch-syms [mapcar car catch-clauses])) - ^(sys:catch ,catch-syms ,try-form ,*catch-clauses))) + ^(sys:catch ,catch-syms ,try-form nil ,*catch-clauses))) (defun sys:expand-handle (form try-form handle-clauses) (let* ((oper (car form)) @@ -57,7 +57,8 @@ static uw_frame_t *uw_exit_point; static uw_frame_t toplevel_env; static uw_frame_t unhandled_ex; -static val unhandled_hook_s, types_s, jump_s, sys_cont_s, sys_cont_poison_s; +static val unhandled_hook_s, types_s, jump_s, desc_s; +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; @@ -363,10 +364,12 @@ static val uw_find_frames_impl(val extype, val frtype, val just_one) args_decl(args, ARGS_MIN); val fr = make_struct(frtype, nil, args); slotset(fr, types_s, ex->ca.matches); - if (et == UW_CATCH) + if (et == UW_CATCH) { + slotset(fr, desc_s, ex->ca.desc); slotset(fr, jump_s, cptr(coerce(mem_t *, ex))); - else + } else { slotset(fr, fun_s, ex->ha.fun); + } if (just_one) return fr; ptail = list_collect(ptail, fr); @@ -1054,6 +1057,7 @@ void uw_late_init(void) &deferred_warnings, &tentative_defs, convert(val *, 0)); types_s = intern(lit("types"), user_package); jump_s = intern(lit("jump"), user_package); + desc_s = intern(lit("desc"), user_package); sys_cont_s = intern(lit("cont"), system_package); sys_cont_poison_s = intern(lit("cont-poison"), system_package); sys_cont_free_s = intern(lit("cont-free"), system_package); @@ -1062,7 +1066,7 @@ void uw_late_init(void) catch_frame_type = make_struct_type(intern(lit("catch-frame"), user_package), frame_type, nil, - list(types_s, jump_s, nao), + list(types_s, desc_s, jump_s, nao), nil, nil, nil, nil); handle_frame_type = make_struct_type(intern(lit("handle-frame"), user_package), @@ -61,6 +61,7 @@ struct uw_catch { int visible; val sym; val args; + val desc; uw_frame_t *cont; extended_jmp_buf jb; }; @@ -203,6 +204,16 @@ noreturn val type_mismatch(val, ...); switch (extended_setjmp(uw_catch.ca.jb)) { \ case 0: +#define uw_catch_begin_w_desc(MATCHES, SYMVAR, \ + EXCVAR, DESC) \ + do { \ + obj_t *SYMVAR = nil; \ + obj_t *EXCVAR = nil; \ + uw_frame_t uw_catch; \ + uw_push_catch(&uw_catch, MATCHES); \ + uw_catch.ca.desc = (DESC); \ + switch (extended_setjmp(uw_catch.ca.jb)) { \ + case 0: #define uw_catch(SYMVAR, EXCVAR) \ goto uw_unwind_label; \ break; \ @@ -859,9 +859,10 @@ NOINLINE static void vm_catch(struct vm *vm, vm_word_t insn) unsigned sym_reg = vm_arg_operand_hi(arg1); unsigned args_reg = vm_arg_operand_lo(arg1); val catch_syms = vm_get(vm->dspl, vm_arg_operand_lo(arg2)); + val desc = vm_get(vm->dspl, vm_arg_operand_hi(arg2)); int saved_lev = vm->lev; - uw_catch_begin (catch_syms, exsym, exvals); + uw_catch_begin_w_desc (catch_syms, exsym, exvals, desc); vm_execute(vm); |