guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, master, updated. release_1-9-8-23-gea6


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-8-23-gea6b18e
Date: Fri, 19 Feb 2010 14:30:42 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=ea6b18e82f3ac2122d07c80bc0f320ea839a25b6

The branch, master has been updated
       via  ea6b18e82f3ac2122d07c80bc0f320ea839a25b6 (commit)
       via  f5b1f76af492f3c398527ee040e8bf09fc438a9a (commit)
       via  706a705eca032f84562ec84ac439b3d4a7ca8c66 (commit)
       via  1e7a0337f1180343ca2f81557bfdeb78e23cd532 (commit)
       via  5ef71027e49ba870556be194e177fa09b2ff306a (commit)
       via  26e6f99fc3543cd4aa24d2d96126ae025f61ab28 (commit)
       via  6e84cb95b18d81ef7a8490cccdfb08d3f88116ea (commit)
       via  07a0c7d5d9523936d5fe4cac595bd75859416c9e (commit)
       via  bcbbba866b56460d097dba17e0dbb0c53d9f9211 (commit)
       via  67a78ddd8381ccf098b52659897a4d40806a0928 (commit)
      from  6360c1d4c1f7d3bb43afa4f71d1d92bbf37fd845 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit ea6b18e82f3ac2122d07c80bc0f320ea839a25b6
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 15:30:34 2010 +0100

    prompt handlers are always inline
    
    * libguile/control.h (SCM_F_PROMPT_INLINE, SCM_PROMPT_INLINE_P): Remove;
      prompts always have "inline" handlers now.
    * libguile/control.c (scm_c_make_prompt): Remove inline_handler_p arg.
    
    * libguile/vm-i-system.c (prompt):
    * module/language/assembly/decompile-bytecode.scm (decode-load-program):
    * module/language/assembly/compile-bytecode.scm (write-bytecode):
     Adapt to prompt changes.
    
    * module/language/glil.scm (make-glil-prompt, glil-prompt-inline?):
      Remove inline? flag.
      (parse-glil, unparse-glil):
    * module/language/glil/compile-assembly.scm (glil->assembly): Adapt to
      <glil-prompt> change.
    
    * module/language/tree-il/compile-glil.scm (flatten): Require the
      handler of a <prompt> to be a lambda-case.
    
    * module/language/tree-il/primitives.scm (*primitive-expand-table*):
      Ensure that the handler of a <prompt> is a lambda-case.
    
    * module/language/tree-il/inline.scm (inline!): Simplify a degenerate
      case: (lambda args (apply (lambda ...) args)) => (lambda ...).

commit f5b1f76af492f3c398527ee040e8bf09fc438a9a
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 11:50:51 2010 +0100

    fluid-ref / fluid-set! compile to dynref/dynset
    
    * module/language/tree-il/primitives.scm: Resolve fluid-ref and
      fluid-set! as primitives, and thence to dynref/dynset.

commit 706a705eca032f84562ec84ac439b3d4a7ca8c66
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 11:42:00 2010 +0100

    add <dynref> and <dynset> to tree-il
    
    * module/language/tree-il.scm (<dynref>, <dynset>): New tree-il language
      elements, corresponding to fluid-ref and fluid-set.
    * module/language/tree-il/analyze.scm:
    * module/language/tree-il/compile-glil.scm: Wire them up in the usual
      manner.

commit 1e7a0337f1180343ca2f81557bfdeb78e23cd532
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 11:40:09 2010 +0100

    new VM operations: fluid-ref, fluid-set
    
    * libguile/vm-i-system.c (fluid-ref, fluid-set): New VM ops.

commit 5ef71027e49ba870556be194e177fa09b2ff306a
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 11:39:44 2010 +0100

    fluids.h exposes more of its interface, internally at least
    
    * libguile/fluids.h (SCM_I_FLUID_P, SCM_I_FLUID_NUM)
      (SCM_I_DYNAMIC_STATE_P, SCM_I_DYNAMIC_STATE_FLUIDS): Expose these
      predicates and accessors, internally at least.
    * libguile/fluids.c (IS_FLUID, FLUID_NUM, IS_DYNAMIC_STATE)
      (DYNAMIC_STATE_FLUIDS): Implement in terms of the exposed macros.

commit 26e6f99fc3543cd4aa24d2d96126ae025f61ab28
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 11:37:42 2010 +0100

    vm caches the dynamic state in a local var
    
    * libguile/vm-engine.c (vm_engine): Cache the dynamic state in a local
      var when we enter the VM.
    * libguile/vm-i-system.c (wind-fluids, unwind-fluids): Use the cached
      dynamic state instead of going through SCM_I_CURRENT_THREAD.

