[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-34-g62c290
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-34-g62c290e |
|
Date: |
Thu, 24 Feb 2011 15:59:28 +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=62c290e977ea71c8dcb9ccb45e5a06d9e5a13a40
The branch, stable-2.0 has been updated
via 62c290e977ea71c8dcb9ccb45e5a06d9e5a13a40 (commit)
via ec7f624d652eaf6e4cf06253101b4a986e1b9e8e (commit)
via 574b7be0ba5dbbecfacf172ed81a5f22d1d5566e (commit)
via b2548e23445d44f9b6f0b21d07c0ee94c83d0607 (commit)
via a964aa62c273d93fad61ae67abd98027e1d142d3 (commit)
from 4a2ac0623c3dabb2c8b9d38c27b837dcb2c7fe4e (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 62c290e977ea71c8dcb9ccb45e5a06d9e5a13a40
Author: Andy Wingo <address@hidden>
Date: Thu Feb 24 17:00:30 2011 +0100
weak hash tables vacuum stale entries after a gc
* libguile/hashtab.c (scm_c_register_weak_gc_callback): New private
helper, arranges for a C function to be called with a SCM as an
argument, as long as the argument is reachable by GC.
(scm_make_weak_key_hash_table)
(scm_make_weak_value_hash_table)
(scm_make_doubly_weak_hash_table): Register a weak GC callback to
vacuum_weak_hash_table.
commit ec7f624d652eaf6e4cf06253101b4a986e1b9e8e
Author: Andy Wingo <address@hidden>
Date: Thu Feb 24 16:30:08 2011 +0100
re-enable the after-gc-hook
* libguile/gc.c (scm_gc): No need to take a mutex here. Don't run the
hook, the hook will run itself.
(scm_c_register_gc_callback): New private helper, registers a callback
the next time GC happens.
(system_gc_callback): Guile's internal callback that runs
scm_after_gc_c_hook, which itself queues a call to the after-gc-hook.
(scm_storage_prehistory): Queue up a call to system_gc_callback.
commit 574b7be0ba5dbbecfacf172ed81a5f22d1d5566e
Author: Andy Wingo <address@hidden>
Date: Thu Feb 24 13:12:58 2011 +0100
pointerless backing buffers for string ports
* libguile/strports.c (scm_mkstrport): String port string buffer
allocated atomically.
commit b2548e23445d44f9b6f0b21d07c0ee94c83d0607
Author: Andy Wingo <address@hidden>
Date: Thu Feb 24 13:10:16 2011 +0100
errno saving in display_string
* libguile/print.c (display_string): Fix a case in which perhaps `errno'
could have been stompled.
commit a964aa62c273d93fad61ae67abd98027e1d142d3
Author: Andy Wingo <address@hidden>
Date: Thu Feb 24 11:10:19 2011 +0100
web server more assiduous about closing ports
* module/web/uri.scm:
* module/web/server.scm (call-with-output-string*):
(call-with-output-bytevector*): Local procs to output to strings or
bytevectors, *and then close the port*. We can't make this change in
call-with-output-string because it would be incompatible.
* module/web/uri.scm (call-with-encoded-output-string, decode-string)
(uri-decode)
* module/web/server.scm (call-with-encoded-output-string): Use the new
helpers.
-----------------------------------------------------------------------
Summary of changes:
libguile/gc.c | 35 ++++++++++-------
libguile/hashtab.c | 70 ++++++++++++++++++++++++----------
libguile/print.c | 4 +-
libguile/strports.c | 4 +-
module/web/server.scm | 31 +++++++++++----
module/web/uri.scm | 99 +++++++++++++++++++++++++++++--------------------
6 files changed, 156 insertions(+), 87 deletions(-)
diff --git a/libguile/gc.c b/libguile/gc.c
index 91250ba..f2c0179 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008,
2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008,
2009, 2010, 2011 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
@@ -69,10 +69,6 @@ extern unsigned long *
__libc_ia64_register_backing_store_base;
#include <unistd.h>
#endif
-/* Lock this mutex before doing lazy sweeping.
- */
-scm_i_pthread_mutex_t scm_i_sweep_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-
/* Set this to != 0 if every cell that is accessed shall be checked:
*/
int scm_debug_cell_accesses_p = 0;
@@ -377,17 +373,7 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
"no longer accessible.")
#define FUNC_NAME s_scm_gc
{
- scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex);
scm_i_gc ("call");
- /* njrev: It looks as though other places, e.g. scm_realloc,
- can call scm_i_gc without acquiring the sweep mutex. Does this
- matter? Also scm_i_gc (or its descendants) touch the
- scm_sys_protects, which are protected in some cases
- (e.g. scm_permobjs above in scm_gc_stats) by a critical section,
- not by the sweep mutex. Shouldn't all the GC-relevant objects be
- protected in the same way? */
- scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex);
- scm_c_hook_run (&scm_after_gc_c_hook, 0);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -587,6 +573,23 @@ scm_gc_unregister_roots (SCM *b, unsigned long n)
scm_gc_unregister_root (p);
}
+static void
+scm_c_register_gc_callback (void *key, void (*func) (void *, void *),
+ void *data)
+{
+ if (!key)
+ key = GC_MALLOC_ATOMIC (sizeof (void*));
+
+ GC_REGISTER_FINALIZER_NO_ORDER (key, func, data, NULL, NULL);
+}
+
+static void
+system_gc_callback (void *key, void *data)
+{
+ scm_c_register_gc_callback (key, system_gc_callback, data);
+ scm_c_hook_run (&scm_after_gc_c_hook, NULL);
+}
+
@@ -642,6 +645,8 @@ scm_storage_prehistory ()
scm_c_hook_init (&scm_before_sweep_c_hook, 0, SCM_C_HOOK_NORMAL);
scm_c_hook_init (&scm_after_sweep_c_hook, 0, SCM_C_HOOK_NORMAL);
scm_c_hook_init (&scm_after_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
+
+ scm_c_register_gc_callback (NULL, system_gc_callback, NULL);
}
scm_i_pthread_mutex_t scm_i_gc_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
diff --git a/libguile/hashtab.c b/libguile/hashtab.c
index c703108..4c4c106 100644
--- a/libguile/hashtab.c
+++ b/libguile/hashtab.c
@@ -33,6 +33,7 @@
#include "libguile/root.h"
#include "libguile/vectors.h"
#include "libguile/ports.h"
+#include "libguile/bdw-gc.h"
#include "libguile/validate.h"
#include "libguile/hashtab.h"
@@ -417,6 +418,34 @@ SCM_DEFINE (scm_make_hash_table, "make-hash-table", 0, 1,
0,
}
#undef FUNC_NAME
+static void
+weak_gc_callback (void *ptr, void *data)
+{
+ void **weak = ptr;
+ void *val = *weak;
+
+ if (val)
+ {
+ void (*callback) (SCM) = data;
+
+ GC_REGISTER_FINALIZER_NO_ORDER (ptr, weak_gc_callback, data, NULL, NULL);
+
+ callback (PTR2SCM (val));
+ }
+}
+
+static void
+scm_c_register_weak_gc_callback (SCM obj, void (*callback) (SCM))
+{
+ void **weak = GC_MALLOC_ATOMIC (sizeof (void**));
+
+ *weak = SCM2PTR (obj);
+ GC_GENERAL_REGISTER_DISAPPEARING_LINK (weak, SCM2PTR (obj));
+
+ GC_REGISTER_FINALIZER_NO_ORDER (weak, weak_gc_callback, (void*)callback,
+ NULL, NULL);
+}
+
SCM_DEFINE (scm_make_weak_key_hash_table, "make-weak-key-hash-table", 0, 1, 0,
(SCM n),
"@deffnx {Scheme Procedure} make-weak-value-hash-table size\n"
@@ -442,13 +471,17 @@ SCM_DEFINE (scm_make_weak_value_hash_table,
"make-weak-value-hash-table", 0, 1,
"(@pxref{Hash Tables})")
#define FUNC_NAME s_scm_make_weak_value_hash_table
{
+ SCM ret;
+
if (SCM_UNBNDP (n))
- return make_hash_table (SCM_HASHTABLEF_WEAK_CDR, 0, FUNC_NAME);
+ ret = make_hash_table (SCM_HASHTABLEF_WEAK_CDR, 0, FUNC_NAME);
else
- {
- return make_hash_table (SCM_HASHTABLEF_WEAK_CDR,
- scm_to_ulong (n), FUNC_NAME);
- }
+ ret = make_hash_table (SCM_HASHTABLEF_WEAK_CDR,
+ scm_to_ulong (n), FUNC_NAME);
+
+ scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table);
+
+ return ret;
}
#undef FUNC_NAME
@@ -459,16 +492,18 @@ SCM_DEFINE (scm_make_doubly_weak_hash_table,
"make-doubly-weak-hash-table", 1, 0
"buckets. (@pxref{Hash Tables})")
#define FUNC_NAME s_scm_make_doubly_weak_hash_table
{
+ SCM ret;
+
if (SCM_UNBNDP (n))
- return make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR,
- 0,
- FUNC_NAME);
+ ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR,
+ 0, FUNC_NAME);
else
- {
- return make_hash_table (SCM_HASHTABLEF_WEAK_CAR |
SCM_HASHTABLEF_WEAK_CDR,
- scm_to_ulong (n),
- FUNC_NAME);
- }
+ ret = make_hash_table (SCM_HASHTABLEF_WEAK_CAR | SCM_HASHTABLEF_WEAK_CDR,
+ scm_to_ulong (n), FUNC_NAME);
+
+ scm_c_register_weak_gc_callback (ret, vacuum_weak_hash_table);
+
+ return ret;
}
#undef FUNC_NAME
@@ -673,14 +708,7 @@ scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init,
SCM_SIMPLE_VECTOR_SET (buckets, k, new_bucket);
SCM_HASHTABLE_INCREMENT (table);
- /* Maybe rehash the table. If it's a weak table, pump all of the
- buckets first to remove stale links. If the weak table is of
- the kind that gets lots of insertions of short-lived values, we
- might never need to actually rehash. */
- if (SCM_HASHTABLE_WEAK_P (table)
- && SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
- vacuum_weak_hash_table (table);
-
+ /* Maybe rehash the table. */
if (SCM_HASHTABLE_N_ITEMS (table) < SCM_HASHTABLE_LOWER (table)
|| SCM_HASHTABLE_N_ITEMS (table) > SCM_HASHTABLE_UPPER (table))
scm_i_rehash (table, hash_fn, closure, FUNC_NAME);
diff --git a/libguile/print.c b/libguile/print.c
index 59b1093..3855146 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -862,6 +862,8 @@ display_string (const void *str, int narrow_p,
if (SCM_UNLIKELY (done == (size_t) -1))
{
+ int errno_save = errno;
+
/* Reset the `iconv' state. */
iconv (pt->output_cd, NULL, NULL, NULL, NULL);
@@ -873,7 +875,7 @@ display_string (const void *str, int narrow_p,
codepoints_read = offsets[input - utf8_buf] - printed;
printed += codepoints_read;
- if (errno == EILSEQ &&
+ if (errno_save == EILSEQ &&
strategy != SCM_FAILED_CONVERSION_ERROR)
{
/* Conversion failed somewhere in INPUT and we want to
diff --git a/libguile/strports.c b/libguile/strports.c
index 625b753..64987fa 100644
--- a/libguile/strports.c
+++ b/libguile/strports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009,
2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002, 2003, 2005, 2006, 2009,
2010, 2011 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
@@ -314,7 +314,7 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char
*caller)
/* Create a copy of STR in the encoding of Z. */
buf = scm_to_stringn (str, &str_len, pt->encoding,
SCM_FAILED_CONVERSION_ERROR);
- c_str = scm_gc_malloc (str_len, "strport");
+ c_str = scm_gc_malloc_pointerless (str_len, "strport");
memcpy (c_str, buf, str_len);
free (buf);
diff --git a/module/web/server.scm b/module/web/server.scm
index 8dbd139..c5e623a 100644
--- a/module/web/server.scm
+++ b/module/web/server.scm
@@ -167,18 +167,33 @@ values."
(warn "Error while accepting client" k args)
(values #f #f #f))))
+;; like call-with-output-string, but actually closes the port (doh)
+(define (call-with-output-string* proc)
+ (let ((port (open-output-string)))
+ (proc port)
+ (let ((str (get-output-string port)))
+ (close-port port)
+ str)))
+
+(define (call-with-output-bytevector* proc)
+ (call-with-values
+ (lambda ()
+ (open-bytevector-output-port))
+ (lambda (port get-bytevector)
+ (proc port)
+ (let ((bv (get-bytevector)))
+ (close-port port)
+ bv))))
+
(define (call-with-encoded-output-string charset proc)
(if (string-ci=? charset "utf-8")
;; I don't know why, but this appears to be faster; at least for
;; examples/debug-sxml.scm (1464 reqs/s versus 850 reqs/s).
- (string->utf8 (call-with-output-string proc))
- (call-with-values
- (lambda ()
- (open-bytevector-output-port))
- (lambda (port get-bytevector)
- (set-port-encoding! port charset)
- (proc port)
- (get-bytevector)))))
+ (string->utf8 (call-with-output-string* proc))
+ (call-with-output-bytevector*
+ (lambda (port)
+ (set-port-encoding! port charset)
+ (proc port)))))
(define (encode-string str charset)
(if (string-ci=? charset "utf-8")
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 23699e9..6f9377c 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -1,6 +1,6 @@
;;;; (web uri) --- URI manipulation tools
;;;;
-;;;; Copyright (C) 1997,2001,2002,2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 1997,2001,2002,2010,2011 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
@@ -227,16 +227,31 @@ printed."
""))))
+;; like call-with-output-string, but actually closes the port (doh)
+(define (call-with-output-string* proc)
+ (let ((port (open-output-string)))
+ (proc port)
+ (let ((str (get-output-string port)))
+ (close-port port)
+ str)))
+
+(define (call-with-output-bytevector* proc)
+ (call-with-values
+ (lambda ()
+ (open-bytevector-output-port))
+ (lambda (port get-bytevector)
+ (proc port)
+ (let ((bv (get-bytevector)))
+ (close-port port)
+ bv))))
+
(define (call-with-encoded-output-string encoding proc)
(if (string-ci=? encoding "utf-8")
- (string->utf8 (call-with-output-string proc))
- (call-with-values
- (lambda ()
- (open-bytevector-output-port))
- (lambda (port get-bytevector)
- (set-port-encoding! port encoding)
- (proc port)
- (get-bytevector)))))
+ (string->utf8 (call-with-output-string* proc))
+ (call-with-output-bytevector*
+ (lambda (port)
+ (set-port-encoding! port encoding)
+ (proc port)))))
(define (encode-string str encoding)
(if (string-ci=? encoding "utf-8")
@@ -250,7 +265,9 @@ printed."
(utf8->string bv)
(let ((p (open-bytevector-input-port bv)))
(set-port-encoding! p encoding)
- (read-delimited "" p))))
+ (let ((res (read-delimited "" p)))
+ (close-port p)
+ res))))
;; A note on characters and bytes: URIs are defined to be sequences of
@@ -279,35 +296,37 @@ There is no guarantee that a given byte sequence is a
valid string
encoding. Therefore this routine may signal an error if the decoded
bytes are not valid for the given encoding. Pass @code{#f} for
@var{encoding} if you want decoded bytes as a bytevector directly."
- (let ((len (string-length str)))
- (call-with-values open-bytevector-output-port
- (lambda (port get-bytevector)
- (let lp ((i 0))
- (if (= i len)
- (if encoding
- (decode-string (get-bytevector) encoding)
- (get-bytevector)) ; raw bytevector
- (let ((ch (string-ref str i)))
- (cond
- ((eqv? ch #\+)
- (put-u8 port (char->integer #\space))
- (lp (1+ i)))
- ((and (< (+ i 2) len) (eqv? ch #\%)
- (let ((a (string-ref str (+ i 1)))
- (b (string-ref str (+ i 2))))
- (and (char-set-contains? hex-chars a)
- (char-set-contains? hex-chars b)
- (string->number (string a b) 16))))
- => (lambda (u8)
- (put-u8 port u8)
- (lp (+ i 3))))
- ((< (char->integer ch) 128)
- (put-u8 port (char->integer ch))
- (lp (1+ i)))
- (else
- (uri-error "Invalid character in encoded URI ~a: ~s"
- str ch))))))))))
-
+ (let* ((len (string-length str))
+ (bv
+ (call-with-output-bytevector*
+ (lambda (port)
+ (let lp ((i 0))
+ (if (< i len)
+ (let ((ch (string-ref str i)))
+ (cond
+ ((eqv? ch #\+)
+ (put-u8 port (char->integer #\space))
+ (lp (1+ i)))
+ ((and (< (+ i 2) len) (eqv? ch #\%)
+ (let ((a (string-ref str (+ i 1)))
+ (b (string-ref str (+ i 2))))
+ (and (char-set-contains? hex-chars a)
+ (char-set-contains? hex-chars b)
+ (string->number (string a b) 16))))
+ => (lambda (u8)
+ (put-u8 port u8)
+ (lp (+ i 3))))
+ ((< (char->integer ch) 128)
+ (put-u8 port (char->integer ch))
+ (lp (1+ i)))
+ (else
+ (uri-error "Invalid character in encoded URI ~a: ~s"
+ str ch))))))))))
+ (if encoding
+ (decode-string bv encoding)
+ ;; Otherwise return raw bytevector
+ bv)))
+
(define ascii-alnum-chars
(string->char-set
"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"))
@@ -337,7 +356,7 @@ within the given @var{encoding}, then encodes each byte as
@address@hidden, where @var{HH} is the hexadecimal representation of
the byte."
(if (string-index str unescaped-chars)
- (call-with-output-string
+ (call-with-output-string*
(lambda (port)
(string-for-each
(lambda (ch)
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-34-g62c290e,
Andy Wingo <=