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. v2.1.0-625-gaef1fcf


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, master, updated. v2.1.0-625-gaef1fcf
Date: Sun, 02 Feb 2014 15:19:50 +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=aef1fcf94e635c51bc1d0849ad1f60a1d1274276

The branch, master has been updated
       via  aef1fcf94e635c51bc1d0849ad1f60a1d1274276 (commit)
       via  407190060bfc9a7625d5c415463fa9bbc70859fd (commit)
      from  7dba1c2ff139be60ccf7f81debd4bb85a07ab8f6 (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 aef1fcf94e635c51bc1d0849ad1f60a1d1274276
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 2 16:04:58 2014 +0100

    Add thread-local lock-free, TLS-free freelists.
    
    * libguile/bdw-gc.h: Remove a needless compatibility hack.
    
    * libguile/gc-inline.h: New file, implementing thread-local freelists
      providing faster allocation if we already have a scm_i_thread*
      pointer.  Based on gc_inline.h from libgc.
    
    * libguile/threads.h (scm_i_thread): Add freelists here.
    * libguile/threads.c (guilify_self_1, guilify_self_2): Initialize
      freelists.
    
    * libguile/vm.c: Include gc-inline.h.
    * libguile/vm-engine.c: Rename current_thread to thread.  Use
      scm_inline_cons instead of scm_cons, scm_inline_cell instead of
      scm_cell, and scm_inline_words instead of words.

commit 407190060bfc9a7625d5c415463fa9bbc70859fd
Author: Andy Wingo <address@hidden>
Date:   Sun Feb 2 11:43:03 2014 +0100

    Add dead slot map cache
    
    * libguile/vm.c (find_dead_slot_map, scm_i_vm_mark_stack): Use a little
      cache for dead slot maps.  Helps when marking very deep recursive
      stacks.

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

Summary of changes:
 libguile/Makefile.am |    3 +-
 libguile/bdw-gc.h    |    7 +--
 libguile/gc-inline.h |  183 ++++++++++++++++++++++++++++++++++++++++++++++++++
 libguile/threads.c   |   31 ++++++++-
 libguile/threads.h   |    6 ++-
 libguile/vm-engine.c |   46 +++++++------
 libguile/vm.c        |   39 ++++++++++-
 7 files changed, 283 insertions(+), 32 deletions(-)
 create mode 100644 libguile/gc-inline.h

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 3f66d9d..2077c4d 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -1,7 +1,7 @@
 ## Process this file with Automake to create Makefile.in
 ##
 ##   Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
-##     2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+##     2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
 ##
 ##   This file is part of GUILE.
 ##
@@ -558,6 +558,7 @@ modinclude_HEADERS =                                \
        fports.h                                \
        frames.h                                \
        gc.h                                    \
+       gc-inline.h                             \
        gettext.h                               \
        generalized-arrays.h                    \
        generalized-vectors.h                   \
diff --git a/libguile/bdw-gc.h b/libguile/bdw-gc.h
index 7aa757f..2deb97e 100644
--- a/libguile/bdw-gc.h
+++ b/libguile/bdw-gc.h
@@ -1,7 +1,7 @@
 #ifndef SCM_BDW_GC_H
 #define SCM_BDW_GC_H
 
-/* Copyright (C) 2006, 2008, 2009, 2011, 2012, 2013 Free Software Foundation, 
Inc.
+/* Copyright (C) 2006, 2008, 2009, 2011, 2012, 2013, 2014 Free Software 
Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -46,11 +46,6 @@
 
 #include <gc/gc.h>
 
-#if (! ((defined GC_VERSION_MAJOR) && (GC_VERSION_MAJOR >= 7)))
-/* This was needed with `libgc' 6.x.  */
-# include <gc/gc_local_alloc.h>
-#endif
-
 /* Return true if PTR points to the heap.  */
 #define SCM_I_IS_POINTER_TO_THE_HEAP(ptr)      \
   (GC_base (ptr) != NULL)
diff --git a/libguile/gc-inline.h b/libguile/gc-inline.h
new file mode 100644
index 0000000..fcbe5a5
--- /dev/null
+++ b/libguile/gc-inline.h
@@ -0,0 +1,183 @@
+/* classes: h_files */
+
+#ifndef SCM_GC_INLINE_H
+#define SCM_GC_INLINE_H
+
+/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006,
+ *   2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, 
Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
+
+/* Much of this file was copied from gc_inline.h, from the BDW
+ * collector.  Its copyright notice is:
+ *
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1995 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 2005 Hewlett-Packard Development Company, L.P.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to use or copy this program
+ * for any purpose,  provided the above notices are retained on all copies.
+ * Permission to modify the code and to distribute modified code is granted,
+ * provided the above notices are retained, and a notice that the code was
+ * modified is included with the above copyright notice.
+ */
+
+
+
+#include "libguile/__scm.h"
+
+#include "libguile/gc.h"
+#include "libguile/bdw-gc.h"
+#include "libguile/threads.h"
+
+#include <gc/gc_inline.h> /* GC_generic_malloc_many */
+
+
+
+#define SCM_INLINE_GC_GRANULE_WORDS 2
+#define SCM_INLINE_GC_GRANULE_BYTES \
+  (sizeof(void *) * SCM_INLINE_GC_GRANULE_WORDS)
+
+/* A freelist set contains SCM_INLINE_GC_FREELIST_COUNT pointers to
+   singly linked lists of objects of different sizes, the ith one
+   containing objects i + 1 granules in size.  This setting of
+   SCM_INLINE_GC_FREELIST_COUNT will hold freelists for allocations of
+   up to 256 bytes.  */
+#define SCM_INLINE_GC_FREELIST_COUNT (256U / SCM_INLINE_GC_GRANULE_BYTES)
+
+static inline size_t
+scm_inline_gc_bytes_to_freelist_index (size_t bytes)
+{
+  return (bytes - 1U) / SCM_INLINE_GC_GRANULE_BYTES;
+}
+
+static inline size_t
+scm_inline_gc_freelist_object_size (size_t idx)
+{
+  return (idx + 1U) * SCM_INLINE_GC_GRANULE_BYTES;
+}
+
+/* The values of these must match the internal POINTERLESS and NORMAL
+   definitions in libgc, for which unfortunately there are no external
+   definitions.  Alack.  */
+typedef enum scm_inline_gc_kind
+  {
+    SCM_INLINE_GC_KIND_POINTERLESS,
+    SCM_INLINE_GC_KIND_NORMAL
+  } scm_inline_gc_kind;
+
+static inline void *
+scm_inline_gc_alloc (void **freelist, size_t idx, scm_inline_gc_kind kind)
+{
+  void *head = *freelist;
+
+  if (SCM_UNLIKELY (!head))
+    {
+      size_t bytes = scm_inline_gc_freelist_object_size (idx);
+      GC_generic_malloc_many (bytes, kind, freelist);
+      head = *freelist;
+      if (SCM_UNLIKELY (!head))
+        return (*GC_get_oom_fn ()) (bytes);
+    }
+
+  *freelist = *(void **)(head);
+
+  return head;
+}
+
+static inline void *
+scm_inline_gc_malloc_pointerless (scm_i_thread *thread, size_t bytes)
+{
+  size_t idx = scm_inline_gc_bytes_to_freelist_index (bytes);
+
+  if (SCM_UNLIKELY (idx >= SCM_INLINE_GC_FREELIST_COUNT))
+    return GC_malloc_atomic (bytes);
+
+  return scm_inline_gc_alloc
+    (&thread->pointerless_freelists[idx], idx, SCM_INLINE_GC_KIND_POINTERLESS);
+}
+
+static inline void *
+scm_inline_gc_malloc (scm_i_thread *thread, size_t bytes)
+{
+  size_t idx = scm_inline_gc_bytes_to_freelist_index (bytes);
+
+  if (SCM_UNLIKELY (idx >= SCM_INLINE_GC_FREELIST_COUNT))
+    return GC_malloc (bytes);
+
+  return scm_inline_gc_alloc
+    (&thread->freelists[idx], idx, SCM_INLINE_GC_KIND_NORMAL);
+}
+
+static inline void *
+scm_inline_gc_malloc_words (scm_i_thread *thread, size_t words)
+{
+  return scm_inline_gc_malloc (thread, words * sizeof (void *));
+}
+
+static inline SCM
+scm_inline_cell (scm_i_thread *thread, scm_t_bits car, scm_t_bits cdr)
+{
+  SCM cell = SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, 2));
+  
+  SCM_GC_SET_CELL_WORD (cell, 0, car);
+  SCM_GC_SET_CELL_WORD (cell, 1, cdr);
+
+  return cell;
+}
+
+static inline SCM
+scm_inline_double_cell (scm_i_thread *thread, scm_t_bits car, scm_t_bits cbr,
+                           scm_t_bits ccr, scm_t_bits cdr)
+{
+  SCM cell = SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, 4));
+  
+  SCM_GC_SET_CELL_WORD (cell, 0, car);
+  SCM_GC_SET_CELL_WORD (cell, 1, cbr);
+  SCM_GC_SET_CELL_WORD (cell, 2, ccr);
+  SCM_GC_SET_CELL_WORD (cell, 3, cdr);
+
+  return cell;
+}
+
+static inline SCM
+scm_inline_words (scm_i_thread *thread, scm_t_bits car, scm_t_uint32 n_words)
+{
+  SCM obj = SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n_words));
+  
+  SCM_GC_SET_CELL_WORD (obj, 0, car);
+
+  return obj;
+}
+
+static inline SCM
+scm_inline_cons (scm_i_thread *thread, SCM x, SCM y)
+{
+  return scm_inline_cell (thread, SCM_UNPACK (x), SCM_UNPACK (y));
+}
+
+
+#endif  /* SCM_GC_INLINE_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/
diff --git a/libguile/threads.c b/libguile/threads.c
index f39bcc3..7902a9a 100644
--- a/libguile/threads.c
+++ b/libguile/threads.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004,
- *   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013
+ *   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014
  *   Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -63,6 +63,7 @@
 #include "libguile/fluids.h"
 #include "libguile/continuations.h"
 #include "libguile/gc.h"