commit 6e84cb95b18d81ef7a8490cccdfb08d3f88116ea
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 10:49:24 2010 +0100

    rename <control> to <abort>
    
    * libguile/vm-i-system.c (abort): Rename instruction from `throw'.
    * libguile/vm.c (vm_abort): Rename from vm_throw.
    * module/language/tree-il.scm (<abort>, make-abort, abort-src,
      abort-tag, abort-args: Rename from <control> & company.
    
    * module/language/tree-il/analyze.scm:
    * module/language/tree-il/compile-glil.scm:
    * module/language/tree-il/primitives.scm: Fix all callers.

commit 07a0c7d5d9523936d5fe4cac595bd75859416c9e
Author: Andy Wingo <address@hidden>
Date:   Thu Feb 18 23:56:12 2010 +0100

    <prompt> has no pre-unwind-handler, it's unnecessary
    
    * libguile/control.h:
    * libguile/control.c (scm_c_make_prompt, SCM_PROMPT_PRE_UNWIND_HANDLER):
    * libguile/vm-i-system.c (prompt)
    * module/language/tree-il.scm (<prompt> prompt-pre-unwind-handler):
    * module/language/tree-il/analyze.scm:
    * module/language/tree-il/compile-glil.scm:
    * module/language/tree-il/inline.scm:
    * module/language/tree-il/primitives.scm: Remove the "pre-unwind"
      handler from prompt; it turns out not to be necessary. Adapt all
      references.

commit bcbbba866b56460d097dba17e0dbb0c53d9f9211
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 12:07:40 2010 +0100

    re-expand psyntax-pp
    
    * module/ice-9/psyntax-pp.scm: Expand again so we actually use
      with-fluids.

commit 67a78ddd8381ccf098b52659897a4d40806a0928
Author: Andy Wingo <address@hidden>
Date:   Fri Feb 19 12:07:02 2010 +0100

    fix tree-il->scheme bug for <dynlet>
    
    * module/language/tree-il.scm (tree-il->scheme): Bugfix for dynlet.

-----------------------------------------------------------------------

Summary of changes:
 libguile/control.c                              |    8 +-
 libguile/control.h                              |   11 +--
 libguile/fluids.c                               |    8 +-
 libguile/fluids.h                               |   12 +--
 libguile/vm-engine.c                            |    1 +
 libguile/vm-i-system.c                          |   67 +++++++++---
 libguile/vm.c                                   |    4 +-
 module/ice-9/psyntax-pp.scm                     |   38 +++----
 module/language/assembly/compile-bytecode.scm   |    3 +-
 module/language/assembly/decompile-bytecode.scm |    4 +-
 module/language/glil.scm                        |   13 +--
 module/language/glil/compile-assembly.scm       |    6 +-
 module/language/tree-il.scm                     |  132 ++++++++++++++---------
 module/language/tree-il/analyze.scm             |   26 +++--
 module/language/tree-il/compile-glil.scm        |  103 ++++++++----------
 module/language/tree-il/inline.scm              |   34 ++++--
 module/language/tree-il/primitives.scm          |   39 +++++---
 17 files changed, 293 insertions(+), 216 deletions(-)

diff --git a/libguile/control.c b/libguile/control.c
index bcbc6a1..b9ecff1 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -49,19 +49,16 @@ SCM_DEFINE (scm_atprompt, "@prompt", 4, 0, 0,
 #undef FUNC_NAME
 
 SCM
-scm_c_make_prompt (SCM vm, SCM k, SCM handler, SCM pre_unwind,
-                   scm_t_uint8 inline_p, scm_t_uint8 escape_only_p)
+scm_c_make_prompt (SCM vm, SCM k, SCM handler, scm_t_uint8 escape_only_p)
 {
   scm_t_bits tag;
   SCM ret;
   struct scm_prompt_registers *regs;
 
   tag = scm_tc7_prompt;
-  if (inline_p)
-    tag |= SCM_F_PROMPT_INLINE;
   if (escape_only_p)
     tag |= SCM_F_PROMPT_ESCAPE;
-  ret = scm_words (tag, 6);
+  ret = scm_words (tag, 5);
 
   regs = scm_gc_malloc_pointerless (sizeof (*regs), "prompt registers");
   regs->fp = SCM_VM_DATA (vm)->fp;
@@ -72,7 +69,6 @@ scm_c_make_prompt (SCM vm, SCM k, SCM handler, SCM pre_unwind,
   SCM_SET_CELL_WORD (ret, 2, (scm_t_bits)regs);
   SCM_SET_CELL_OBJECT (ret, 3, scm_i_dynwinds ());
   SCM_SET_CELL_OBJECT (ret, 4, handler);
-  SCM_SET_CELL_OBJECT (ret, 5, pre_unwind);
 
   return ret;
 }
diff --git a/libguile/control.h b/libguile/control.h
index b498562..e95ef99 100644
--- a/libguile/control.h
+++ b/libguile/control.h
@@ -20,18 +20,15 @@
 #define SCM_CONTROL_H
 
 
-#define SCM_F_PROMPT_INLINE 0x1
-#define SCM_F_PROMPT_ESCAPE 0x2
+#define SCM_F_PROMPT_ESCAPE 0x1
 
 #define SCM_PROMPT_P(x)                (!SCM_IMP (x) && SCM_TYP7(x) == 
scm_tc7_prompt)
 #define SCM_PROMPT_FLAGS(x)    (SCM_CELL_WORD ((x), 0) >> 8)
-#define SCM_PROMPT_INLINE_P(x) (SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_INLINE)
 #define SCM_PROMPT_ESCAPE_P(x) (SCM_PROMPT_FLAGS (x) & SCM_F_PROMPT_ESCAPE)
-#define SCM_PROMPT_TAG(x)      (SCM_CELL_OBJECT ((x), 1)
+#define SCM_PROMPT_TAG(x)      (SCM_CELL_OBJECT ((x), 1))
 #define SCM_PROMPT_REGISTERS(x)        ((struct 
scm_prompt_registers*)SCM_CELL_WORD ((x), 2))
 #define SCM_PROMPT_DYNENV(x)   (SCM_CELL_OBJECT ((x), 3))
 #define SCM_PROMPT_HANDLER(x)  (SCM_CELL_OBJECT ((x), 4))
-#define SCM_PROMPT_PRE_UNWIND_HANDLER(x) (SCM_CELL_OBJECT ((x), 5))
 
 #define SCM_PROMPT_SETJMP(p)   (SCM_I_SETJMP (SCM_PROMPT_REGISTERS (p)->regs))
 
@@ -44,8 +41,8 @@ struct scm_prompt_registers
 };
 
 
-SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, SCM handler, SCM pre_unwind,
-                                    scm_t_uint8 inline_p, scm_t_uint8 
escape_only_p);
+SCM_INTERNAL SCM scm_c_make_prompt (SCM vm, SCM k, SCM handler,
+                                    scm_t_uint8 escape_only_p);
 
 
 SCM_INTERNAL void scm_register_control (void);
diff --git a/libguile/fluids.c b/libguile/fluids.c
index c9ea68b..d493053 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -65,11 +65,11 @@ static size_t allocated_fluids_len = 0;
 static size_t allocated_fluids_num = 0;
 static char *allocated_fluids = NULL;
 
-#define IS_FLUID(x)         (!SCM_IMP (x) && SCM_TYP7 (x) == scm_tc7_fluid)
-#define FLUID_NUM(x)        ((size_t)SCM_CELL_WORD_1(x))
+#define IS_FLUID(x)         SCM_I_FLUID_P (x)
+#define FLUID_NUM(x)        SCM_I_FLUID_NUM (x)
 
-#define IS_DYNAMIC_STATE(x) (!SCM_IMP (x) && SCM_TYP7 (x) == 
scm_tc7_dynamic_state)
-#define DYNAMIC_STATE_FLUIDS(x)        SCM_PACK (SCM_CELL_WORD_1 (x))
+#define IS_DYNAMIC_STATE(x) SCM_I_DYNAMIC_STATE_P (x)
+#define DYNAMIC_STATE_FLUIDS(x)        SCM_I_DYNAMIC_STATE_FLUIDS (x)
 #define SET_DYNAMIC_STATE_FLUIDS(x, y) SCM_SET_CELL_WORD_1 ((x), (SCM_UNPACK 
(y)))
 
 
diff --git a/libguile/fluids.h b/libguile/fluids.h
index 7aefd47..0d61fd2 100644
--- a/libguile/fluids.h
+++ b/libguile/fluids.h
@@ -54,13 +54,8 @@
    grow.
  */
 
-/* The fastest way to acces/modify the value of a fluid.  These macros
-   do no error checking at all.  The first argument is the index
-   number of the fluid, obtained via SCM_FLUID_NUM, not the fluid
-   itself.  You must make sure that the fluid remains protected as
-   long you use its number since numbers of unused fluids are reused
-   eventually.
-*/
+#define SCM_I_FLUID_P(x)          (!SCM_IMP (x) && SCM_TYP7 (x) == 
scm_tc7_fluid)
+#define SCM_I_FLUID_NUM(x)        ((size_t)SCM_CELL_WORD_1(x))
 
 SCM_API SCM scm_make_fluid (void);
 SCM_API int scm_is_fluid (SCM obj);
@@ -80,6 +75,9 @@ SCM_API SCM scm_with_fluid (SCM fluid, SCM val, SCM thunk);
 
 SCM_API void scm_dynwind_fluid (SCM fluid, SCM value);
 
+#define SCM_I_DYNAMIC_STATE_P(x) (!SCM_IMP (x) && SCM_TYP7 (x) == 
scm_tc7_dynamic_state)
+#define SCM_I_DYNAMIC_STATE_FLUIDS(x)        SCM_PACK (SCM_CELL_WORD_1 (x))
+
 SCM_API SCM scm_make_dynamic_state (SCM parent);
 SCM_API SCM scm_dynamic_state_p (SCM obj);
 SCM_API int scm_is_dynamic_state (SCM obj);
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 75dd613..5d1e1d6 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -47,6 +47,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
   SCM *objects = NULL;                 /* constant objects */
   size_t object_count = 0;              /* length of OBJECTS */
   SCM *stack_limit = vp->stack_limit;  /* stack limit address */
+  SCM dynstate = SCM_I_CURRENT_THREAD->dynamic_state;
 
   /* Internal variables */
   int nvalues = 0;
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 003bdb4..98ef189 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1450,16 +1450,14 @@ VM_DEFINE_INSTRUCTION (82, make_symbol, "make-symbol", 
0, 1, 1)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 5, 3, 0)
+VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 4, 2, 0)
 {
   scm_t_int32 offset;
-  scm_t_uint8 inline_handler_p, escape_only_p;
-  SCM k, handler, pre_unwind, prompt;
+  scm_t_uint8 escape_only_p;
+  SCM k, handler, prompt;
 
-  inline_handler_p = FETCH ();
   escape_only_p = FETCH ();
   FETCH_OFFSET (offset);
-  POP (pre_unwind);
   POP (handler);
   POP (k);
 
@@ -1467,15 +1465,13 @@ VM_DEFINE_INSTRUCTION (83, prompt, "prompt", 5, 3, 0)
   /* Push the prompt onto the dynamic stack. The setjmp itself has to be local
      to this procedure. */
   /* FIXME: do more error checking */
-  prompt = scm_c_make_prompt (vm, k, handler, pre_unwind,
-                              inline_handler_p, escape_only_p);
+  prompt = scm_c_make_prompt (vm, k, handler, escape_only_p);
   scm_i_set_dynwinds (scm_cons (prompt, scm_i_dynwinds ()));
   if (SCM_PROMPT_SETJMP (prompt))
     {
       /* The prompt exited nonlocally. Cache the regs back from the vp, and go
-         to the handler or post-handler label. (The meaning of the label 
differs
-         depending on whether the prompt's handler is rendered inline or not.)
-         */
+         to the handler.
+      */
       CACHE_REGISTER (); /* Really we only need SP. FP and IP should be
                             unmodified. */
       ip += offset;
@@ -1510,7 +1506,7 @@ VM_DEFINE_INSTRUCTION (85, wind, "wind", 0, 2, 0)
   NEXT;
 }
 
-VM_DEFINE_INSTRUCTION (86, throw, "throw", 1, -1, -1)
+VM_DEFINE_INSTRUCTION (86, abort, "abort", 1, -1, -1)
 {
   unsigned n = FETCH ();
   SCM k;
@@ -1519,8 +1515,8 @@ VM_DEFINE_INSTRUCTION (86, throw, "throw", 1, -1, -1)
   POP (args);
   POP (k);
   SYNC_REGISTER ();
-  vm_throw (vm, k, args);
-  /* vm_throw should not return */
+  vm_abort (vm, k, args);
+  /* vm_abort should not return */
   abort ();
 }
 
@@ -1541,7 +1537,7 @@ VM_DEFINE_INSTRUCTION (90, wind_fluids, "wind-fluids", 1, 
-1, 0)
     goto vm_error_stack_underflow;
 
   wf = scm_i_make_with_fluids (n, sp + 1 - 2*n, sp + 1 - n);
-  scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
+  scm_i_swap_with_fluids (wf, dynstate);
   scm_i_set_dynwinds (scm_cons (wf, scm_i_dynwinds ()));
   NEXT;
 }
@@ -1551,7 +1547,48 @@ VM_DEFINE_INSTRUCTION (91, unwind_fluids, 
"unwind-fluids", 0, 0, 0)
   SCM wf;
   wf = scm_car (scm_i_dynwinds ());
   scm_i_set_dynwinds (scm_cdr (scm_i_dynwinds ()));
-  scm_i_swap_with_fluids (wf, SCM_I_CURRENT_THREAD->dynamic_state);
+  scm_i_swap_with_fluids (wf, dynstate);
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (92, fluid_ref, "fluid-ref", 0, 1, 1)
+{
+  size_t num;
+  SCM fluids;
+  
+  CHECK_UNDERFLOW ();
+  fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate);
+  if (SCM_UNLIKELY (!SCM_I_FLUID_P (*sp))
+      || ((num = SCM_I_FLUID_NUM (*sp)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
+    {
+      /* Punt dynstate expansion and error handling to the C proc. */
+      SYNC_REGISTER ();
+      *sp = scm_fluid_ref (*sp);
+    }
+  else
+    *sp = SCM_SIMPLE_VECTOR_REF (fluids, num);
+  
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (93, fluid_set, "fluid-set", 0, 2, 0)
+{
+  size_t num;
+  SCM val, fluid, fluids;
+  
+  POP (val);
+  POP (fluid);
+  fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate);
+  if (SCM_UNLIKELY (!SCM_I_FLUID_P (fluid))
+      || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH 
(fluids)))
+    {
+      /* Punt dynstate expansion and error handling to the C proc. */
+      SYNC_REGISTER ();
+      scm_fluid_set_x (fluid, val);
+    }
+  else
+    SCM_SIMPLE_VECTOR_SET (fluids, num, val);
+  
   NEXT;
 }
 
diff --git a/libguile/vm.c b/libguile/vm.c
index 66d89a4..c8dd07e 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -207,9 +207,9 @@ vm_dispatch_hook (SCM vm, int hook_num)
  */
 #define VM_SETJMP(jmpbuf) 0
 
-static void vm_throw (SCM vm, SCM k, SCM args) SCM_NORETURN;
+static void vm_abort (SCM vm, SCM tag, SCM args) SCM_NORETURN;
 static void
-vm_throw (SCM vm, SCM k, SCM args)
+vm_abort (SCM vm, SCM tag, SCM args)
 {
   abort ();
 }
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 948b1cc..af34467 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -10243,15 +10243,15 @@
                                       #{mod\ 3384}#))
                                   #{val\ 3399}#)
                              (#{chi-body\ 333}#
-                              (cons #{b\ 3400}# #{b*\ 3401}#)
-                              (#{source-wrap\ 311}#
-                               #{e\ 3380}#
+                               (cons #{b\ 3400}# #{b*\ 3401}#)
+                               (#{source-wrap\ 311}#
+                                 #{e\ 3380}#
+                                 #{w\ 3382}#
+                                 #{s\ 3383}#
+                                 #{mod\ 3384}#)
+                               #{r\ 3381}#
                                #{w\ 3382}#
-                               #{s\ 3383}#
-                               #{mod\ 3384}#)
-                              #{r\ 3381}#
-                              #{w\ 3382}#
-                              #{mod\ 3384}#)))
+                               #{mod\ 3384}#)))
                          #{tmp\ 3391}#)
                   (syntax-violation
                     #f
@@ -11170,18 +11170,16 @@
                             (null? (cdr #{rest\ 3658}#))))
                       '(eval)
                       (cadr #{rest\ 3658}#))))
-              (with-fluid*
-                #{*mode*\ 139}#
-                #{m\ 3665}#
-                (lambda ()
-                  (#{chi-top\ 323}#
-                    #{x\ 3657}#
-                    '()
-                    '((top))
-                    #{m\ 3665}#
-                    #{esew\ 3666}#
-                    (cons 'hygiene
-                          (module-name (current-module))))))))))
+              (with-fluids
+                  ((#{*mode*\ 139}# #{m\ 3665}#))
+                (#{chi-top\ 323}#
+                 #{x\ 3657}#
+                 '()
+                 '((top))
+                 #{m\ 3665}#
+                 #{esew\ 3666}#
+                 (cons 'hygiene
+                       (module-name (current-module)))))))))
       (set! identifier?
         (lambda (#{x\ 3673}#)
           (#{nonsymbol-id?\ 238}# #{x\ 3673}#)))
diff --git a/module/language/assembly/compile-bytecode.scm 
b/module/language/assembly/compile-bytecode.scm
index 98fb27f..5c0e115 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -119,8 +119,7 @@
         ((br-if-nargs-lt ,hi ,lo ,l) (write-byte hi) (write-byte lo) 
(write-break l))
         ((br-if-nargs-gt ,hi ,lo ,l) (write-byte hi) (write-byte lo) 
(write-break l))
         ((mv-call ,n ,l) (write-byte n) (write-break l))
-        ((prompt ,inline-handler? ,escape-only? ,l)
-         (write-byte inline-handler?) (write-byte escape-only?) (write-break 
l))
+        ((prompt ,escape-only? ,l) (write-byte escape-only?) (write-break l))
         (else
          (cond
           ((< (instruction-length inst) 0)
diff --git a/module/language/assembly/decompile-bytecode.scm 
b/module/language/assembly/decompile-bytecode.scm
index a021b57..3ae96d2 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -90,8 +90,8 @@
                   (lp (cons `(,br ,hi ,lo ,(ensure-label rel1 rel2 rel3)) 
