core: Fix continuations.
* src/eval-apply.c: Do not add a frame to the GC stack while making a continuation. * mes/module/mes/catch.mes (catch): Remove workaround. * tests/boot.test: Add test.
This commit is contained in:
parent
5167f70038
commit
543e4300c0
|
@ -43,9 +43,7 @@
|
|||
(lambda (k . args)
|
||||
(let ((handler (if (or (eq? key #t) (eq? key k)) handler
|
||||
previous-eh)))
|
||||
(cc
|
||||
(lambda (x)
|
||||
(apply handler (cons k args)))))))
|
||||
(cc (apply handler (cons k args))))))
|
||||
(thunk)))))))
|
||||
|
||||
(define (throw key . args)
|
||||
|
|
|
@ -968,14 +968,12 @@ if_expr:
|
|||
goto vm_return;
|
||||
|
||||
call_with_current_continuation:
|
||||
gc_push_frame ();
|
||||
x = make_continuation (g_continuations);
|
||||
g_continuations = g_continuations + 1;
|
||||
v = make_vector_ (STACK_SIZE - g_stack, cell_unspecified);
|
||||
for (i = g_stack; i < STACK_SIZE; i = i + 1)
|
||||
vector_set_x_ (v, i - g_stack, g_stack_array[i]);
|
||||
x->continuation = v;
|
||||
gc_pop_frame ();
|
||||
push_cc (cons (R1->car, cons (x, cell_nil)), x, R0, cell_vm_call_with_current_continuation2);
|
||||
goto apply;
|
||||
call_with_current_continuation2:
|
||||
|
|
|
@ -10,6 +10,7 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
|
|||
|
||||
;;; GNU Mes --- Maxwell Equations of Software
|
||||
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
|
||||
;;;
|
||||
;;; This file is part of GNU Mes.
|
||||
;;;
|
||||
|
@ -58,4 +59,11 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
|
|||
(pass-if-eq "append2 3" 0 (append 0))
|
||||
(pass-if-eq "append2 4" 'cons (append2 (cdr '(c)) (car '(cons))))
|
||||
|
||||
(pass-if-eq "call/cc string"
|
||||
2
|
||||
(string-length
|
||||
(call-with-current-continuation
|
||||
(lambda (cc)
|
||||
(cc "hi")))))
|
||||
|
||||
(result 'report)
|
||||
|
|
Loading…
Reference in New Issue