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-10-75-g9a


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. release_1-9-10-75-g9a974fd
Date: Fri, 30 Apr 2010 22:30:15 +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=9a974fd38438eee10a2e5389c14129193c833860

The branch, master has been updated
       via  9a974fd38438eee10a2e5389c14129193c833860 (commit)
      from  52272fc764d0ca3eee00dcf7f1f51734198ad777 (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 9a974fd38438eee10a2e5389c14129193c833860
Author: Andy Wingo <address@hidden>
Date:   Sat May 1 00:31:18 2010 +0200

    optimize and bugfix make-struct VM opcode
    
    * libguile/_scm.h (SCM_OBJCODE_MINOR_VERSION): Bump for make-struct
      change.
    
    * libguile/struct.c (scm_i_alloc_struct): Use scm_words instead of
      scm_gc_malloc to simplify the code and inline the call to GC_MALLOC.
    
    * module/language/tree-il/compile-glil.scm (*primcall-ops*): Compile
      make-struct/no-tail to make-struct.
    
    * module/language/tree-il/primitives.scm (define-primitive-expander):
      Allow a conditional branch of #f to aboirt inlining.
      (make-struct): Expand into make-struct/no-tail in the case that
      tail-size is 0.
    
    * libguile/vm-i-scheme.c (make-struct): Adapt to always assume tail-size
      is 0. Inline allocation if possible. Don't decrement the SP past live
      objects on the stack, which could cause GC to miss references. Use the
      NULLSTACK macro.

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

Summary of changes:
 libguile/_scm.h                          |    2 +-
 libguile/struct.c                        |   13 ++++-----
 libguile/vm-i-scheme.c                   |   42 ++++++++++++++---------------
 module/language/tree-il/compile-glil.scm |    2 +-
 module/language/tree-il/primitives.scm   |   10 +++++++
 5 files changed, 38 insertions(+), 31 deletions(-)

diff --git a/libguile/_scm.h b/libguile/_scm.h
index a1884ca..3bb78b4 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -178,7 +178,7 @@
 
 /* Major and minor versions must be single characters. */
 #define SCM_OBJCODE_MAJOR_VERSION 0
-#define SCM_OBJCODE_MINOR_VERSION P
+#define SCM_OBJCODE_MINOR_VERSION Q
 #define SCM_OBJCODE_MAJOR_VERSION_STRING        \
   SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
 #define SCM_OBJCODE_MINOR_VERSION_STRING        \
diff --git a/libguile/struct.c b/libguile/struct.c
index c28a76d..5b1213c 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -391,11 +391,10 @@ struct_finalizer_trampoline (GC_PTR ptr, GC_PTR 
unused_data)
 SCM
 scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words)
 {
-  scm_t_bits ret;
-  ret = (scm_t_bits)scm_gc_malloc (sizeof (scm_t_bits) * (n_words + 2), 
"struct");
-  SCM_SET_CELL_WORD_0 (SCM_PACK (ret), (scm_t_bits)vtable_data | 
scm_tc3_struct);
-  SCM_SET_CELL_WORD_1 (SCM_PACK (ret),
-                       (scm_t_bits)SCM_CELL_OBJECT_LOC (SCM_PACK (ret), 2));
+  SCM ret;
+
+  ret = scm_words ((scm_t_bits)vtable_data | scm_tc3_struct, n_words + 2);
+  SCM_SET_CELL_WORD_1 (ret, (scm_t_bits)SCM_CELL_OBJECT_LOC (ret, 2));
 
   /* vtable_data can be null when making a vtable vtable */
   if (vtable_data && vtable_data[scm_vtable_index_instance_finalize])
@@ -403,14 +402,14 @@ scm_i_alloc_struct (scm_t_bits *vtable_data, int n_words)
       /* Register a finalizer for the newly created instance.  */
       GC_finalization_proc prev_finalizer;
       GC_PTR prev_finalizer_data;
-      GC_REGISTER_FINALIZER_NO_ORDER ((void*)ret,
+      GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
                                      struct_finalizer_trampoline,
                                      NULL,
                                      &prev_finalizer,
                                      &prev_finalizer_data);
     }
 