out)))
                  ((mv-call ,n ,rel1 ,rel2 ,rel3)
                   (lp (cons `(mv-call ,n ,(ensure-label rel1 rel2 rel3)) out)))
-                 ((prompt ,n0 ,n1 ,rel1 ,rel2 ,rel3)
-                  (lp (cons `(prompt ,n0 ,n1 ,(ensure-label rel1 rel2 rel3)) 
out)))
+                 ((prompt ,n0 ,rel1 ,rel2 ,rel3)
+                  (lp (cons `(prompt ,n0 ,(ensure-label rel1 rel2 rel3)) out)))
                  (else 
                   (lp (cons exp out))))))))))
 
diff --git a/module/language/glil.scm b/module/language/glil.scm
index 1874c80..9c23854 100644
--- a/module/language/glil.scm
+++ b/module/language/glil.scm
@@ -75,8 +75,7 @@
    <glil-mv-call> make-glil-mv-call glil-mv-call?
    glil-mv-call-nargs glil-mv-call-ra
 
-   <glil-prompt> make-glil-prompt glil-prompt?
-   glil-prompt-label glil-prompt-inline? glil-prompt-escape-only?
+   <glil-prompt> make-glil-prompt glil-prompt? glil-prompt-label 
glil-prompt-escape-only?
 
    parse-glil unparse-glil))
 
@@ -105,7 +104,7 @@
   (<glil-branch> inst label)
   (<glil-call> inst nargs)
   (<glil-mv-call> nargs ra)
-  (<glil-prompt> label inline? escape-only?))
+  (<glil-prompt> label escape-only?))
 
 
 
@@ -133,8 +132,8 @@
     ((branch ,inst ,label) (make-glil-branch inst label))
     ((call ,inst ,nargs) (make-glil-call inst nargs))
     ((mv-call ,nargs ,ra) (make-glil-mv-call nargs ra))
-    ((prompt ,label ,inline? ,escape-only?)
-     (make-glil-prompt label inline? escape-only?))
+    ((prompt ,label ,escape-only?)
+     (make-glil-prompt label escape-only?))
     (else (error "invalid glil" x))))
 
 (define (unparse-glil glil)
@@ -167,5 +166,5 @@
     ((<glil-branch> inst label) `(branch ,inst ,label))
     ((<glil-call> inst nargs) `(call ,inst ,nargs))
     ((<glil-mv-call> nargs ra) `(mv-call ,nargs ,ra))
-    ((<glil-prompt> label inline? escape-only?)
-     `(prompt ,label ,inline? escape-only?))))
+    ((<glil-prompt> label escape-only?)
+     `(prompt ,label escape-only?))))
diff --git a/module/language/glil/compile-assembly.scm 
b/module/language/glil/compile-assembly.scm
index 95804ec..47002a8 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -514,10 +514,8 @@
     ((<glil-mv-call> nargs ra)
      (emit-code `((mv-call ,nargs ,ra))))
 
-    ((<glil-prompt> label inline? escape-only?)
-     (emit-code `((prompt ,(if inline? 1 0)
-                          ,(if escape-only? 1 0)
-                          ,label))))))
+    ((<glil-prompt> label escape-only?)
+     (emit-code `((prompt ,(if escape-only? 1 0) ,label))))))
 
 (define (dump-object x addr)
   (define (too-long x)
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index 2d160d6..cfd26bf 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -47,8 +47,10 @@
             <let-values> let-values? make-let-values let-values-src 
let-values-exp let-values-body
             <dynwind> dynwind? make-dynwind dynwind-src dynwind-winder 
dynwind-body dynwind-unwinder
             <dynlet> dynlet? make-dynlet dynlet-src dynlet-fluids dynlet-vals 
dynlet-body
-            <prompt> prompt? make-prompt prompt-src prompt-tag prompt-body 
prompt-handler prompt-pre-unwind-handler 
-            <control> control? make-control control-src control-tag 
control-type control-args
+            <dynref> dynref? make-dynref dynref-src dynref-fluid 
+            <dynset> dynset? make-dynset dynset-src dynset-fluid dynset-exp
+            <prompt> prompt? make-prompt prompt-src prompt-tag prompt-body 
prompt-handler
+            <abort> abort? make-abort abort-src abort-tag abort-args
 
             parse-tree-il
             unparse-tree-il
@@ -81,8 +83,10 @@
   (<let-values> exp body)
   (<dynwind> winder body unwinder)
   (<dynlet> fluids vals body)
-  (<prompt> tag body handler pre-unwind-handler)
-  (<control> tag type args))
+  (<dynref> fluid)
+  (<dynset> fluid exp)
+  (<prompt> tag body handler)
+  (<abort> tag args))
   
 
 
@@ -179,12 +183,17 @@
      ((dynlet ,fluids ,vals ,body)
       (make-dynlet loc (map retrans fluids) (map retrans vals) (retrans body)))
      
-     ((prompt ,tag ,body ,handler ,pre-unwind-handler)
-      (make-prompt loc (retrans tag) (retrans body) (retrans handler)
-                   (and=> pre-unwind-handler retrans)))
+     ((dynref ,fluid)
+      (make-dynref loc (retrans fluid)))
      
-     ((control ,tag ,type ,args)
-      (make-control loc (retrans tag) type (map retrans args)))
+     ((dynset ,fluid ,exp)
+      (make-dynset loc (retrans fluid) (retrans exp)))
+     
+     ((prompt ,tag ,body ,handler)
+      (make-prompt loc (retrans tag) (retrans body) (retrans handler)))
+     
+     ((abort ,tag ,type ,args)
+      (make-abort loc (retrans tag) type (map retrans args)))
 
      (else
       (error "unrecognized tree-il" exp)))))
@@ -258,12 +267,17 @@
      `(dynlet ,(map unparse-tree-il fluids) ,(map unparse-tree-il vals)
               ,(unparse-tree-il body)))
     
-    ((<prompt> tag body handler pre-unwind-handler)
-     `(prompt ,tag ,(unparse-tree-il body) ,(unparse-tree-il handler)
-              ,(and=> pre-unwind-handler unparse-tree-il)))
+    ((<dynref> fluid)
+     `(dynref ,(unparse-tree-il fluid)))
+    
+    ((<dynset> fluid exp)
+     `(dynref ,(unparse-tree-il fluid) ,(unparse-tree-il exp)))
     
-    ((<control> tag type args)
-     `(control ,(unparse-tree-il tag) ,type ,(map unparse-tree-il args)))))
+    ((<prompt> tag body handler)
+     `(prompt ,tag ,(unparse-tree-il body) ,(unparse-tree-il handler)))
+    
+    ((<abort> tag args)
+     `(abort ,(unparse-tree-il tag) ,(map unparse-tree-il args)))))
 
 (define (tree-il->scheme e)
   (record-case e
@@ -346,18 +360,22 @@
      `(with-fluids ,(map list
                          (map tree-il->scheme fluids)
                          (map tree-il->scheme vals))
-        (lambda () ,(tree-il->scheme body))))
+        ,(tree-il->scheme body)))
+    
+    ((<dynref> fluid)
+     `(fluid-ref ,(tree-il->scheme fluid)))
     
-    ((<prompt> tag body handler pre-unwind-handler)
+    ((<dynset> fluid exp)
+     `(fluid-set! ,(tree-il->scheme fluid) ,(tree-il->scheme exp)))
+    
+    ((<prompt> tag body handler)
      `((@ (ice-9 control) prompt) 
        ,(tree-il->scheme tag) (lambda () ,(tree-il->scheme body))
-       ,(tree-il->scheme handler) ,(and=> pre-unwind-handler tree-il->scheme)))
+       ,(tree-il->scheme handler)))
     
 
-    ((<control> tag type args)
-     (case type
-       ((throw) `(throw ,(tree-il->scheme tag) ,@(map tree-il->scheme args)))
-       (else (error "bad control type" type))))))
+    ((<abort> tag args)
+     `(@abort ,(tree-il->scheme tag) ,@(map tree-il->scheme args)))))
 
 
 (define (tree-il-fold leaf down up seed tree)
@@ -418,15 +436,15 @@ This is an implementation of `foldts' as described by 
Andy Wingo in
            (up tree (loop body
                           (loop vals
                                 (loop fluids (down tree result))))))
-          ((<prompt> tag body handler pre-unwind-handler)
-           (up tree (loop tag
-                          (loop body
-                                (loop handler
-                                      (if pre-unwind-handler
-                                          (loop pre-unwind-handler
-                                                (down tree result))
-                                          (down tree result)))))))
-          ((<control> tag type args)
+          ((<dynref> fluid)
+           (up tree (loop fluid (down tree result))))
+          ((<dynset> fluid exp)
+           (up tree (loop exp (loop fluid (down tree result)))))
+          ((<prompt> tag body handler)
+           (up tree
+               (loop tag (loop body (loop handler
+                                          (down tree result))))))
+          ((<abort> tag args)
            (up tree (loop tag (loop args (down tree result)))))
           (else
            (leaf tree result))))))
@@ -491,14 +509,16 @@ This is an implementation of `foldts' as described by 
Andy Wingo in
                   (let*-values (((seed ...) (fold-values foldts fluids seed 
...))
                                 ((seed ...) (fold-values foldts vals seed 
...)))
                     (foldts body seed ...)))
