[Guile-commits] GNU Guile branch, wip-rtl-halloween, updated. v2.1.0-358-g8734229

[Andy Wingo]

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=873422952847a458f5a236ee8d73e17963f0d58e

The branch, wip-rtl-halloween has been updated
       via  873422952847a458f5a236ee8d73e17963f0d58e (commit)
       via  9f309e2cd9ec78408d2b0df77c46d44f7bddb368 (commit)
      from  f41accb9c26e3b4df4170bda04b8860ee962657f (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 873422952847a458f5a236ee8d73e17963f0d58e
Author: Andy Wingo <address@hidden>
Date:   Fri Nov 8 14:19:41 2013 +0100

    Fix program-minimum-arity to work better with case-lambda.
    
    * module/system/vm/debug.scm (program-minimum-arity): Be more precise
      with case-lambdas.

commit 9f309e2cd9ec78408d2b0df77c46d44f7bddb368
Author: Andy Wingo <address@hidden>
Date:   Fri Nov 8 14:08:42 2013 +0100

    Builtins have procedure properties
    
    * libguile/vm-builtins.h (FOR_EACH_VM_BUILTIN): Add arity information.
      (enum scm_vm_builtins):
    * libguile/vm.c (scm_vm_builtin_ref):
      (scm_vm_builtin_name_to_index):
      (scm_vm_builtin_index_to_name): Adapt to macro interface change.
      (scm_init_vm_builtin_properties): New helper, sets procedure
      properties on builtins.
      (scm_bootstrap_vm): Just define the builtins here.  Later in the
      bootstrap we set their properties.
      (scm_sym_apply): Move definition here from expand.c.
    
    * libguile/procprop.c (scm_init_procprop): Call
      scm_init_vm_builtin_properties.

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

Summary of changes:
 libguile/expand.c          |    1 -
 libguile/procprop.c        |    2 +
 libguile/vm-builtins.h     |   13 ++++++-----
 libguile/vm.c              |   48 ++++++++++++++++++++++++++++---------------
 module/system/vm/debug.scm |   12 ++++++++++-
 5 files changed, 51 insertions(+), 25 deletions(-)

diff --git a/libguile/expand.c b/libguile/expand.c
index a8625ea..7d6a6ed 100644
--- a/libguile/expand.c
+++ b/libguile/expand.c
@@ -173,7 +173,6 @@ SCM_SYNTAX ("case-lambda", expand_case_lambda);
 SCM_SYNTAX ("case-lambda*", expand_case_lambda_star);
 
 
-SCM_GLOBAL_SYMBOL (scm_sym_apply, "apply");
 SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>");
 SCM_GLOBAL_SYMBOL (scm_sym_at, "@");
 SCM_GLOBAL_SYMBOL (scm_sym_atat, "@@");
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 9965b45..5bb9e62 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -33,6 +33,7 @@
 #include "libguile/vectors.h"
 #include "libguile/weak-table.h"
 #include "libguile/programs.h"
+#include "libguile/vm-builtins.h"
 
 #include "libguile/validate.h"
 #include "libguile/procprop.h"
@@ -342,6 +343,7 @@ scm_init_procprop ()
   overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
   arity_overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
 #include "libguile/procprop.x"
+  scm_init_vm_builtin_properties ();
 }
 
 
diff --git a/libguile/vm-builtins.h b/libguile/vm-builtins.h
index c51174c..ea9b9e2 100644
--- a/libguile/vm-builtins.h
+++ b/libguile/vm-builtins.h
@@ -22,17 +22,17 @@
 #ifdef BUILDING_LIBGUILE
 
 #define FOR_EACH_VM_BUILTIN(M) \
