[Guile-commits] GNU Guile branch, master, updated. release_1-9-4-80-ged7e076

[Ludovic Courtès]

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=ed7e0765c48bbf6d028d9eefd15a3dedb53c92ec

The branch, master has been updated
       via  ed7e0765c48bbf6d028d9eefd15a3dedb53c92ec (commit)
       via  88cbb421895656c6d255610e32c2ae1addb2ea07 (commit)
      from  731dd0ce191bf4f3ba8fedfe0e08c0e67a966ce4 (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 ed7e0765c48bbf6d028d9eefd15a3dedb53c92ec
Author: Ludovic Courtès <address@hidden>
Date:   Mon Nov 2 00:55:17 2009 +0100

    Allocate vectors in a contiguous memory area.
    
    * libguile/vectors.c (scm_c_make_vector): Allocate the whole vector and
      header with `scm_gc_malloc ()'.
      (scm_vector_copy): Use `scm_c_make_vector ()'.
      (scm_i_vector_free, MAKE_WEAK_VECTOR): Remove.
      (allocate_weak_vector): Rename to...
      (make_weak_vector): ... this.  Change to return the whole weak vector,
      allocated with `scm_gc_malloc_pointerless ()'.
      (scm_i_make_weak_vector, scm_i_make_weak_vector_from_list): Use
      `make_weak_vector ()'.
    
    * libguile/vectors.h (SCM_I_VECTOR_HEADER_SIZE): New macro.
      (SCM_I_VECTOR_ELTS): Write in terms of `SCM_I_VECTOR_WELTS ()'.
      (SCM_I_VECTOR_WELTS): Update to the new representation.
      (SCM_I_WVECT_EXTRA, SCM_I_SET_WVECT_EXTRA): Likewise.
      (SCM_I_WVECT_GC_CHAIN, SCM_I_SET_WVECT_GC_CHAIN): Remove.
    
    * libguile/weaks.h (SCM_I_WVECT_DELTA, SCM_I_SET_WVECT_DELTA): Remove.

commit 88cbb421895656c6d255610e32c2ae1addb2ea07
Author: Ludovic Courtès <address@hidden>
Date:   Sun Nov 1 23:29:36 2009 +0100

    Restore signature of `scm_search_path ()' as found in 1.8.
    
    The incompatibly was introduced by
    22f4ee48822db5e30df3abf9a11b6066f2bab9d3 ("make primitive-load-path load
    compiled files if available").
    
    * doc/ref/api-options.texi (Build Config): Update `search-path'
      documentation.
    
    * libguile/load.c (scm_search_path): Change C prototype to expect only 3
      arguments.  Parse the rest argument accordingly.  Update callers.
    
    * libguile/load.h (scm_search_path): Update accordingly.

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

Summary of changes:
 doc/ref/api-options.texi |   12 +++++--
 libguile/load.c          |   52 +++++++++++++++++++++++++----
 libguile/load.h          |    2 +-
 libguile/vectors.c       |   81 +++++++++++++++++++---------------------------
 libguile/vectors.h       |   21 ++++++------
 libguile/weaks.h         |   11 ------
 6 files changed, 98 insertions(+), 81 deletions(-)

diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi
index f4caa8a..1b526a8 100644
--- a/doc/ref/api-options.texi
+++ b/doc/ref/api-options.texi
@@ -113,15 +113,21 @@ string, into a list and return the resulting list with
 is returned.
 @end deffn
 
address@hidden {Scheme Procedure} search-path path filename [extensions]
address@hidden {C Function} scm_search_path (path, filename, extensions)
address@hidden {Scheme Procedure} search-path path filename [extensions 
[require-exts?]]
address@hidden {C Function} scm_search_path (path, filename, rest)
 Search @var{path} for a directory containing a file named
 @var{filename}. The file must be readable, and not a directory.
 If we find one, return its full filename; otherwise, return
 @code{#f}.  If @var{filename} is absolute, return it unchanged.
 If given, @var{extensions} is a list of strings; for each
 directory in @var{path}, we search for @var{filename}
-concatenated with each @var{extension}.
+concatenated with each @var{extension}.  If @var{require-exts?}
+is true, require that the returned file name have one of the
+given extensions; if @var{require-exts?} is not given, it
+defaults to @code{#f}.
+
+For compatibility with Guile 1.8 and earlier, the C function takes only
+three arguments
 @end deffn
 
 @defvar %guile-build-info
diff --git a/libguile/load.c b/libguile/load.c
index 50af256..c6fbf5f 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -391,8 +391,8 @@ scm_c_string_has_an_ext (char *str, size_t len, SCM 
extensions)
    If FILENAME is absolute, return it unchanged.
    If given, EXTENSIONS is a list of strings; for each directory 
    in PATH, we search for FILENAME concatenated with each EXTENSION.  */
-SCM_DEFINE (scm_search_path, "search-path", 2, 2, 0,
-            (SCM path, SCM filename, SCM extensions, SCM require_exts),
+SCM_DEFINE (scm_search_path, "search-path", 2, 0, 1,
+            (SCM path, SCM filename, SCM rest),
            "Search @var{path} for a directory containing a file named\n"
            "@var{filename}. The file must be readable, and not a directory.\n"
            "If we find one, return its full filename; otherwise, return\n"
@@ -405,11 +405,46 @@ SCM_DEFINE (scm_search_path, "search-path", 2, 2, 0,
   struct stringbuf buf;
   char *filename_chars;
   size_t filename_len;
+  SCM extensions, require_exts;
   SCM result = SCM_BOOL_F;
 
+  if (scm_is_null (rest))
+    {
+      /* Called either by Scheme code that didn't provide the optional
+         arguments, or C code that used the Guile 1.8 signature (2 required,
+         1 optional arg) and passed '() as the EXTENSIONS argument.  */
+      extensions = SCM_EOL;
+      require_exts = SCM_UNDEFINED;
+    }
+  else
+    {
+      if (scm_is_null (SCM_CAR (rest)) || scm_is_pair (SCM_CAR (rest)))
+       {
+         /* Called by Scheme code written for 1.9.  */
+         extensions = SCM_CAR (rest);
+         if (scm_is_null (SCM_CDR (rest)))
+           require_exts = SCM_UNDEFINED;
+         else
+           {
+             require_exts = SCM_CADR (rest);
+             if (SCM_UNLIKELY (!scm_is_null (SCM_CDDR (rest))))
+               scm_wrong_num_args (scm_from_locale_string (FUNC_NAME));
+           }
+       }
+      else
+       {
+         /* Called by C code that uses the 1.8 signature, i.e., which
+            expects the 3rd argument to be EXTENSIONS.  */
+         extensions = rest;
+         require_exts = SCM_UNDEFINED;
+       }
+    }
+
   if (SCM_UNBNDP (extensions))
     extensions = SCM_EOL;
 
+  SCM_VALIDATE_LIST (3, extensions);
+
   if (SCM_UNBNDP (require_exts))
     require_exts = SCM_BOOL_F;
 
@@ -565,7 +600,7 @@ SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 
1, 0, 0,
     SCM_MISC_ERROR ("%load-path is not a proper list", SCM_EOL);
   if (scm_ilength (exts) < 0)
     SCM_MISC_ERROR ("%load-extension list is not a proper list", SCM_EOL);
-  return scm_search_path (path, filename, exts, SCM_UNDEFINED);
+  return scm_search_path (path, filename, exts);
 }
 #undef FUNC_NAME
 
@@ -726,11 +761,12 @@ SCM_DEFINE (scm_primitive_load_path, 
"primitive-load-path", 0, 0, 1,
     exception_on_not_found = SCM_BOOL_T;
 
   full_filename = scm_sys_search_load_path (filename);
-  compiled_filename = scm_search_path (*scm_loc_load_compiled_path,
-                                       filename,
-                                       *scm_loc_load_compiled_extensions,
-                                       SCM_BOOL_T);
-  
+  compiled_filename =
+    scm_search_path (*scm_loc_load_compiled_path,
+                    filename,
+                    scm_list_2 (*scm_loc_load_compiled_extensions,
+                                SCM_BOOL_T));
+
   if (scm_is_false (compiled_filename)
       && scm_is_true (full_filename)
       && scm_is_true (*scm_loc_compile_fallback_path)
diff --git a/libguile/load.h b/libguile/load.h
index cf825fc..81fbfba 100644
--- a/libguile/load.h
+++ b/libguile/load.h
@@ -32,7 +32,7 @@ SCM_API SCM scm_c_primitive_load (const char *filename);
 SCM_API SCM scm_sys_package_data_dir (void);
 SCM_API SCM scm_sys_library_dir (void);
 SCM_API SCM scm_sys_site_dir (void);
-SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts, SCM 
require_exts);
+SCM_API SCM scm_search_path (SCM path, SCM filename, SCM rest);
 SCM_API SCM scm_sys_search_load_path (SCM filename);
 SCM_API SCM scm_primitive_load_path (SCM filename_and_exception_on_not_found);
 SCM_API SCM scm_c_primitive_load_path (const char *filename);
diff --git a/libguile/vectors.c b/libguile/vectors.c
index b1b5890..405ebb1 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -339,26 +339,28 @@ SCM
 scm_c_make_vector (size_t k, SCM fill)
 #define FUNC_NAME s_scm_make_vector
 {
-  SCM v;
-  SCM *base;
+  SCM *vector;
 
-  if (k > 0) 
+  vector = (SCM *)
+    scm_gc_malloc ((k + SCM_I_VECTOR_HEADER_SIZE) * sizeof (SCM),
+                  "vector");
+
+  if (k > 0)
     {
+      SCM *base;
       unsigned long int j;
 
       SCM_ASSERT_RANGE (1, scm_from_ulong (k), k <= VECTOR_MAX_LENGTH);
 
-      base = scm_gc_malloc (k * sizeof (SCM), "vector");
+      base = vector + SCM_I_VECTOR_HEADER_SIZE;
       for (j = 0; j != k; ++j)
        base[j] = fill;
     }
-  else
-    base = NULL;
 
-  v = scm_immutable_cell ((k << 8) | scm_tc7_vector, (scm_t_bits) base);
-  scm_remember_upto_here_1 (fill);
+  ((scm_t_bits *) vector)[0] = (k << 8) | scm_tc7_vector;
+  ((scm_t_bits *) vector)[1] = 0;
 
-  return v;
+  return PTR2SCM (vector);
 }
 #undef FUNC_NAME
 
@@ -371,54 +373,39 @@ SCM_DEFINE (scm_vector_copy, "vector-copy", 1, 0, 0,
   size_t i, len;
   ssize_t inc;
   const SCM *src;
-  SCM *dst;
+  SCM result, *dst;
 
   src = scm_vector_elements (vec, &handle, &len, &inc);
-  dst = scm_gc_malloc (len * sizeof (SCM), "vector");
+
+  result = scm_c_make_vector (len, SCM_UNDEFINED);
+  dst = SCM_I_VECTOR_WELTS (result);
   for (i = 0; i < len; i++, src += inc)
     dst[i] = *src;
+
   scm_array_handle_release (&handle);
 
-  return scm_cell ((len << 8) | scm_tc7_vector, (scm_t_bits) dst);
+  return result;
 }
 #undef FUNC_NAME
 
-void
-scm_i_vector_free (SCM vec)
-{
-  scm_gc_free (SCM_I_VECTOR_WELTS (vec),
-              SCM_I_VECTOR_LENGTH (vec) * sizeof(SCM),
-              "vector");
-}
-
 
 /* Weak vectors.  */
 
-
-/* Initialize RET as a weak vector of type TYPE of SIZE elements pointed to
-   by BASE.  */
-#define MAKE_WEAK_VECTOR(_ret, _type, _size, _base)            \
-  (_ret) = scm_double_cell ((_size << 8) | scm_tc7_wvect,      \
-                           (scm_t_bits) (_base),               \
-                           (_type),                            \
-                           SCM_UNPACK (SCM_EOL));
-
-
 /* Allocate memory for the elements of a weak vector on behalf of the
    caller.  */
-static SCM *
-allocate_weak_vector (scm_t_bits type, size_t c_size)
+static SCM
+make_weak_vector (scm_t_bits type, size_t c_size)
 {
-  SCM *base;
+  SCM *vector;
+  size_t total_size;
 
-  if (c_size > 0)
-    /* The base itself should not be scanned for pointers otherwise those
-       pointers will always be reachable.  */
-    base = scm_gc_malloc_pointerless (c_size * sizeof (SCM), "weak vector");
-  else
-    base = NULL;
+  total_size = (c_size + SCM_I_VECTOR_HEADER_SIZE) * sizeof (SCM);
+  vector = (SCM *) scm_gc_malloc_pointerless (total_size, "weak vector");
 
-  return base;
+  ((scm_t_bits *) vector)[0] = (c_size << 8) | scm_tc7_wvect;
+  ((scm_t_bits *) vector)[1] = type;
+
+  return PTR2SCM (vector);
 }
 
 /* Return a new weak vector.  The allocated vector will be of the given weak
@@ -434,13 +421,12 @@ scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM 
fill)
     fill = SCM_UNSPECIFIED;
 
   c_size = scm_to_unsigned_integer (size, 0, VECTOR_MAX_LENGTH);
-  base = allocate_weak_vector (type, c_size);
+  wv = make_weak_vector (type, c_size);
+  base = SCM_I_WVECT_GC_WVELTS (wv);
 
   for (j = 0; j != c_size; ++j)
     base[j] = fill;
 
-  MAKE_WEAK_VECTOR (wv, type, c_size, base);
-
   return wv;
 }
 
@@ -449,22 +435,21 @@ scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM 
fill)
 SCM
 scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst)
 {
-  SCM wv, *base, *elt;
+  SCM wv, *elt;
   long c_size;
 
   c_size = scm_ilength (lst);
   SCM_ASSERT (c_size >= 0, lst, SCM_ARG2, "scm_i_make_weak_vector_from_list");
 
-  base = allocate_weak_vector (type, (size_t)c_size);
-  for (elt = base;
+  wv = make_weak_vector(type, (size_t) c_size);
+
+  for (elt = SCM_I_WVECT_GC_WVELTS (wv);
        scm_is_pair (lst);
        lst = SCM_CDR (lst), elt++)
     {
       *elt = SCM_CAR (lst);
     }
 
-  MAKE_WEAK_VECTOR (wv, type, (size_t)c_size, base);
-
   return wv;
 }
 
diff --git a/libguile/vectors.h b/libguile/vectors.h
index 0e2cb6e..a74c8a9 100644
--- a/libguile/vectors.h
+++ b/libguile/vectors.h
@@ -3,7 +3,7 @@
 #ifndef SCM_VECTORS_H
 #define SCM_VECTORS_H
 
-/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008 Free 
Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009 
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
@@ -61,29 +61,30 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
 #define SCM_SIMPLE_VECTOR_REF(x,idx)     ((SCM_I_VECTOR_ELTS(x))[idx])
 #define SCM_SIMPLE_VECTOR_SET(x,idx,val) ((SCM_I_VECTOR_WELTS(x))[idx]=(val))
 
+
 /* Internals */
 
+/* Vectors have a 2-word header: 1 for the type tag, and 1 for the weak
+   vector extra data (see below.)  */
+#define SCM_I_VECTOR_HEADER_SIZE  2U
+
 #define SCM_I_IS_VECTOR(x)     (!SCM_IMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))
-#define SCM_I_VECTOR_ELTS(x)   ((const SCM *) SCM_CELL_WORD_1 (x))
-#define SCM_I_VECTOR_WELTS(x)  ((SCM *) SCM_CELL_WORD_1 (x))
+#define SCM_I_VECTOR_ELTS(x)   ((const SCM *) SCM_I_VECTOR_WELTS (x))
+#define SCM_I_VECTOR_WELTS(x)  (SCM_CELL_OBJECT_LOC (x, 
SCM_I_VECTOR_HEADER_SIZE))
 #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)
 
-SCM_INTERNAL void scm_i_vector_free (SCM vec);
 SCM_INTERNAL SCM  scm_i_vector_equal_p (SCM x, SCM y);
 
 /* Weak vectors share implementation details with ordinary vectors,
-   but no one else should.
- */
+   but no one else should.  */
 
 #define SCM_I_WVECTP(x)                 (!SCM_IMP (x) && \
                                          SCM_TYP7 (x) == scm_tc7_wvect)
 #define SCM_I_WVECT_LENGTH              SCM_I_VECTOR_LENGTH
 #define SCM_I_WVECT_VELTS               SCM_I_VECTOR_ELTS
 #define SCM_I_WVECT_GC_WVELTS           SCM_I_VECTOR_WELTS
-#define SCM_I_WVECT_EXTRA(x)            (SCM_CELL_WORD_2 (x))
-#define SCM_I_SET_WVECT_EXTRA(x, t)     (SCM_SET_CELL_WORD_2 ((x),(t)))
-#define SCM_I_WVECT_GC_CHAIN(x)         (SCM_CELL_OBJECT_3 (x))
-#define SCM_I_SET_WVECT_GC_CHAIN(x, o)  (SCM_SET_CELL_OBJECT_3 ((x), (o)))
+#define SCM_I_WVECT_EXTRA(x)            (SCM_CELL_WORD_1 (x))
+#define SCM_I_SET_WVECT_EXTRA(x, t)     (SCM_SET_CELL_WORD_1 ((x),(t)))
 
 SCM_INTERNAL SCM scm_i_make_weak_vector (scm_t_bits type, SCM size, SCM fill);
 SCM_INTERNAL SCM scm_i_make_weak_vector_from_list (scm_t_bits type, SCM lst);
diff --git a/libguile/weaks.h b/libguile/weaks.h
index eecc618..5cb8bc3 100644
--- a/libguile/weaks.h
+++ b/libguile/weaks.h
@@ -33,17 +33,6 @@
 #define SCM_WVECT_WEAK_KEY_P(x) (SCM_I_WVECT_EXTRA(x) & SCM_WVECTF_WEAK_KEY)
 #define SCM_WVECT_WEAK_VALUE_P(x) (SCM_I_WVECT_EXTRA(x) & 
SCM_WVECTF_WEAK_VALUE)
 
-/* The DELTA field is used by the abstract hash tables.  During GC,
-   this field will be set to the number of items that have been
-   dropped.  The abstract hash table will then use it to update its
-   item count.  DELTA is unsigned.
-*/
-
-#define SCM_I_WVECT_DELTA(x)       (SCM_I_WVECT_EXTRA(x) >> 3)
-#define SCM_I_SET_WVECT_DELTA(x,n) (SCM_I_SET_WVECT_EXTRA \
-                                   ((x), ((SCM_I_WVECT_EXTRA (x) & 7)  \
-                                          | ((n) << 3))))
-
 #define SCM_I_WVECT_TYPE(x)       (SCM_I_WVECT_EXTRA(x) & 7)
 #define SCM_I_SET_WVECT_TYPE(x,t) (SCM_I_SET_WVECT_EXTRA               \
                                   ((x), (SCM_I_WVECT_EXTRA (x) & ~7) | (t)))


hooks/post-receive
-- 
GNU Guile