guile-commits
[Top][All Lists]
Advanced

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

[Guile-commits] 01/05: VM throw uses intrinsics


From: Andy Wingo
Subject: [Guile-commits] 01/05: VM throw uses intrinsics
Date: Wed, 27 Jun 2018 08:03:22 -0400 (EDT)

wingo pushed a commit to branch master
in repository guile.

commit 0ce9a1f870d8e5d20c4f89bc0e5959fc0aa6fe03
Author: Andy Wingo <address@hidden>
Date:   Tue Jun 26 20:45:26 2018 +0200

    VM throw uses intrinsics
    
    * libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Add intrinsics for
      throw, throw/value, and throw/value+data.
    * libguile/intrinsics.c (throw_, throw_with_value):
      (throw_with_value_and_data): And here they are.
    * libguile/vm-engine.c (throw, throw/value, throw/value+data): Use
      intrinsics.
    * libguile/vm.c: Remove vm_throw et al.
---
 libguile/intrinsics.c | 42 ++++++++++++++++++++++++++++++++++++++++++
 libguile/intrinsics.h |  4 ++++
 libguile/vm-engine.c  |  6 +++---
 libguile/vm.c         | 44 +++-----------------------------------------
 4 files changed, 52 insertions(+), 44 deletions(-)

diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c
index 4adb67b..9094134 100644
--- a/libguile/intrinsics.c
+++ b/libguile/intrinsics.c
@@ -269,6 +269,45 @@ lookup (SCM module, SCM name)
   return scm_module_variable (module, name);
 }
 
+static void throw_ (SCM key, SCM args) SCM_NORETURN;
+static void throw_with_value (SCM val, SCM key_subr_and_message) SCM_NORETURN;
+static void throw_with_value_and_data (SCM val, SCM key_subr_and_message) 
SCM_NORETURN;
+
+static void
+throw_ (SCM key, SCM args)
+{
+  scm_throw (key, args);
+  abort(); /* not reached */
+}
+
+static void
+throw_with_value (SCM val, SCM key_subr_and_message)
+{
+  SCM key, subr, message, args, data;
+
+  key = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 0);
+  subr = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 1);
+  message = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 2);
+  args = scm_list_1 (val);
+  data = SCM_BOOL_F;
+
+  throw_ (key, scm_list_4 (subr, message, args, data));
+}
+
+static void
+throw_with_value_and_data (SCM val, SCM key_subr_and_message)
+{
+  SCM key, subr, message, args, data;
+
+  key = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 0);
+  subr = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 1);
+  message = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 2);
+  args = scm_list_1 (val);
+  data = args;
+
+  throw_ (key, scm_list_4 (subr, message, args, data));
+}
+
 void
 scm_bootstrap_intrinsics (void)
 {
@@ -314,6 +353,9 @@ scm_bootstrap_intrinsics (void)
   scm_vm_intrinsics.resolve_module = resolve_module;
   scm_vm_intrinsics.lookup = lookup;
   scm_vm_intrinsics.define_x = scm_module_ensure_local_variable;
+  scm_vm_intrinsics.throw_ = throw_;
+  scm_vm_intrinsics.throw_with_value = throw_with_value;
+  scm_vm_intrinsics.throw_with_value_and_data = throw_with_value_and_data;
 
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_intrinsics",
diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h
index a46f731..cc175fe 100644
--- a/libguile/intrinsics.h
+++ b/libguile/intrinsics.h
@@ -58,6 +58,7 @@ typedef SCM (*scm_t_scm_from_thread_regs_intrinsic) 
(scm_thread*, jmp_buf*);
 typedef void (*scm_t_thread_regs_scm_intrinsic) (scm_thread*, jmp_buf*, SCM);
 typedef int (*scm_t_int_from_scm_intrinsic) (SCM);
 typedef void (*scm_t_thread_regs_intrinsic) (scm_thread*, jmp_buf*);
+typedef void (*scm_t_scm_scm_noreturn_intrinsic) (SCM, SCM) SCM_NORETURN;
 
 #define SCM_FOR_ALL_VM_INTRINSICS(M) \
   M(scm_from_scm_scm, add, "add", ADD) \
@@ -113,6 +114,9 @@ typedef void (*scm_t_thread_regs_intrinsic) (scm_thread*, 
jmp_buf*);
   M(thread_regs_scm, compose_continuation, "compose-continuation", 
COMPOSE_CONTINUATION) \
   M(int_from_scm, rest_arg_length, "rest-arg-length", REST_ARG_LENGTH) \
   M(thread_regs, abort_to_prompt, "abort-to-prompt", ABORT_TO_PROMPT) \
+  M(scm_scm_noreturn, throw_, "throw", THROW) \
+  M(scm_scm_noreturn, throw_with_value, "throw/value", THROW_WITH_VALUE) \
+  M(scm_scm_noreturn, throw_with_value_and_data, "throw/value+data", 
THROW_WITH_VALUE_AND_DATA) \
   /* Add new intrinsics here; also update scm_bootstrap_intrinsics.  */
 
 enum scm_vm_intrinsic
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 71b3dfd..18ae5a6 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -832,7 +832,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume)
       args = SP_REF (b);
 
       SYNC_IP ();