-                 ((<prompt> tag body handler pre-unwind-handler)
+                 ((<dynref> fluid)
+                  (foldts fluid seed ...))
+                 ((<dynset> fluid exp)
+                  (let*-values (((seed ...) (foldts fluid seed ...)))
+                    (foldts exp seed ...)))
+                 ((<prompt> tag body handler)
                   (let*-values (((seed ...) (foldts tag seed ...))
-                                ((seed ...) (foldts body seed ...))
-                                ((seed ...) (foldts handler seed ...)))
-                    (if pre-unwind-handler
-                        (values seed ...)
-                        (foldts pre-unwind-handler seed ...))))
-                 ((<control> tag args)
+                                ((seed ...) (foldts body seed ...)))
+                    (foldts handler seed ...)))
+                 ((<abort> tag args)
                   (let*-values (((seed ...) (foldts tag seed ...)))
                     (fold-values foldts args seed ...)))
                  (else
@@ -567,16 +587,21 @@ This is an implementation of `foldts' as described by 
Andy Wingo in
        (set! (dynlet-vals x) (map lp vals))
        (set! (dynlet-body x) (lp body)))
       
-      ((<prompt> tag body handler pre-unwind-handler)
+      ((<dynref> fluid)
+       (set! (dynref-fluid x) (lp fluid)))
+      
+      ((<dynset> fluid exp)
+       (set! (dynset-fluid x) (lp fluid))
+       (set! (dynset-exp x) (lp exp)))
+      
+      ((<prompt> tag body handler)
        (set! (prompt-tag x) (lp tag))
        (set! (prompt-body x) (lp body))
-       (set! (prompt-handler x) (lp handler))
-       (if pre-unwind-handler
-           (set! (prompt-pre-unwind-handler x) (lp pre-unwind-handler))))
+       (set! (prompt-handler x) (lp handler)))
       
-      ((<control> tag args)
-       (set! (control-tag x) (lp tag))
-       (set! (control-args x) (map lp args)))
+      ((<abort> tag args)
+       (set! (abort-tag x) (lp tag))
+       (set! (abort-args x) (map lp args)))
       
       (else #f))
     
@@ -644,16 +669,21 @@ This is an implementation of `foldts' as described by 
Andy Wingo in
          (set! (dynlet-vals x) (map lp vals))
          (set! (dynlet-body x) (lp body)))
       
