Merge remote-tracking branch 'local-2.0/stable-2.0'

Conflicts:
	configure.ac

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

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 ()
 {

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)))