+#include "libguile/gc-inline.h"
 #include "libguile/init.h"
 #include "libguile/scmsigs.h"
 #include "libguile/strings.h"
@@ -95,6 +96,26 @@ thread_mark (GC_word *addr, struct GC_ms_entry 
*mark_stack_ptr,
                                       mark_stack_ptr, mark_stack_limit,
                                       NULL);
 
+  /* The pointerless freelists are threaded through their first word,
+     but GC doesn't know to trace them (as they are pointerless), so we
+     need to do that here.  See the comments at the top of libgc's
+     gc_inline.h.  */
+  {
+    size_t n;
+    for (n = 0; n < SCM_INLINE_GC_FREELIST_COUNT; n++)
+      {
+        void *chain = t->pointerless_freelists[n];
+        if (chain)
+          {
+            /* The first link is already marked by the freelist vector,
+               so we just have to mark the tail.  */
+            while ((chain = *(void **)chain))
+              mark_stack_ptr = GC_mark_and_push (chain, mark_stack_ptr,
+                                                 mark_stack_limit, NULL);
+          }
+      }
+  }
+
   if (t->vp)
     mark_stack_ptr = scm_i_vm_mark_stack (t->vp, mark_stack_ptr,
                                           mark_stack_limit);
@@ -389,6 +410,8 @@ guilify_self_1 (struct GC_stack_base *base)
   t.mutexes = SCM_EOL;
   t.held_mutex = NULL;
   t.join_queue = SCM_EOL;