-  M(apply, APPLY) \
-  M(values, VALUES) \
-  M(abort_to_prompt, ABORT_TO_PROMPT) \
-  M(call_with_values, CALL_WITH_VALUES) \
-  M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION)
+  M(apply, APPLY, 2, 0, 1) \
+  M(values, VALUES, 0, 0, 1) \
+  M(abort_to_prompt, ABORT_TO_PROMPT, 1, 0, 1) \
+  M(call_with_values, CALL_WITH_VALUES, 2, 0, 0) \
+  M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION, 1, 0, 0)
 
 /* These enumerated values are embedded in RTL code, and as such are
    part of Guile's ABI.  */
 enum scm_vm_builtins
 {
-#define ENUM(builtin, BUILTIN) SCM_VM_BUILTIN_##BUILTIN,
+#define ENUM(builtin, BUILTIN, req, opt, rest) SCM_VM_BUILTIN_##BUILTIN,
   FOR_EACH_VM_BUILTIN(ENUM)
 #undef ENUM
   SCM_VM_BUILTIN_COUNT
@@ -40,6 +40,7 @@ enum scm_vm_builtins
 
 SCM_INTERNAL SCM scm_vm_builtin_name_to_index (SCM name);
 SCM_INTERNAL SCM scm_vm_builtin_index_to_name (SCM idx);
+SCM_INTERNAL void scm_init_vm_builtin_properties (void);
 
 #endif /* BUILDING_LIBGUILE */
 
diff --git a/libguile/vm.c b/libguile/vm.c
index bf1a269..f87236e 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -652,7 +652,7 @@ scm_vm_builtin_ref (unsigned idx)
 {
   switch (idx)
     {
-#define INDEX_TO_NAME(builtin, BUILTIN) \
+#define INDEX_TO_NAME(builtin, BUILTIN, req, opt, rest)                 \
       case SCM_VM_BUILTIN_##BUILTIN: return vm_builtin_##builtin;
       FOR_EACH_VM_BUILTIN(INDEX_TO_NAME)
 #undef INDEX_TO_NAME
@@ -660,6 +660,7 @@ scm_vm_builtin_ref (unsigned idx)
     }
 }
 
+SCM scm_sym_apply;
 static SCM scm_sym_values;
 static SCM scm_sym_abort_to_prompt;
 static SCM scm_sym_call_with_values;
@@ -671,7 +672,7 @@ scm_vm_builtin_name_to_index (SCM name)
 {
   SCM_VALIDATE_SYMBOL (1, name);
 
-#define NAME_TO_INDEX(builtin, BUILTIN)                 \
+#define NAME_TO_INDEX(builtin, BUILTIN, req, opt, rest) \
   if (scm_is_eq (name, scm_sym_##builtin))              \
     return scm_from_uint (SCM_VM_BUILTIN_##BUILTIN);
   FOR_EACH_VM_BUILTIN(NAME_TO_INDEX)
@@ -691,7 +692,7 @@ scm_vm_builtin_index_to_name (SCM index)
 
   switch (idx)
     {
-#define INDEX_TO_NAME(builtin, BUILTIN) \
+#define INDEX_TO_NAME(builtin, BUILTIN, req, opt, rest)         \
       case SCM_VM_BUILTIN_##BUILTIN: return scm_sym_##builtin;
       FOR_EACH_VM_BUILTIN(INDEX_TO_NAME)
 #undef INDEX_TO_NAME
@@ -703,12 +704,6 @@ scm_vm_builtin_index_to_name (SCM index)
 static void
 scm_init_vm_builtins (void)
 {
-  scm_sym_values = scm_from_utf8_symbol ("values");
-  scm_sym_abort_to_prompt = scm_from_utf8_symbol ("abort-to-prompt");
-  scm_sym_call_with_values = scm_from_utf8_symbol ("call-with-values");
-  scm_sym_call_with_current_continuation =
-    scm_from_utf8_symbol ("call-with-current-continuation");
-
   scm_c_define_gsubr ("builtin-name->index", 1, 0, 0,
                       scm_vm_builtin_name_to_index);
   scm_c_define_gsubr ("builtin-index->name", 1, 0, 0,
@@ -1228,6 +1223,28 @@ make_boot_program (void)
 }
 
 void
+scm_init_vm_builtin_properties (void)
+{
+  /* FIXME: Seems hacky to do this here, but oh well :/ */
+  scm_sym_apply = scm_from_utf8_symbol ("apply");
+  scm_sym_values = scm_from_utf8_symbol ("values");
+  scm_sym_abort_to_prompt = scm_from_utf8_symbol ("abort-to-prompt");
+  scm_sym_call_with_values = scm_from_utf8_symbol ("call-with-values");
+  scm_sym_call_with_current_continuation =
+    scm_from_utf8_symbol ("call-with-current-continuation");
+
+#define INIT_BUILTIN(builtin, BUILTIN, req, opt, rest)                  \
+  scm_set_procedure_property_x (vm_builtin_##builtin, scm_sym_name,     \
+                                scm_sym_##builtin);                     \
+  scm_set_procedure_minimum_arity_x (vm_builtin_##builtin,              \
+                                     SCM_I_MAKINUM (req),               \
+                                     SCM_I_MAKINUM (opt),               \
+                                     scm_from_bool (rest));
+  FOR_EACH_VM_BUILTIN (INIT_BUILTIN);
+#undef INIT_BUILTIN
+}
+
+void
 scm_bootstrap_vm (void)
 {
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
@@ -1252,14 +1269,11 @@ scm_bootstrap_vm (void)
   SCM_SET_CELL_WORD_0 (rtl_boot_continuation,
                        (SCM_CELL_WORD_0 (rtl_boot_continuation)
                         | SCM_F_PROGRAM_IS_BOOT));
-  vm_builtin_apply = scm_i_make_rtl_program (vm_builtin_apply_code);
-  vm_builtin_values = scm_i_make_rtl_program (vm_builtin_values_code);
-  vm_builtin_abort_to_prompt =
-    scm_i_make_rtl_program (vm_builtin_abort_to_prompt_code);
-  vm_builtin_call_with_values =
-    scm_i_make_rtl_program (vm_builtin_call_with_values_code);
-  vm_builtin_call_with_current_continuation =
-    scm_i_make_rtl_program (vm_builtin_call_with_current_continuation_code);
+
+#define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest)                \
+  vm_builtin_##builtin = scm_i_make_rtl_program (vm_builtin_##builtin##_code);
+  FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN);
+#undef DEFINE_BUILTIN
 
 #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
   vm_stack_gc_kind =
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 09bc161..af99a54 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -400,7 +400,17 @@ section of the ELF image.  Returns an ELF symbol, or 
@code{#f}."
      (let* ((base (elf-section-offset sec))
             (first (find-first-arity context base addr)))
        (if (arity-is-case-lambda? first)
-           (list 0 0 #t) ;; FIXME: be more precise.
+           (let ((arities (read-sub-arities context base
+                                            (arity-header-offset first))))
+             (and (pair? arities)
+                  (list (apply min (map arity-nreq arities))
+                        0
+                        (or-map (lambda (arity)
+                                  (or (positive? (arity-nopt arity))
+                                      (arity-has-rest? arity)
+                                      (arity-has-keyword-args? arity)
+                                      (arity-allow-other-keys? arity)))
+                                arities))))
            (list (arity-nreq first)
                  (arity-nopt first)
                  (arity-has-rest? first)))))))


hooks/post-receive
-- 
GNU Guile