diff --git a/libguile/debug.c b/libguile/debug.c index 1c86c76c0..c8e908fdf 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -208,15 +208,6 @@ scm_reverse_lookup (SCM env, SCM data) return SCM_BOOL_F; } -SCM_DEFINE (scm_sys_start_stack, "%start-stack", 2, 0, 0, - (SCM id, SCM thunk), - "Call @var{thunk} on an evaluator stack tagged with @var{id}.") -#define FUNC_NAME s_scm_sys_start_stack -{ - return scm_vm_call_with_new_stack (scm_the_vm (), thunk, id); -} -#undef FUNC_NAME - /* Undocumented debugging procedure */ diff --git a/libguile/debug.h b/libguile/debug.h index 6a1ee5a61..7c1d02f5c 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -3,7 +3,7 @@ #ifndef SCM_DEBUG_H #define SCM_DEBUG_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009 +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008,2009,2010 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -42,7 +42,6 @@ typedef union scm_t_debug_info SCM_API SCM scm_reverse_lookup (SCM env, SCM data); -SCM_API SCM scm_sys_start_stack (SCM info_id, SCM thunk); SCM_API SCM scm_procedure_source (SCM proc); SCM_API SCM scm_procedure_name (SCM proc); SCM_API SCM scm_with_traps (SCM thunk); diff --git a/libguile/vm.c b/libguile/vm.c index 142061185..98df0571b 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -544,12 +544,6 @@ SCM_DEFINE (scm_vm_apply, "vm-apply", 3, 0, 0, } #undef FUNC_NAME -SCM -scm_vm_call_with_new_stack (SCM vm, SCM thunk, SCM id) -{ - return scm_c_vm_run (vm, thunk, NULL, 0); -} - /* Scheme interface */ SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0, diff --git a/libguile/vm.h b/libguile/vm.h index ade4bb667..8e22d028c 100644 --- a/libguile/vm.h +++ b/libguile/vm.h @@ -64,7 +64,6 @@ SCM_API SCM scm_the_vm (); SCM_API SCM scm_make_vm (void); SCM_API SCM scm_vm_apply (SCM vm, SCM program, SCM args); SCM_API SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs); -SCM_API SCM scm_vm_call_with_new_stack (SCM vm, SCM thunk, SCM id); SCM_API SCM scm_vm_option_ref (SCM vm, SCM key); SCM_API SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val); diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 0b4f83c88..f02342679 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -1022,8 +1022,20 @@ If there is no handler at all, Guile prints an error and then exits." ;;; {The interpreter stack} ;;; -(defmacro start-stack (tag exp) - `(%start-stack ,tag (lambda () ,exp))) +(define %stacks (make-fluid)) +(define (%start-stack tag thunk) + (let ((prompt-tag (gensym))) + (prompt prompt-tag + (lambda () + (with-fluids ((%stacks (acons tag prompt-tag + (or (fluid-ref %stacks) '())))) + (thunk))) + (lambda (k . args) + (%start-stack tag (lambda () (apply k args))))))) +(define-syntax start-stack + (syntax-rules () + ((_ tag exp) + (%start-stack tag (lambda () exp)))))