-        ((<prompt> tag body handler pre-unwind-handler)
+        ((<dynref> fluid)
+         (set! (dynref-fluid x) (lp fluid)))
+        
+        ((<dynset> fluid exp)
+         (set! (dynset-fluid x) (lp fluid))
+         (set! (dynset-exp x) (lp exp)))
+        
+        ((<prompt> tag body handler)
          (set! (prompt-tag x) (lp tag))
          (set! (prompt-body x) (lp body))
-         (set! (prompt-handler x) (lp handler))
-         (if pre-unwind-handler
-             (set! (prompt-pre-unwind-handler x) (lp pre-unwind-handler))))
+         (set! (prompt-handler x) (lp handler)))
         
-        ((<control> tag args)
-         (set! (control-tag x) (lp tag))
-         (set! (control-args x) (map lp args)))
+        ((<abort> tag args)
+         (set! (abort-tag x) (lp tag))
+         (set! (abort-args x) (map lp args)))
         
         (else #f))
       x)))
diff --git a/module/language/tree-il/analyze.scm 
b/module/language/tree-il/analyze.scm
index c60bcce..c5f6cb9 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -342,11 +342,16 @@
       ((<dynlet> fluids vals body)
        (apply lset-union eq? (step body) (map step (append fluids vals))))
       