+  t.freelists = NULL;
+  t.pointerless_freelists = NULL;
   t.dynamic_state = SCM_BOOL_F;
   t.dynstack.base = NULL;
   t.dynstack.top = NULL;
@@ -459,6 +482,12 @@ guilify_self_2 (SCM parent)
   t->continuation_root = scm_cons (t->handle, SCM_EOL);
   t->continuation_base = t->base;
 
+  {
+    size_t size = SCM_INLINE_GC_FREELIST_COUNT * sizeof (void *);
+    t->freelists = scm_gc_malloc (size, "freelists");
+    t->pointerless_freelists = scm_gc_malloc (size, "atomic freelists");
+  }
+
   if (scm_is_true (parent))
     t->dynamic_state = scm_make_dynamic_state (parent);
   else
diff --git a/libguile/threads.h b/libguile/threads.h
index 6db6c75..6b85baf 100644
--- a/libguile/threads.h
+++ b/libguile/threads.h
@@ -4,7 +4,7 @@
 #define SCM_THREADS_H
 
 /* Copyright (C) 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2006,
- *   2007, 2008, 2009, 2011, 2012, 2013 Free Software Foundation, Inc.
+ *   2007, 2008, 2009, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -72,6 +72,10 @@ typedef struct scm_i_thread {
   scm_i_pthread_cond_t sleep_cond;
   int sleep_fd, sleep_pipe[2];
 
+  /* Thread-local freelists; see gc-inline.h.  */
+  void **freelists;
+  void **pointerless_freelists;
+
   /* Other thread local things.
    */
   SCM dynamic_state;
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index fe0329f..bc94a69 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -127,7 +127,7 @@
   RUN_HOOK0 (abort)
 
 #define VM_HANDLE_INTERRUPTS                     \