-      vm_throw (key, args);
+      scm_vm_intrinsics.throw_ (key, args);
 
       abort (); /* never reached */
     }
@@ -861,7 +861,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume)
       key_subr_and_message = SCM_PACK (key_subr_and_message_bits);
 
       SYNC_IP ();
-      vm_throw_with_value (val, key_subr_and_message);
+      scm_vm_intrinsics.throw_with_value (val, key_subr_and_message);
 
       abort (); /* never reached */
     }
@@ -890,7 +890,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume)
       key_subr_and_message = SCM_PACK (key_subr_and_message_bits);
 
       SYNC_IP ();
-      vm_throw_with_value_and_data (val, key_subr_and_message);
+      scm_vm_intrinsics.throw_with_value_and_data (val, key_subr_and_message);
 
       abort (); /* never reached */
     }
diff --git a/libguile/vm.c b/libguile/vm.c
index 4504099..bb6c32a 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -308,9 +308,6 @@ static void vm_dispatch_abort_hook (struct scm_vm *vp)
  * VM Error Handling
  */
 
-static void vm_throw (SCM key, SCM args) SCM_NORETURN;
-static void vm_throw_with_value (SCM val, SCM key_subr_and_message) 
SCM_NORETURN SCM_NOINLINE;
-static void vm_throw_with_value_and_data (SCM val, SCM key_subr_and_message) 
SCM_NORETURN SCM_NOINLINE;
 
 static void vm_error (const char *msg, SCM arg) SCM_NORETURN;
 static void vm_error_bad_instruction (uint32_t inst) SCM_NORETURN SCM_NOINLINE;
@@ -321,46 +318,11 @@ static void vm_error_not_enough_values (void) 
SCM_NORETURN SCM_NOINLINE;
 static void vm_error_wrong_number_of_values (uint32_t expected) SCM_NORETURN 
SCM_NOINLINE;
 
 static void
-vm_throw (SCM key, SCM args)
-{
-  scm_throw (key, args);
-  abort(); /* not reached */
-}
-
-static void
-vm_throw_with_value (SCM val, SCM key_subr_and_message)
-{
-  SCM key, subr, message, args, data;
-
-  key = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 0);
-  subr = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 1);
-  message = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 2);
-  args = scm_list_1 (val);
-  data = SCM_BOOL_F;
-
-  vm_throw (key, scm_list_4 (subr, message, args, data));
-}
-
-static void
-vm_throw_with_value_and_data (SCM val, SCM key_subr_and_message)
-{
-  SCM key, subr, message, args, data;
-
-  key = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 0);
-  subr = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 1);
-  message = SCM_SIMPLE_VECTOR_REF (key_subr_and_message, 2);
-  args = scm_list_1 (val);
-  data = args;
-
-  vm_throw (key, scm_list_4 (subr, message, args, data));
-}
-
-static void
 vm_error (const char *msg, SCM arg)
 {
-  vm_throw (sym_vm_error,
-            scm_list_3 (sym_vm_run, scm_from_latin1_string (msg),
-                        SCM_UNBNDP (arg) ? SCM_EOL : scm_list_1 (arg)));
+  scm_throw (sym_vm_error,
+             scm_list_3 (sym_vm_run, scm_from_latin1_string (msg),
+                         SCM_UNBNDP (arg) ? SCM_EOL : scm_list_1 (arg)));
 }
 
 static void



reply via email to

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