-      ((<prompt> tag body handler pre-unwind-handler)
-       (lset-union eq? (step tag) (step handler)
-                   (if pre-unwind-handler (step pre-unwind-handler) '())))
+      ((<dynref> fluid)
+       (step fluid))
       
-      ((<control> tag type args)
+      ((<dynset> fluid exp)
+       (lset-union eq? (step fluid) (step exp)))
+      
+      ((<prompt> tag body handler)
+       (lset-union eq? (step tag) (step handler)))
+      
+      ((<abort> tag args)
        (apply lset-union eq? (step tag) (map step args)))
       
       (else '())))
@@ -506,16 +511,21 @@
       ((<dynlet> fluids vals body)
        (apply max (recur body) (map recur (append fluids vals))))
       
-      ((<prompt> tag body handler pre-unwind-handler)
+      ((<dynref> fluid)
+       (recur fluid))
+      
+      ((<dynset> fluid exp)
+       (max (recur fluid) (recur exp)))
+      
+      ((<prompt> tag body handler)
        (let ((cont-var (and (lambda-case? handler)
                             (pair? (lambda-case-vars handler))
                             (car (lambda-case-vars handler)))))
          (hashq-set! allocation x
                      (and cont-var (zero? (hashq-ref refcounts cont-var 0))))
-         (max (recur tag) (recur body) (recur handler)
-              (if pre-unwind-handler (recur pre-unwind-handler) 0))))
+         (max (recur tag) (recur body) (recur handler))))
       
-      ((<control> tag type args)
+      ((<abort> tag args)
        (apply max (recur tag) (map recur args)))
       
       (else n)))
diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index 887a247..0646688 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -1013,6 +1013,24 @@
           (if RA
               (emit-branch #f 'br RA)))))
 
+      ((<dynref> src fluid)
+       (case context
+         ((drop)
+          (comp-drop fluid))
+         ((push vals tail)
+          (comp-push fluid)
+          (emit-code #f (make-glil-call 'fluid-ref 1))))
+       (maybe-emit-return))
+      
+      ((<dynset> src fluid exp)
+       (comp-push fluid)
+       (comp-push exp)
+       (emit-code #f (make-glil-call 'fluid-set 2))
+       (case context
+         ((push vals tail)
+          (emit-code #f (make-glil-void))))
+       (maybe-emit-return))
+      
       ;; What's the deal here? The deal is that we are compiling the start of a
       ;; delimited continuation. We try to avoid heap allocation in the normal
       ;; case; so the body is an expression, not a thunk, and we try to render
@@ -1020,20 +1038,13 @@
       ;; if the continuation isn't referenced, we don't reify it. This makes it
       ;; possible to implement catch and throw with delimited continuations,
       ;; without any overhead.
-      ((<prompt> src tag body handler pre-unwind-handler)
+      ((<prompt> src tag body handler)
        (let ((H (make-label))
              (POST (make-label))
-             (inline? (lambda-case? handler))
              (escape-only? (hashq-ref allocation x)))
          ;; First, set up the prompt.
          (comp-push tag)
-         (if inline?
-             (emit-code #f (make-glil-const #f)) ;; push #f as handler
-             (comp-push handler))
-         (if pre-unwind-handler
-             (comp-push pre-unwind-handler)
-             (emit-code #f (make-glil-const #f)))
-         (emit-code src (make-glil-prompt H inline? escape-only?))
+         (emit-code src (make-glil-prompt H escape-only?))
 
          ;; Then we compile the body, with its normal return path, unwinding
          ;; before proceeding.
@@ -1072,59 +1083,35 @@
             (emit-code #f (make-glil-call 'unwind 0))
             (emit-branch #f 'br (or RA POST))))
          
-         ;; Now the handler.
          (emit-label H)
-         (cond
-          (inline?
-           ;; The inlined handler. The stack is now made up of the 
continuation,
-           ;; and then the args to the continuation (pushed separately), and
-           ;; then the number of args, including the continuation.
-           (record-case handler
-             ((<lambda-case> req opt kw rest vars body alternate)
-              (if (or opt kw alternate)
-                  (error "unexpected lambda-case in prompt" x))
-              (emit-code src (make-glil-mv-bind
-                              (vars->bind-list
-                               (append req (if rest (list rest) '()))
-                               vars allocation self)
-                              (and rest #t)))
-              (for-each (lambda (v)
-                          (pmatch (hashq-ref (hashq-ref allocation v) self)
-                            ((#t #f . ,n)
-                             (emit-code src (make-glil-lexical #t #f 'set n)))
-                            ((#t #t . ,n)
-                             (emit-code src (make-glil-lexical #t #t 'box n)))
-                            (,loc (error "badness" x loc))))
-                        (reverse vars))
-              (comp-tail body)
-              (emit-code #f (make-glil-unbind)))))
-          (else
-           ;; The handler was on the heap, so here we're just processing its
-           ;; return values.
-           (case context
-             ((tail)
-              (emit-code #f (make-glil-call 'return/nvalues 1)))
-             ((push)
-              ;; truncate to one value, leave on stack
-              (emit-code #f (make-glil-mv-bind '(handler-ret) #f))
-              (emit-code #f (make-glil-unbind)))
-             ((vals)
-              (emit-branch #f 'br MVRA))
-             ((drop)
-              ;; truncate to 0 vals
-              (emit-code #f (make-glil-mv-bind '() #f))
-              (emit-code #f (make-glil-unbind))
-              (if RA (emit-branch #f 'br RA))))))
+         ;; Now the handler. The stack is now made up of the continuation, and
+         ;; then the args to the continuation (pushed separately), and then the
+         ;; number of args, including the continuation.
+         (record-case handler
+           ((<lambda-case> req opt kw rest vars body alternate)
+            (if (or opt kw alternate)
+                (error "unexpected lambda-case in prompt" x))
+            (emit-code src (make-glil-mv-bind
+                            (vars->bind-list
+                             (append req (if rest (list rest) '()))
+                             vars allocation self)
+                            (and rest #t)))
+            (for-each (lambda (v)
+                        (pmatch (hashq-ref (hashq-ref allocation v) self)
+                          ((#t #f . ,n)
+                           (emit-code src (make-glil-lexical #t #f 'set n)))
+                          ((#t #t . ,n)
+                           (emit-code src (make-glil-lexical #t #t 'box n)))
+                          (,loc (error "badness" x loc))))
+                      (reverse vars))
+            (comp-tail body)
+            (emit-code #f (make-glil-unbind))))
 
-         ;; The POST label, if necessary.
          (if (or (eq? context 'push)
                  (and (eq? context 'drop) (not RA)))
              (emit-label POST))))
 
-      ((<control> src tag type args)
+      ((<abort> src tag args)
        (comp-push tag)
-       (case type
-         ((throw)
-          (for-each comp-push args)
-          (emit-code src (make-glil-call 'throw (length args))))
-         (else (error "bad control type" x)))))))
+       (for-each comp-push args)
+       (emit-code src (make-glil-call 'abort (length args)))))))
diff --git a/module/language/tree-il/inline.scm 
b/module/language/tree-il/inline.scm
index ec030c8..905622d 100644
--- a/module/language/tree-il/inline.scm
+++ b/module/language/tree-il/inline.scm
@@ -110,15 +110,29 @@
       ((<fix> vars body)
        (if (null? vars) body x))
        
-      ((<prompt> src tag body handler pre-unwind-handler)
-       ;; If the handler is a simple lambda, inline it.
-       (if (and (lambda? handler)
-                (record-case (lambda-body handler)
-                  ((<lambda-case> req opt kw rest alternate)
-                   (and (pair? req) (not opt) (not kw) (not alternate)))
-                  (else #f)))
-           (make-prompt src tag body (lambda-body handler) pre-unwind-handler)
-           x))
-       
+      ((<lambda-case> req opt rest kw vars body alternate)
+       (let ()
+         (define (args-compatible? args vars)
+           (let lp ((args args) (vars vars))
+             (cond
+              ((null? args) (null? vars))
+              ((null? vars) #f)
+              ((and (lexical-ref? (car args))
+                    (eq? (lexical-ref-gensym (car args)) (car vars)))
+               (lp (cdr args) (cdr vars)))
+              (else #f))))
+         
+         (and (not opt) (not kw) (not alternate)
+              (record-case body
+                ((<application> proc args)
+                 ;; (lambda args (apply (lambda ...) args)) => (lambda ...)
+                 (and (primitive-ref? proc)
+                      (eq? (primitive-ref-name proc) '@apply)
+                      (pair? args)
+                      (lambda? (car args))
+                      (args-compatible? (cdr args) vars)
+                      (lambda-body (car args))))
+                (else #f)))))
+      
       (else #f)))
   (post-order! inline1 x))
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index 2593426..58b75fc 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -61,6 +61,8 @@
     variable-bound?
     ;; args of variable-set are switched; it needs special help
 
+    fluid-ref fluid-set!
+
     struct? struct-vtable make-struct struct-ref struct-set!
 
     bytevector-u8-ref bytevector-u8-set!
@@ -421,32 +423,43 @@
                    (make-lexical-ref #f 'post POST)))))))
 
 (hashq-set! *primitive-expand-table*
-            'prompt
+            'fluid-ref
             (case-lambda
-              ((src tag thunk handler)
-               (make-prompt src tag (make-application #f thunk '())
-                            handler #f))
-              ((src tag thunk handler pre)
-               (make-prompt src tag (make-application #f thunk '())
-                            handler pre))
+              ((src fluid) (make-dynref src fluid))
               (else #f)))
+
+(hashq-set! *primitive-expand-table*
+            'fluid-set!
+            (case-lambda
+              ((src fluid exp) (make-dynset src fluid exp))
+              (else #f)))
+
 (hashq-set! *primitive-expand-table*
             '@prompt
             (case-lambda
-              ((src tag thunk handler pre)
-               (make-prompt src tag (make-application #f thunk '())
-                            handler pre))
+              ((src tag exp handler)
+               (let ((args-sym (gensym)))
+                 (make-prompt
+                  src tag exp
+                  ;; If handler itself is a lambda, the inliner can do some
+                  ;; trickery here.
+                  (make-lambda-case
+                   (tree-il-src handler) '() #f 'args #f '() (list args-sym)
+                   (make-application #f (make-primitive-ref #f 'apply)
+                                     (list handler
+                                           (make-lexical-ref #f 'args 
args-sym)))
+                   #f))))
               (else #f)))
 
 (hashq-set! *primitive-expand-table*
             'control
             (case-lambda
               ((src tag . args)
-               (make-control src tag 'throw args))
+               (make-abort src tag args))
               (else #f)))
 (hashq-set! *primitive-expand-table*
             '@control
             (case-lambda
-              ((src tag type . args)
-               (make-control src tag (if (const? type) (const-exp type) (error 
"what ho" type)) args))
+              ((src tag . args)
+               (make-abort src tag args))
               (else #f)))


hooks/post-receive
-- 
GNU Guile




reply via email to

[Prev in Thread] Current Thread [Next in Thread]