-  SCM_ASYNC_TICK_WITH_GUARD_CODE (current_thread, SYNC_IP (), CACHE_FP ())
+  SCM_ASYNC_TICK_WITH_GUARD_CODE (thread, SYNC_IP (), CACHE_FP ())
 
 
 /* Virtual Machine
@@ -430,7 +430,7 @@
   ((scm_t_uintptr) (ptr) % alignof_type (type) == 0)
 
 static SCM
-VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
+VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
          scm_i_jmp_buf *registers, int resume)
 {
   /* Instruction pointer: A pointer to the opcode that is currently
@@ -527,7 +527,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
           scm_t_uint32 n;
           ret = SCM_EOL;
           for (n = nvals; n > 0; n--)
-            ret = scm_cons (LOCAL_REF (4 + n - 1), ret);
+            ret = scm_inline_cons (thread, LOCAL_REF (4 + n - 1), ret);
           ret = scm_values (ret);
         }
 
@@ -810,7 +810,8 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
       SYNC_IP ();
 
       // FIXME: separate args
-      ret = scm_i_foreign_call (scm_cons (cif, pointer), LOCAL_ADDRESS (1));
+      ret = scm_i_foreign_call (scm_inline_cons (thread, cif, pointer),
+                                LOCAL_ADDRESS (1));
 
       CACHE_FP ();
 
@@ -872,7 +873,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
                  vm_error_continuation_not_rewindable (vmcont));
       vm_reinstate_partial_continuation (vp, vmcont, FRAME_LOCALS_COUNT_FROM 
(1),
                                          LOCAL_ADDRESS (1),
-                                         &current_thread->dynstack,
+                                         &thread->dynstack,
                                          registers);
       CACHE_REGISTER ();
       NEXT (0);
@@ -938,7 +939,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
       VM_HANDLE_INTERRUPTS;
 
       SYNC_IP ();
-      dynstack = scm_dynstack_capture_all (&current_thread->dynstack);
+      dynstack = scm_dynstack_capture_all (&thread->dynstack);
       vm_cont = scm_i_vm_capture_stack (vp->stack_base,
                                         SCM_FRAME_DYNAMIC_LINK (fp),
                                         SCM_FRAME_PREVIOUS_SP (fp),
@@ -1242,7 +1243,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
           SCM rest = SCM_EOL;
           n = nkw;
           while (n--)
-            rest = scm_cons (LOCAL_REF (ntotal + n), rest);
+            rest = scm_inline_cons (thread, LOCAL_REF (ntotal + n), rest);
           LOCAL_SET (nreq_and_opt, rest);
         }
 
@@ -1274,7 +1275,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
         {
           while (nargs-- > dst)
             {
-              rest = scm_cons (LOCAL_REF (nargs), rest);
+              rest = scm_inline_cons (thread, LOCAL_REF (nargs), rest);
               LOCAL_SET (nargs, SCM_UNDEFINED);
             }
 
@@ -1490,7 +1491,8 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
     {
       scm_t_uint16 dst, src;
       UNPACK_12_12 (op, dst, src);
-      LOCAL_SET (dst, scm_cell (scm_tc7_variable, SCM_UNPACK (LOCAL_REF 
(src))));
+      LOCAL_SET (dst, scm_inline_cell (thread, scm_tc7_variable,
+                                       SCM_UNPACK (LOCAL_REF (src))));
       NEXT (1);
     }
 
@@ -1547,7 +1549,8 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
       UNPACK_24 (ip[2], nfree);
 
       // FIXME: Assert range of nfree?
-      closure = scm_words (scm_tc7_program | (nfree << 16), nfree + 2);
+      closure = scm_inline_words (thread, scm_tc7_program | (nfree << 16),
+                                  nfree + 2);
       SCM_SET_CELL_WORD_1 (closure, ip + offset);
       // FIXME: Elide these initializations?
       for (n = 0; n < nfree; n++)
@@ -2002,7 +2005,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
   
       /* Push the prompt onto the dynamic stack. */
       flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
