diff options
author | Andy Wingo <wingo@pobox.com> | 2012-03-11 11:06:14 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2012-03-11 11:06:14 +0100 |
commit | 8b49b6b1f5522dfbb78c9249cf219a29264df490 (patch) | |
tree | 0af376e25d46d4edf9023b64957817012de0f890 | |
parent | e0dc497832fbd175538bfe60b468fcb43c49aaae (diff) | |
parent | 02360ed6050833d5436ea4f1b9b4f10f3783491b (diff) | |
download | guile-8b49b6b1f5522dfbb78c9249cf219a29264df490.tar.gz |
Merge remote-tracking branch 'local-2.0/stable-2.0'
Conflicts:
configure.ac
-rw-r--r-- | configure.ac | 2 | ||||
-rw-r--r-- | libguile/gc.c | 8 | ||||
-rw-r--r-- | module/web/server/http.scm | 16 |
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))) |