summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-03-11 11:06:14 +0100
committerAndy Wingo <wingo@pobox.com>2012-03-11 11:06:14 +0100
commit8b49b6b1f5522dfbb78c9249cf219a29264df490 (patch)
tree0af376e25d46d4edf9023b64957817012de0f890
parente0dc497832fbd175538bfe60b468fcb43c49aaae (diff)
parent02360ed6050833d5436ea4f1b9b4f10f3783491b (diff)
downloadguile-8b49b6b1f5522dfbb78c9249cf219a29264df490.tar.gz
Merge remote-tracking branch 'local-2.0/stable-2.0'
Conflicts: configure.ac
-rw-r--r--configure.ac2
-rw-r--r--libguile/gc.c8
-rw-r--r--module/web/server/http.scm16
3 files changed, 23 insertions, 3 deletions
diff --git a/configure.ac b/configure.ac
index f79c671df..e2ccb8c67 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1232,7 +1232,7 @@ save_LIBS="$LIBS"
LIBS="$BDW_GC_LIBS $LIBS"
CFLAGS="$BDW_GC_CFLAGS $CFLAGS"
-AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit GC_pthread_cancel GC_allow_register_threads GC_pthread_sigmask GC_set_start_callback GC_get_suspend_signal GC_move_disappearing_link GC_get_heap_usage_safe GC_get_free_space_divisor GC_gcollect_and_unmap GC_get_unmapped_bytes GC_set_finalizer_notifier])
+AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit GC_pthread_cancel GC_allow_register_threads GC_pthread_sigmask GC_set_start_callback GC_get_suspend_signal GC_move_disappearing_link GC_get_heap_usage_safe GC_get_free_space_divisor GC_gcollect_and_unmap GC_get_unmapped_bytes GC_set_finalizer_notifier GC_set_finalize_on_demand])
# Though the `GC_do_blocking ()' symbol is present in GC 7.1, it is not
# declared, and has a different type (returning void instead of
diff --git a/libguile/gc.c b/libguile/gc.c
index df93d32e5..71efd032c 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -611,6 +611,14 @@ scm_getenv_int (const char *var, int def)
return res;
}
+#ifndef HAVE_GC_SET_FINALIZE_ON_DEMAND
+static void
+GC_set_finalize_on_demand (int foo)
+{
+ GC_finalize_on_demand = foo;
+}
+#endif
+
void
scm_storage_prehistory ()
{
diff --git a/module/web/server/http.scm b/module/web/server/http.scm
index a9a90499e..cda44f4aa 100644
--- a/module/web/server/http.scm
+++ b/module/web/server/http.scm
@@ -1,6 +1,6 @@
;;; Web I/O: HTTP
-;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011, 2012 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
@@ -69,6 +69,11 @@
(poll-set-add! poll-set socket *events*)
(make-http-server socket 0 poll-set)))
+(define (bad-request port)
+ (write-response (build-response #:version '(1 . 0) #:code 400
+ #:headers '((content-length . 0)))
+ port))
+
;; -> (client request body | #f #f #f)
(define (http-read server)
(let* ((poll-set (http-poll-set server)))
@@ -123,7 +128,14 @@
req
(read-request-body req))))
(lambda (k . args)
- (false-if-exception (close-port port)))))))))))))
+ (define-syntax-rule (cleanup-catch statement)
+ (catch #t
+ (lambda () statement)
+ (lambda (k . args)
+ (format (current-error-port) "In ~a:\n" 'statement)
+ (print-exception (current-error-port) #f k args))))
+ (cleanup-catch (bad-request port))
+ (cleanup-catch (close-port port)))))))))))))
(define (keep-alive? response)
(let ((v (response-version response)))