-      scm_dynstack_push_prompt (&current_thread->dynstack, flags,
+      scm_dynstack_push_prompt (&thread->dynstack, flags,
                                 LOCAL_REF (tag),
                                 fp - vp->stack_base,
                                 LOCAL_ADDRESS (proc_slot) - vp->stack_base,
@@ -2023,7 +2026,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
     {
       scm_t_uint16 winder, unwinder;
       UNPACK_12_12 (op, winder, unwinder);
-      scm_dynstack_push_dynwind (&current_thread->dynstack,
+      scm_dynstack_push_dynwind (&thread->dynstack,
                                  LOCAL_REF (winder), LOCAL_REF (unwinder));
       NEXT (1);
     }
@@ -2035,7 +2038,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
    */
   VM_DEFINE_OP (64, unwind, "unwind", OP1 (U8_X24))
     {
-      scm_dynstack_pop (&current_thread->dynstack);
+      scm_dynstack_pop (&thread->dynstack);
       NEXT (1);
     }
 
@@ -2049,9 +2052,9 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
 
       UNPACK_12_12 (op, fluid, value);
 
-      scm_dynstack_push_fluid (&current_thread->dynstack,
+      scm_dynstack_push_fluid (&thread->dynstack,
                                LOCAL_REF (fluid), LOCAL_REF (value),
-                               current_thread->dynamic_state);
+                               thread->dynamic_state);
       NEXT (1);
     }
 
@@ -2063,8 +2066,8 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
   VM_DEFINE_OP (66, pop_fluid, "pop-fluid", OP1 (U8_X24))
     {
       /* This function must not allocate.  */
-      scm_dynstack_unwind_fluid (&current_thread->dynstack,
-                                 current_thread->dynamic_state);
+      scm_dynstack_unwind_fluid (&thread->dynstack,
+                                 thread->dynamic_state);
       NEXT (1);
     }
 
@@ -2080,7 +2083,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
 
       UNPACK_12_12 (op, dst, src);
       fluid = LOCAL_REF (src);
-      fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
+      fluids = SCM_I_DYNAMIC_STATE_FLUIDS (thread->dynamic_state);
       if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
           || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH 
(fluids)))
         {
@@ -2113,7 +2116,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
 
       UNPACK_12_12 (op, a, b);
       fluid = LOCAL_REF (a);
-      fluids = SCM_I_DYNAMIC_STATE_FLUIDS (current_thread->dynamic_state);
+      fluids = SCM_I_DYNAMIC_STATE_FLUIDS (thread->dynamic_state);
       if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
           || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH 
(fluids)))
         {
@@ -2229,7 +2232,7 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
   VM_DEFINE_OP (74, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
     {
       ARGS2 (x, y);
-      RETURN (scm_cons (x, y));
+      RETURN (scm_inline_cons (thread, x, y));
     }
 
   /* car dst:12 src:12
@@ -2497,7 +2500,8 @@ VM_NAME (scm_i_thread *current_thread, struct scm_vm *vp,
       UNPACK_8_8_8 (op, dst, length, init);
 
       val = LOCAL_REF (init);
-      vector = scm_words (scm_tc7_vector | (length << 8), length + 1);
+      vector = scm_inline_words (thread, scm_tc7_vector | (length << 8),
+                                 length + 1);
       for (n = 0; n < length; n++)
         SCM_SIMPLE_VECTOR_SET (vector, n, val);
       LOCAL_SET (dst, vector);
diff --git a/libguile/vm.c b/libguile/vm.c
index 7f88e46..95f12ee 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -40,6 +40,7 @@
 #include "_scm.h"
 #include "control.h"
 #include "frames.h"
+#include "gc-inline.h"
 #include "instructions.h"
 #include "loader.h"
 #include "programs.h"
@@ -824,6 +825,38 @@ return_unused_stack_to_os (struct scm_vm *vp)
 #endif
 }
 
+#define DEAD_SLOT_MAP_CACHE_SIZE 32U
+struct dead_slot_map_cache_entry
+{
+  scm_t_uint32 *ip;
+  const scm_t_uint8 *map;
+};
+
+struct dead_slot_map_cache
+{
+  struct dead_slot_map_cache_entry entries[DEAD_SLOT_MAP_CACHE_SIZE];
+};
+
+static const scm_t_uint8 *
+find_dead_slot_map (scm_t_uint32 *ip, struct dead_slot_map_cache *cache)
+{
+  /* The lower two bits should be zero.  FIXME: Use a better hash
+     function; we don't expose scm_raw_hashq currently.  */
+  size_t slot = (((scm_t_uintptr) ip) >> 2) % DEAD_SLOT_MAP_CACHE_SIZE;
+  const scm_t_uint8 *map;
+
+  if (cache->entries[slot].ip == ip)
+    map = cache->entries[slot].map;
+  else
+    {
+      map = scm_find_dead_slot_map_unlocked (ip);
+      cache->entries[slot].ip = ip;
+      cache->entries[slot].map = map;
+    }
+
+  return map;
+}
+
 /* Mark the VM stack region between its base and its current top.  */
 struct GC_ms_entry *
 scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry *mark_stack_ptr,
@@ -838,6 +871,9 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry 
*mark_stack_ptr,
   const scm_t_uint8 *dead_slots = NULL;
   scm_t_uintptr upper = (scm_t_uintptr) GC_greatest_plausible_heap_addr;
   scm_t_uintptr lower = (scm_t_uintptr) GC_least_plausible_heap_addr;
+  struct dead_slot_map_cache cache;
+
+  memset (&cache, 0, sizeof (cache));
 
   for (fp = vp->fp, sp = vp->sp; fp; fp = SCM_FRAME_DYNAMIC_LINK (fp))
     {
@@ -870,8 +906,7 @@ scm_i_vm_mark_stack (struct scm_vm *vp, struct GC_ms_entry 
*mark_stack_ptr,
          Note that there may be other reasons to not have a dead slots
          map, e.g. if all of the frame's slots below the callee frame
          are live.  */
-      dead_slots =
-        scm_find_dead_slot_map_unlocked (SCM_FRAME_RETURN_ADDRESS (fp));
+      dead_slots = find_dead_slot_map (SCM_FRAME_RETURN_ADDRESS (fp), &cache);
     }
 
   return_unused_stack_to_os (vp);


hooks/post-receive
-- 
GNU Guile



reply via email to

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