-  return SCM_PACK (ret);
+  return ret;
 }
 
 
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 3e31691..f076d6b 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -420,36 +420,34 @@ VM_DEFINE_INSTRUCTION (166, make_struct, "make-struct", 
2, -1, 1)
 {
   unsigned h = FETCH ();
   unsigned l = FETCH ();
-  scm_t_bits n_args = ((h << 8U) + l);
-  SCM vtable = sp[1 - n_args], n_tail = sp[2 - n_args];
-  const SCM *inits = sp - n_args + 3;
-
-  sp -= n_args - 1;
+  scm_t_bits n = ((h << 8U) + l);
+  SCM vtable = sp[-(n - 1)];
+  const SCM *inits = sp - n + 2;
+  SCM ret;
 
   SYNC_REGISTER ();
 
   if (SCM_LIKELY (SCM_STRUCTP (vtable)
                  && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
-                 && SCM_I_INUMP (n_tail)))
+                  && (SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size) + 1
+                      == n)
+                  && !SCM_VTABLE_INSTANCE_FINALIZER (vtable)))
     {
-      scm_t_bits n_inits, len;
-
-      n_inits = SCM_I_INUM (n_tail) + n_args - 2;
-      len = SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size);
-
-      if (SCM_LIKELY (n_inits == len))
-       {
-         SCM obj;
-
-         obj = scm_i_alloc_struct (SCM_STRUCT_DATA (vtable), n_inits);
-         memcpy (SCM_STRUCT_DATA (obj), inits, n_inits * sizeof (SCM));
-
-         RETURN (obj);
-       }
+      /* Verily, we are making a simple struct with the right number of
+         initializers, and no finalizer. */
+      ret = scm_words ((scm_t_bits)SCM_STRUCT_DATA (vtable) | scm_tc3_struct,
+                       n + 1);
+      SCM_SET_CELL_WORD_1 (ret, (scm_t_bits)SCM_CELL_OBJECT_LOC (ret, 2));
+      memcpy (SCM_STRUCT_DATA (ret), inits, (n - 1) * sizeof (SCM));
     }
+  else
+    ret = scm_c_make_structv (vtable, 0, n - 1, (scm_t_bits *) inits);
 
-  RETURN (scm_c_make_structv (vtable, scm_to_size_t (n_tail),
-                             n_args - 2, (scm_t_bits *) inits));
+  sp -= n;
+  NULLSTACK (n);
+  PUSH (ret);
+
+  NEXT;
 }
 
 VM_DEFINE_FUNCTION (167, struct_ref, "struct-ref", 2)
diff --git a/module/language/tree-il/compile-glil.scm 
b/module/language/tree-il/compile-glil.scm
index 4d5e29b..a07ad66 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -120,7 +120,7 @@
    ((struct-vtable . 1) . struct-vtable)
    ((struct-ref . 2) . struct-ref)
    ((struct-set! . 3) . struct-set)
-   (make-struct . make-struct)
+   (make-struct/no-tail . make-struct)
 
    ;; hack for javascript
    ((return . 1) . return)
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index b6953ca..c5a80c0 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -212,6 +212,9 @@
       exp)
      ((number? exp)
       `(make-const src ,exp))
+     ((not exp)
+      ;; failed match
+      #f)
      (else (error "bad consequent yall" exp))))
   `(hashq-set! *primitive-expand-table*
                ',sym
@@ -317,6 +320,13 @@
 (define-primitive-expander variable-set! (var val)
   (variable-set val var))
 
+(define-primitive-expander make-struct (vtable tail-size . args)
+  (if (and (const? tail-size)
+           (let ((n (const-exp tail-size)))
+             (and (number? n) (exact? n) (zero? n))))
+      (make-struct/no-tail vtable . args)
+      #f))
+
 (define-primitive-expander u8vector-ref (vec i)
   (bytevector-u8-ref vec i))
 (define-primitive-expander u8vector-set! (vec i x)


hooks/post-receive
-- 
GNU Guile




reply via email to

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