From 07db6fcd4cceca090c386ca0527e3762a81467cf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 13 Apr 2008 19:35:46 +0200 Subject: [PATCH 01/87] Really fix inline machinery for MacOS X. --- libguile/ChangeLog | 6 ++++++ libguile/inline.h | 9 +++++---- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 2b471c45a..6a90c5e10 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2008-04-13 Ludovic Courtès + + * inline.h (SCM_C_USE_EXTERN_INLINE): New macro. Use it to make + sure "extern" declarations are produced when "extern inline" is + used. + 2008-04-10 Ludovic Courtès * inline.h (SCM_C_EXTERN_INLINE): Special-case Apple's GCC diff --git a/libguile/inline.h b/libguile/inline.h index 34bb84345..904ec50e4 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -55,6 +55,7 @@ inline" in that case. */ # if (defined __GNUC__) && (!(__APPLE_CC__ > 5400 && __STDC_VERSION__ >= 199901L)) +# define SCM_C_USE_EXTERN_INLINE 1 # if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2) # define SCM_C_EXTERN_INLINE \ extern __inline__ __attribute__ ((__gnu_inline__)) @@ -68,12 +69,12 @@ #endif /* SCM_INLINE_C_INCLUDING_INLINE_H */ -#if ((!defined SCM_C_INLINE) && (!defined SCM_INLINE_C_INCLUDING_INLINE_H)) \ - || (defined __GNUC__) +#if (!defined SCM_C_INLINE) || (defined SCM_INLINE_C_INCLUDING_INLINE_H) \ + || (defined SCM_C_USE_EXTERN_INLINE) /* The `extern' declarations. They should only appear when used from - "inline.c", when `inline' is not supported at all or when GCC's "extern - inline" is used. */ + "inline.c", when `inline' is not supported at all or when "extern inline" + is used. */ SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr); SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, From 9dca89355ff2364ead7bcc4d9c5bea03f77b4423 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 13 Apr 2008 19:38:42 +0200 Subject: [PATCH 02/87] Slightly simplify inline machinery. --- libguile/ChangeLog | 2 +- libguile/inline.h | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 6a90c5e10..ea7515811 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -2,7 +2,7 @@ * inline.h (SCM_C_USE_EXTERN_INLINE): New macro. Use it to make sure "extern" declarations are produced when "extern inline" is - used. + used. Simplify macrology around inline definitions. 2008-04-10 Ludovic Courtès diff --git a/libguile/inline.h b/libguile/inline.h index 904ec50e4..8a6635ee1 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -88,7 +88,7 @@ SCM_API int scm_is_pair (SCM x); #endif -#if defined SCM_C_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H +#if defined SCM_C_EXTERN_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H /* either inlining, or being included from inline.c. We use (and repeat) this long #if test here and below so that we don't have to introduce any extraneous symbols into the public namespace. We @@ -98,7 +98,7 @@ extern unsigned scm_newcell2_count; extern unsigned scm_newcell_count; -#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H SCM_C_EXTERN_INLINE #endif SCM @@ -168,7 +168,7 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) return z; } -#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H SCM_C_EXTERN_INLINE #endif SCM @@ -237,7 +237,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, return z; } -#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H SCM_C_EXTERN_INLINE #endif SCM @@ -246,7 +246,7 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p) return h->ref (h, p); } -#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H SCM_C_EXTERN_INLINE #endif void @@ -255,7 +255,7 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v) h->set (h, p, v); } -#if defined SCM_C_EXTERN_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H SCM_C_EXTERN_INLINE #endif int From cac3960028d0c9d01076074d442b2a80483aff9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 13 Apr 2008 20:41:23 +0200 Subject: [PATCH 03/87] Test the interaction of GOOPS objects with `struct-{ref,set!}'. --- test-suite/ChangeLog | 7 +++++++ test-suite/tests/goops.test | 28 ++++++++++++++++++++++++++-- 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 5284f30ff..7b546b3e1 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,10 @@ +2008-04-13 Ludovic Courtès + + * tests/goops.test (defining classes)[interaction with + `struct-ref', interaction with `struct-set!']: New test. Checks + the interaction of `struct-ref' with "light structs", fixed on + 2008-04-10 (commit 4650d115020924e8da5547d4c346cbe5cd01029e). + 2008-04-06 Ludovic Courtès * standalone/test-asmobs-lib.c, standalone/test-conversion.c, diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index 8ed697c59..e4c2df906 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -1,6 +1,6 @@ ;;;; goops.test --- test suite for GOOPS -*- scheme -*- ;;;; -;;;; Copyright (C) 2001,2003,2004, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 2001,2003,2004, 2006, 2008 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -148,7 +148,31 @@ #t) (lambda args #f))) - )) + + (pass-if "interaction with `struct-ref'" + (eval '(define-class () + (foo #:init-keyword #:foo) + (bar #:init-keyword #:bar)) + (current-module)) + (eval '(let ((x (make + #:foo 'hello + #:bar 'world))) + (and (struct? x) + (eq? (struct-ref x 0) 'hello) + (eq? (struct-ref x 1) 'world))) + (current-module))) + + (pass-if "interaction with `struct-set!'" + (eval '(define-class () + (foo) (bar)) + (current-module)) + (eval '(let ((x (make ))) + (struct-set! x 0 'hello) + (struct-set! x 1 'world) + (and (struct? x) + (eq? (struct-ref x 0) 'hello) + (eq? (struct-ref x 1) 'world))) + (current-module))))) (with-test-prefix "defining generics" From ef4cbc08c88b9c0ca6498ba36af91e1ad35b5dfe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 15 Apr 2008 19:52:43 +0200 Subject: [PATCH 04/87] Add support for SRFI-88-like postfix keyword read syntax. --- NEWS | 4 ++++ doc/ref/ChangeLog | 7 +++++++ doc/ref/api-data.texi | 22 ++++++++++++++++++++-- doc/ref/api-options.texi | 6 +++--- libguile/ChangeLog | 7 +++++++ libguile/read.c | 26 ++++++++++++++++++++------ test-suite/ChangeLog | 5 +++++ test-suite/tests/reader.test | 16 +++++++++++++++- 8 files changed, 81 insertions(+), 12 deletions(-) diff --git a/NEWS b/NEWS index c4cdb4430..cc2fc3666 100644 --- a/NEWS +++ b/NEWS @@ -46,6 +46,10 @@ The new repository can be accessed using "git-clone git://git.sv.gnu.org/guile.git", or can be browsed on-line at http://git.sv.gnu.org/gitweb/?p=guile.git . See `README' for details. +* New features (see the manual for details) + +** New `postfix' read option, for SRFI-88 keyword syntax + * Bugs fixed ** `scm_add_slot ()' no longer segfaults (fixes bug #22369) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 77198194c..1847fc507 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,10 @@ +2008-04-15 Ludovic Courtès + + * api-data.texi (Keywords): Mention postfix syntax. + (Keyword Read Syntax): Document `postfix' read option. + * api-options.texi (Reader options): Update examples. + (Examples of option use): Likewise. + 2008-03-28 Neil Jerram * libguile-concepts.texi (Multi-Threading): Fix typo. diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index a73e81905..1eeee8563 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -4901,7 +4901,7 @@ makes them easy to type. Guile's keyword support conforms to R5RS, and adds a (switchable) read syntax extension to permit keywords to begin with @code{:} as well as -@code{#:}. +@code{#:}, or to end with @code{:}. @menu * Why Use Keywords?:: Motivation for keyword usage. @@ -5046,9 +5046,17 @@ If the @code{keyword} read option is set to @code{'prefix}, Guile also recognizes the alternative read syntax @code{:NAME}. Otherwise, tokens of the form @code{:NAME} are read as symbols, as required by R5RS. +@cindex SRFI-88 keyword syntax + +If the @code{keyword} read option is set to @code{'postfix}, Guile +recognizes the @uref{http://srfi.schemers.org/srfi-88/srfi-88.html, +SRFI-88 read syntax} @code{NAME:}. Otherwise, tokens of this form are +read as symbols. + To enable and disable the alternative non-R5RS keyword syntax, you use the @code{read-set!} procedure documented in @ref{User level options -interfaces} and @ref{Reader options}. +interfaces} and @ref{Reader options}. Note that the @code{prefix} and +@code{postfix} syntax are mutually exclusive. @smalllisp (read-set! keywords 'prefix) @@ -5061,6 +5069,16 @@ interfaces} and @ref{Reader options}. @result{} #:type +(read-set! keywords 'postfix) + +type: +@result{} +#:type + +:type +@result{} +:type + (read-set! keywords #f) #:type diff --git a/doc/ref/api-options.texi b/doc/ref/api-options.texi index c44de8c59..c6ce34623 100644 --- a/doc/ref/api-options.texi +++ b/doc/ref/api-options.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2008 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -491,7 +491,7 @@ Here is the list of reader options generated by typing values. @smalllisp -keywords #f Style of keyword recognition: #f or 'prefix +keywords #f Style of keyword recognition: #f, 'prefix or 'postfix case-insensitive no Convert symbols to lower case. positions yes Record positions of source code expressions. copy no Copy source code expressions. @@ -729,7 +729,7 @@ ABORT: (misc-error) Type "(backtrace)" to get more information. guile> (read-options 'help) -keywords #f Style of keyword recognition: #f or 'prefix +keywords #f Style of keyword recognition: #f, 'prefix or 'postfix case-insensitive no Convert symbols to lower case. positions yes Record positions of source code expressions. copy no Copy source code expressions. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index ea7515811..8ca09bde1 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,10 @@ +2008-04-15 Ludovic Courtès + Julian Graham + + * read.c (scm_keyword_postfix): New. + (scm_read_opts): Update docstring for `keywords'. + (scm_read_mixed_case_symbol): Add support for postfix keywords. + 2008-04-13 Ludovic Courtès * inline.h (SCM_C_USE_EXTERN_INLINE): New macro. Use it to make diff --git a/libguile/read.c b/libguile/read.c index 40f6aa824..5a448b7f8 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -53,6 +53,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_dot, "."); SCM_SYMBOL (scm_keyword_prefix, "prefix"); +SCM_SYMBOL (scm_keyword_postfix, "postfix"); scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "copy", 0, @@ -62,7 +63,7 @@ scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "case-insensitive", 0, "Convert symbols to lower case."}, { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), - "Style of keyword recognition: #f or 'prefix."}, + "Style of keyword recognition: #f, 'prefix or 'postfix."}, #if SCM_ENABLE_ELISP { SCM_OPTION_BOOLEAN, "elisp-vectors", 0, "Support Elisp vector syntax, namely `[...]'."}, @@ -531,15 +532,19 @@ static SCM scm_read_mixed_case_symbol (int chr, SCM port) { SCM result, str = SCM_EOL; - int overflow = 0; + int overflow = 0, ends_with_colon = 0; char buffer[READER_BUFFER_SIZE]; size_t read = 0; + int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix); scm_ungetc (chr, port); do { overflow = read_token (port, buffer, sizeof (buffer), &read); + if (read > 0) + ends_with_colon = (buffer[read - 1] == ':'); + if ((overflow) || (scm_is_pair (str))) str = scm_cons (scm_from_locale_stringn (buffer, read), str); } @@ -549,12 +554,21 @@ scm_read_mixed_case_symbol (int chr, SCM port) { str = scm_string_concatenate (scm_reverse_x (str, SCM_EOL)); result = scm_string_to_symbol (str); + + /* Per SRFI-88, `:' alone is an identifier, not a keyword. */ + if (postfix && ends_with_colon && (scm_c_string_length (result) > 1)) + result = scm_symbol_to_keyword (result); } else - /* For symbols smaller than `sizeof (buffer)', we don't need to recur to - Scheme strings. Therefore, we only create one Scheme object (a - symbol) per symbol read. */ - result = scm_from_locale_symboln (buffer, read); + { + /* For symbols smaller than `sizeof (buffer)', we don't need to recur + to Scheme strings. Therefore, we only create one Scheme object (a + symbol) per symbol read. */ + if (postfix && ends_with_colon && (read > 1)) + result = scm_from_locale_keywordn (buffer, read - 1); + else + result = scm_from_locale_symboln (buffer, read); + } return result; } diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 7b546b3e1..7030be780 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2008-04-15 Ludovic Courtès + + * tests/reader.test (read-options)[prefix non-keywords, postfix + keywords, `:' is not a postfix keyword (per SRFI-88)]: New tests. + 2008-04-13 Ludovic Courtès * tests/goops.test (defining classes)[interaction with diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index d6047a2d3..0b13cf1c0 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -1,6 +1,6 @@ ;;;; reader.test --- Exercise the reader. -*- Scheme -*- ;;;; -;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008 Free Software Foundation, Inc. ;;;; Jim Blandy ;;;; ;;;; This library is free software; you can redistribute it and/or @@ -149,6 +149,20 @@ (with-read-options '(keywords prefix case-insensitive) (lambda () (read-string ":KeyWord"))))) + (pass-if "prefix non-keywords" + (symbol? (with-read-options '(keywords prefix) + (lambda () + (read-string "srfi88-keyword:"))))) + (pass-if "postfix keywords" + (eq? #:keyword + (with-read-options '(keywords postfix) + (lambda () + (read-string "keyword:"))))) + (pass-if "`:' is not a postfix keyword (per SRFI-88)" + (eq? ': + (with-read-options '(keywords postfix) + (lambda () + (read-string ":"))))) (pass-if "no positions" (let ((sexp (with-read-options '() (lambda () From 6ddb3ca825b1ee8b746eb688e98aa3b37ab55c3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 15 Apr 2008 20:01:13 +0200 Subject: [PATCH 05/87] Fix typo in `read.c'. --- libguile/read.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/read.c b/libguile/read.c index 5a448b7f8..54b3e7d2f 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -63,7 +63,7 @@ scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "case-insensitive", 0, "Convert symbols to lower case."}, { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), - "Style of keyword recognition: #f, 'prefix or 'postfix."}, + "Style of keyword recognition: #f, 'prefix or 'postfix."} #if SCM_ENABLE_ELISP { SCM_OPTION_BOOLEAN, "elisp-vectors", 0, "Support Elisp vector syntax, namely `[...]'."}, From 904fabb6020baeef5c8c7cd313c759912cc918e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 15 Apr 2008 20:14:44 +0200 Subject: [PATCH 06/87] Revert "Fix typo in `read.c'." This reverts commit 6ddb3ca825b1ee8b746eb688e98aa3b37ab55c3e. --- libguile/read.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/read.c b/libguile/read.c index 54b3e7d2f..5a448b7f8 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -63,7 +63,7 @@ scm_t_option scm_read_opts[] = { { SCM_OPTION_BOOLEAN, "case-insensitive", 0, "Convert symbols to lower case."}, { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), - "Style of keyword recognition: #f, 'prefix or 'postfix."} + "Style of keyword recognition: #f, 'prefix or 'postfix."}, #if SCM_ENABLE_ELISP { SCM_OPTION_BOOLEAN, "elisp-vectors", 0, "Support Elisp vector syntax, namely `[...]'."}, From b1860cb3429e8b4f71d414e79c89400f18dff569 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Mon, 14 Apr 2008 19:40:02 +0100 Subject: [PATCH 07/87] * gds-client.scm (gds-debug-trap): Ensure that frame index passed to Emacs is always positive. --- ice-9/ChangeLog | 5 +++++ ice-9/gds-client.scm | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index e96d7d306..a399dc69b 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2008-04-14 Neil Jerram + + * gds-client.scm (gds-debug-trap): Ensure that frame index passed + to Emacs is always positive. + 2008-03-19 Neil Jerram * debugging/ice-9-debugger-extensions.scm (command-loop): Use diff --git a/ice-9/gds-client.scm b/ice-9/gds-client.scm index 7e6e524e5..903e803e5 100755 --- a/ice-9/gds-client.scm +++ b/ice-9/gds-client.scm @@ -73,7 +73,9 @@ (slot-ref (car fired-traps) 'depth))))) ;; Write current stack to the frontend. (write-form (list 'stack - (or special-index 0) + (if (and special-index (> special-index 0)) + special-index + 0) (stack->emacs-readable stack) (append (flags->emacs-readable flags) (slot-ref trap-context From ee9e3a93f7c67f94d8cc7a748861cb7880fdaab2 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Mon, 14 Apr 2008 21:25:17 +0100 Subject: [PATCH 08/87] A few elisp fixes and enhancements --- lang/elisp/ChangeLog | 9 +++++++++ lang/elisp/internals/load.scm | 5 ++--- lang/elisp/primitives/strings.scm | 6 ++++++ lang/elisp/primitives/symprop.scm | 2 +- 4 files changed, 18 insertions(+), 4 deletions(-) diff --git a/lang/elisp/ChangeLog b/lang/elisp/ChangeLog index 1114618d0..a2c3bc84b 100644 --- a/lang/elisp/ChangeLog +++ b/lang/elisp/ChangeLog @@ -1,3 +1,12 @@ +2008-04-14 Neil Jerram + + * primitives/symprop.scm (get): Use lambda->nil. + + * primitives/strings.scm (aset): New primitive. + + * internals/load.scm (load): Use in-vicinity (instead of + string-append) to add a slash if needed. + 2004-02-08 Mikael Djurfeldt * primitives/Makefile.am (TAGS_FILES), internals/Makefile.am diff --git a/lang/elisp/internals/load.scm b/lang/elisp/internals/load.scm index e55c8b50f..2b6cac36f 100644 --- a/lang/elisp/internals/load.scm +++ b/lang/elisp/internals/load.scm @@ -15,9 +15,8 @@ '("") load-path))) (cond ((null? dirs) #f) - ((file-exists? (string-append (car dirs) - filename)) - (string-append (car dirs) filename)) + ((file-exists? (in-vicinity (car dirs) filename)) + (in-vicinity (car dirs) filename)) (else (loop (cdr dirs))))))) (if pathname (begin diff --git a/lang/elisp/primitives/strings.scm b/lang/elisp/primitives/strings.scm index 85a1c10a9..85e462f8b 100644 --- a/lang/elisp/primitives/strings.scm +++ b/lang/elisp/primitives/strings.scm @@ -29,6 +29,12 @@ ((string? array) (char->integer (string-ref array idx))) (else (wta 'arrayp array 1))))) +(fset 'aset + (lambda (array idx newelt) + (cond ((vector? array) (vector-set! array idx newelt)) + ((string? array) (string-set! array idx (integer->char newelt))) + (else (wta 'arrayp array 1))))) + (fset 'stringp (lambda->nil string?)) (fset 'vector vector) diff --git a/lang/elisp/primitives/symprop.scm b/lang/elisp/primitives/symprop.scm index a520a4b81..8f10fd8cd 100644 --- a/lang/elisp/primitives/symprop.scm +++ b/lang/elisp/primitives/symprop.scm @@ -9,7 +9,7 @@ (fset 'put set-symbol-property!) -(fset 'get symbol-property) +(fset 'get (lambda->nil symbol-property)) (fset 'set set) From f0c88df7de9dee90e7718fb5d47f23cefd182657 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 15 Apr 2008 23:52:58 +0100 Subject: [PATCH 09/87] Add TAGS to .gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 83835ca98..fde53928d 100644 --- a/.gitignore +++ b/.gitignore @@ -68,3 +68,4 @@ guile-procedures.txt guile-config/guile-config guile-readline/guile-readline-config.h guile-readline/guile-readline-config.h.in +TAGS From c4d088f54cd7827c9678d5f043b325a4e343eacf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 16 Apr 2008 09:01:33 +0200 Subject: [PATCH 10/87] Don't use "echo -n" in `guile-readline/configure.in'. --- guile-readline/ChangeLog | 6 ++++++ guile-readline/configure.in | 7 ++++++- 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index 3163b5f18..f8d393f16 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,9 @@ +2008-04-16 Ludovic Courtès + + * configure.in (AC_INIT): Don't use "echo -n", which is not + available on MacOS X; use `patsubst' instead to remove the + newline. Reported by Steven Wu . + 2008-02-16 Ludovic Courtès * LIBGUILEREADLINE-VERSION diff --git a/guile-readline/configure.in b/guile-readline/configure.in index d0fda02a1..9098a31e6 100644 --- a/guile-readline/configure.in +++ b/guile-readline/configure.in @@ -1,7 +1,12 @@ AC_PREREQ(2.50) +dnl Don't use "echo -n", which is not portable (e.g., not available on +dnl MacOS X). Instead, use `patsubst' to remove the newline. AC_INIT(guile-readline, - m4_esyscmd(. ../GUILE-VERSION && echo -n ${GUILE_VERSION})) + patsubst(m4_esyscmd(. ../GUILE-VERSION && echo ${GUILE_VERSION}), [ +]), + [bug-guile@gnu.org]) + AC_CONFIG_AUX_DIR([.]) AC_CONFIG_SRCDIR(readline.c) AM_CONFIG_HEADER([guile-readline-config.h]) From f5c2af4be0d2b5deefe489e093a9bafc77f69b33 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 14 Apr 2008 18:09:49 +0200 Subject: [PATCH 11/87] Inline `scm_getc', `scm_putc' and `scm_puts'. --- NEWS | 1 + libguile/ChangeLog | 5 +++ libguile/inline.h | 86 +++++++++++++++++++++++++++++++++++++++++++--- libguile/ports.c | 60 +------------------------------- libguile/ports.h | 5 +-- 5 files changed, 89 insertions(+), 68 deletions(-) diff --git a/NEWS b/NEWS index cc2fc3666..59c870115 100644 --- a/NEWS +++ b/NEWS @@ -49,6 +49,7 @@ http://git.sv.gnu.org/gitweb/?p=guile.git . See `README' for details. * New features (see the manual for details) ** New `postfix' read option, for SRFI-88 keyword syntax +** Some I/O primitives have been inlined, which improves I/O performance * Bugs fixed diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 8ca09bde1..ee9dd37d7 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2008-04-16 Ludovic Courtès + + * ports.c (scm_getc, scm_putc, scm_puts): Moved... + * inline.h: ... here. Noticeably improves `read' performance. + 2008-04-15 Ludovic Courtès Julian Graham diff --git a/libguile/inline.h b/libguile/inline.h index 8a6635ee1..8fa9a8cfb 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -25,17 +25,17 @@ "inline.c". */ -#include "libguile/__scm.h" - -#if (SCM_DEBUG_CELL_ACCESSES == 1) #include -#endif +#include + +#include "libguile/__scm.h" #include "libguile/pairs.h" #include "libguile/gc.h" #include "libguile/threads.h" #include "libguile/unif.h" -#include "libguile/pairs.h" +#include "libguile/ports.h" +#include "libguile/error.h" #ifndef SCM_INLINE_C_INCLUDING_INLINE_H @@ -85,6 +85,10 @@ SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val); SCM_API int scm_is_pair (SCM x); +SCM_API int scm_getc (SCM port); +SCM_API void scm_putc (char c, SCM port); +SCM_API void scm_puts (const char *str_data, SCM port); + #endif @@ -285,5 +289,77 @@ scm_is_pair (SCM x) return SCM_I_CONSP (x); } + +/* Port I/O. */ + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +int +scm_getc (SCM port) +{ + int c; + scm_t_port *pt = SCM_PTAB_ENTRY (port); + + if (pt->rw_active == SCM_PORT_WRITE) + /* may be marginally faster than calling scm_flush. */ + scm_ptobs[SCM_PTOBNUM (port)].flush (port); + + if (pt->rw_random) + pt->rw_active = SCM_PORT_READ; + + if (pt->read_pos >= pt->read_end) + { + if (scm_fill_input (port) == EOF) + return EOF; + } + + c = *(pt->read_pos++); + + switch (c) + { + case '\a': + break; + case '\b': + SCM_DECCOL (port); + break; + case '\n': + SCM_INCLINE (port); + break; + case '\r': + SCM_ZEROCOL (port); + break; + case '\t': + SCM_TABCOL (port); + break; + default: + SCM_INCCOL (port); + break; + } + + return c; +} + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +void +scm_putc (char c, SCM port) +{ + SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); + scm_lfwrite (&c, 1, port); +} + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +void +scm_puts (const char *s, SCM port) +{ + SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); + scm_lfwrite (s, strlen (s), port); +} + + #endif #endif diff --git a/libguile/ports.c b/libguile/ports.c index c4ccca3e2..b25a7d007 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008 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 @@ -960,64 +960,6 @@ scm_fill_input (SCM port) return scm_ptobs[SCM_PTOBNUM (port)].fill_input (port); } -int -scm_getc (SCM port) -{ - int c; - scm_t_port *pt = SCM_PTAB_ENTRY (port); - - if (pt->rw_active == SCM_PORT_WRITE) - /* may be marginally faster than calling scm_flush. */ - scm_ptobs[SCM_PTOBNUM (port)].flush (port); - - if (pt->rw_random) - pt->rw_active = SCM_PORT_READ; - - if (pt->read_pos >= pt->read_end) - { - if (scm_fill_input (port) == EOF) - return EOF; - } - - c = *(pt->read_pos++); - - switch (c) - { - case '\a': - break; - case '\b': - SCM_DECCOL (port); - break; - case '\n': - SCM_INCLINE (port); - break; - case '\r': - SCM_ZEROCOL (port); - break; - case '\t': - SCM_TABCOL (port); - break; - default: - SCM_INCCOL (port); - break; - } - - return c; -} - -void -scm_putc (char c, SCM port) -{ - SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); - scm_lfwrite (&c, 1, port); -} - -void -scm_puts (const char *s, SCM port) -{ - SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); - scm_lfwrite (s, strlen (s), port); -} /* scm_lfwrite * diff --git a/libguile/ports.h b/libguile/ports.h index b93135e6f..fb0ef4eee 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -3,7 +3,7 @@ #ifndef SCM_PORTS_H #define SCM_PORTS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2008 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 @@ -264,15 +264,12 @@ SCM_API SCM scm_eof_object_p (SCM x); SCM_API SCM scm_force_output (SCM port); SCM_API SCM scm_flush_all_ports (void); SCM_API SCM scm_read_char (SCM port); -SCM_API void scm_putc (char c, SCM port); -SCM_API void scm_puts (const char *str_data, SCM port); SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size); SCM_API void scm_c_write (SCM port, const void *buffer, size_t size); SCM_API void scm_lfwrite (const char *ptr, size_t size, SCM port); SCM_API void scm_flush (SCM port); SCM_API void scm_end_input (SCM port); SCM_API int scm_fill_input (SCM port); -SCM_API int scm_getc (SCM port); SCM_API void scm_ungetc (int c, SCM port); SCM_API void scm_ungets (const char *s, int n, SCM port); SCM_API SCM scm_peek_char (SCM port); From be10cba84b4ab85a89cb8e4f30281d40820b4f5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 16 Apr 2008 12:00:49 +0200 Subject: [PATCH 12/87] Update `NEWS'. --- NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS b/NEWS index 59c870115..e6f845478 100644 --- a/NEWS +++ b/NEWS @@ -68,6 +68,7 @@ lead to a stack overflow. ** Fixed type-checking for the second argument of `eval' ** Fixed `struct-ref' and `struct-set!' on "light structs" ** Honor struct field access rights in GOOPS +** Changed the storage strategy of source properties, which fixes a deadlock ** Allow compilation of Guile-using programs in C99 mode with GCC 4.3 and later ** Fixed build issue for GNU/Linux on IA64 ** Fixed build issues on NetBSD 1.6 From 6bb1dc98b9faecfc9943b724f5f99e3e0aa39340 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 17 Apr 2008 10:04:09 +0200 Subject: [PATCH 13/87] Add `read' benchmark. --- benchmark-suite/ChangeLog | 5 +++ benchmark-suite/Makefile.am | 9 +++-- benchmark-suite/benchmarks/read.bm | 62 ++++++++++++++++++++++++++++++ 3 files changed, 72 insertions(+), 4 deletions(-) create mode 100644 benchmark-suite/benchmarks/read.bm diff --git a/benchmark-suite/ChangeLog b/benchmark-suite/ChangeLog index f4356a9c3..fcfedc2de 100644 --- a/benchmark-suite/ChangeLog +++ b/benchmark-suite/ChangeLog @@ -1,3 +1,8 @@ +2008-04-17 Ludovic Courtès + + * Makefile.am (SCM_BENCHMARKS): Add `benchmarks/read.bm'. + * benchmarks/read.bm: New file. + 2008-01-22 Neil Jerram * COPYING: Removed. diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am index 464150a5c..a8f471996 100644 --- a/benchmark-suite/Makefile.am +++ b/benchmark-suite/Makefile.am @@ -1,6 +1,7 @@ -SCM_BENCHMARKS = benchmarks/0-reference.bm \ - benchmarks/continuations.bm \ - benchmarks/if.bm \ - benchmarks/logand.bm +SCM_BENCHMARKS = benchmarks/0-reference.bm \ + benchmarks/continuations.bm \ + benchmarks/if.bm \ + benchmarks/logand.bm \ + benchmarks/read.bm EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) diff --git a/benchmark-suite/benchmarks/read.bm b/benchmark-suite/benchmarks/read.bm new file mode 100644 index 000000000..cb876b5ad --- /dev/null +++ b/benchmark-suite/benchmarks/read.bm @@ -0,0 +1,62 @@ +;;; read.bm --- Exercise the reader. -*- Scheme -*- +;;; +;;; Copyright (C) 2008 Free Software Foundation, Inc. +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2, or (at your option) +;;; any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this software; see the file COPYING. If not, write to +;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;; Boston, MA 02110-1301 USA + +(define-module (benchmarks read) + :use-module (benchmark-suite lib)) + + +(define %files-to-load + ;; Various large Scheme files. + (map %search-load-path + '("ice-9/boot-9.scm" "ice-9/common-list.scm" + "ice-9/format.scm" "ice-9/optargs.scm" + "ice-9/session.scm" "ice-9/getopt-long.scm" + "ice-9/psyntax.pp"))) + +(define (load-file-with-reader file-name reader buffering) + (with-input-from-file file-name + (lambda () + (apply setvbuf (current-input-port) buffering) + (let loop ((sexp (reader))) + (if (eof-object? sexp) + #t + (loop (reader))))))) + +(define (exercise-read buffering) + (for-each (lambda (file) + (load-file-with-reader file read buffering)) + %files-to-load)) + + +(with-benchmark-prefix "read" + + (benchmark "_IONBF" 5 ;; this one is very slow + (exercise-read (list _IONBF))) + + (benchmark "_IOLBF" 100 + (exercise-read (list _IOLBF))) + + (benchmark "_IOFBF 4096" 100 + (exercise-read (list _IOFBF 4096))) + + (benchmark "_IOFBF 8192" 100 + (exercise-read (list _IOFBF 8192))) + + (benchmark "_IOFBF 16384" 100 + (exercise-read (list _IOFBF 16384)))) From 839e63263cbd494ef5368448c46b3134c7f3c6a5 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 17 Apr 2008 21:36:20 +0100 Subject: [PATCH 14/87] Document file-exists? --- doc/ref/ChangeLog | 4 ++++ doc/ref/posix.texi | 5 +++++ 2 files changed, 9 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 1847fc507..a3f4398d6 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,7 @@ +2008-04-17 Neil Jerram + + * posix.texi (File System): New doc for file-exists?. + 2008-04-15 Ludovic Courtès * api-data.texi (Keywords): Mention postfix syntax. diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index f81abbc6b..34194fb19 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -956,6 +956,11 @@ If @var{suffix} is provided, and is equal to the end of @end lisp @end deffn +@deffn {Scheme Procedure} file-exists? filename +Return @code{#t} if the file named @var{filename} exists, @code{#f} if +not. +@end deffn + @node User Information @subsection User Information From 535b3592b24693a0d24b7c7fd4702d3c405bf3d6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 24 Apr 2008 19:25:30 +0200 Subject: [PATCH 15/87] Don't use "-I$(srcdir)", so that our "random.h" doesn't shadow libc's on Tru64. --- NEWS | 1 + libguile/ChangeLog | 9 +++++++++ libguile/Makefile.am | 10 ++++++++-- libguile/gen-scmconfig.c | 2 +- 4 files changed, 19 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index e6f845478..6cce9d27e 100644 --- a/NEWS +++ b/NEWS @@ -76,6 +76,7 @@ lead to a stack overflow. ** Fixed build issue with DEC/Compaq/HP's compiler ** Fixed `scm_from_complex_double' build issue on FreeBSD ** Fixed `alloca' build issue on FreeBSD 6 +** Fixed shadowing of libc's on Tru64, which broke compilation ** Make sure all tests honor `$TMPDIR' * Changes to the distribution diff --git a/libguile/ChangeLog b/libguile/ChangeLog index ee9dd37d7..a68a03dab 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,12 @@ +2008-04-24 Ludovic Courtès + + * Makefile.am (DEFAULT_INCLUDES): New. Fixes compilation on + Tru64 where our "random.h" would shadown libc's one. + (INCLUDES): Add "-I$(top_buildir)", which is normally in + `DEFAULT_INCLUDES'. + * gen-scmconfig.c: Include , not + "gen-scmconfig.h" since that file is under `$(builddir)'. + 2008-04-16 Ludovic Courtès * ports.c (scm_getc, scm_putc, scm_puts): Moved... diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 3444f5d70..487b8b274 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -23,10 +23,16 @@ AUTOMAKE_OPTIONS = gnu ## Prevent automake from adding extra -I options DEFS = @DEFS@ + +# Override Automake's `DEFAULT_INCLUDES'. By default, it contains +# "-I$(srcdir)", which causes problems on Tru64 where our "random.h" +# is picked up by instead of the libc's . +DEFAULT_INCLUDES = + ## Check for headers in $(srcdir)/.., so that #include ## will find MUMBLE.h in this dir when we're ## building. Also look for Gnulib headers in `lib'. -INCLUDES = -I.. -I$(top_srcdir) \ +INCLUDES = -I$(top_srcdir) -I$(top_builddir) \ -I$(top_srcdir)/lib -I$(top_builddir)/lib ## The Gnulib Libtool archive. diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c index 6afa72fcc..788b45144 100644 --- a/libguile/gen-scmconfig.c +++ b/libguile/gen-scmconfig.c @@ -121,7 +121,7 @@ # include #endif -#include "gen-scmconfig.h" +#include #include #include From 1afb97c4643163efdeb9cde28533132d823ac516 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 26 Apr 2008 19:27:55 +0200 Subject: [PATCH 16/87] Fix dangling references to files that have been removed. --- ChangeLog | 4 ++++ Makefile.am | 6 ++---- doc/ChangeLog | 4 ++++ doc/Makefile.am | 4 ++-- 4 files changed, 12 insertions(+), 6 deletions(-) diff --git a/ChangeLog b/ChangeLog index 40c0f6fdb..12649dc9f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2008-04-26 Ludovic Courtès + + * Makefile.am (EXTRA_DIST): Remove `ANON-CVS' and `SNAPSHOTS'. + 2008-02-23 Neil Jerram * FAQ: New file. diff --git a/Makefile.am b/Makefile.am index 6f927654b..14140f093 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, 2007, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -31,9 +31,7 @@ bin_SCRIPTS = guile-tools include_HEADERS = libguile.h -# automake sometimes forgets to distribute acconfig.h, -# apparently depending on the phase of the moon. -EXTRA_DIST = LICENSE HACKING GUILE-VERSION ANON-CVS SNAPSHOTS \ +EXTRA_DIST = LICENSE HACKING GUILE-VERSION \ m4/ChangeLog FAQ TESTS = check-guile diff --git a/doc/ChangeLog b/doc/ChangeLog index 4e07bcbb2..4153ad873 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,3 +1,7 @@ +2008-04-26 Ludovic Courtès + + * Makefile.am (EXAMPLE_SMOB_FILES): Remove `COPYING'. + 2008-01-22 Neil Jerram * COPYING: Removed. diff --git a/doc/Makefile.am b/doc/Makefile.am index a9a072225..5a850fc51 100644 --- a/doc/Makefile.am +++ b/doc/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 2002, 2006 Free Software Foundation, Inc. +## Copyright (C) 1998, 2002, 2006, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -27,7 +27,7 @@ SUBDIRS = ref tutorial goops r5rs # man_MANS = guile.1 EXAMPLE_SMOB_FILES = \ - ChangeLog Makefile README COPYING image-type.c image-type.h myguile.c + ChangeLog Makefile README image-type.c image-type.h myguile.c OLDFMT = oldfmt.c From 189681f55b464888b47b1e798bc20e3f984eb6ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 26 Apr 2008 19:34:37 +0200 Subject: [PATCH 17/87] Add `(srfi srfi-88)'. --- NEWS | 4 +++ doc/ref/ChangeLog | 6 ++++ doc/ref/api-data.texi | 5 ++- doc/ref/srfi-modules.texi | 53 ++++++++++++++++++++++++++++++- srfi/ChangeLog | 5 +++ srfi/Makefile.am | 5 +-- srfi/srfi-88.scm | 50 +++++++++++++++++++++++++++++ test-suite/ChangeLog | 5 +++ test-suite/Makefile.am | 3 +- test-suite/tests/srfi-88.test | 59 +++++++++++++++++++++++++++++++++++ 10 files changed, 188 insertions(+), 7 deletions(-) create mode 100644 srfi/srfi-88.scm create mode 100644 test-suite/tests/srfi-88.test diff --git a/NEWS b/NEWS index 6cce9d27e..5cd1b74c5 100644 --- a/NEWS +++ b/NEWS @@ -46,6 +46,10 @@ The new repository can be accessed using "git-clone git://git.sv.gnu.org/guile.git", or can be browsed on-line at http://git.sv.gnu.org/gitweb/?p=guile.git . See `README' for details. +* New modules (see the manual for details) + +** `(srfi srfi-88)' + * New features (see the manual for details) ** New `postfix' read option, for SRFI-88 keyword syntax diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index a3f4398d6..342285aee 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2008-04-26 Ludovic Courtès + + * srfi-modules.texi (SRFI-88): New section. + * api-data.texi (Keyword Read Syntax): Add reference to + `SRFI-88'. + 2008-04-17 Neil Jerram * posix.texi (File System): New doc for file-exists?. diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 1eeee8563..b2b5b076f 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -5049,9 +5049,8 @@ of the form @code{:NAME} are read as symbols, as required by R5RS. @cindex SRFI-88 keyword syntax If the @code{keyword} read option is set to @code{'postfix}, Guile -recognizes the @uref{http://srfi.schemers.org/srfi-88/srfi-88.html, -SRFI-88 read syntax} @code{NAME:}. Otherwise, tokens of this form are -read as symbols. +recognizes the SRFI-88 read syntax @code{NAME:} (@pxref{SRFI-88}). +Otherwise, tokens of this form are read as symbols. To enable and disable the alternative non-R5RS keyword syntax, you use the @code{read-set!} procedure documented in @ref{User level options diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 07e4b7c3f..ba8966d82 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007, 2008 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -45,6 +45,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-60:: Integers as bits. * SRFI-61:: A more general `cond' clause * SRFI-69:: Basic hash tables. +* SRFI-88:: Keyword objects. @end menu @@ -3216,6 +3217,56 @@ Answer a hash value appropriate for equality predicate @code{equal?}, @code{hash} is a backwards-compatible replacement for Guile's built-in @code{hash}. +@node SRFI-88 +@subsection SRFI-88 Keyword Objects +@cindex SRFI-88 +@cindex keyword objects + +@uref{http://srfi.schemers.org/srfi/srfi-88.html, SRFI-88} provides +@dfn{keyword objects}, which are equivalent to Guile's keywords +(@pxref{Keywords}). SRFI-88 keywords can be entered using the +@dfn{postfix keyword syntax}, which consists of an identifier followed +by @code{:} (@pxref{Reader options, @code{postfix} keyword syntax}). +SRFI-88 can be made available with: + +@example +(use-modules (srfi srfi-88)) +@end example + +Doing so installs the right reader option for keyword syntax, using +@code{(read-set! keywords 'postfix)}. It also provides the procedures +described below. + +@deffn {Scheme Procedure} keyword? obj +Return @code{#t} if @var{obj} is a keyword. This is the same procedure +as the same-named built-in procedure (@pxref{Keyword Procedures, +@code{keyword?}}). + +@example +(keyword? foo:) @result{} #t +(keyword? 'foo:) @result{} #t +(keyword? "foo") @result{} #f +@end example +@end deffn + +@deffn {Scheme Procedure} keyword->string kw +Return the name of @var{kw} as a string, i.e., without the trailing +colon. The returned string may not be modified, e.g., with +@code{string-set!}. + +@example +(keyword->string foo:) @result{} "foo" +@end example +@end deffn + +@deffn {Scheme Procedure} string->keyword str +Return the keyword object whose name is @var{str}. + +@example +(keyword->string (string->keyword "a b c")) @result{} "a b c" +@end example +@end deffn + @c srfi-modules.texi ends here diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 338942562..f431f6eca 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,8 @@ +2008-04-26 Ludovic Courtès + + * Makefile.am (srfi_DATA): Add `srfi-88.scm'. + * srfi-88.scm: New file. + 2008-03-12 Ludovic Courtès * srfi-37.scm (args-fold)[short-option]: Set ARGS to `(cdr diff --git a/srfi/Makefile.am b/srfi/Makefile.am index 7a2b89126..34c6ffb71 100644 --- a/srfi/Makefile.am +++ b/srfi/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 2001, 2002, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +## Copyright (C) 2001, 2002, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -83,7 +83,8 @@ srfi_DATA = srfi-1.scm \ srfi-37.scm \ srfi-39.scm \ srfi-60.scm \ - srfi-69.scm + srfi-69.scm \ + srfi-88.scm EXTRA_DIST = $(srfi_DATA) TAGS_FILES = $(srfi_DATA) diff --git a/srfi/srfi-88.scm b/srfi/srfi-88.scm new file mode 100644 index 000000000..ebde81d0b --- /dev/null +++ b/srfi/srfi-88.scm @@ -0,0 +1,50 @@ +;;; srfi-88.scm --- Keyword Objects + +;; Copyright (C) 2008 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 as published by the Free Software Foundation; either +;; version 2.1 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Author: Ludovic Courtès + +;;; Commentary: + +;; This is a convenience module providing SRFI-88 "keyword object". All it +;; does is setup the right reader option and export keyword-related +;; convenience procedures. + +;;; Code: + +(define-module (srfi srfi-88) + #:re-export (keyword?) + #:export (keyword->string string->keyword)) + +(cond-expand-provide (current-module) '(srfi-88)) + + +(read-set! keywords 'postfix) + +(define (keyword->string k) + "Return the name of @var{k} as a string." + (symbol->string (keyword->symbol k))) + +(define (string->keyword s) + "Return the keyword object whose name is @var{s}." + (symbol->keyword (string->symbol s))) + +;;; Local Variables: +;;; coding: latin-1 +;;; End: + +;;; srfi-88.scm ends here diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 7030be780..3c8987c1e 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2008-04-26 Ludovic Courtès + + * Makefile.am (SCM_TESTS): Add `tests/srfi-88.test'. + * tests/srfi-88.test: New file. + 2008-04-15 Ludovic Courtès * tests/reader.test (read-options)[prefix non-keywords, postfix diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am index 035f6c906..4a9380849 100644 --- a/test-suite/Makefile.am +++ b/test-suite/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with automake to produce Makefile.in. ## -## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007 Software Foundation, Inc. +## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -81,6 +81,7 @@ SCM_TESTS = tests/alist.test \ tests/srfi-39.test \ tests/srfi-60.test \ tests/srfi-69.test \ + tests/srfi-88.test \ tests/srfi-4.test \ tests/srfi-9.test \ tests/strings.test \ diff --git a/test-suite/tests/srfi-88.test b/test-suite/tests/srfi-88.test new file mode 100644 index 000000000..63f40cc40 --- /dev/null +++ b/test-suite/tests/srfi-88.test @@ -0,0 +1,59 @@ +;;;; srfi-88.test --- Test suite for SRFI-88 -*- Scheme -*- +;;;; Ludovic Courtès +;;;; +;;;; Copyright (C) 2008 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;;; Boston, MA 02110-1301 USA + +(define-module (test-srfi-88) + :use-module (test-suite lib) + :use-module (srfi srfi-88)) + + +;; Most of the test cases are taken from SRFI-88. + +(with-test-prefix "srfi-88" + + (pass-if "cond-expand" + (cond-expand (srfi-88 #t) + (else #f))) + + (pass-if "keyword?" + (and (keyword? 'foo:) + (keyword? foo:) + (not (keyword? 'foo)) + (not (keyword? ':)) + (keyword? (car '(a: b:))) + (not (keyword? "bar")))) + + (pass-if "keyword->string" + (and (string=? (keyword->string foo:) "foo") + (string=? "a b c" + (keyword->string (string->keyword "a b c"))))) + + (pass-if "string->keyword" + (eq? (string->keyword "foo") foo:)) + + (pass-if "empty keyword" + ;; XXX: We don't currently support syntax of the form + ;; `#{extended symbol}#:'. + (string=? "" + (keyword->string (string->keyword ""))))) + + +;;; Local Variables: +;;; coding: latin-1 +;;; End: From 816e3edf152f8c4d8a219e0bf24daa908c710adf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 26 Apr 2008 21:09:40 +0200 Subject: [PATCH 18/87] Make `(srfi srfi-35)' visible through `cond-expand'. --- NEWS | 1 + srfi/ChangeLog | 4 ++++ srfi/srfi-35.scm | 4 +++- test-suite/ChangeLog | 4 ++++ test-suite/tests/srfi-35.test | 12 +++++++++++- 5 files changed, 23 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index 5cd1b74c5..f45d0aefe 100644 --- a/NEWS +++ b/NEWS @@ -69,6 +69,7 @@ would trigger an unbound variable error for `match:andmap'. Previously, parsing short option names of argument-less options would lead to a stack overflow. +** `(srfi srfi-35)' is now visible through `cond-expand' ** Fixed type-checking for the second argument of `eval' ** Fixed `struct-ref' and `struct-set!' on "light structs" ** Honor struct field access rights in GOOPS diff --git a/srfi/ChangeLog b/srfi/ChangeLog index f431f6eca..d93ac8232 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,7 @@ +2008-04-26 Ludovic Courtès + + * srfi-35.scm: Provide `srfi-35' through `cond-expand-provide'. + 2008-04-26 Ludovic Courtès * Makefile.am (srfi_DATA): Add `srfi-88.scm'. diff --git a/srfi/srfi-35.scm b/srfi/srfi-35.scm index c9e25ce12..203546625 100644 --- a/srfi/srfi-35.scm +++ b/srfi/srfi-35.scm @@ -1,6 +1,6 @@ ;;; srfi-35.scm --- Conditions -;; Copyright (C) 2007 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008 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 @@ -37,6 +37,8 @@ &serious serious-condition? &error error?)) +(cond-expand-provide (current-module) '(srfi-35)) + ;;; ;;; Condition types. diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 3c8987c1e..f3c075c4d 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2008-04-26 Ludovic Courtès + + * tests/srfi-35.test (cond-expand): New test. + 2008-04-26 Ludovic Courtès * Makefile.am (SCM_TESTS): Add `tests/srfi-88.test'. diff --git a/test-suite/tests/srfi-35.test b/test-suite/tests/srfi-35.test index ec7a104c3..83efd61d9 100644 --- a/test-suite/tests/srfi-35.test +++ b/test-suite/tests/srfi-35.test @@ -1,7 +1,7 @@ ;;;; srfi-35.test --- Test suite for SRFI-35 -*- Scheme -*- ;;;; Ludovic Courtès ;;;; -;;;; Copyright (C) 2007 Free Software Foundation, Inc. +;;;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -22,6 +22,12 @@ :use-module (test-suite lib) :use-module (srfi srfi-35)) + +(with-test-prefix "cond-expand" + (pass-if "srfi-35" + (cond-expand (srfi-35 #t) + (else #f)))) + (with-test-prefix "condition types" (pass-if "&condition" @@ -308,3 +314,7 @@ (pass-if "(c2-b v5)" (equal? (c2-b v5) "b2"))) + +;;; Local Variables: +;;; coding: latin-1 +;;; End: From bd22f1c768e2d5c7ec6264b8c68cc56019daccf4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 26 Apr 2008 21:39:27 +0200 Subject: [PATCH 19/87] Remove extraneous semi-colon in `read.c'. --- libguile/ChangeLog | 6 ++++++ libguile/read.c | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index a68a03dab..d35b1b6a8 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2008-04-26 Ludovic Courtès + + * read.c (scm_read_sexp): Remove extraneous semi-colon at + end-of-line, which broke compilation with GCC 2.7. Reported by + Alain Guibert . + 2008-04-24 Ludovic Courtès * Makefile.am (DEFAULT_INCLUDES): New. Fixes compilation on diff --git a/libguile/read.c b/libguile/read.c index 5a448b7f8..47b80041e 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -292,7 +292,7 @@ scm_read_sexp (int chr, SCM port) register int c; register SCM tmp; register SCM tl, ans = SCM_EOL; - SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F;; + SCM tl2 = SCM_EOL, ans2 = SCM_EOL, copy = SCM_BOOL_F; static const int terminating_char = ')'; /* Need to capture line and column numbers here. */ From 56ae2148173f0b9a8fe8bb82530113f99f1f364d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 26 Apr 2008 21:55:29 +0200 Subject: [PATCH 20/87] Only run `test-with-guile-module' when pthread support is built. --- ChangeLog | 5 +++++ configure.in | 7 +++++++ test-suite/ChangeLog | 6 ++++++ test-suite/standalone/Makefile.am | 11 ++++++++++- 4 files changed, 28 insertions(+), 1 deletion(-) diff --git a/ChangeLog b/ChangeLog index 12649dc9f..598fb177f 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2008-04-26 Ludovic Courtès + + * configure.in (BUILD_PTHREAD_SUPPORT): New Automake + conditional. + 2008-04-26 Ludovic Courtès * Makefile.am (EXTRA_DIST): Remove `ANON-CVS' and `SNAPSHOTS'. diff --git a/configure.in b/configure.in index 193d6a6c2..fcfe2bf79 100644 --- a/configure.in +++ b/configure.in @@ -1166,6 +1166,9 @@ AC_SUBST(SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER, 0) case "$with_threads" in "yes" | "pthread" | "pthreads" | "pthread-threads" | "") + + build_pthread_support="yes" + ACX_PTHREAD(CC="$PTHREAD_CC" LIBS="$PTHREAD_LIBS $LIBS" SCM_I_GSC_USE_PTHREAD_THREADS=1 @@ -1245,6 +1248,10 @@ esac AC_MSG_CHECKING(what kind of threads to support) AC_MSG_RESULT($with_threads) +AM_CONDITIONAL([BUILD_PTHREAD_SUPPORT], + [test "x$build_pthread_support" = "xyes"]) + + ## Check whether pthread_attr_getstack works for the main thread if test "$with_threads" = pthreads; then diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index f3c075c4d..fa0fb7821 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2008-04-26 Ludovic Courtès + + * standalone/Makefile.am (TESTS): Only add + `test-with-guile-module' when `BUILD_PTHREAD_SUPPORT' is true. + Reported by Alain Guibert . + 2008-04-26 Ludovic Courtès * tests/srfi-35.test (cond-expand): New test. diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index bafe0c711..ae68d5fe1 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -26,6 +26,7 @@ noinst_LTLIBRARIES = check_PROGRAMS = check_SCRIPTS = BUILT_SOURCES = +EXTRA_DIST = TESTS_ENVIRONMENT = "${top_builddir}/pre-inst-guile-env" @@ -113,13 +114,21 @@ TESTS += test-conversion check_SCRIPTS += test-use-srfi TESTS += test-use-srfi +if BUILD_PTHREAD_SUPPORT + # test-with-guile-module test_with_guile_module_CFLAGS = ${test_cflags} test_with_guile_module_LDADD = ${top_builddir}/libguile/libguile.la check_PROGRAMS += test-with-guile-module TESTS += test-with-guile-module +else + +EXTRA_DIST += test-with-guile-module.c + +endif + all-local: cd ${srcdir} && chmod u+x ${check_SCRIPTS} -EXTRA_DIST = ${check_SCRIPTS} +EXTRA_DIST += ${check_SCRIPTS} From a030cb4b16cf9c39fcd8c4ab3b6570d599cd993f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 27 Apr 2008 00:50:05 +0200 Subject: [PATCH 21/87] Include in SRFI-1. --- srfi/ChangeLog | 4 ++++ srfi/srfi-1.c | 6 +++++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/srfi/ChangeLog b/srfi/ChangeLog index d93ac8232..65ea3e982 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,7 @@ +2008-04-27 Ludovic Courtès + + * srfi-1.c: Include . + 2008-04-26 Ludovic Courtès * srfi-35.scm: Provide `srfi-35' through `cond-expand-provide'. diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index 8e27ab4e6..2989a25cf 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -1,6 +1,6 @@ /* srfi-1.c --- SRFI-1 procedures for Guile * - * Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006 + * Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2005, 2006, 2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -18,6 +18,10 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ +#if HAVE_CONFIG_H +# include +#endif + #include #include From 0fb11ae43259bfa3d07e2da97e644caaff65c477 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 28 Apr 2008 18:03:27 +0200 Subject: [PATCH 22/87] Fix type-checking of SRFI-1 `partition'. --- NEWS | 1 + srfi/ChangeLog | 5 +++++ srfi/srfi-1.c | 11 +++++++++-- test-suite/ChangeLog | 5 +++++ test-suite/tests/srfi-1.test | 14 +++++++++++--- 5 files changed, 31 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index f45d0aefe..ec3f37648 100644 --- a/NEWS +++ b/NEWS @@ -71,6 +71,7 @@ lead to a stack overflow. ** `(srfi srfi-35)' is now visible through `cond-expand' ** Fixed type-checking for the second argument of `eval' +** Fixed type-checking for SRFI-1 `partition' ** Fixed `struct-ref' and `struct-set!' on "light structs" ** Honor struct field access rights in GOOPS ** Changed the storage strategy of source properties, which fixes a deadlock diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 65ea3e982..1f6c599a8 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,8 @@ +2008-04-28 Ludovic Courtès + + * srfi-1.c (scm_srfi1_partition): Properly type-check LIST. + Reported by Julian Graham . + 2008-04-27 Ludovic Courtès * srfi-1.c: Include . diff --git a/srfi/srfi-1.c b/srfi/srfi-1.c index 2989a25cf..35815b32f 100644 --- a/srfi/srfi-1.c +++ b/srfi/srfi-1.c @@ -1667,6 +1667,7 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, /* In this implementation, the output lists don't share memory with list, because it's probably not worth the effort. */ scm_t_trampoline_1 call = scm_trampoline_1(pred); + SCM orig_list = list; SCM kept = scm_cons(SCM_EOL, SCM_EOL); SCM kept_tail = kept; SCM dropped = scm_cons(SCM_EOL, SCM_EOL); @@ -1675,8 +1676,14 @@ SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0, SCM_ASSERT(call, pred, 2, FUNC_NAME); for (; !SCM_NULL_OR_NIL_P (list); list = SCM_CDR(list)) { - SCM elt = SCM_CAR(list); - SCM new_tail = scm_cons(SCM_CAR(list), SCM_EOL); + SCM elt, new_tail; + + /* Make sure LIST is not a dotted list. */ + SCM_ASSERT (scm_is_pair (list), orig_list, SCM_ARG2, FUNC_NAME); + + elt = SCM_CAR (list); + new_tail = scm_cons (SCM_CAR (list), SCM_EOL); + if (scm_is_true (call (pred, elt))) { SCM_SETCDR(kept_tail, new_tail); kept_tail = new_tail; diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index fa0fb7821..c2dc5aaed 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2008-04-28 Ludovic Courtès + + * tests/srfi-1.test (partition)[with improper list]: New test. + (partition!)[with improper list]: New test. + 2008-04-26 Ludovic Courtès * standalone/Makefile.am (TESTS): Only add diff --git a/test-suite/tests/srfi-1.test b/test-suite/tests/srfi-1.test index 22c4a9a68..4f2838744 100644 --- a/test-suite/tests/srfi-1.test +++ b/test-suite/tests/srfi-1.test @@ -1,6 +1,6 @@ ;;;; srfi-1.test --- Test suite for Guile's SRFI-1 functions. -*- scheme -*- ;;;; -;;;; Copyright 2003, 2004, 2005, 2006 Free Software Foundation, Inc. +;;;; Copyright 2003, 2004, 2005, 2006, 2008 Free Software Foundation, Inc. ;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -2068,7 +2068,11 @@ (make-list 10000 1))) (lambda (even odd) (and (= (length odd) 10000) - (= (length even) 0)))))) + (= (length even) 0))))) + + (pass-if-exception "with improper list" + exception:wrong-type-arg + (partition symbol? '(a b . c)))) ;; ;; partition! @@ -2111,7 +2115,11 @@ (make-list 10000 1))) (lambda (even odd) (and (= (length odd) 10000) - (= (length even) 0)))))) + (= (length even) 0))))) + + (pass-if-exception "with improper list" + exception:wrong-type-arg + (partition! symbol? (cons* 'a 'b 'c)))) ;; ;; reduce From 92826dd0e28a8c7abe5a29f46fd8ed8dd0a3b3b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 4 May 2008 22:19:30 +0200 Subject: [PATCH 23/87] Add `pkg-config' support. --- .gitignore | 1 + ChangeLog | 6 ++++++ Makefile.am | 5 ++++- NEWS | 4 ++++ configure.in | 7 +++++++ doc/ref/ChangeLog | 6 ++++++ doc/ref/autoconf.texi | 41 ++++++++++++++++++++++++++++++++++++----- doc/ref/guile.texi | 4 ++++ guile-1.8.pc.in | 15 +++++++++++++++ 9 files changed, 83 insertions(+), 6 deletions(-) create mode 100644 guile-1.8.pc.in diff --git a/.gitignore b/.gitignore index fde53928d..a1221767f 100644 --- a/.gitignore +++ b/.gitignore @@ -69,3 +69,4 @@ guile-config/guile-config guile-readline/guile-readline-config.h guile-readline/guile-readline-config.h.in TAGS +guile-1.8.pc diff --git a/ChangeLog b/ChangeLog index 598fb177f..fc7dc9860 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2008-05-04 Ludovic Courtès + + * configure.in: Substitute `sitedir', produce `guile-1.8.pc'. + * Makefile.am (EXTRA_DIST): Add `guile-1.8.pc.in'. + (pkgconfigdir, pkgconfig_DATA): New. + 2008-04-26 Ludovic Courtès * configure.in (BUILD_PTHREAD_SUPPORT): New Automake diff --git a/Makefile.am b/Makefile.am index 14140f093..016255a6a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -32,7 +32,7 @@ bin_SCRIPTS = guile-tools include_HEADERS = libguile.h EXTRA_DIST = LICENSE HACKING GUILE-VERSION \ - m4/ChangeLog FAQ + m4/ChangeLog FAQ guile-1.8.pc.in TESTS = check-guile @@ -40,4 +40,7 @@ ACLOCAL_AMFLAGS = -I guile-config -I m4 DISTCLEANFILES = check-guile.log +pkgconfigdir = $(libdir)/pkgconfig +pkgconfig_DATA = guile-1.8.pc + # Makefile.am ends here diff --git a/NEWS b/NEWS index ec3f37648..55be683ad 100644 --- a/NEWS +++ b/NEWS @@ -46,6 +46,10 @@ The new repository can be accessed using "git-clone git://git.sv.gnu.org/guile.git", or can be browsed on-line at http://git.sv.gnu.org/gitweb/?p=guile.git . See `README' for details. +** Add support for `pkg-config' + +See "Autoconf Support" in the manual for details. + * New modules (see the manual for details) ** `(srfi srfi-88)' diff --git a/configure.in b/configure.in index fcfe2bf79..0afefad27 100644 --- a/configure.in +++ b/configure.in @@ -1430,6 +1430,12 @@ AC_SUBST(top_builddir_absolute) top_srcdir_absolute=`(cd $srcdir && pwd)` AC_SUBST(top_srcdir_absolute) +dnl We need `sitedir' in `guile-1.8.pc'. +dnl Note: `sitedir' must be kept in sync with `GUILE_SITE_DIR' in `guile.m4'. +pkgdatadir="$datadir/guile" +sitedir="$pkgdatadir/site" +AC_SUBST([sitedir]) + # Additional SCM_I_GSC definitions are above. AC_SUBST([SCM_I_GSC_GUILE_DEBUG]) AC_SUBST([SCM_I_GSC_GUILE_DEBUG_FREELIST]) @@ -1476,6 +1482,7 @@ AC_CONFIG_FILES([ test-suite/standalone/Makefile ]) +AC_CONFIG_FILES([guile-1.8.pc]) AC_CONFIG_FILES([check-guile], [chmod +x check-guile]) AC_CONFIG_FILES([benchmark-guile], [chmod +x benchmark-guile]) AC_CONFIG_FILES([guile-tools], [chmod +x guile-tools]) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 342285aee..24e5e33ab 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2008-05-04 Ludovic Courtès + + * guile.texi (Guile Modules): Include `autoconf.texi'. + * autoconf.texi (Autoconf Support): Mention `pkg-config'. + (Autoconf Macros): Document `pkg-config' support. + 2008-04-26 Ludovic Courtès * srfi-modules.texi (SRFI-88): New section. diff --git a/doc/ref/autoconf.texi b/doc/ref/autoconf.texi index 828155c3d..8622fde8f 100644 --- a/doc/ref/autoconf.texi +++ b/doc/ref/autoconf.texi @@ -8,10 +8,10 @@ @node Autoconf Support @chapter Autoconf Support -When Guile is installed, a set of autoconf macros is also installed as -PREFIX/share/aclocal/guile.m4. This chapter documents the macros provided in -that file, as well as the high-level guile-tool Autofrisk. @xref{Top,The GNU -Autoconf Manual,,autoconf}, for more info. +When Guile is installed, a pkg-config description file and a set of +Autoconf macros is installed. This chapter documents pkg-config and +Autoconf support, as well as the high-level guile-tool Autofrisk. +@xref{Top,The GNU Autoconf Manual,,autoconf}, for more info. @menu * Autoconf Background:: Why use autoconf? @@ -45,7 +45,38 @@ checks. @node Autoconf Macros @section Autoconf Macros -The macro names all begin with "GUILE_". +@cindex pkg-config +@cindex autoconf + +GNU Guile provides a @dfn{pkg-config} description file, installed as +@file{@var{prefix}/lib/pkgconfig/guile.pc}, which contains all the +information necessary to compile and link C applications that use Guile. +The @code{pkg-config} program is able to read this file and provide this +information to application programmers; it can be obtained at +@url{http://pkg-config.freedesktop.org/}. + +The following command lines give respectively the C compilation and link +flags needed to build Guile-using programs: + +@example +pkg-config guile --cflags +pkg-config guile --libs +@end example + +To ease use of pkg-config with Autoconf, pkg-config comes with a +convenient Autoconf macro. The following example looks for Guile and +sets the @code{GUILE_CFLAGS} and @code{GUILE_LIBS} variables +accordingly, or prints an error and exits if Guile was not found: + +@findex PKG_CHECK_MODULES + +@example +PKG_CHECK_MODULES([GUILE], [guile]) +@end example + +Guile comes with additional Autoconf macros providing more information, +installed as @file{@var{prefix}/share/aclocal/guile.m4}. Their names +all begin with @code{GUILE_}. @c see Makefile.am @include autoconf-macros.texi diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi index 2023c6e96..a56f95cf8 100644 --- a/doc/ref/guile.texi +++ b/doc/ref/guile.texi @@ -177,6 +177,8 @@ x * Guile Modules:: +* Autoconf Support:: + Appendices * Data Representation:: All the details. @@ -362,6 +364,8 @@ available through both Scheme and C interfaces. @include scsh.texi @include scheme-debugging.texi +@include autoconf.texi + @include data-rep.texi @include fdl.texi diff --git a/guile-1.8.pc.in b/guile-1.8.pc.in new file mode 100644 index 000000000..15c83d84b --- /dev/null +++ b/guile-1.8.pc.in @@ -0,0 +1,15 @@ +prefix=@prefix@ +exec_prefix=@exec_prefix@ +libdir=@libdir@ +includedir=@includedir@ +datarootdir=@datarootdir@ +datadir=@datadir@ + +sitedir=@sitedir@ +libguileinterface=@LIBGUILE_INTERFACE@ + +Name: GNU Guile +Description: GNU's Ubiquitous Intelligent Language for Extension +Version: @GUILE_VERSION@ +Libs: -L${libdir} -lguile @GUILE_LIBS@ +Cflags: -I${includedir} @GUILE_CFLAGS@ From cdbbe19250efa534a937dde381ae3d5a84960b68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 4 May 2008 22:42:13 +0200 Subject: [PATCH 24/87] Fix omissions and typos in previous commit. --- ChangeLog | 3 +++ doc/ref/autoconf.texi | 8 ++++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index fc7dc9860..dc8a3fa06 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,8 @@ 2008-05-04 Ludovic Courtès + Add `pkg-config' support. Suggested by Aaron VanDevender, Greg + Troxel, and others. + * configure.in: Substitute `sitedir', produce `guile-1.8.pc'. * Makefile.am (EXTRA_DIST): Add `guile-1.8.pc.in'. (pkgconfigdir, pkgconfig_DATA): New. diff --git a/doc/ref/autoconf.texi b/doc/ref/autoconf.texi index 8622fde8f..83686dada 100644 --- a/doc/ref/autoconf.texi +++ b/doc/ref/autoconf.texi @@ -49,7 +49,7 @@ checks. @cindex autoconf GNU Guile provides a @dfn{pkg-config} description file, installed as -@file{@var{prefix}/lib/pkgconfig/guile.pc}, which contains all the +@file{@var{prefix}/lib/pkgconfig/guile-1.8.pc}, which contains all the information necessary to compile and link C applications that use Guile. The @code{pkg-config} program is able to read this file and provide this information to application programmers; it can be obtained at @@ -59,8 +59,8 @@ The following command lines give respectively the C compilation and link flags needed to build Guile-using programs: @example -pkg-config guile --cflags -pkg-config guile --libs +pkg-config guile-1.8 --cflags +pkg-config guile-1.8 --libs @end example To ease use of pkg-config with Autoconf, pkg-config comes with a @@ -71,7 +71,7 @@ accordingly, or prints an error and exits if Guile was not found: @findex PKG_CHECK_MODULES @example -PKG_CHECK_MODULES([GUILE], [guile]) +PKG_CHECK_MODULES([GUILE], [guile-1.8]) @end example Guile comes with additional Autoconf macros providing more information, From b20ef3a6afe57e07140185912d937f12da4eda6b Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Mon, 5 May 2008 22:31:07 +0100 Subject: [PATCH 25/87] Add NEWS and concept index entries for traps infrastructure and Emacs support. --- NEWS | 12 ++++++++++++ doc/ref/ChangeLog | 7 +++++++ doc/ref/api-debug.texi | 1 + doc/ref/scheme-using.texi | 2 ++ 4 files changed, 22 insertions(+) diff --git a/NEWS b/NEWS index 55be683ad..31a5313a1 100644 --- a/NEWS +++ b/NEWS @@ -58,7 +58,19 @@ See "Autoconf Support" in the manual for details. ** New `postfix' read option, for SRFI-88 keyword syntax ** Some I/O primitives have been inlined, which improves I/O performance +** New object-based traps infrastructure +This is a GOOPS-based infrastructure that builds on Guile's low-level +evaluator trap calls and facilitates the development of debugging +features like single-stepping, breakpoints, tracing and profiling. +See the `Traps' node of the manual for details. + +** New support for working on Guile code from within Emacs + +Guile now incorporates the `GDS' library (previously distributed +separately) for working on Guile code from within Emacs. See the +`Using Guile In Emacs' node of the manual for details. + * Bugs fixed ** `scm_add_slot ()' no longer segfaults (fixes bug #22369) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 24e5e33ab..d39180df4 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,10 @@ +2008-05-05 Neil Jerram + + * scheme-using.texi (Using Guile in Emacs): Add concept index + entries `GDS' and `Emacs'. + + * api-debug.texi (Debugging): Add concept index entry `Debugging'. + 2008-05-04 Ludovic Courtès * guile.texi (Guile Modules): Include `autoconf.texi'. diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi index 0e8c6909f..d99a56724 100644 --- a/doc/ref/api-debug.texi +++ b/doc/ref/api-debug.texi @@ -8,6 +8,7 @@ @node Debugging @section Debugging Infrastructure +@cindex Debugging In order to understand Guile's debugging facilities, you first need to understand a little about how the evaluator works and what the Scheme stack is. With that in place we explain the low level trap calls that diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi index 986252eac..092fb4e39 100644 --- a/doc/ref/scheme-using.texi +++ b/doc/ref/scheme-using.texi @@ -359,6 +359,8 @@ debugger to continue.) @node Using Guile in Emacs @section Using Guile in Emacs +@cindex GDS +@cindex Emacs There are several options for working on Guile Scheme code in Emacs. The simplest are to use Emacs's standard @code{scheme-mode} for editing code, and to run the interpreter when you need it by typing From 6d4e1f627ee5738d9edb66ad4045a01637888f92 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Mon, 5 May 2008 23:47:24 +0100 Subject: [PATCH 26/87] Fix c-tokenize.c error: 'input' defined but not used, when compiling with GCC 4.3.0 --- libguile/ChangeLog | 4 ++++ libguile/c-tokenize.lex | 7 ++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d35b1b6a8..33f3210b2 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2008-05-05 Neil Jerram + + * c-tokenize.lex: #define YY_NO_INPUT. + 2008-04-26 Ludovic Courtès * read.c (scm_read_sexp): Remove extraneous semi-colon at diff --git a/libguile/c-tokenize.lex b/libguile/c-tokenize.lex index 1d9b40b92..938a5d2cf 100644 --- a/libguile/c-tokenize.lex +++ b/libguile/c-tokenize.lex @@ -18,7 +18,12 @@ INTQUAL (l|L|ll|LL|lL|Ll|u|U) #include #include #include - + +/* Prevent compilation of static input() function in generated scanner + code. This function is never actually used, and GCC 4.3 will emit + an error for that. */ +#define YY_NO_INPUT + int yylex(void); int yyget_lineno (void); From 7a35784c6b5f7c15bf53e01a6dfb9d85ab48f755 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 7 May 2008 17:43:17 +0200 Subject: [PATCH 27/87] Avoid warning with GCC on FreeBSD 6.2 in `numbers.c'. --- libguile/ChangeLog | 5 +++++ libguile/numbers.c | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 33f3210b2..e805e63ab 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2008-05-07 Ludovic Courtès + + * numbers.c (scm_from_complex_double): Mark as `SCM_UNUSED'. + This fixes compilation with `-Werror' on FreeBSD 6.2 (i386). + 2008-05-05 Neil Jerram * c-tokenize.lex: #define YY_NO_INPUT. diff --git a/libguile/numbers.c b/libguile/numbers.c index 1191042f8..4a458c4a1 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -170,8 +170,10 @@ xisnan (double x) #define SCM_COMPLEX_VALUE(z) \ (SCM_COMPLEX_REAL (z) + GUILE_I * SCM_COMPLEX_IMAG (z)) +static inline SCM scm_from_complex_double (complex double z) SCM_UNUSED; + /* Convert a C "complex double" to an SCM value. */ -static SCM +static inline SCM scm_from_complex_double (complex double z) { return scm_c_make_rectangular (creal (z), cimag (z)); From a728672018cda71c77016555a69011bdc269c8fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 7 May 2008 19:57:40 +0200 Subject: [PATCH 28/87] Remove uses of non-portable makefile constructs. --- NEWS | 1 + doc/ref/ChangeLog | 6 ++++++ doc/ref/Makefile.am | 5 +++-- guile-readline/ChangeLog | 5 +++++ guile-readline/ice-9/Makefile.am | 7 ++++--- 5 files changed, 19 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 31a5313a1..5f84659c0 100644 --- a/NEWS +++ b/NEWS @@ -98,6 +98,7 @@ lead to a stack overflow. ** Fixed build issue with DEC/Compaq/HP's compiler ** Fixed `scm_from_complex_double' build issue on FreeBSD ** Fixed `alloca' build issue on FreeBSD 6 +** Removed use of non-portable makefile constructs ** Fixed shadowing of libc's on Tru64, which broke compilation ** Make sure all tests honor `$TMPDIR' diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index d39180df4..275a2a166 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2008-05-07 Ludovic Courtès + + * Makefile.am (autoconf-macros.texi): Avoid use of GNU Make + specific `$<' variable. This broke with BSD Make as found on + FreeBSD 6.2. + 2008-05-05 Neil Jerram * scheme-using.texi (Using Guile in Emacs): Add concept index diff --git a/doc/ref/Makefile.am b/doc/ref/Makefile.am index 6ab2171af..60e23c27d 100644 --- a/doc/ref/Makefile.am +++ b/doc/ref/Makefile.am @@ -1,6 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 2004, 2006 Free Software Foundation, Inc. +## Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -86,7 +86,8 @@ include $(top_srcdir)/am/pre-inst-guile autoconf.texi: autoconf-macros.texi autoconf-macros.texi: $(top_srcdir)/guile-config/guile.m4 - $(preinstguiletool)/snarf-guile-m4-docs $< > $(srcdir)/$@ + $(preinstguiletool)/snarf-guile-m4-docs $(top_srcdir)/guile-config/guile.m4 \ + > $(srcdir)/$@ lib-version.texi: $(top_srcdir)/GUILE-VERSION cat "$^" | grep '^LIBGUILE_.*_MAJOR' | \ diff --git a/guile-readline/ChangeLog b/guile-readline/ChangeLog index f8d393f16..2188b78e1 100644 --- a/guile-readline/ChangeLog +++ b/guile-readline/ChangeLog @@ -1,3 +1,8 @@ +2008-05-07 Ludovic Courtès + + * ice-9/Makefile.am (guile_pdd): Don't use `patsubst': it's GNU + Make and broke BSD Make as found on FreeBSD 6.2. + 2008-04-16 Ludovic Courtès * configure.in (AC_INIT): Don't use "echo -n", which is not diff --git a/guile-readline/ice-9/Makefile.am b/guile-readline/ice-9/Makefile.am index 1917c76fc..d1e7c8270 100644 --- a/guile-readline/ice-9/Makefile.am +++ b/guile-readline/ice-9/Makefile.am @@ -1,7 +1,6 @@ ## Process this file with Automake to create Makefile.in ## -## Copyright (C) 1998, 1999, 2000, 2001, 2006 Free Software Foundation, Inc. -## Copyright (C) 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +## Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc. ## ## This file is part of GUILE. ## @@ -20,7 +19,9 @@ ## to the Free Software Foundation, Inc., 51 Franklin Street, Fifth ## Floor, Boston, MA 02110-1301 USA -guile_pdd = $(patsubst %/guile-readline,%/guile,$(pkgdatadir)) +# Guile's `pkgdatadir'. +guile_pdd = $(datadir)/guile + ice9dir = $(guile_pdd)/$(GUILE_EFFECTIVE_VERSION)/ice-9 ice9_DATA = readline.scm ETAGS_ARGS = $(ice9_DATA) From 33384c27eb64ad70b9bbbfb4e76a6e222e5d5ba6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 7 May 2008 20:52:59 +0200 Subject: [PATCH 29/87] Merge changes for 1.8.5. --- ChangeLog | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/ChangeLog b/ChangeLog index dc8a3fa06..dc49d16c8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2008-05-07 Ludovic Courtès + + Guile 1.8.5 released. + + * GUILE-VERSION (LIBGUILE_INTERFACE_CURRENT): Increment due to + the addition of an inlined version of `scm getc ()' and friends. + (LIBGUILE_INTERFACE_AGE): Increment. + (LIBGUILE_INTERFACE_REVISION): Zeroed. + (LIBGUILE_SRFI_SRFI_1_INTERFACE_REVISION): Increment. + 2008-05-04 Ludovic Courtès Add `pkg-config' support. Suggested by Aaron VanDevender, Greg From 346e4402a4e0110d53ee691137d562a8018a27e1 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 8 May 2008 00:29:53 +0100 Subject: [PATCH 30/87] Fix continuation problems on IA64. * Specific problems in IA64 make check ** test-unwind Representation of the relevant dynamic context: non-rewindable catch frame make cont. o----o-----a----------b-------------c \ \ call cont. o-----o-----------d A continuation is captured at (c), with a non-rewindable frame in the dynamic context at (b). If a rewind through that frame was attempted, Guile would throw to the catch at (a). Then the context unwinds back past (a), then winds forwards again, and the captured continuation is called at (d). We should end up at the catch at (a). On ia64, we get an "illegal instruction". The problem is that Guile does not restore the ia64 register backing store (RBS) stack (which is saved off when the continuation is captured) until all the unwinding and rewinding is done. Therefore, when the rewind code (scm_i_dowinds) hits the non-rewindable frame at (b), the RBS stack hasn't yet been restored. The throw finds the jmp_buf (for the catch at (a)) correctly from the dynamic context, and jumps back to (a), but the RBS stack is invalid, hence the illegal instruction. This could be fixed by restoring the RBS stack earlier, at the same point (copy_stack) where the normal stack is restored. But that causes a problem in the next test... ** continuations.test The dynamic context diagram for this case is similar: non-rewindable catch frame make cont. a----x-----o----------b-------------c \ \ call cont. o-------d The only significant difference is that the catch point (a) is upstream of where the dynamic context forks. This means that the RBS stack at (d) already contains the correct RBS contents for throwing back to (a), so it doesn't matter whether the RBS stack that was saved off with the continuation gets restored. This test passes with the Guile 1.8.4 code, but fails (with an "illegal instruction") when the code is changed to restore the RBS stack earlier as described above. The problem now is that the RBS stack is being restored _too_ early; specifically when there is still stuff to do that relies on the old RBS contents. When a continuation is called, the sequence of relevant events is: (1) Grow the (normal) stack until it is bigger than the (normal) stack saved off in the continuation. (scm_dynthrow, grow_stack) (2) scm_i_dowinds calls itself recursively, such that (2.1) for each rewind (from (x) to (c)) that will be needed, another frame is added to the stack (both normal and RBS), with local variables specifying the required rewind; the rewinds don't actually happen yet, they will happen when the stack unwinds again through these frames (2.2) required unwinds - back from where the continuation was called (d) to the fork point (x) - are done immediately. (3) The normal (i.e. non-RBS) stack that was stored in the continuation is restored (i.e. copied on top of the actual stack). Note that this doesn't overwrite the frames that were added in (2.1), because the growth in (1) ensures that the added frames are beyond the end of the restored stack. (4) ? Restore the RBS stack here too ? (5) Return (from copy_stack) through the (2.1) frames, which means that the rewinds now happen. (6) setcontext (or longjmp) to the context (c) where the continuation was captured. The trouble is that step (1) does not create space in the RBS stack in the same kind of way that it does for the normal stack. Therefore, if the saved (in the continuation) RBS stack is big enough, it can overwrite the RBS of the (2.1) frames that still need to complete. This causes an illegal instruction when we return through those frames and try to perform the rewinds. * Fix The key to the fix is that the saved RBS stack only needs to be restored at some point before the next setcontext call, and that doing it as close to the setcontext call as possible will avoid bad interactions with the pre-setcontext stack. Therefore we do the restoration at the last possible point, immediately before the next setcontext call. The situation is complicated by there being two ways that the next setcontext call can happen. - If the unwinding and rewinding is all successful, the next setcontext will be the one from step (6) above. This is the "normal" continuation invocation case. - If one of the rewinds throws an error, the next setcontext will come from the throw implementation code. (And the one in step (6) will never happen.) This is the rewind error case. In the rewind error case, the code calling setcontext knows nothing about the continuation. So to cover both cases, we: - copy (in step (4) above) the address and length of the continuation's saved RBS stack to the current thread state (SCM_I_CURRENT_THREAD) - modify all setcontext callers so that they check the current thread state for a saved RBS stack, and restore it if so before calling setcontext. * Notes ** I think rewinders cannot rely on using any stack data Unless it can be guaranteed that the data won't go into a register. I'm not 100% sure about this, but I think it follows from the fact that the RBS stack is not restored until after the rewinds have happened. Note that this isn't a regression caused by the current fix. In Guile 1.8.4, the RBS stack was restored _after_ the rewinds, and this is still the case now. ** Most setcontext calls for `throw' don't need to change the RBS stack In the absence of continuation invocation, the setcontext call in the throw implementation code always sets context to a place higher up the same stack (both normal and RBS), hence no stack restoration is needed. * Other changes ** Using setcontext for all non-local jumps (for __ia64__) Along the way, I read a claim somewhere that setcontext was more reliable than longjmp, in cases where the stack has been manipulated. I don't now have any reason to believe this, but it seems reasonable anyway to leave the __ia64__ code using getcontext/setcontext, instead of setjmp/longjmp. (I think the only possible argument against this would be performance - if getcontext was significantly slower than setjmp. It that proves to be the case, we should revisit this.) ** Capping RBS base for non-main threads Somewhere else along the way, I hit a problem in GC, involving the RBS stack of a non-main thread. The problem was, in SCM_MARK_BACKING_STORE, that scm_ia64_register_backing_store_base was returning a value that was massively greater than the value of scm_ia64_ar_bsp, leading to a seg fault. This is because the implementation of scm_ia64_register_backing_store_base is only valid for the main thread. I couldn't find a neat way of getting the true RBS base of a non-main thread, but one idea is simply to call scm_ia64_ar_bsp when guilifying a thread, and use the value returned as an upper bound for that thread's RBS base. (Note that the RBS stack grows upwards.) (Were it not for scm_init_guile, we could be much more definitive about this. We could take the value of scm_ia64_ar_bsp as a definitive base address for the part of the RBS stack that Guile cares about. We could also then discard scm_ia64_register_backing_store_base.) --- libguile/ChangeLog | 35 ++++++++++++++++++++++++ libguile/__scm.h | 18 ++++++++++++- libguile/continuations.c | 58 +++++++++++++++++++--------------------- libguile/continuations.h | 2 -- libguile/threads.c | 20 ++++++++++++-- libguile/threads.h | 5 ++++ libguile/throw.c | 6 +++++ 7 files changed, 108 insertions(+), 36 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index e805e63ab..4bd2f2c7a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,38 @@ +2008-05-08 Neil Jerram + + * throw.c (scm_ithrow): For IA64 add a return statement, to + appease GCC. + + * threads.h (scm_i_thread): New IA64 fields: + register_backing_store_base and pending_rbs_continuation. + + * threads.c (guilify_self_1): For IA64: cap RBS base address at + the current value of scm_ia64_ar_bsp, and store the capped value + in thread state. + (SCM_MARK_BACKING_STORE): Use thread->register_backing_store_base + instead of scm_ia64_register_backing_store_base(). + (scm_threads_mark_stacks): Add "&" in "&t->regs", so that the code + works both for jmp_buf defined as an array, and jmp_buf defined as + a struct. + + * continuations.h (scm_t_contregs): Remove `fresh' and `ctx' + fields; these are now inside the IA64 definition of `jmp_buf'. + + * continuations.c (scm_make_continuation): Simplify, by moving + some of the IA64 code inside the definition of "setjmp", and by + some obvious commonizations. For IA64 register backing store + (RBS) stack base, use thread->register_backing_store_base instead + of scm_ia64_register_backing_store_base(). + (copy_stack): For IA64, store pointer to continuation being + invoked in thread state, so we can restore the continuation's RBS + stack just before the next setcontext call. + (copy_stack_and_call): Don't restore RBS stack explicitly here. + It will be restored, if appropriate, inside the longjmp call. + (scm_ia64_longjmp): New function. + + * __scm.h (setjmp, longjmp, jmp_buf): For IA64, implement using + getcontext and setcontext. + 2008-05-07 Ludovic Courtès * numbers.c (scm_from_complex_double): Mark as `SCM_UNUSED'. diff --git a/libguile/__scm.h b/libguile/__scm.h index 3d6d9a7f3..b198f9d6a 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -402,7 +402,23 @@ # define setjmp setjump # define longjmp longjump # else /* ndef _CRAY1 */ -# include +# if defined (__ia64__) +/* For IA64, emulate the setjmp API using getcontext. */ +# include +# include + typedef struct { + ucontext_t ctx; + int fresh; + } jmp_buf; +# define setjmp(JB) \ + ( (JB).fresh = 1, \ + getcontext (&((JB).ctx)), \ + ((JB).fresh ? ((JB).fresh = 0, 0) : 1) ) +# define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL) + void scm_ia64_longjmp (jmp_buf *, int); +# else /* ndef __ia64__ */ +# include +# endif /* ndef __ia64__ */ # endif /* ndef _CRAY1 */ #endif /* ndef vms */ diff --git a/libguile/continuations.c b/libguile/continuations.c index 39785a528..80a2790b8 100644 --- a/libguile/continuations.c +++ b/libguile/continuations.c @@ -124,47 +124,30 @@ scm_make_continuation (int *first) continuation->offset = continuation->stack - src; memcpy (continuation->stack, src, sizeof (SCM_STACKITEM) * stack_size); -#ifdef __ia64__ - continuation->fresh = 1; - getcontext (&continuation->ctx); - if (continuation->fresh) + *first = !setjmp (continuation->jmpbuf); + if (*first) { +#ifdef __ia64__ continuation->backing_store_size = - (char *) scm_ia64_ar_bsp(&continuation->ctx) + (char *) scm_ia64_ar_bsp(&continuation->jmpbuf.ctx) - - (char *) scm_ia64_register_backing_store_base (); + (char *) thread->register_backing_store_base; continuation->backing_store = NULL; continuation->backing_store = scm_gc_malloc (continuation->backing_store_size, "continuation backing store"); memcpy (continuation->backing_store, - (void *) scm_ia64_register_backing_store_base (), + (void *) thread->register_backing_store_base, continuation->backing_store_size); - *first = 1; - continuation->fresh = 0; +#endif /* __ia64__ */ return cont; } else { SCM ret = continuation->throw_value; - *first = 0; continuation->throw_value = SCM_BOOL_F; return ret; } -#else /* !__ia64__ */ - if (setjmp (continuation->jmpbuf)) - { - SCM ret = continuation->throw_value; - *first = 0; - continuation->throw_value = SCM_BOOL_F; - return ret; - } - else - { - *first = 1; - return cont; - } -#endif /* !__ia64__ */ } #undef FUNC_NAME @@ -218,6 +201,9 @@ copy_stack (void *data) copy_stack_data *d = (copy_stack_data *)data; memcpy (d->dst, d->continuation->stack, sizeof (SCM_STACKITEM) * d->continuation->num_stack_items); +#ifdef __ia64__ + SCM_I_CURRENT_THREAD->pending_rbs_continuation = d->continuation; +#endif } static void @@ -235,16 +221,26 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val, scm_i_set_last_debug_frame (continuation->dframe); continuation->throw_value = val; -#ifdef __ia64__ - memcpy (scm_ia64_register_backing_store_base (), - continuation->backing_store, - continuation->backing_store_size); - setcontext (&continuation->ctx); -#else longjmp (continuation->jmpbuf, 1); -#endif } +#ifdef __ia64__ +void +scm_ia64_longjmp (jmp_buf *JB, int VAL) +{ + scm_i_thread *t = SCM_I_CURRENT_THREAD; + + if (t->pending_rbs_continuation) + { + memcpy (t->register_backing_store_base, + t->pending_rbs_continuation->backing_store, + t->pending_rbs_continuation->backing_store_size); + t->pending_rbs_continuation = NULL; + } + setcontext (&JB->ctx); +} +#endif + /* Call grow_stack until the stack space is large enough, then, as the current * stack frame might get overwritten, let copy_stack_and_call perform the * actual copying and continuation calling. diff --git a/libguile/continuations.h b/libguile/continuations.h index 0274c1b2d..f6fb96aa2 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -46,8 +46,6 @@ typedef struct jmp_buf jmpbuf; SCM dynenv; #ifdef __ia64__ - ucontext_t ctx; - int fresh; void *backing_store; unsigned long backing_store_size; #endif /* __ia64__ */ diff --git a/libguile/threads.c b/libguile/threads.c index 68c5f79d3..b3a3934f9 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -447,6 +447,22 @@ guilify_self_1 (SCM_STACKITEM *base) t->pending_asyncs = 1; t->last_debug_frame = NULL; t->base = base; +#ifdef __ia64__ + /* Calculate and store off the base of this thread's register + backing store (RBS). Unfortunately our implementation(s) of + scm_ia64_register_backing_store_base are only reliable for the + main thread. For other threads, therefore, find out the current + top of the RBS, and use that as a maximum. */ + t->register_backing_store_base = scm_ia64_register_backing_store_base (); + { + ucontext_t ctx; + void *bsp; + getcontext (&ctx); + bsp = scm_ia64_ar_bsp (&ctx); + if (t->register_backing_store_base > bsp) + t->register_backing_store_base = bsp; + } +#endif t->continuation_root = SCM_EOL; t->continuation_base = base; scm_i_pthread_cond_init (&t->sleep_cond, NULL); @@ -1658,7 +1674,7 @@ SCM_DEFINE (scm_condition_variable_p, "condition-variable?", 1, 0, 0, scm_mark_locations ((SCM_STACKITEM *) &ctx.uc_mcontext, \ ((size_t) (sizeof (SCM_STACKITEM) - 1 + sizeof ctx.uc_mcontext) \ / sizeof (SCM_STACKITEM))); \ - bot = (SCM_STACKITEM *) scm_ia64_register_backing_store_base (); \ + bot = (SCM_STACKITEM *) SCM_I_CURRENT_THREAD->register_backing_store_base; \ top = (SCM_STACKITEM *) scm_ia64_ar_bsp (&ctx); \ scm_mark_locations (bot, top - bot); } while (0) #else @@ -1682,7 +1698,7 @@ scm_threads_mark_stacks (void) #else scm_mark_locations (t->top, t->base - t->top); #endif - scm_mark_locations ((SCM_STACKITEM *) t->regs, + scm_mark_locations ((SCM_STACKITEM *) &t->regs, ((size_t) sizeof(t->regs) / sizeof (SCM_STACKITEM))); } diff --git a/libguile/threads.h b/libguile/threads.h index e1944a552..49d1f2efb 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -28,6 +28,7 @@ #include "libguile/root.h" #include "libguile/iselect.h" #include "libguile/dynwind.h" +#include "libguile/continuations.h" #if SCM_USE_PTHREAD_THREADS #include "libguile/pthread-threads.h" @@ -113,6 +114,10 @@ typedef struct scm_i_thread { SCM_STACKITEM *base; SCM_STACKITEM *top; jmp_buf regs; +#ifdef __ia64__ + void *register_backing_store_base; + scm_t_contregs *pending_rbs_continuation; +#endif } scm_i_thread; diff --git a/libguile/throw.c b/libguile/throw.c index 55d83d41a..f605af7ae 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -852,6 +852,12 @@ scm_ithrow (SCM key, SCM args, int noreturn SCM_UNUSED) /* Otherwise, it's some random piece of junk. */ else abort (); + +#ifdef __ia64__ + /* On IA64, we #define longjmp as setcontext, and GCC appears not to + know that that doesn't return. */ + return SCM_UNSPECIFIED; +#endif } From e4c1d4cf612897d0eef7b2c5308056722daf2502 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Tue, 13 May 2008 00:00:34 +0100 Subject: [PATCH 31/87] Expand DEFFROM and DEFTO macros in discouraged.c * discouraged.c: Expand DEFFROM and DEFTO macros, to avoid compiler warnings about excess semicolons. (Reported by Didier Godefroy.) --- THANKS | 1 + libguile/ChangeLog | 6 ++ libguile/discouraged.c | 141 ++++++++++++++++++++++++++++++++++------- 3 files changed, 125 insertions(+), 23 deletions(-) diff --git a/THANKS b/THANKS index bc5d8dd13..a6be8f6e5 100644 --- a/THANKS +++ b/THANKS @@ -37,6 +37,7 @@ For fixes or providing information which led to a fix: Charles Gagnon Peter Gavin Eric Gillespie, Jr + Didier Godefroy John Goerzen Mike Gran Szavai Gyula diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 4bd2f2c7a..5afdd6589 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2008-05-12 Neil Jerram + + * discouraged.c: Expand DEFFROM and DEFTO macros, to avoid + compiler warnings about excess semicolons. (Reported by Didier + Godefroy.) + 2008-05-08 Neil Jerram * throw.c (scm_ithrow): For IA64 add a return statement, to diff --git a/libguile/discouraged.c b/libguile/discouraged.c index 1b5794a82..07663e0fe 100644 --- a/libguile/discouraged.c +++ b/libguile/discouraged.c @@ -23,33 +23,128 @@ #if (SCM_ENABLE_DISCOURAGED == 1) -#define DEFFROM(t,f1,f2) SCM f1(t x) { return f2 (x); } -#define DEFTO(t,f1,f2) t f1(SCM x, unsigned long pos, const char *s_caller) \ - { return f2 (x); } +SCM +scm_short2num (short x) +{ + return scm_from_short (x); +} -DEFFROM (short, scm_short2num, scm_from_short); -DEFFROM (unsigned short, scm_ushort2num, scm_from_ushort); -DEFFROM (int, scm_int2num, scm_from_int); -DEFFROM (unsigned int, scm_uint2num, scm_from_uint); -DEFFROM (long, scm_long2num, scm_from_long); -DEFFROM (unsigned long, scm_ulong2num, scm_from_ulong); -DEFFROM (size_t, scm_size2num, scm_from_size_t); -DEFFROM (ptrdiff_t, scm_ptrdiff2num, scm_from_ssize_t); +SCM +scm_ushort2num (unsigned short x) +{ + return scm_from_ushort (x); +} -DEFTO (short, scm_num2short, scm_to_short); -DEFTO (unsigned short, scm_num2ushort, scm_to_ushort); -DEFTO (int, scm_num2int, scm_to_int); -DEFTO (unsigned int, scm_num2uint, scm_to_uint); -DEFTO (long, scm_num2long, scm_to_long); -DEFTO (unsigned long, scm_num2ulong, scm_to_ulong); -DEFTO (size_t, scm_num2size, scm_to_size_t); -DEFTO (ptrdiff_t, scm_num2ptrdiff, scm_to_ssize_t); +SCM +scm_int2num (int x) +{ + return scm_from_int (x); +} + +SCM +scm_uint2num (unsigned int x) +{ + return scm_from_uint (x); +} + +SCM +scm_long2num (long x) +{ + return scm_from_long (x); +} + +SCM +scm_ulong2num (unsigned long x) +{ + return scm_from_ulong (x); +} + +SCM +scm_size2num (size_t x) +{ + return scm_from_size_t (x); +} + +SCM +scm_ptrdiff2num (ptrdiff_t x) +{ + return scm_from_ssize_t (x); +} + +short +scm_num2short (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_short (x); +} + +unsigned short +scm_num2ushort (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_ushort (x); +} + +int +scm_num2int (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_int (x); +} + +unsigned int +scm_num2uint (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_uint (x); +} + +long +scm_num2long (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_long (x); +} + +unsigned long +scm_num2ulong (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_ulong (x); +} + +size_t +scm_num2size (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_size_t (x); +} + +ptrdiff_t +scm_num2ptrdiff (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_ssize_t (x); +} #if SCM_SIZEOF_LONG_LONG != 0 -DEFFROM (long long, scm_long_long2num, scm_from_long_long); -DEFFROM (unsigned long long, scm_ulong_long2num, scm_from_ulong_long); -DEFTO (long long, scm_num2long_long, scm_to_long_long); -DEFTO (unsigned long long, scm_num2ulong_long, scm_to_ulong_long); + +SCM +scm_long_long2num (long long x) +{ + return scm_from_long_long (x); +} + +SCM +scm_ulong_long2num (unsigned long long x) +{ + return scm_from_ulong_long (x); +} + +long long +scm_num2long_long (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_long_long (x); +} + +unsigned long long +scm_num2ulong_long (SCM x, unsigned long pos, const char *s_caller) +{ + return scm_to_ulong_long (x); +} + #endif SCM From adc085f17c2ce4c6b5cb51f5cb8abc6975023b99 Mon Sep 17 00:00:00 2001 From: Julian Graham Date: Sun, 13 Apr 2008 19:51:23 -0400 Subject: [PATCH 32/87] latest set of SRFI-18 support changes to core threads --- doc/ref/api-scheduling.texi | 33 ++++++- libguile/threads.c | 164 +++++++++++++++++++--------------- libguile/threads.h | 5 +- test-suite/tests/threads.test | 46 ++++++++++ 4 files changed, 169 insertions(+), 79 deletions(-) diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi index ec136fbfd..29eed5e3f 100644 --- a/doc/ref/api-scheduling.texi +++ b/doc/ref/api-scheduling.texi @@ -409,17 +409,21 @@ function is equivalent to calling `make-mutex' and specifying the @code{recursive} flag. @end deffn -@deffn {Scheme Procedure} lock-mutex mutex [timeout] +@deffn {Scheme Procedure} lock-mutex mutex [timeout [owner]] @deffnx {C Function} scm_lock_mutex (mutex) -@deffnx {C Function} scm_lock_mutex_timed (mutex, timeout) -Lock @var{mutex}. If the mutex is already locked by another thread -then block and return only when @var{mutex} has been acquired. +@deffnx {C Function} scm_lock_mutex_timed (mutex, timeout, owner) +Lock @var{mutex}. If the mutex is already locked, then block and +return only when @var{mutex} has been acquired. When @var{timeout} is given, it specifies a point in time where the waiting should be aborted. It can be either an integer as returned by @code{current-time} or a pair as returned by @code{gettimeofday}. When the waiting is aborted, @code{#f} is returned. +When @var{owner} is given, it specifies an owner for @var{mutex} other +than the calling thread. @var{owner} may also be @code{#f}, +indicating that the mutex should be locked but left unowned. + For standard mutexes (@code{make-mutex}), and error is signalled if the thread has itself already locked @var{mutex}. @@ -471,6 +475,27 @@ returned by @code{current-time} or a pair as returned by returned. Otherwise the function returns @code{#t}. @end deffn +@deffn {Scheme Procedure} mutex-owner mutex +@deffnx {C Function} scm_mutex_owner (mutex) +Return the current owner of @var{mutex}, in the form of a thread or +@code{#f} (indicating no owner). Note that a mutex may be unowned but +still locked. +@end deffn + +@deffn {Scheme Procedure} mutex-level mutex +@deffnx {C Function} scm_mutex_level (mutex) +Return the current lock level of @var{mutex}. If @var{mutex} is +currently unlocked, this value will be 0; otherwise, it will be the +number of times @var{mutex} has been recursively locked by its current +owner. +@end deffn + +@deffn {Scheme Procedure} mutex-locked? mutex +@deffnx {C Function} scm_mutex_locked_p (mutex) +Return @code{#t} if @var{mutex} is locked, regardless of ownership; +otherwise, return @code{#f}. +@end deffn + @deffn {Scheme Procedure} make-condition-variable @deffnx {C Function} scm_make_condition_variable () Return a new condition variable. diff --git a/libguile/threads.c b/libguile/threads.c index b3a3934f9..6c4526ba4 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -527,9 +527,9 @@ guilify_self_2 (SCM parent) typedef struct { scm_i_pthread_mutex_t lock; SCM owner; - int level; /* how much the owner owns us. - < 0 for non-recursive mutexes */ + int level; /* how much the owner owns us. <= 1 for non-recursive mutexes */ + int recursive; /* allow recursive locking? */ int unchecked_unlock; /* is it an error to unlock an unlocked mutex? */ int allow_external_unlock; /* is it an error to unlock a mutex that is not owned by the current thread? */ @@ -1170,8 +1170,9 @@ make_fat_mutex (int recursive, int unchecked_unlock, int external_unlock) m = scm_gc_malloc (sizeof (fat_mutex), "mutex"); scm_i_pthread_mutex_init (&m->lock, NULL); m->owner = SCM_BOOL_F; - m->level = recursive? 0 : -1; + m->level = 0; + m->recursive = recursive; m->unchecked_unlock = unchecked_unlock; m->allow_external_unlock = external_unlock; @@ -1227,79 +1228,77 @@ SCM_DEFINE (scm_make_recursive_mutex, "make-recursive-mutex", 0, 0, 0, SCM_SYMBOL (scm_abandoned_mutex_error_key, "abandoned-mutex-error"); static SCM -fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, int *ret) +fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret) { fat_mutex *m = SCM_MUTEX_DATA (mutex); - SCM thread = scm_current_thread (); - scm_i_thread *t = SCM_I_THREAD_DATA (thread); - + SCM new_owner = SCM_UNBNDP (owner) ? scm_current_thread() : owner; SCM err = SCM_BOOL_F; struct timeval current_time; scm_i_scm_pthread_mutex_lock (&m->lock); - if (scm_is_false (m->owner)) + + while (1) { - m->owner = thread; - scm_i_pthread_mutex_lock (&t->admin_mutex); - t->mutexes = scm_cons (mutex, t->mutexes); - scm_i_pthread_mutex_unlock (&t->admin_mutex); - *ret = 1; - } - else if (scm_is_eq (m->owner, thread)) - { - if (m->level >= 0) + if (m->level == 0) { + m->owner = new_owner; m->level++; - *ret = 1; - } - else - err = scm_cons (scm_misc_error_key, - scm_from_locale_string ("mutex already locked by " - "current thread")); - } - else - { - int first_iteration = 1; - while (1) - { - if (scm_is_eq (m->owner, thread) || scm_c_thread_exited_p (m->owner)) + + if (SCM_I_IS_THREAD (new_owner)) { + scm_i_thread *t = SCM_I_THREAD_DATA (new_owner); scm_i_pthread_mutex_lock (&t->admin_mutex); t->mutexes = scm_cons (mutex, t->mutexes); scm_i_pthread_mutex_unlock (&t->admin_mutex); - *ret = 1; - if (scm_c_thread_exited_p (m->owner)) - { - m->owner = thread; - err = scm_cons (scm_abandoned_mutex_error_key, - scm_from_locale_string ("lock obtained on " - "abandoned mutex")); - } - break; } - else if (!first_iteration) + *ret = 1; + break; + } + else if (SCM_I_IS_THREAD (m->owner) && scm_c_thread_exited_p (m->owner)) + { + m->owner = new_owner; + err = scm_cons (scm_abandoned_mutex_error_key, + scm_from_locale_string ("lock obtained on abandoned " + "mutex")); + *ret = 1; + break; + } + else if (scm_is_eq (m->owner, new_owner)) + { + if (m->recursive) { - if (timeout != NULL) - { - gettimeofday (¤t_time, NULL); - if (current_time.tv_sec > timeout->tv_sec || - (current_time.tv_sec == timeout->tv_sec && - current_time.tv_usec * 1000 > timeout->tv_nsec)) - { - *ret = 0; - break; - } - } - scm_i_pthread_mutex_unlock (&m->lock); - SCM_TICK; - scm_i_scm_pthread_mutex_lock (&m->lock); + m->level++; + *ret = 1; } else - first_iteration = 0; - block_self (m->waiting, mutex, &m->lock, timeout); + { + err = scm_cons (scm_misc_error_key, + scm_from_locale_string ("mutex already locked " + "by thread")); + *ret = 0; + } + break; } + else + { + if (timeout != NULL) + { + gettimeofday (¤t_time, NULL); + if (current_time.tv_sec > timeout->tv_sec || + (current_time.tv_sec == timeout->tv_sec && + current_time.tv_usec * 1000 > timeout->tv_nsec)) + { + *ret = 0; + break; + } + } + scm_i_pthread_mutex_unlock (&m->lock); + SCM_TICK; + scm_i_scm_pthread_mutex_lock (&m->lock); + } + block_self (m->waiting, mutex, &m->lock, timeout); } scm_i_pthread_mutex_unlock (&m->lock); return err; @@ -1307,11 +1306,11 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, int *ret) SCM scm_lock_mutex (SCM mx) { - return scm_lock_mutex_timed (mx, SCM_UNDEFINED); + return scm_lock_mutex_timed (mx, SCM_UNDEFINED, SCM_UNDEFINED); } -SCM_DEFINE (scm_lock_mutex_timed, "lock-mutex", 1, 1, 0, - (SCM m, SCM timeout), +SCM_DEFINE (scm_lock_mutex_timed, "lock-mutex", 1, 2, 0, + (SCM m, SCM timeout, SCM owner), "Lock @var{mutex}. If the mutex is already locked, the calling thread " "blocks until the mutex becomes available. The function returns when " "the calling thread owns the lock on @var{mutex}. Locking a mutex that " @@ -1331,7 +1330,7 @@ SCM_DEFINE (scm_lock_mutex_timed, "lock-mutex", 1, 1, 0, waittime = &cwaittime; } - exception = fat_mutex_lock (m, waittime, &ret); + exception = fat_mutex_lock (m, waittime, owner, &ret); if (!scm_is_false (exception)) scm_ithrow (SCM_CAR (exception), scm_list_1 (SCM_CDR (exception)), 1); return ret ? SCM_BOOL_T : SCM_BOOL_F; @@ -1362,7 +1361,7 @@ SCM_DEFINE (scm_try_mutex, "try-mutex", 1, 0, 0, to_timespec (scm_from_int(0), &cwaittime); waittime = &cwaittime; - exception = fat_mutex_lock (mutex, waittime, &ret); + exception = fat_mutex_lock (mutex, waittime, SCM_UNDEFINED, &ret); if (!scm_is_false (exception)) scm_ithrow (SCM_CAR (exception), scm_list_1 (SCM_CDR (exception)), 1); return ret ? SCM_BOOL_T : SCM_BOOL_F; @@ -1389,15 +1388,19 @@ fat_mutex_unlock (SCM mutex, SCM cond, int err = 0, ret = 0; scm_i_scm_pthread_mutex_lock (&m->lock); - if (!scm_is_eq (m->owner, scm_current_thread ())) + + SCM owner = m->owner; + + if (!scm_is_eq (owner, scm_current_thread ())) { - if (scm_is_false (m->owner)) + if (m->level == 0) { if (!m->unchecked_unlock) { scm_i_pthread_mutex_unlock (&m->lock); scm_misc_error (NULL, "mutex not locked", SCM_EOL); } + owner = scm_current_thread (); } else if (!m->allow_external_unlock) { @@ -1408,8 +1411,6 @@ fat_mutex_unlock (SCM mutex, SCM cond, if (! (SCM_UNBNDP (cond))) { - int lock_ret = 0; - c = SCM_CONDVAR_DATA (cond); while (1) { @@ -1418,8 +1419,9 @@ fat_mutex_unlock (SCM mutex, SCM cond, scm_i_scm_pthread_mutex_lock (&c->lock); if (m->level > 0) m->level--; - else + if (m->level == 0) m->owner = unblock_from_queue (m->waiting); + scm_i_pthread_mutex_unlock (&m->lock); t->block_asyncs++; @@ -1446,7 +1448,7 @@ fat_mutex_unlock (SCM mutex, SCM cond, if (brk) { if (relock) - fat_mutex_lock (mutex, NULL, &lock_ret); + scm_lock_mutex_timed (mutex, SCM_UNDEFINED, owner); scm_i_pthread_mutex_unlock (&c->lock); break; } @@ -1465,8 +1467,9 @@ fat_mutex_unlock (SCM mutex, SCM cond, { if (m->level > 0) m->level--; - else + if (m->level == 0) m->owner = unblock_from_queue (m->waiting); + scm_i_pthread_mutex_unlock (&m->lock); ret = 1; } @@ -1517,22 +1520,27 @@ SCM_DEFINE (scm_mutex_p, "mutex?", 1, 0, 0, } #undef FUNC_NAME -#if 0 - SCM_DEFINE (scm_mutex_owner, "mutex-owner", 1, 0, 0, (SCM mx), "Return the thread owning @var{mx}, or @code{#f}.") #define FUNC_NAME s_scm_mutex_owner { + SCM owner; + fat_mutex *m = NULL; + SCM_VALIDATE_MUTEX (1, mx); - return (SCM_MUTEX_DATA(mx))->owner; + m = SCM_MUTEX_DATA (mx); + scm_i_pthread_mutex_lock (&m->lock); + owner = m->owner; + scm_i_pthread_mutex_unlock (&m->lock); + + return owner; } #undef FUNC_NAME SCM_DEFINE (scm_mutex_level, "mutex-level", 1, 0, 0, (SCM mx), - "Return the lock level of a recursive mutex, or -1\n" - "for a standard mutex.") + "Return the lock level of mutex @var{mx}.") #define FUNC_NAME s_scm_mutex_level { SCM_VALIDATE_MUTEX (1, mx); @@ -1540,7 +1548,15 @@ SCM_DEFINE (scm_mutex_level, "mutex-level", 1, 0, 0, } #undef FUNC_NAME -#endif +SCM_DEFINE (scm_mutex_locked_p, "mutex-locked?", 1, 0, 0, + (SCM mx), + "Returns @code{#t} if the mutex @var{mx} is locked.") +#define FUNC_NAME s_scm_mutex_locked_p +{ + SCM_VALIDATE_MUTEX (1, mx); + return SCM_MUTEX_DATA (mx)->level > 0 ? SCM_BOOL_T : SCM_BOOL_F; +} +#undef FUNC_NAME static SCM fat_cond_mark (SCM cv) diff --git a/libguile/threads.h b/libguile/threads.h index 49d1f2efb..05ae1f4ff 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -175,12 +175,15 @@ SCM_API SCM scm_make_mutex (void); SCM_API SCM scm_make_recursive_mutex (void); SCM_API SCM scm_make_mutex_with_flags (SCM flags); SCM_API SCM scm_lock_mutex (SCM m); -SCM_API SCM scm_lock_mutex_timed (SCM m, SCM timeout); +SCM_API SCM scm_lock_mutex_timed (SCM m, SCM timeout, SCM owner); SCM_API void scm_dynwind_lock_mutex (SCM mutex); SCM_API SCM scm_try_mutex (SCM m); SCM_API SCM scm_unlock_mutex (SCM m); SCM_API SCM scm_unlock_mutex_timed (SCM m, SCM cond, SCM timeout); SCM_API SCM scm_mutex_p (SCM o); +SCM_API SCM scm_mutex_locked_p (SCM m); +SCM_API SCM scm_mutex_owner (SCM m); +SCM_API SCM scm_mutex_level (SCM m); SCM_API SCM scm_make_condition_variable (void); SCM_API SCM scm_wait_condition_variable (SCM cond, SCM mutex); diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test index 62ee0cdc7..9cd062d95 100644 --- a/test-suite/tests/threads.test +++ b/test-suite/tests/threads.test @@ -278,6 +278,52 @@ (pass-if "initial handler is false" (not (thread-cleanup (current-thread))))) + ;; + ;; mutex ownership + ;; + + (with-test-prefix "mutex-ownership" + (pass-if "mutex ownership for locked mutex" + (let ((m (make-mutex))) + (lock-mutex m) + (eq? (mutex-owner m) (current-thread)))) + + (pass-if "mutex ownership for unlocked mutex" + (let ((m (make-mutex))) + (not (mutex-owner m)))) + + (pass-if "locking mutex on behalf of other thread" + (let* ((m (make-mutex)) + (t (begin-thread 'foo))) + (lock-mutex m #f t) + (eq? (mutex-owner m) t))) + + (pass-if "locking mutex with no owner" + (let ((m (make-mutex))) + (lock-mutex m #f #f) + (not (mutex-owner m))))) + + ;; + ;; mutex lock levels + ;; + + (with-test-prefix "mutex-lock-levels" + + (pass-if "unlocked level is 0" + (let ((m (make-mutex))) + (and (not (mutex-locked? m)) (eqv? (mutex-level m) 0)))) + + (pass-if "non-recursive lock level is 1" + (let ((m (make-mutex))) + (lock-mutex m) + (and (mutex-locked? m) (eqv? (mutex-level m) 1)))) + + (pass-if "recursive lock level is >1" + (let ((m (make-mutex 'recursive))) + (lock-mutex m) + (lock-mutex m) + (and (mutex-locked? m) (eqv? (mutex-level m) 2))))) + ;; ;; mutex behavior ;; From 74926120a316f161c69a6df92b72318600737d36 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Wed, 14 May 2008 23:52:49 +0100 Subject: [PATCH 33/87] Delete trailing whitespace. --- doc/ref/api-scheduling.texi | 50 +++++++++++++++---------------- libguile/threads.c | 56 +++++++++++++++++------------------ libguile/threads.h | 4 +-- test-suite/tests/threads.test | 14 ++++----- 4 files changed, 62 insertions(+), 62 deletions(-) diff --git a/doc/ref/api-scheduling.texi b/doc/ref/api-scheduling.texi index 29eed5e3f..3b622868c 100644 --- a/doc/ref/api-scheduling.texi +++ b/doc/ref/api-scheduling.texi @@ -90,8 +90,8 @@ execution and triggering this execution. They will not be executed automatically. @menu -* System asyncs:: -* User asyncs:: +* System asyncs:: +* User asyncs:: @end menu @node System asyncs @@ -279,11 +279,11 @@ Return @code{#t} iff @var{obj} is a thread; otherwise, return @deffnx {C Function} scm_join_thread_timed (thread, timeout, timeoutval) Wait for @var{thread} to terminate and return its exit value. Threads that have not been created with @code{call-with-new-thread} or -@code{scm_spawn_thread} have an exit value of @code{#f}. When +@code{scm_spawn_thread} have an exit value of @code{#f}. When @var{timeout} is given, it specifies a point in time where the waiting -should be aborted. It can be either an integer as returned by -@code{current-time} or a pair as returned by @code{gettimeofday}. -When the waiting is aborted, @var{timeoutval} is returned (if it is +should be aborted. It can be either an integer as returned by +@code{current-time} or a pair as returned by @code{gettimeofday}. +When the waiting is aborted, @var{timeoutval} is returned (if it is specified; @code{#f} is returned otherwise). @end deffn @@ -378,9 +378,9 @@ in all threads is one way to avoid such problems. @deffn {Scheme Procedure} make-mutex . flags @deffnx {C Function} scm_make_mutex () @deffnx {C Function} scm_make_mutex_with_flags (SCM flags) -Return a new mutex. It is initially unlocked. If @var{flags} is +Return a new mutex. It is initially unlocked. If @var{flags} is specified, it must be a list of symbols specifying configuration flags -for the newly-created mutex. The supported flags are: +for the newly-created mutex. The supported flags are: @table @code @item unchecked-unlock Unless this flag is present, a call to `unlock-mutex' on the returned @@ -398,7 +398,7 @@ The returned mutex will be recursive. @deffn {Scheme Procedure} mutex? obj @deffnx {C Function} scm_mutex_p (obj) -Return @code{#t} iff @var{obj} is a mutex; otherwise, return +Return @code{#t} iff @var{obj} is a mutex; otherwise, return @code{#f}. @end deffn @@ -412,16 +412,16 @@ function is equivalent to calling `make-mutex' and specifying the @deffn {Scheme Procedure} lock-mutex mutex [timeout [owner]] @deffnx {C Function} scm_lock_mutex (mutex) @deffnx {C Function} scm_lock_mutex_timed (mutex, timeout, owner) -Lock @var{mutex}. If the mutex is already locked, then block and +Lock @var{mutex}. If the mutex is already locked, then block and return only when @var{mutex} has been acquired. -When @var{timeout} is given, it specifies a point in time where the -waiting should be aborted. It can be either an integer as returned -by @code{current-time} or a pair as returned by @code{gettimeofday}. -When the waiting is aborted, @code{#f} is returned. +When @var{timeout} is given, it specifies a point in time where the +waiting should be aborted. It can be either an integer as returned +by @code{current-time} or a pair as returned by @code{gettimeofday}. +When the waiting is aborted, @code{#f} is returned. When @var{owner} is given, it specifies an owner for @var{mutex} other -than the calling thread. @var{owner} may also be @code{#f}, +than the calling thread. @var{owner} may also be @code{#f}, indicating that the mutex should be locked but left unowned. For standard mutexes (@code{make-mutex}), and error is signalled if @@ -433,7 +433,7 @@ call increments the lock count. An additional @code{unlock-mutex} will be required to finally release. If @var{mutex} was locked by a thread that exited before unlocking it, -the next attempt to lock @var{mutex} will succeed, but +the next attempt to lock @var{mutex} will succeed, but @code{abandoned-mutex-error} will be signalled. When a system async (@pxref{System asyncs}) is activated for a thread @@ -445,7 +445,7 @@ executed. When the async returns, the wait resumes. Arrange for @var{mutex} to be locked whenever the current dynwind context is entered and to be unlocked when it is exited. @end deftypefn - + @deffn {Scheme Procedure} try-mutex mx @deffnx {C Function} scm_try_mutex (mx) Try to lock @var{mutex} as per @code{lock-mutex}. If @var{mutex} can @@ -458,26 +458,26 @@ the return is @code{#f}. @deffnx {C Function} scm_unlock_mutex (mutex) @deffnx {C Function} scm_unlock_mutex_timed (mutex, condvar, timeout) Unlock @var{mutex}. An error is signalled if @var{mutex} is not locked -and was not created with the @code{unchecked-unlock} flag set, or if +and was not created with the @code{unchecked-unlock} flag set, or if @var{mutex} is locked by a thread other than the calling thread and was not created with the @code{allow-external-unlock} flag set. If @var{condvar} is given, it specifies a condition variable upon which the calling thread will wait to be signalled before returning. -(This behavior is very similar to that of +(This behavior is very similar to that of @code{wait-condition-variable}, except that the mutex is left in an unlocked state when the function returns.) -When @var{timeout} is also given, it specifies a point in time where -the waiting should be aborted. It can be either an integer as -returned by @code{current-time} or a pair as returned by -@code{gettimeofday}. When the waiting is aborted, @code{#f} is +When @var{timeout} is also given, it specifies a point in time where +the waiting should be aborted. It can be either an integer as +returned by @code{current-time} or a pair as returned by +@code{gettimeofday}. When the waiting is aborted, @code{#f} is returned. Otherwise the function returns @code{#t}. @end deffn @deffn {Scheme Procedure} mutex-owner mutex @deffnx {C Function} scm_mutex_owner (mutex) -Return the current owner of @var{mutex}, in the form of a thread or +Return the current owner of @var{mutex}, in the form of a thread or @code{#f} (indicating no owner). Note that a mutex may be unowned but still locked. @end deffn @@ -503,7 +503,7 @@ Return a new condition variable. @deffn {Scheme Procedure} condition-variable? obj @deffnx {C Function} scm_condition_variable_p (obj) -Return @code{#t} iff @var{obj} is a condition variable; otherwise, +Return @code{#t} iff @var{obj} is a condition variable; otherwise, return @code{#f}. @end deffn diff --git a/libguile/threads.c b/libguile/threads.c index 6c4526ba4..bf4ab165b 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -1,5 +1,5 @@ /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 as published by the Free Software Foundation; either @@ -565,15 +565,15 @@ do_thread_exit (void *v) while (scm_is_true (unblock_from_queue (t->join_queue))) ; - while (!scm_is_null (t->mutexes)) + while (!scm_is_null (t->mutexes)) { SCM mutex = SCM_CAR (t->mutexes); fat_mutex *m = SCM_MUTEX_DATA (mutex); scm_i_pthread_mutex_lock (&m->lock); - + unblock_from_queue (m->waiting); - scm_i_pthread_mutex_unlock (&m->lock); + scm_i_pthread_mutex_unlock (&m->lock); t->mutexes = SCM_CDR (t->mutexes); } @@ -678,7 +678,7 @@ scm_i_init_thread_for_guile (SCM_STACKITEM *base, SCM parent) { /* This thread is already guilified but not in guile mode, just resume it. - + XXX - base might be lower than when this thread was first guilified. */ @@ -807,7 +807,7 @@ scm_i_with_guile_and_parent (void *(*func)(void *), void *data, SCM parent) scm_i_pthread_cleanup_pop (0); scm_leave_guile (); } - else + else res = scm_c_with_continuation_barrier (func, data); return res; @@ -905,7 +905,7 @@ SCM_DEFINE (scm_call_with_new_thread, "call-with-new-thread", 1, 1, 0, } scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex); scm_i_pthread_mutex_unlock (&data.mutex); - + return data.thread; } #undef FUNC_NAME @@ -982,7 +982,7 @@ scm_spawn_thread (scm_t_catch_body body, void *body_data, } scm_i_scm_pthread_cond_wait (&data.cond, &data.mutex); scm_i_pthread_mutex_unlock (&data.mutex); - + return data.thread; } @@ -1100,7 +1100,7 @@ SCM_DEFINE (scm_join_thread_timed, "join-thread", 1, 2, 0, { while (1) { - int err = block_self (t->join_queue, thread, &t->admin_mutex, + int err = block_self (t->join_queue, thread, &t->admin_mutex, timeout_ptr); if (err == 0) { @@ -1208,7 +1208,7 @@ SCM_DEFINE (scm_make_mutex_with_flags, "make-mutex", 0, 0, 1, external_unlock = 1; else if (scm_is_eq (flag, recursive_sym)) recursive = 1; - else + else SCM_MISC_ERROR ("unsupported mutex option: ~a", scm_list_1 (flag)); ptr = SCM_CDR (ptr); } @@ -1245,7 +1245,7 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret) { m->owner = new_owner; m->level++; - + if (SCM_I_IS_THREAD (new_owner)) { scm_i_thread *t = SCM_I_THREAD_DATA (new_owner); @@ -1270,7 +1270,7 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret) if (m->recursive) { m->level++; - *ret = 1; + *ret = 1; } else { @@ -1279,11 +1279,11 @@ fat_mutex_lock (SCM mutex, scm_t_timespec *timeout, SCM owner, int *ret) "by thread")); *ret = 0; } - break; + break; } else { - if (timeout != NULL) + if (timeout != NULL) { gettimeofday (¤t_time, NULL); if (current_time.tv_sec > timeout->tv_sec || @@ -1360,7 +1360,7 @@ SCM_DEFINE (scm_try_mutex, "try-mutex", 1, 0, 0, to_timespec (scm_from_int(0), &cwaittime); waittime = &cwaittime; - + exception = fat_mutex_lock (mutex, waittime, SCM_UNDEFINED, &ret); if (!scm_is_false (exception)) scm_ithrow (SCM_CAR (exception), scm_list_1 (SCM_CDR (exception)), 1); @@ -1423,9 +1423,9 @@ fat_mutex_unlock (SCM mutex, SCM cond, m->owner = unblock_from_queue (m->waiting); scm_i_pthread_mutex_unlock (&m->lock); - + t->block_asyncs++; - + err = block_self (c->waiting, cond, &c->lock, waittime); if (err == 0) @@ -1439,11 +1439,11 @@ fat_mutex_unlock (SCM mutex, SCM cond, brk = 1; } else if (err != EINTR) - { + { errno = err; scm_i_pthread_mutex_unlock (&c->lock); scm_syserror (NULL); - } + } if (brk) { @@ -1452,12 +1452,12 @@ fat_mutex_unlock (SCM mutex, SCM cond, scm_i_pthread_mutex_unlock (&c->lock); break; } - + scm_i_pthread_mutex_unlock (&c->lock); t->block_asyncs--; scm_async_click (); - + scm_remember_upto_here_2 (cond, mutex); scm_i_scm_pthread_mutex_lock (&m->lock); @@ -1467,13 +1467,13 @@ fat_mutex_unlock (SCM mutex, SCM cond, { if (m->level > 0) m->level--; - if (m->level == 0) + if (m->level == 0) m->owner = unblock_from_queue (m->waiting); - + scm_i_pthread_mutex_unlock (&m->lock); ret = 1; } - + return ret; } @@ -1518,7 +1518,7 @@ SCM_DEFINE (scm_mutex_p, "mutex?", 1, 0, 0, { return SCM_MUTEXP (obj) ? SCM_BOOL_T : SCM_BOOL_F; } -#undef FUNC_NAME +#undef FUNC_NAME SCM_DEFINE (scm_mutex_owner, "mutex-owner", 1, 0, 0, (SCM mx), @@ -1618,7 +1618,7 @@ SCM_DEFINE (scm_timed_wait_condition_variable, "wait-condition-variable", 2, 1, SCM_VALIDATE_CONDVAR (1, cv); SCM_VALIDATE_MUTEX (2, mx); - + if (!SCM_UNBNDP (t)) { to_timespec (t, &waittime); @@ -1924,7 +1924,7 @@ scm_i_thread_put_to_sleep () scm_leave_guile (); scm_i_pthread_mutex_lock (&thread_admin_mutex); - /* Signal all threads to go to sleep + /* Signal all threads to go to sleep */ scm_i_thread_go_to_sleep = 1; for (t = all_threads; t; t = t->next_thread) @@ -2007,7 +2007,7 @@ scm_threads_prehistory (SCM_STACKITEM *base) scm_i_pthread_cond_init (&wake_up_cond, NULL); scm_i_pthread_key_create (&scm_i_freelist, NULL); scm_i_pthread_key_create (&scm_i_freelist2, NULL); - + guilify_self_1 (base); } diff --git a/libguile/threads.h b/libguile/threads.h index 05ae1f4ff..8abe452bb 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -67,7 +67,7 @@ typedef struct scm_i_thread { int sleep_fd, sleep_pipe[2]; /* This mutex represents this threads right to access the heap. - That right can temporarily be taken away by the GC. + That right can temporarily be taken away by the GC. */ scm_i_pthread_mutex_t heap_mutex; @@ -89,7 +89,7 @@ typedef struct scm_i_thread { */ SCM active_asyncs; /* The thunks to be run at the next safe point */ - unsigned int block_asyncs; /* Non-zero means that asyncs should + unsigned int block_asyncs; /* Non-zero means that asyncs should not be run. */ unsigned int pending_asyncs; /* Non-zero means that asyncs might be pending. */ diff --git a/test-suite/tests/threads.test b/test-suite/tests/threads.test index 9cd062d95..caace7fd4 100644 --- a/test-suite/tests/threads.test +++ b/test-suite/tests/threads.test @@ -188,9 +188,9 @@ (signal-condition-variable c1) (lock-mutex m2) (unlock-mutex m1) - (unlock-mutex m2 - c2 - (+ (current-time) + (unlock-mutex m2 + c2 + (+ (current-time) 2)))))) (wait-condition-variable c1 m1) (unlock-mutex m1) @@ -213,7 +213,7 @@ (r (join-thread t (current-time)))) (cancel-thread t) (not r))) - + (pass-if "join-thread returns timeoutval on timeout" (let* ((m (make-mutex)) (c (make-condition-variable)) @@ -222,7 +222,7 @@ (r (join-thread t (current-time) 'foo))) (cancel-thread t) (eq? r 'foo))) - + (pass-if "timed joining succeeds if thread exits within timeout" (let ((t (begin-thread (begin (sleep 1) #t)))) @@ -308,7 +308,7 @@ ;; (with-test-prefix "mutex-lock-levels" - + (pass-if "unlocked level is 0" (let ((m (make-mutex))) (and (not (mutex-locked? m)) (eqv? (mutex-level m) 0)))) @@ -343,7 +343,7 @@ (pass-if "recursive mutexes" (let* ((m (make-mutex 'recursive))) (lock-mutex m) - (lock-mutex m))) + (lock-mutex m))) (pass-if "locking abandoned mutex throws exception" (let* ((m (make-mutex)) From 184af225b8a5233e6e5a24379f99026de3721117 Mon Sep 17 00:00:00 2001 From: Julian Graham Date: Sun, 13 Apr 2008 20:31:18 -0400 Subject: [PATCH 34/87] ChangeLog updates for latest set of SRFI-18 changes --- doc/ref/ChangeLog | 8 ++++++++ libguile/ChangeLog | 14 ++++++++++++++ test-suite/ChangeLog | 9 +++++++++ 3 files changed, 31 insertions(+) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 275a2a166..a143afe06 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,11 @@ +2008-05-14 Julian Graham + + * api-scheduling.texi (Mutexes and Condition Variables): Add + documentation for new functions "scm_mutex_owner", + "scm_mutex_level", and "scm_mutex_locked_p". Update + documentation for function "scm_lock_mutex_timed" to reflect + addition of optional ownership argument. + 2008-05-07 Ludovic Courtès * Makefile.am (autoconf-macros.texi): Avoid use of GNU Make diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5afdd6589..93814071c 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,17 @@ +2008-05-14 Julian Graham + + * threads.c (fat_mutex)[recursive]: New field. + (make_fat_mutex): Adjust initialization to reflect changes to + mutex lock level semantics. + (fat_mutex_lock, fat_mutex_unlock): Add support for unowned + mutexes and locking mutexes on behalf of other threads. + (scm_lock_mutex, scm_lock_mutex_timed): Update to reflect + signature change to fat_mutex_lock. + (scm_mutex_owner, scm_mutex_level, scm_mutex_locked_p): New / + re-enabled functions. + * threads.h (scm_mutex_owner, scm_mutex_level, + scm_mutex_locked_p): Prototypes for new functions. + 2008-05-12 Neil Jerram * discouraged.c: Expand DEFFROM and DEFTO macros, to avoid diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index c2dc5aaed..5a1afc84c 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,12 @@ +2008-05-14 Julian Graham + + * tests/threads.test (mutex-ownership, mutex-lock-levels): New + test prefix. + (mutex ownership for locked mutex, mutex ownership for unlocked + mutex, locking mutex on behalf of other thread, locking mutex + with no owner, unlocked level is 0, non-recursive lock level + is 1, recursive lock level is >1): New tests. + 2008-04-28 Ludovic Courtès * tests/srfi-1.test (partition)[with improper list]: New test. From 241d9cea20f77eeaa3546be4f8e7af7135bd3654 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 15 May 2008 00:00:57 +0100 Subject: [PATCH 35/87] Delete trailing whitespace. --- doc/ref/ChangeLog | 68 +++--- libguile/ChangeLog | 482 +++++++++++++++++++++---------------------- test-suite/ChangeLog | 18 +- 3 files changed, 284 insertions(+), 284 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index a143afe06..de6409755 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -50,7 +50,7 @@ Applying patch from Julian Graham, containing minor fixes to his thread enhancements: - + * api-scheduling.texi (Mutexes and Condition Variables): Change `flag' to `flags' in docstring. @@ -86,14 +86,14 @@ (Examples): Moved to api-debug.texi. (Tracing, Old Tracing): Promoted one level. (New Tracing, Tracing Compared): Removed. - + 2008-03-08 Julian Graham - * api-scheduling.texi (Threads): Add documentation for new + * api-scheduling.texi (Threads): Add documentation for new functions "scm_thread_p" and new "scm_join_thread_timed". - (Mutexes and Condition Variables): Add documentation for new - functions "scm_make_mutex_with_flags", "scm_mutex_p", - "scm_lock_mutex_timed", "scm_unlock_mutex_timed", and + (Mutexes and Condition Variables): Add documentation for new + functions "scm_make_mutex_with_flags", "scm_mutex_p", + "scm_lock_mutex_timed", "scm_unlock_mutex_timed", and "scm_condition_variable_p". 2008-02-11 Neil Jerram @@ -255,7 +255,7 @@ (lib-version.texi): New target. * guile.texi: Include `lib-version.texi'. - + * api-data.texi (Conversion): Link to `The ice-9 i18n Module' when describing `string->number'. (String Comparison): Likewise. @@ -443,7 +443,7 @@ * api-debug.texi (Debug on Error): Note need to handling of errors in C. - + * api-debug.texi (Debugging): New intro text. New subsection "Evaluation Model". Moved existing subsections "Capturing the Stack or Innermost Stack Frame", "Examining the Stack", "Examining @@ -479,7 +479,7 @@ * api-evaluation.texi (Fly Evaluation): Add scm_c_eval_string. (Loading): Add scm_c_primitive_load. Reported by Jon Wilson. - + 2006-06-25 Kevin Ryde * posix.texi (Time): In tm:gmtoff, give example values, note not the @@ -613,7 +613,7 @@ * api-data.texi (Operations Related to Symbols): Documented `scm_take_locale_symbol ()'. - + 2005-12-15 Kevin Ryde * api-evaluation.texi (Fly Evaluation): Add scm_call_4, suggested by @@ -704,7 +704,7 @@ * misc-modules.texi (Formatted Output): Show modifiers like ~:d instead of in words. - + 2005-08-06 Kevin Ryde * api-compound.texi (List Modification): In filter, return may share a @@ -1051,7 +1051,7 @@ * api-i18n.texi: New file. * Makefile.am (guile_TEXINFOS): Added it. * guile.texi: Include it. - + 2004-09-16 Kevin Ryde * api-utility.texi (Equality): Revise for clarity. @@ -1106,16 +1106,16 @@ Ran a (docstring-process-module "(guile)") and moved entries from new-docstrings.texi to their appropriate place. - + * api-undocumented.texi: New file. 2004-08-21 Marius Vollmer From Richard Todd, Thanks! - + * scheme-scripts.texi (Invoking Guile): documented new '-L' switch. - + 2004-08-20 Marius Vollmer * gh.texi: Updated transition section with new recommended things. @@ -1126,7 +1126,7 @@ mutation-sharing substrings. (Symbols): Document scm_from_locale_symbol and scm_from_locale_symboln. - + 2004-08-18 Kevin Ryde * posix.texi (Network Sockets and Communication): Add SOCK_RDM and @@ -1188,7 +1188,7 @@ scm_is_complex, scm_is_number, scm_c_make_rectangular, scm_c_make_polar, scm_c_real_part, scm_c_imag_part, scm_c_magnitude, and scm_c_angle. - + 2004-08-02 Marius Vollmer * gh.texi: Replaced references to scm_num2* with scm_to_* and @@ -1224,7 +1224,7 @@ * api-deprecated.texi: Removed. * intro.texi (Discouraged and Deprecated): General information about deprecation, etc. - + 2004-07-30 Marius Vollmer * misc-modules.texi (Formatted Output): Changed @w to @w{} in @@ -1309,7 +1309,7 @@ * Makefile.am (CLEANFILES): Remove guile.cps guile.fns guile.rns guile.tps guile.vrs guile.tmp, cleaned by automake these days. - + 2004-05-06 Marius Vollmer * scheme-smobs.texi: Updated for new SCM_SMOB_* macros. @@ -1392,7 +1392,7 @@ * scheme-control.texi (while do): Expand and clarify `do', in particular note iteration binds fresh locations, rather than values "stored". - + * srfi-modules.texi (SRFI-4): Revise for clarity, give each function explicitly rather than showing TAG so Emacs info-look can find them, merge "SRFI-4 - Read Syntax" and "SRFI-4 - Procedures" into just one @@ -1422,7 +1422,7 @@ 2004-01-21 Marius Vollmer Added copyright notices to all TeXinfo files. - + * fdl.texi: New. * guile.texi: Include it as an appendix. * preface.texi: State that the manual is FDL. @@ -1444,7 +1444,7 @@ * misc-modules.texi (Queues): New chapter. * guile.texi (Top): Add it. - + 2004-01-09 Kevin Ryde * scheme-compound.texi (Bit Vectors): Revise for clarity, following @@ -1499,7 +1499,7 @@ * scheme-data.texi: Include exact rationals. From Stephen Compall. Thanks! - + * intro.texi (What is Guile?): Add @acronym for POSIX, R5RS, GUI, and HTTP. Conclude linking libguile. Say what one can find *for*. @@ -1580,7 +1580,7 @@ * data-rep.texi, scheme-memory.texi (scm_remember_upto_here_1, scm_remember_upto_here_2): Moved from data-rep.texi to scheme-memory.texi. - + 2003-10-02 Kevin Ryde * scheme-io.texi (String Ports): In call-with-output-string, note proc @@ -1911,7 +1911,7 @@ remainder and modulo round their results. * scheme-io.texi (Reading): In read-char and peek-char, fix typos "?" - in @rnindex. In port-column, use @: after i.e. + in @rnindex. In port-column, use @: after i.e. (Writing): In get-print-state, two spaces after full stop. Add write, revise display. @@ -1930,7 +1930,7 @@ 2003-04-30 Marius Vollmer - * posix.texi (scm_c_port_for_each): Added. + * posix.texi (scm_c_port_for_each): Added. 2003-04-26 Neil Jerram @@ -2061,7 +2061,7 @@ Configuration. The following doc updates are from Ian Sheldon - thanks! - + * scheme-data.texi (Appending Strings, Regexp Functions, Match Structures): Add examples. (Regular Expressions): Add instruction to use (ice-9 regex) @@ -2099,7 +2099,7 @@ * intro.texi: Updated GNu ftp server name. Use "-lguile" instead of "libguile.a". Some small fixes/improvements. - + * scheme-reading.texi: Added www.schemers.org. Removed foldoc, it's too generic. Updated 'teach yourself ...' URL. @@ -2110,7 +2110,7 @@ 2002-08-14 Marius Vollmer - * scheme-evaluation.texi (eval-string): Updated. + * scheme-evaluation.texi (eval-string): Updated. * scheme-scheduling.texi (Fluids): Touched up a bit, added with-fluids. @@ -2150,7 +2150,7 @@ * scheme-memory.texi (Memory Blocks): add scm_calloc, scm_gc_calloc. correct typos. - + 2002-08-05 Marius Vollmer * intro.texi, srfi-modules.texi: Added (use-modules (ice-9 @@ -2194,7 +2194,7 @@ rather than deprecated section. Hence this change. Added `@deftp' for scm_t_bits data type so that a proper index entry is added for this. Thanks to Richard Y. Kim! - + * data-rep.texi (Subrs): Changed scm_make_gsubr to scm_c_define_gsubr. Thanks to Richard Y. Kim! @@ -2231,13 +2231,13 @@ * scheme-debug.texi (Debugging): Rename chapter `Debugging Infrastructure' and reorganize its contents. - + * scheme-debug.texi (Debugging), scheme-control.texi (Handling Errors): Move display-error to error-focussed section. * scheme-debug.texi (Debugging), debugging.texi (Backtrace): Move backtrace to user-level debugging chapter. - + * scheme-debug.texi (Debugging), scheme-procedures.texi (Procedure Properties): Move procedure-name, procedure-source and procedure-environment to procedures chapter. @@ -2320,7 +2320,7 @@ * scheme-utility.texi (Hooks): Further updates. New material on GC hooks. - + * scheme-evaluation.texi (Fly Evaluation): Note disappearance of eval2 and read-and-eval!. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 93814071c..5962f7e14 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -154,15 +154,15 @@ 2008-03-08 Julian Graham - * threads.c (scm_join_thread_timed, scm_thread_p, - scm_make_mutex_with_flags, scm_lock_mutex_timed, - scm_unlock_mutex_timed, scm_mutex_p, scm_condition_variable_p): New + * threads.c (scm_join_thread_timed, scm_thread_p, + scm_make_mutex_with_flags, scm_lock_mutex_timed, + scm_unlock_mutex_timed, scm_mutex_p, scm_condition_variable_p): New functions. (thread_mark): Updated to mark new struct field `mutexes'. - (do_thread_exit): Notify threads waiting on mutexes locked by exiting + (do_thread_exit): Notify threads waiting on mutexes locked by exiting thread. - (scm_join_thread, scm_make_mutex, scm_make_recursive_mutex, - scm_mutex_lock): Reimplement in terms of their newer + (scm_join_thread, scm_make_mutex, scm_make_recursive_mutex, + scm_mutex_lock): Reimplement in terms of their newer counterparts. (scm_abandoned_mutex_error_key): New symbol. (fat_mutex)[unchecked_unlock, allow_external_unlock]: New fields. @@ -171,11 +171,11 @@ reimplement scm_try_mutex as a lock attempt with a timeout of zero. (fat_mutex_unlock): Allow unlocking from other threads and unchecked unlocking; implement in terms of condition variable wait. - (scm_timed_wait_condition_variable): Reimplement in terms of + (scm_timed_wait_condition_variable): Reimplement in terms of fat_mutex_unlock. * threads.h (scm_i_thread)[mutexes]: New field. (scm_join_thread_timed, scm_thread_p, scm_lock_mutex_timed, - scm_unlock_mutex_timed, scm_mutex_p, scm_condition_variable_p): + scm_unlock_mutex_timed, scm_mutex_p, scm_condition_variable_p): Prototypes for new functions. 2008-03-06 Ludovic Courtès @@ -256,14 +256,14 @@ 2008-02-07 Julian Graham - * threads.c (do_thread_exit, scm_cancel_thread, - scm_set_thread_cleanup_x, scm_thread_cleanup): Lock on thread-specific + * threads.c (do_thread_exit, scm_cancel_thread, + scm_set_thread_cleanup_x, scm_thread_cleanup): Lock on thread-specific admin mutex instead of `thread_admin_mutex'. * threads.h (scm_i_thread)[admin_mutex]: New field. * throw.c (make_jmpbuf): Don't enter critical section during thread spawn -- there is a possibility of deadlock if other threads are exiting. - + 2008-02-06 Neil Jerram * gc-malloc.c (scm_gc_malloc): Return NULL if requested size is 0. @@ -373,7 +373,7 @@ Call `scm_i_close_signal_pipe ()' when the next-to-last thread vanishes. (scm_leave_guile_cleanup): New. - (scm_i_with_guile_and_parent): Use `scm_i_pthread_cleanup_push ()' + (scm_i_with_guile_and_parent): Use `scm_i_pthread_cleanup_push ()' and `scm_leave_guile_cleanup ()' to leave guile mode, rather than call `scm_leave_guile ()' after FUNC. (scm_cancel_thread, scm_set_thread_cleanup_x, @@ -383,7 +383,7 @@ * threads.h (scm_i_thread)[cleanup_handler, canceled]: New fields. Add declarations of new functions. - + 2007-10-17 Ludovic Courtès * read.c (CHAR_IS_BLANK_): Add `\r' (ASCII 0x0d). This fixes a @@ -406,9 +406,9 @@ `enter_locale_section ()' since the mutex is not held and locale settings are unchanged. (scm_nl_langinfo)[!USE_GNU_LOCALE_API]: Use - `restore_locale_settings ()' instead of `leave_locale_section ()' + `restore_locale_settings ()' instead of `leave_locale_section ()' since the mutex is not held. - + 2007-10-02 Ludovic Courtès * threads.c (on_thread_exit): Don't call `scm_leave_guile ()' @@ -425,7 +425,7 @@ * posix.c (scm_putenv): Confine the putenv("NAME=") bit to mingw, use putenv("NAME") as the fallback everywhere else. In particular this is needed for solaris 9. Reported by Frank Storbeck. - + 2007-09-03 Ludovic Courtès * read.c (flush_ws): Handle SCSH block comments. @@ -489,7 +489,7 @@ Fix tests of the tc16 number types, they were checked under scm_tc7_number, but the values went down the tag>=255 smob case. Put smob case under scm_tc7_smob instead of using tag>=255, per - recommendation in comments with scm_tc7_smob to use symbolic values. + recommendation in comments with scm_tc7_smob to use symbolic values. Use SCM_TC2SMOBNUM to extract scm_smobs index, instead of explicit code. Lose some unnecessary "break" statements. @@ -755,7 +755,7 @@ is equal to S1 and FIELD2 is equal to S2. This avoids infinite recursion when comparing `s' fields, as the REQUIRED_VTABLE_FIELDS added by `make-vtable-vtable'. Reported by Marco Maggi. - + 2007-01-18 Han-Wen Nienhuys * throw.c (scm_ithrow): more refined error message: print symbols @@ -848,7 +848,7 @@ Also, the REDUCED bit alters the SCM_CELL_TYPE(), making comparisons between reduced and unreduced fractions go wrong. - + * numbers.h: remove SCM_FRACTION_SET_NUMERATOR, SCM_FRACTION_SET_DENOMINATOR, SCM_FRACTION_REDUCED_BIT, SCM_FRACTION_REDUCED_SET, SCM_FRACTION_REDUCED_CLEAR, @@ -959,7 +959,7 @@ * script.c (scm_shell_usage): Note need for subscription to bug-guile@gnu.org. 2006-11-08 Ludovic Courtès - + * libguile/gc-freelist.c (scm_i_adjust_min_yield): Take two "sweep_stats" arguments; use them instead of accessing the global variables `scm_gc_cells_collected' and `scm_gc_cells_collected_1'. @@ -1010,7 +1010,7 @@ 2006-10-25 Neil Jerram IA64 HP-UX GC patch from Hrvoje NikÅ¡ić. (Thanks!) - + * threads.c (SCM_MARK_BACKING_STORE): Use scm_ia64_ar_bsp() and scm_ia64_register_backing_store_base() instead of Linux-specific implementations. @@ -1198,7 +1198,7 @@ HAVE_TM_ZONE. (scm_strptime): Use tm_gmtoff from the strptime result when that field exists, it's set by glibc strptime "%s". - + 2006-06-13 Ludovic Courtès * eq.c: Include "struct.h", "goops.h" and "objects.h". @@ -1224,7 +1224,7 @@ * throw.c (scm_handle_by_message): Add dummy return value to avoid compiler warning on cygwin. Reported by Ryan VanderBijl. - + * Makefile.am (EXTRA_DOT_X_FILES): Typo in dependency rule, was a duplicate of EXTRA_DOT_DOC_FILES. (DOT_X_FILES, EXTRA_DOT_X_FILES, DOT_DOC_FILES, EXTRA_DOT_DOC_FILES): @@ -1338,7 +1338,7 @@ * fports.c (scm_setvbuf): Fix for not _IOLBF, clear SCM_BUFLINE instead of toggling it. Reported by Ludovic Courtès. - + 2006-03-26 Marius Vollmer * threads.c (get_thread_stack_base): Use scm_get_stack_base @@ -1608,7 +1608,7 @@ 2005-12-07 Marius Vollmer Reported by Bruce Korb: - + * init.c (invoke_main_func): Don't call exit here. Throws that are only caught by scm_with_guile will bypass us and would cause scm_boot_guile to return erroneously. @@ -1616,16 +1616,16 @@ here, passing it an appropriate exit code. From Andy Wingo: - + * script.c (scm_find_executable): Compile fix -- fgetc returns an unsigned char cast to an int, or -1 for EOS. - + 2005-12-06 Marius Vollmer * srfi-4.h, srfi-4.c, srfi-4.i.c (take_uvec): Make BASE pointer non-const. (scm_take_u8vector, etc): Likewise. Thanks to Ludovic Courtès! - + * threads.h, threads.c (scm_t_guile_ticket, scm_leave_guile, scm_enter_guile): Removed from public API. See comment at scm_without_guile for the rationale. @@ -1726,7 +1726,7 @@ 2005-10-23 Marius Vollmer PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP is not portable enough. - + * null-threads.h, pthread-threads.h (SCM_I_PTHREAD_RECURSIVE_MUTEX_INITIALIZER): Removed. (scm_i_pthread_mutexattr_recursive): New. @@ -1736,7 +1736,7 @@ (scm_threads_prehistory): Initialize scm_i_pthread_mutexattr_recursive and scm_i_critical_section_mutex here. - + * eval.c (source_mutex): Do not initialiaze statically. (scm_init_eval): Do it here, using scm_i_pthread_mutexattr_recursive. @@ -1750,7 +1750,7 @@ (quote_keywordish_symbol): New, for evaluating the option. (scm_print_symbol_name): Use it. (scm_init_print): Initialize new option to sym_reader. - + 2005-08-15 Neil Jerram * eval.c (eval_letrec_inits): New. @@ -1785,7 +1785,7 @@ * modules.h, modules.c (scm_eval_closure_module): Removed, we already have scm_lookup_closure_module, which does the same thing. - + 2005-08-01 Marius Vollmer New marking algorithm for weak hashtables that fixes the problem @@ -1794,7 +1794,7 @@ Guardians have been changed back to their original semantics and are no longer greedy and no longer drop cycles. - + * gc-mark.c (scm_mark_all): Do not rely on hooks to run the weak hashtable and guardian machinery but call the relevant functions directly. @@ -1809,7 +1809,7 @@ scm_i_identify_inaccessible_guardeds, scm_i_mark_inaccessible_guardeds): New. (scm_make_guardian): Removed greedy_p argument. - + * weaks.h, weaks.c (SCM_I_WVECT_TYPE, SCM_I_SET_WVECT_TYPE): New. (SCM_I_WVECT_N_ITEMS, SCM_I_SET_WVECT_N_ITEMS): New. (SCM_WVECTF_NOSCAN, SCM_WVECT_NOSCAN_P): Removed. @@ -1819,7 +1819,7 @@ scm_i_remove_weaks_from_weak_vectors, scm_i_remove_weaks): New. (scm_weak_vector_gc_init, scm_mark_weak_vector_spines, scm_scan_weak_vectors): Removed. - + * hashtab.h (scm_i_scan_weak_hashtables): New. * hashtab.c (make_hash_table, scm_i_rehash): Do not use SCM_WVECTF_NOSCAN. @@ -1845,7 +1845,7 @@ * hashtab.c (scm_i_rehash): Cast SCM_HASHTABLE_FLAGS (table) to scm_t_bits before storing them in the type word. - + * gc.c (tag_table_to_type_alist): Modified type of c_tag from scm_t_bits to int. @@ -1856,11 +1856,11 @@ * pairs.c (scm_error_pair_access): Use scm_from_locale_string rather than scm_makfrom0str. Reported by Ken Raeburn. - + * gc-card.c (scm_dbg_gc_get_bvec): Change return from long* to scm_t_c_bvec_long*, gcc 4 doesn't like different pointer targets when returning SCM_GC_CARD_BVEC. - + * pairs.c (scm_error_pair_access): Plain ascii ' in error message rather than latin-1 acute accent, the latter may not print on all terminals. @@ -1932,7 +1932,7 @@ 2005-06-09 Han-Wen Nienhuys * gc.c (tag_table_to_type_alist): convert tag number to "tag %d" - string, so live object stats can be sorted with string @@ -1963,21 +1963,21 @@ From Jan Nieuwenhuizen . Thanks! * hashtab.h: Bugfix: use SCM_API (WAS: extern). - + * socket.c: Remove obsolete comment about socklen_t. (s_scm_setsockopt)[!HAVE_IP_MREQ]: Do not use ip_mreq code. - + * numbers.h (isnan)[__MINGW32__]: Remove. - + * Makefile.am (gen_scmconfig_SOURCES): Bugfix: Add DEFAULT_INCLUDES when cross compiling. - + * threads.c (ETIMEDOUT, pipe)[__MINGW32__]: Add defines. * stime.c (scm_strftime)[!HAVE_TM_ZONE]: Use SCM_SIMPLE_VECTOR_REF instead of SCM_VELTS. (Changed slightly from Jan's patch.) - + 2005-05-22 Marius Vollmer * unif.c (scm_make_shared_array): Add old base to new base since @@ -1990,7 +1990,7 @@ 2005-05-12 Neil Jerram Mac OS X compile warning fixes, reported by Richard Todd. - + * unif.c (scm_i_read_array): Declare rank as ssize_t, to guarantee that it is signed. @@ -2011,7 +2011,7 @@ 2005-05-11 Neil Jerram Fix C99isms reported by Ludovic Courtès: - + * threads.c (s_scm_lock_mutex): Don't declare msg in middle of code. @@ -2086,7 +2086,7 @@ non-NULL. Always use a NULL closure. (scm_hash_fn_create_handle_x): Also rehash when table contains too few entries. - + 2005-03-29 Marius Vollmer * hashtab.h, hashtab.c (scm_hash_fx_remove_x): Removed delete_fn @@ -2096,7 +2096,7 @@ (scm_hashx_remove_x): Likewise. Also, exported to Scheme. (scm_hash_clear): Accept plain vectors as hashtables. (scm_delx_x): Removed. - + 2005-03-28 Han-Wen Nienhuys * inline.h (scm_double_cell): use __asm__ iso. asm, to maintain @@ -2108,7 +2108,7 @@ scm_root. * threads.c: Removed fprintf debug statements. - + 2005-03-24 Neil Jerram * debug.c (scm_make_memoized): Restore use of SCM_UNPACK. @@ -2208,13 +2208,13 @@ simple things inside that region. (scm_make_fluid, scm_make_dynamic_state): Lock fluid_admin_mutex while adding to the global lists. - + 2005-03-08 Marius Vollmer libltdl is no longer distributed. We expect it to be installed already. - + * Makefile.am (INCLUDES): Removed @LTDLINCL@. (libguile_la_LIBADD): Removed @LIBLTDL@. @@ -2232,14 +2232,14 @@ * throw.c (scm_ithrow): Abort when scm_i_critical_section_level is not zero. - + * threads.h, threads.c (scm_frame_lock_mutex): New. (scm_frame_critical_section): Take mutex as argument. (framed_critical_section_mutex): New, used as default for above. (scm_init_threads): Initialize it. (scm_threads_prehistory): Do not initialize thread_admin_mutex and scm_i_critical_section_mutex; both are initialized statically. - + * continuation.c, deprecated.c, goops.c, guardians.c keywords.c, libguile_la-arrays.loT, objprop.c, ports.c, smob.c, sort.s, srcprop.c, stime.c, struct.c, throw.c, regex-posix.c: Include @@ -2253,7 +2253,7 @@ section. (scm_dynthrow): Abort when scm_i_critical_section_level is not zero. - + 2005-03-04 Marius Vollmer * threads.c (scm_try_mutex): Renamed argument for consistency. @@ -2266,11 +2266,11 @@ Big merge from the mvo-thread-cleanup branch. The main changes are: - + - The dynamic roots functionality has been split into dynamic states and continuations barriers. Fluids have been reimplemented and can now be garbage collected. - + - Initialization of Guile now works in a multi-thread friendly manner. Threads can freely enter and leave guile mode. @@ -2281,13 +2281,13 @@ - Signals are delivered via a pipe to a dedicated 'signal delivery thread'. - + - SCM_DEFER_INTS, SCM_ALLOW_INTS etc have been deprecated. * throw.c (scm_handle_by_message): Exit only the current thread, not the whole process. (scm_handle_by_message_noexit): Exit when catching 'quit. - + * scmsigs.c (take_signal, signal_delivery_thread, start_signal_delivery_thread, ensure_signal_delivery_thread, install_handler): Reimplemented signal delivery as explained in @@ -2313,7 +2313,7 @@ when using pthreads. * null-threads.c, null-threads.h: Provide dummy definitions for the above symbols when not using pthreads. - + * modules.h, modules.c (scm_frame_current_module): New. * load.c (scm_primitive_load): Use scm_i_frame_current_load_port @@ -2328,7 +2328,7 @@ Moved around some init funcs. Call scm_init_threads_default_dynamic_state. Register cleanup_for_exit with atexit. - + * hashtab.c (scm_hash_fn_create_handle_x, scm_hash_fn_remove_x): Use "!scm_is_eq" instead of "!=". @@ -2340,7 +2340,7 @@ scm_after_gc_c_hook. (scm_permanent_object): Allocate outside of critical section. (cleanup): Removed. - + * fluids.h, fluids.c: Reimplemented completely. (SCM_FLUID_NUM, SCM_FAST_FLUID_REF, SCM_FAST_FLUID_SET): Reimplemented as functions. @@ -2351,19 +2351,19 @@ scm_set_current_dynamic_state, scm_frame_current_dynamic_state, scm_c_with_dynamic_state, scm_with_dynamic_state, scm_i_make_initial_dynamic_state, scm_fluids_prehistory): New. - + * feature.c (progargs_fluid): New. (scm_program_arguments, scm_set_program_arguments): Use it instead of scm_progargs. (scm_init_feature): Allocate it. Also, only add "threads" feature when SCM_USE_PTHREAD_THREADS is true. - + * eval.c (scm_makprom): Use scm_make_recursive_mutex instead of scm_make_rec_mutex, with all the consequences. (scm_eval_x, scm_eval): Use scm_frame_begin etc instead of scm_internal_dynamic_wind. Handle dynamic states as second argument. - + * threads.h, threads.c (scm_internal_select): Renamed to scm_std_select and discouraged old name. (scm_thread_sleep, scm_thread_usleep): Likewise, as scm_std_sleep @@ -2433,9 +2433,9 @@ respectively. * fluid.h (SCM_FLUIDP): Deprecated. - + * coop-threads.c: Removed. - + * continuations.h, continuations.c (scm_with_continuation_barrier, scm_c_with_continuation_barrier, scm_i_with_continuation_barrier): New. @@ -2449,14 +2449,14 @@ current sleep. (scm_system_async_mark_for_thread): Do not use scm_current_thread since that might not work during early initialization. - + * __scm.h (SCM_DEFER_INTS, SCM_ALLOW_INTS, SCM_REDEFER_INTS, SCM_REALLOW_INTS): Deprecated by moving into deprecated.h and deprecated.c. Replaced all uses with SCM_CRITICAL_SECTION_START and SCM_CRITICAL_SECTION_END. (SCM_ENTER_A_SECTION, SCM_EXIT_A_SECTION): Removed. Replaced with SCM_CRITICAL_SECTION_START/END. - + * Makefile.am (modinclude_HEADER): Removed threads-plugin.h. (libguile_la_SOURCES): Added null-threads.c (EXTRA_libguile_la_SOURCES): Removed pthread-threads.c and @@ -2476,8 +2476,8 @@ scm_frame_current_dynamic_state and scm_i_with_continuation_barrier. (scm_dynamic_root): Return current continuation barrier. - - + + 2005-02-28 Marius Vollmer * socket.c (scm_setsockopt): Handle IP_ADD_MEMBERSHIP and @@ -2505,7 +2505,7 @@ the hashtable. (scm_hash_fn_create_handle_x): Likewise. * vectors.h (SCM_I_SET_WVECT_TYPE): New, for use in scm_i_rehash. - + 2005-02-10 Mikael Djurfeldt * unif.c (prototype_to_type): Bugfix: Don't compare prototype to @@ -2543,7 +2543,7 @@ statistics on the number of live objects of each type. * gc-card.c (scm_i_tag_name): new function. - (scm_i_card_statistics): new function. + (scm_i_card_statistics): new function. 2005-01-24 Kevin Ryde @@ -2586,14 +2586,14 @@ (scm_classes_initialized): Removed. (scm_class_of): Do not check it. (create_standard_classes): Do not set it. - + 2005-01-17 Marius Vollmer * objects.h, objects.c (scm_classes_initialized): New. (scm_class_of): Signal error when scm_classes_initialized is zero. * goops.c (create_standard_classes): Set scm_classes_initialized to one. - + * random.c (scm_random_solid_sphere_x): Use scm_c_generalized_vector_length instead of scm_uniform_vector_length. @@ -2635,13 +2635,13 @@ (scm_init_srfi_4): Set mark function of smob when needed. Initialize scm_uint64_min, scm_uint64_max, scm_int64_min, scm_int64_max. - + Recognize 1.4 -e syntax. - + * script.c (sym_at, sym_atat, sym_main, all_symbols): New. (scm_compile_shell_switches): Use them to recognize and convert 1.4 "-e" syntax. - + 2005-01-12 Marius Vollmer * deprecated.h, deprecated.c, strings.h, strings.c: Turn all @@ -2657,9 +2657,9 @@ (print_summary): New. (scm_init_deprecation): Initialize SCM_WARN_DEPRECATED instead of mode. - + Deprecated SCM_ARRAY* macros. - + * unif.h, unif.c, ramap.c, vectors.c, srfi-4.c, srfi-4.i.c (SCM_ARRAYP, SCM_I_ARRAYP): Renamed former to latter internal version. Changed all uses. @@ -2678,11 +2678,11 @@ Moved from unif.h to unif.c. (scm_c_array_rank): New. (scm_array_rank): Reimplement using it. - + * deprecated.h, deprecated.c (SCM_ARRAYP, SCM_ARRAY_NDIM, SCM_ARRAY_CONTP, SCM_ARRAY_MEM, SCM_ARRAY_V, SCM_ARRAY_BASE, SCM_ARRAY_DIMS, scm_t_array): New deprecated versions. - + 2005-01-11 Marius Vollmer * ramap.c: Replace uses of scm_make_ra with scm_i_make_ra. @@ -2702,7 +2702,7 @@ (scm_ra_set_contp): Deprecated, changed all uses to scm_i_ra_set_contp. (scm_cvref, scm_aind, scm_raprin1): Deprecated. - + 2005-01-10 Marius Vollmer * eval.c (scm_eval): Added example to docstring. Thanks to Issac @@ -2714,7 +2714,7 @@ (scm_i_print_array): Print length information for arrays that need it. (scm_i_read_array): Parse it. - + * deprecated.h, deprecated.c (SCM_CHARS, SCM_UCHARS, SCM_LENGTH, scm_i_object_chars, scm_i_object_length): Brought back from the dead. @@ -2750,7 +2750,7 @@ uvec_fast_ref since scm_array_handle_ref should be faster now. (coerce_to_uvec, scm_c_uniform_vector_ref, scm_c_uniform_vector_set_x): Likewise. - + * unif.h, unif.c, inline.h (scm_i_t_array_ref, scm_i_t_array_set): New. (scm_t_array_handle): Added ref, set, elements and @@ -2768,12 +2768,12 @@ scm_bit_position, scm_bit_set_star_x, scm_bit_count_star, scm_bit_invert_x): Correctly multiply index with increment in the general case. - + * unif.c (scm_array_handle_set): Correctly execute only one alternative. D'Oh! (scm_list_to_typed_array, l2ra): Use scm_t_array_handle to fill the array; this covers all cases with much simpler code. - + * srfi-4.c (scm_uniform_element_size): Deprecated implementation as well. @@ -2790,7 +2790,7 @@ (scm_i_print_array): Print zero rank arrays specially. (tag_to_type): Return #t for an empty tag, not the empty symbol. (scm_i_read_array): Allow zero rank arrays. - + 2005-01-07 Marius Vollmer * hashtab.h, hashtab.c (SCM_HASHTAB_BUCKET_LOC): Removed. @@ -2801,9 +2801,9 @@ Removed ref_stack field. (PSTATE_STACK_REF, PSTATE_STACK_SET): New, for accessing the stack of a print state. Use them everywhere instead of ref_stack. - + * srfi-4.h (scm_uniform_element_size): Deprecated for real. - + * srfi-4.c: Include deprecation.h. * vectors.h, vectors.c, unif.h, unif.c, deprecated.h, @@ -2818,12 +2818,12 @@ scm_vector_equal_p): Moved from vectors.[hc] to deprecated.[hc]. (scm_vector_equal_p, scm_i_vector_equal_p): Renamed former to latter. Changed use in eq.c. - + 2005-01-07 Marius Vollmer Make the uniform vector routines also deal with one dimensional arrays. - + * srfi-4.c (SCM_IS_UVEC): New, use it instead of SCM_SMOB_PREDICATE in this file. (is_uvec): Also recognize one-dimensional uniform numeric arrays @@ -2840,13 +2840,13 @@ (scm_uniform_vector_to_list): Let uvec_to_list do all the checking. (scm_uniform_vector_length): Use uvec_length. - + 2005-01-06 Marius Vollmer * srfi-4.h, srfi-4.c (scm_c_uniform_vector_element_size, scm_c_uniform_vector_size): Removed. (scm_array_handle_uniform_element_size): New. - + * unif.h (scm_array_handle_ref, scm_array_handle_set): Changed type of POS parameter to be signed, positions can be negative. @@ -2854,11 +2854,11 @@ scm_t_array_handle to properly call it. (scm_vector_get_handle, scm_generalized_vector_get_handle): Renamed former to latter, changed all uses. - + 2005-01-05 Marius Vollmer Updated bitvector routines to also use scm_t_array_handles. - + * unif.h (scm_bitvector_elements, scm_bitvector_writable_elements): Use a scm_t_array_handle and deliver offset, length and increment to caller. Changed all uses. @@ -2873,7 +2873,7 @@ arrays is now SCM_UNSPECIFIED. The old special value SCM_BOOL_F was a valid value to fill bitvectors with, so it can't really be specialed out. - + 2005-01-04 Kevin Ryde * stime.c (scm_strftime): Free t.tm_zone produced by bdtime2c. @@ -2895,7 +2895,7 @@ so that it doesn't leak. (scm_stable_sort): Simply call scm_stable_sort_x on a copy of the list or vector. - + * ramap.c (scm_array_map_x): Do not try to convert fill value before filling, any necessary conversion is done while storing. @@ -2915,7 +2915,7 @@ vector elements API or simple vector API, as appropriate. Removed SCM_HAVE_ARRAYS ifdefery. Replaced all uses of SCM_HASHTABLE_BUCKETS with SCM_HASHTABLE_BUCKET. - + * srfi-4.h, srfi-4.c, srfi-4.i.c (scm_array_handle_uniform_elements, scm_array_handle_uniform_writable_elements, @@ -2925,10 +2925,10 @@ scm_t_array_handle, deliver length and increment. (scm_array_handle__elements, scm_array_handle__writable_elements): New. - + * gen-scmconfig.h.in (SCM_I_GSC_HAVE_ARRAYS): Removed. * gen-scmconfig.c: Hard code SCM_HAVE_ARRAYS to "1". - + * unif.h, unif.c (scm_t_array_handle, scm_array_get_handle, scm_array_handle_rank, scm_array_handle_dims, scm_array_handle_ref scm_array_handle_set, scm_array_handle_elements @@ -2940,7 +2940,7 @@ (scm_make_shared_array, scm_enclose_array): Correctly use scm_c_generalized_vector_length instead of scm_uniform_vector_length. - + * validate.h (SCM_VALIDATE_VECTOR, SCM_VALIDATE_VECTOR_OR_DVECTOR): use scm_is_simple_vector instead of SCM_VECTORP. @@ -2986,7 +2986,7 @@ No longer use creators to specify the type of an array. Creators expose the fact that arrays are wrapped around vectors, but that might change. - + * srfi-4.h (scm_i_proc_make_u8vector, scm_i_proc_make_s8vector, scm_i_proc_make_u16vector, scm_i_proc_make_s16vector, scm_i_proc_make_u32vector, scm_i_proc_make_s32vector, @@ -3020,7 +3020,7 @@ (tag_to_type): New. (scm_i_read_array): Use scm_list_to_typed_array instead of scm_list_to_uniform_array. - + 2004-12-27 Marius Vollmer * unif.h, unif.c (scm_bitvector_elements): Made return value "const". @@ -3047,7 +3047,7 @@ scm_frame_uniform_vector_release_writable_elements): New. Takes crown of longest identifier yet. Changed all uses as required by the changes above. - + * vectors.h, vectors.c (scm_c_vector_set_x): Make return type void. (scm_is_vector, scm_vector_p, scm_vector_length, @@ -3067,7 +3067,7 @@ scm_uniform_vector_length. (scm_ramap, rafe): Use scm_c_vector_ref instead of SCM_VELTS. use scm_c_generalized_vector_ref instead of scm_uniform_vector_ref. - + 2004-12-23 Marius Vollmer * continuations.h, continuations.c (scm_t_contregs): New 'offset' @@ -3078,7 +3078,7 @@ scm_last_stack_frame, scm_stack_id): Use the new 'offset' member of continuations instead of calculating the offset ourselves. Relocate 'vect' member of scm_t_debug_frame. - + 2004-12-16 Kevin Ryde * ramap.c (scm_array_map_x): Check for at least one source argument. @@ -3122,7 +3122,7 @@ use of an array as their storage 'vector'. When all generalized vectors are allowed as storage, including one-dimensional arrays, this will no longer work.) - + * unif.h, unif.c: (scm_tc16_enclosed_array, SCM_ENCLOSED_ARRAYP): New. (exactly_one_third, singp): Removed. @@ -3162,7 +3162,7 @@ explicitly. (scm_init_unif): Initialize scm_tc16_enclosed_array smob. Use scm_i_print_array as printer for scm_tc16_array. - + 2004-11-10 Marius Vollmer * ramap.c (cind): Changed second arg to be pointer to long instead @@ -3178,7 +3178,7 @@ in terms of scm_uniform_vector_read_x and scm_uniform_vector_write, respectively. Strings and bitvector support has been dropped. - + * srfi-4.h, srfi-4.c: Do not include , include the needed files directly. Include config.h, and when available. @@ -3201,7 +3201,7 @@ (make_uvec): ...but not here. (coerce_to_uvec): Use new generalized vector functions to handle all kinds of vectors in one go. - + * tags.h (scm_tc7_bvect): Renamed to scm_tc7_unused7, renaming the remaining scm_tc7_unused tags to get a neatly ordered list. @@ -3218,7 +3218,7 @@ scm_is_generalized_vector, scm_c_generalized_vector_length, scm_c_generalized_vector_ref, scm_c_generalized_vector_set_x): New. - + * unif.h, unif.c (scm_bitvector_p, scm_bitvector, scm_make_bitvector, scm_bitvector_length, scm_bitvector_ref, scm_bitvector_set_x, scm_list_to_bitvector, scm_bitvector_to_list, @@ -3303,7 +3303,7 @@ * srfi-4.h, srfi-4.c (scm_frame_uniform_vector_release): New. * unif.c (scm_bit_set_star_x, scm_bit_count_star_x): Use it to get more efficient access to the u32vector. - + * tags.h (scm_tc7_llvect, scm_tc7_uvect, scm_tc7_fvect, scm_tc7_dvect, scm_tc7_cvect, scm_tc7_svect, scm_tc7_byvect, scm_tc7_ivect): Renamed to scm_tc7_unused_1 to scm_tc7_unused_8. @@ -3319,7 +3319,7 @@ * unif.c (scm_bit_set_star_x, scm_bit_count_star_x): Use u32vectors instead of old-sytle uvectors. - + * convert.c, convert.i.c: Rewritten completely, using scm_any_to_u8vector, etc and other new-style uniform vector functions. @@ -3344,7 +3344,7 @@ return creators. (scm_make_uve): Use scm_call_1 instead of scm_call_2 with a second arg of SCM_UNDEFINED. The latter is wrong. - + * unif.h, unif.c (scm_make_u1vector): New, but only temporary. (make_uve): Removed. (scm_i_proc_make_vector, scm_i_proc_make_string, @@ -3376,7 +3376,7 @@ Updated all tables and generic functions to support them. (scm_i_proc_make_u8vector, scm_i_proc_make_s8vector, etc): New. (scm_init_srfi_4): Initialize them. - + * srfi-4.i.c (scm_take_u8vector, etc): use uvec_sizes instead of sizeof(CTYPE) as explained in the comment. @@ -3393,7 +3393,7 @@ vector. The plan is to gradually replace one type after the other until none is left and then to consider general cleanups and optimizations. - + * srfi-4.h, srfi-4.i.c (scm_u8vector_elements, etc): New. * srfi-4.h, srfi-4.c (scm_uniform_vector_p, @@ -3455,7 +3455,7 @@ requested. * convert.c (scm_c_scm2chars, scm_c_chars2scm, scm_c_chars2byvect): Use a s8vector instead of a scm_tc7_byvect. - + 2004-10-26 Marius Vollmer * numbers.h, numbers.c (scm_i_print_double): New. @@ -3486,11 +3486,11 @@ (scm_uint2str): New, for scm_t_uintmax. (scm_iint2str): Argument type changed to scm_t_intmax, reimplemented in terms of scm_uint2str. - + * print.c, print.h (scm_uintprint): New, for printing scm_t_uintmax values. (scm_intprint): Argument type changed to scm_t_intmax. - + * sort.c (quicksort, scm_merge, scm_merge_list_x, scm_merge_list_step, scm_merge_vector_step): Inserted SCM_TICKs at strategic places so that the loops can be interrupted. @@ -3499,7 +3499,7 @@ "-I$(top_srcdir)/libguile-ltdl". (libguile_la_LIBADD): Use @LIBLTDL@ instead of "../libguile-ltdl/libguile-ltdl.a". - + * guile.c, dynl.c: Switched to using libltdl directly. Replaced all references to scm_lt_* with just lt_*. Include instead of . @@ -3512,12 +3512,12 @@ quicksort to fail, it just put all the burdon on the insertion sort and was thus very slow. Thanks to Rolan Orre for reporting the slowness! - + 2004-10-19 Marius Vollmer * numbers.c (scm_i_range_error): New. * conv-integer.i.c, conv-uinteger.i.c: Use it instead of - scm_out_of_range. + scm_out_of_range. * sort.c (scm_restricted_vector_sort_x): Validate startpos <= endpos. State inclusiveness/exclusiveness of bounds in docstring. @@ -3545,11 +3545,11 @@ Keywords no longer store a 'dash symbol'. Instead, they store a symbol with their real name. - + * keywords.h, keywords.c, deprecated.h, deprecated.c (SCM_KEYWORDP, SCM_KEYWORDSYM): Deprecated and implemented in terms of scm_is_keyword and scm_keyword_dash_symbol. - + * keywords.h, keywords.c, discouraged.h, discouraged.c (scm_make_keyword_from_dash_symbol, scm_keyword_dash_symbol, scm_c_make_keyword): Discouraged. @@ -3559,7 +3559,7 @@ (scm_is_keyword, scm_from_locale_keyword, scm_from_locale_keywordn): New. - * goops.c: Replaced SCM_KEYWORDP with scm_is_keyword. + * goops.c: Replaced SCM_KEYWORDP with scm_is_keyword. * snarf.h (SCM_KEYWORD, SCM_GLOBAL_KEYWORD): Use scm_from_locale_keyword instead of scm_c_make_keyword. @@ -3617,7 +3617,7 @@ (libguile_la_LIBADD): Removed THREAD_LIBS_LOCAL, which is unused now. (libpath.h): Put GUILE_CFLAGS in the build-info. - + 2004-09-23 Marius Vollmer * print.h (scm_print_state): Added highlight_objects. @@ -3629,14 +3629,14 @@ * backtrace.h, backtrace.c (scm_display_backtrace_with_highlights, scm_backtrace_with_highlights): New. Set highlight_objects of printstate. - + * error.c (scm_error_scm): Document new meaning of data/rest argument for out-of-range and wrong-type-arg errors. (scm_out_of_range, scm_out_of_range_pos, scm_wrong_type_arg, scm_wrong_type_arg_msg): Pass bad_value in rest argument of exception so that it gets highlighted in the backtrace. Don't talk about "argument" when not giving a position. - + * throw.c (handler_message): The rest argument is the fourth argument, not everything after the third. Call scm_display_backtrace_with_highlights, passing the rest argument @@ -3700,8 +3700,8 @@ * strings.h, strings.c (scm_substring_read_only, scm_c_substring_read_only, scm_i_substring_read_only): New. (RO_STRING_TAG, IS_RO_STRING): New. - (scm_i_string_writable_chars): Bail on read-only strings. - + (scm_i_string_writable_chars): Bail on read-only strings. + * read.c (scm_lreadr): use scm_c_substring_read_only for string literals, thus making them read-only as specified by R5RS. @@ -3716,7 +3716,7 @@ numbers.c. (scm_to_mpz, scm_from_mpz): New. Thanks to Andreas Vögele! - + * read.c (skip_scsh_block_comment): Recognize "!#" everywhere, not just on a line of its own. @@ -3727,7 +3727,7 @@ over- or underflow occurs. Thanks to Andreas Vögele! (scm_xsubstring, scm_string_xcopy_x): Use ints for 'extended' indices, which can also be negative. - + 2004-09-20 Marius Vollmer * gc-mark.c (SCM_MARK_BACKING_STORE): Removed, it was unused. @@ -3765,7 +3765,7 @@ (scm_lreadr): Abort on seeing "#!", which should no longer happen. (skip_scsh_block_comment): Use scm_input_error instead of scm_misc_error in case of EOF. - + 2004-09-07 Kevin Ryde * numbers.c (scm_integer_expt): Reject exponent +/-inf. @@ -3839,7 +3839,7 @@ scm_i_string_chars et al. Copious scm_remember_upto_heres have been inserted. Made sure that no internal string pointer is used across a SCM_TICK or a possible GC. - + * script.c (scm_compile_shell_switches): Use scm_from_locale_string instead of scm_makfrom0str. @@ -3854,7 +3854,7 @@ * srfi-13.c, srfi-13.h, srfi-14.c, srfi-14.h: New files. * strop.h, strop.c: Removed, they are now empty. * Makefile.am: Updated for new and removed files. - + * symbols.h, symbols.c (scm_string_ci_to_symbol): Moved here, next to scm_string_to_symbol. @@ -3868,7 +3868,7 @@ scm_string_geq_p, scm_string_ci_less_p, scm_string_ci_leq_p, scm_string_ci_gr_p, scm_string_ci_geq_p): Use scm_string_eq, etc instead of explicit code. - + * deprecated.c, load.c, posix.c, unif.c, symbols.c: Include "srfi-13.h" instead of "strop.h". @@ -3886,14 +3886,14 @@ scm_i_string_char, scm_i_string_writable_chars): Use it. (scm_i_substring_copy): Make START argument optional for C callers, for upcoming SRFI-13 integration. - + 2004-08-21 Marius Vollmer From Richard Todd, Thanks! - + * script.c (scm_compile_shell_switches): added '-L' switch to add to the %load-path. - + 2004-08-21 Dirk Herrmann * eval.c (unmemoize_exprs): When dropping internal body markers @@ -3911,7 +3911,7 @@ scm_i_string_writable_chars doesn't give that. Fixed by letting mkstemp modify a locale version of the tmpl argument and copying the result back into tmpl. - + * strop.c (scm_substring_move_x): Store into str2, not str1. 2004-08-20 Kevin Ryde @@ -3930,7 +3930,7 @@ New string implementation, with copy-on-write strings and mutation-sharing substrings, and a new internal string API. Symbols can now share memory with strings. - + * tags.h (scm_tc7_stringbuf): New tag. * strings.h, strings.c: (scm_i_string_chars, scm_i_string_length, @@ -3985,12 +3985,12 @@ (scm_i_thread_wake_up): Unlock all threads, including ourselves, call scm_i_enter_guile. (scm_thread_mark_stacks): Expect all threads to be suspended. - + * gc.h, gc.c (scm_i_gc_admin_mutex): New, to protect scm_gc_mallocated, for now. (scm_init_storage): Initialize it. * gc-malloc.c (descrease_mtrigger, increase_mtrigger): Use it. - + * gc-mark.c (scm_gc_mark_dependencies): Call scm_i_string_mark, scm_i_stringbuf_mark and scm_i_symbol_mark, as appropriate. * gc-card.c (scm_i_sweep_card): Call scm_i_string_free, @@ -4033,7 +4033,7 @@ (scm_recv, scm_send, scm_recvfrom, scm_sendto): Use SCM_I_STRING_CHARS and SCM_I_STRING_LENGTH instead of SCM_STRING_CHARS and SCM_STRING_LENGTH. - + * simpos.c (scm_system): Convert SCM strings to locale strings instead of accessing their internals. @@ -4057,12 +4057,12 @@ (scm_basename, scm_dirname): Use SCM_I_STRING_CHARS and SCM_I_STRING_LENGTH instead of SCM_STRING_CHARS and SCM_STRING_LENGTH. - + * extensions.c (load_extension): Convert lib and init to locale strings instead of accessing the internals directly. (scm_c_load_extension): Use scm_from_locale_string instead of scm_makfrom0str. - + * fports.h, fports.c (scm_i_fdes_to_port): New, like scm_fdes_to_port, but take mode bits directly instead of as a C string. @@ -4081,7 +4081,7 @@ (scm_void_port): Implement using above. (scm_sys_make_void_port): Use scm_i_void_port together with scm_i_mode_bits to avoid accessing internals of SCM string. - + * strings.h, strings.c (scm_i_get_substring_spec): New. * socket.c, rw.c, deprecated.h, validate.h @@ -4090,7 +4090,7 @@ scm_to_locale_string, etc. (SCM_VALIDATE_SUBSTRING_SPEC_COPY): Deprecated. Replaced as above, plus scm_i_get_substring_spec. - + * regex-posix.c, read.c, random.c, ramap.c, print.c, numbers.c, hash.c, gc.c, gc-card.c, convert.i.c, backtrace.c, strop.c, strorder.c, strports.c, struct.c, symbols.c, unif.c, ports.c: Use @@ -4108,7 +4108,7 @@ (scm_putenv): Rewritten to use only C strings. (scm_setlocale, scm_crpt): Convert argument strings to locale strings. - + 2004-08-11 Marius Vollmer * load.c (scm_primitive_load_path): Do not check for absolute @@ -4152,7 +4152,7 @@ (scm_string_append): Use memcpy instead of explicit loop. Do not use register keyword. Use plain 'char' instead of 'unsigned char'. - + * strports.c (scm_mkstrport): Use SCM_I_STRING_UCHARS instead of SCM_STRING_UCHARS. Use SCM_I_STRINGP instead of SCM_STRINGP. @@ -4168,7 +4168,7 @@ SCM_STRING_LENGTH with SCM_I_STRINGP, SCM_I_STRING_CHARS, and SCM_I_STRING_LENGTH, respectively. (gh_scm2newstr): Implement in terms of scm_to_locale_string. - + * environments.c: Instead calling scm_puts on the SCM_STRING_CHARS of a string, call scm_display on the string itself. @@ -4194,7 +4194,7 @@ scm_error, this avoids the back and forth conversion of SUBR and MESSAGE and also plugs a memory leak. (scm_error): Call scm_error_scm. - + * backtrace.c: Replaced SCM_STRINGP with scm_is_string. (display_header): Print FNAME when it is true, not merely when it is a string. @@ -4202,7 +4202,7 @@ * strings.h (SCM_SET_STRING_LENGTH, SCM_SET_STRING_CHARS): Removed unceremoniously. They were unused by Guile itself, and external use should stop immediately. - + 2004-08-10 Marius Vollmer @@ -4210,7 +4210,7 @@ scm_truncate): Renamed to scm_c_round and scm_c_truncate; deprecated versions installed in deprecated.h and deprecated.c. Changed all uses. - + 2004-08-06 Rob Browning * net_db.c (scm_resolv_error): don't cause an exception while @@ -4240,7 +4240,7 @@ stat on the filename, to be certain a file rename can't mean we get info on one filesystem object but open another. This fstat usage is similar to Emacs copy-file. - + * posix.c (scm_setgroups): Enhance docstring, per doc/ref/posix.texi. * simpos.c (scm_system_star): Change scm_from_long to scm_from_int on @@ -4262,7 +4262,7 @@ New. (scm_make_complex): Discouraged by moving to discouraged.h and discouraged.c. Replaced all uses with scm_c_make_rectangular. - + * discouraged.h, discouraged.c, numbers.c, numbers.h (scm_is_rational): New. (scm_i_short2big, scm_i_int2big, scm_i_uint2big, scm_i_size2big, @@ -4278,7 +4278,7 @@ explicit code. (scm_from_double): Do not implement in terms of scm_make_real, use explicit code. - + 2004-08-02 Marius Vollmer * init.c (scm_init_guile_1): Call scm_i_init_discouraged. @@ -4310,7 +4310,7 @@ * numbers.h, numbers.c: Removed GUILE_DEBUG code. (scm_i_short2big, scm_i_ushort2big, scm_i_int2big, scm_i_uint2big, scm_i_size2big, scm_i_ptrdiff2big): Removed. - (scm_i_long2big, scm_i_ulong2big): New, explicit definitions. + (scm_i_long2big, scm_i_ulong2big): New, explicit definitions. * conv-integer.i.c, conv-uinteger.i.c: Use them instead of explicit code. @@ -4364,7 +4364,7 @@ SCM_T_INT64_MIN, SCM_T_INT64_MAX, SCM_T_UINT64_MAX, SCM_T_INTMAX_MIN, SCM_T_INTMAX_MAX, SCM_T_UINTMAX_MAX): Moved definition into __scm.h, using new SCM_I_TYPE_MIN, etc. - + * conv-integer.i.c, conv-uinteger.i.c: New files, used to generate the functions below. @@ -4379,11 +4379,11 @@ (scm_to_signed_integer, scm_to_unsigned_integer, scm_from_signed_integer, scm_from_unsigned_integer): Generate via conv-integer.i.c and conv-uinteger.i.c, as well. - + * number.h (scm_to_ssize_t, scm_to_size_t): Use the new SCM_I_SSIZE_MIN, SCM_I_SSIZE_MAX, and SCM_I_SIZE_MAX macros for the limits. Those are always defined. - + 2004-07-29 Kevin Ryde * posix.c (scm_ttyname): Use scm_i_misc_mutex for thread safety. @@ -4403,7 +4403,7 @@ Reimplement using scm_is_false, scm_is_true, scm_is_bool, and scm_from_bool, respectively. (SCM_NINUMP): Added. - + * tags.h, deprecated.h (SCM_EQ_P): Deprecated by moving it into deprecated.h. Replaced all uses with scm_is_eq. @@ -4424,7 +4424,7 @@ * dynwind.c (scm_i_dowinds): Removed unused code that would call the unexisting scm_cross_dynwind_binding_scope for inums on the windlist. - + 2004-07-10 Marius Vollmer * socket.c (ipv6_net_to_num, scm_from_ipv6): Renamed @@ -4435,7 +4435,7 @@ an IPv& byte-wise address to a SCM integer. Changed all uses. (bignum_in_ipv6_range_p, VALIDATE_INET6): Removed, their function is now done by scm_to_ipv6. - + * numbers.c (scm_to_signed_integer, scm_to_unsigned_integer): dot not accept inexact integers. @@ -4469,7 +4469,7 @@ use CHAR_BIT instead of hardcoding 8. (LLONG_MIN, LLONG_MAX, ULLONG_MAX): Removed and used SCM_I_LLONG_MIN etc. instead. - + * numbers.h (SCM_MAKINUM, SCM_I_MAKINUM): Renamed SCM_MAKINUM to SCM_I_MAKINUM and changed all uses. * deprecated.h, deprecated.c (SCM_MAKINUM): Newly deprecated. @@ -4497,7 +4497,7 @@ scm_from_uint8, scm_from_int16, scm_from_uint16, scm_from_int32, scm_from_uint32, scm_from_int64, scm_from_uint64, scm_from_intmax, scm_from_uintmax): New. - + 2004-07-06 Marius Vollmer * tags.h (scm_is_eq): New. @@ -4521,7 +4521,7 @@ scm_from_uint, scm_from_long, scm_from_ulong, scm_from_size_t, scm_from_ssize_t, scm_is_real, scm_to_double, scm_from_double): New. - + 2004-07-05 Marius Vollmer * boolean.h, boolean.c (scm_is_true, scm_is_false, scm_from_bool, @@ -4601,7 +4601,7 @@ unmemoize_do, unmemoize_if, unmemoize_lambda, unmemoize_let, unmemoize_letrec, unmemoize_letstar, unmemoize_or, unmemoize_set_x, unmemoize_apply, unmemoize_atcall_cc, - unmemoize_at_call_with_values, unmemoize_future, sym_atslot_ref, + unmemoize_at_call_with_values, unmemoize_future, sym_atslot_ref, unmemoize_atslot_ref, sym_atslot_set_x, unmemoize_atslot_set_x, unmemoize_builtin_macro): New static functions and symbols. @@ -4629,7 +4629,7 @@ macroexp and made static. Added new version of scm_macroexp that emits a deprecation warning and then calls macroexp. (scm_m_undefine): Issue deprecation warning. - + 2004-05-30 Dirk Herrmann * eval.c (lookup_global_symbol, literal_p, try_macro_lookup): @@ -4737,7 +4737,7 @@ Convert floating point numbers into strings with an arbitrary radix. Thanks to Richard Todd! - + * numbers.c (FLOBUFLEN): Increase so that radix 2 strings will fit. (fx): Removed. @@ -4823,7 +4823,7 @@ * num2integral.i.c (NUM2INTEGRAL): Test BIGMPZ_FITSP with "!= 0" to avoid warning from gcc 3.4. Reported by Hyperdivision. - + * numbers.c (scm_bit_extract): Use min instead of MIN. (MIN): Remove, this conflicts with similar macro defined by limits.h on HP-UX. Reported by Andreas Vögele. @@ -4910,7 +4910,7 @@ rounding in x+0.5 when x is a big value already an integer. In certain hardware rounding cases x+0.5 can give an adjacent integer, leading to that as the result, when we really just wanted x itself. - + 2004-04-19 Dirk Herrmann * eval.c (scm_unmemocopy): Fixed unmemoization of let*. @@ -4960,7 +4960,7 @@ 2004-04-15 Kevin Ryde * cpp_sig_symbols.in: Add SIGSYS. - + * list.c (scm_append_x): Use iterative style, to avoid non-tail recursion. @@ -4977,9 +4977,9 @@ * inline.h (scm_cell): use SCM_GC_CELL_WORD for checking tag. * chars.h (scm_init_chars): change scm_{upcase,downcase} to - scm_c_{up,down}case. + scm_c_{up,down}case. (SCM_MAKE_CHAR): add (unsigned char) cast. This prevents havoc - when hi-bit ASCII is subjected to SCM_MAKE_CHAR(). + when hi-bit ASCII is subjected to SCM_MAKE_CHAR(). 2004-04-06 Kevin Ryde @@ -5187,7 +5187,7 @@ SCM_DEBUG_CELL_ACCESSES is not defined. Scheme source code should use (if (defined? 'set-debug-cell-accesses!) .. ) to switch on debugging conditionally. - + 2004-03-21 Kevin Ryde * stime.c (scm_gmtime): Use gmtime_r when available, for thread safety. @@ -5259,10 +5259,10 @@ * gc.h (scm_gc_cells_collected): Removed duplicated declaration. Thanks to Bill Schottstaedt! - + * socket.h (scm_gethost): Removed prototype it is already in "net_db.h". Thanks to Bill Schottstaedt! - + 2004-02-18 Kevin Ryde * num2integral.i.c (INTEGRAL2BIG): WORDS_BIGENDIAN not right for word @@ -5355,7 +5355,7 @@ * read.h: Remove conditionally compiled last arg to scm_lreadparen. (SCM_ELISP_VECTORS_P, SCM_ESCAPED_PARENS_P): New. - + 2004-01-23 Han-Wen Nienhuys * eval.c (m_expand_body): remove stray variable new_body. @@ -5377,7 +5377,7 @@ * dynwind.h, dynwind.c (scm_frame_unwind, scm_frame_unwind_handler): Renamed and changed all uses. (scm_frame_rewind, scm_frame_rewind_handler): Likewise. - + 2004-01-11 Kevin Ryde * unif.c (scm_bit_count, scm_bit_position, s_scm_bit_set_star_x, @@ -5403,14 +5403,14 @@ case of only one fluid. (scm_with_fluid): New. (scm_c_with_fluid): Use frames instead of scm_c_with_fluids. - + * fluids.h, fluids.c (scm_frame_fluid): New. (scm_with_fluid): New. (scm_i_swap_fluids, scm_i_swap_fluids_reverse): Removed. * dynwind.c (scm_frame_end): Do not use scm_i_dowinds. Instead, do the unwinding directly. It is simple enough. - + * dynwind.h, dynwind.c: Did the following renamings: scm_begin_frame -> scm_frame_begin, scm_end_frame -> scm_frame_end, @@ -5424,7 +5424,7 @@ scm_with_blocked_asyncs -> scm_frame_block_asyncs, scm_with_unblocked_asyncs -> scm_frame_unblock_asyncs. Changed all uses. - + * ports.h, ports.c: Did the follwing renamings: scm_with_current_input_port -> scm_frame_current_input_port, scm_with_current_output_port -> scm_frame_current_output_port, @@ -5456,12 +5456,12 @@ (WINDER_F_MARK, WINDER_MARK_P, winder_mark): New. (scm_on_unwind_with_scm, scm_on_rewind_with_scm): New. Use above to protect SCM values. - + * dynwind.h (SCM_F_WIND_EXPLICITELY, SCM_F_WIND_EXPLICITLY): It's "explicitly" not "explicitely", damn. Changed all uses. (scm_on_unwind_with_scm, scm_on_rewind_with_scm): New. - + 2004-01-05 Marius Vollmer * ports.h, ports.c (scm_with_current_input_port, @@ -5490,12 +5490,12 @@ rewinding. (scm_dynthrow): Do not call scm_dowinds, this is now done by copy_stack_and_call. - + 2004-01-04 Kevin Ryde * numbers.c (scm_less_p): Don't convert frac to float for compares, can give bad results due to rounding. - + * stime.c (scm_current_time, scm_gettimeofday): Add a comment about setzone/restorezone protection for DOS. @@ -5596,13 +5596,13 @@ 2003-11-18 Marius Vollmer Support for exact fractions from Bill Schottstaedt! Thanks! - + * print.c (scm_iprin1): Handle fractions. * objects.h (scm_class_fraction): New. - * objects.c (scm_class_fraction): New. + * objects.c (scm_class_fraction): New. (scm_class_of): Handle fractions. - + * hash.c (scm_hasher): Handle fractions. * numbers.c: New code for handling fraction all over the place. @@ -5625,7 +5625,7 @@ scm_rational_p): New prototypes. (scm_i_dbl2num, scm_i_fraction2double, scm_i_fraction_equalp, scm_i_print_fraction): New prototypes. - + * goops.c (create_standard_classes): Create "" class. * gc-mark.c (scm_gc_mark_dependencies): Handle fractions. @@ -6199,7 +6199,7 @@ * numbers.c (scm_lognot): Rewrite using ~ and mpz_com, for directness and to have non-integer types rejected as per other logical funcs. - + 2003-08-28 Kevin Ryde * gc.h (scm_remember_upto_here_1): Revise comments on the asm form. @@ -6236,7 +6236,7 @@ that parameter name. (scm_primitive_property_set_x): In docstring, VAL is the value parameter not CODE. - + 2003-07-27 Marius Vollmer * print.c (scm_print_symbol_name): handle more weird characters by @@ -6246,7 +6246,7 @@ * posix.c (scm_setgroups): New. Thanks to Paul Jarc! (scm_getgroups): Handle groups ids that don't fit into a fixnum. Don't use SCM_WRITABLE_VELTS. - + * gc.h (SCM_GC_SET_CELL_BVEC): New. * gc-card.c (scm_i_init_card_freelist): Use it. Thanks to Matthias Koeppe! @@ -6324,13 +6324,13 @@ 2003-07-03 Han-Wen Nienhuys - * __scm.h (SCM_ASSERT): change "else" expansion to "do { } while (0)" + * __scm.h (SCM_ASSERT): change "else" expansion to "do { } while (0)" 2003-07-02 Han-Wen Nienhuys * __scm.h (SCM_ASRTGO): add "else" to macro expansions with if clauses. - + 2003-06-29 Marius Vollmer * deprecated.h (SCM_OPDIRP, scm_fport, scm_option, scm_srcprops, @@ -6345,7 +6345,7 @@ * continuations.c: Redeclaration of getcontext() via the __asm__ ("getcontext") directive. - * continuations.h: Include instead of + * continuations.h: Include instead of . 2003-06-21 Kevin Ryde @@ -6376,7 +6376,7 @@ (scm_getspecific, scm_setspecific): Made these two function real part of the API. - * posix.c (s_scm_putenv): Added some code to make a + * posix.c (s_scm_putenv): Added some code to make a (putenv "FOO="), i.e. setting an empty string, work also on Win32 systems. Thanks to Kevin Ryde for the proposal. @@ -6424,7 +6424,7 @@ * read.c (scm_input_error): Pass arg list parameter to scm_error_scm, rather than SCM_EOL. Needed by "Unknown # object" case in scm_lreadr. - + 2003-06-04 Dirk Herrmann * __scm.h, gc-card.c (SCM_DEBUG_DEBUGGER_SUPPORT, @@ -6508,7 +6508,7 @@ 2003-05-30 Stefan Jahn - * posix.c (s_scm_putenv): Use the new HAVE_UNSETENV + * posix.c (s_scm_putenv): Use the new HAVE_UNSETENV appropriately for mingw32 hosts. * numbers.h: Defining copysign(), isnan() and finite() to @@ -6539,13 +6539,13 @@ * load.c (s_scm_search_path): Fixed absolute and relative path detections for native Windows platforms. - * gc.h, threads.h: Export some more symbols using SCM_API (necessary + * gc.h, threads.h: Export some more symbols using SCM_API (necessary to build on mingw32). - * gc-freelist.c ("s_scm_map_free_list", + * gc-freelist.c ("s_scm_map_free_list", "s_scm_gc_set_debug_check_freelist_x"): Fixed use of FUNC_NAME. - * fports.c (fport_fill_input): Disable use of + * fports.c (fport_fill_input): Disable use of fport_wait_for_input() on Win32 platforms. * filesys.c (s_scm_basename): Fixed __MINGW32__ code. @@ -6601,7 +6601,7 @@ branch. Some have been slightly rewritten. (scm_i_object_chars, scm_i_object_length): New, to support SCM_CHARS, SCM_UCHARS, and SCM_LENTH. - + 2003-05-19 Dirk Herrmann * eval.c (scm_m_do, unmemocopy, SCM_CEVAL): Reversed order of @@ -6655,7 +6655,7 @@ (print_state_mutex): New mutex. (scm_make_print_state, scm_free_print_state, scm_prin1): Lock/unlock print_state_mutex. - + * deprecated.h (SCM_GC8MARKP, SCM_SETGC8MARK, SCM_CLRGC8MARK): Use current names in definitions. @@ -6738,7 +6738,7 @@ scm_port_for_each. (scm_port_for_each): Reimplemented using scm_c_port_for_each. * ports.h (scm_c_port_for_each): New prototype. - + 2003-04-28 Mikael Djurfeldt * eval.c (scm_m_atdispatch): Removed until actually needed. (This @@ -7003,7 +7003,7 @@ * goops.c (prep_hashsets): make static to match prototype. (scm_sym_args): SCM_SYMBOL -> SCM_GLOBAL_SYMBOL. Thanks to Albert Chin. - + * c-tokenize.lex: remove trailing comma from enum. Thanks to Albert Chin. @@ -7269,7 +7269,7 @@ builds work. (DOT_X_FILES): Removed "iselect.x". (DOT_DOC_FILES): Removed "iselect.doc". - + 2003-03-25 Rob Browning * win32-socket.h: #include "libguile/__scm.h". Replace usage of @@ -7793,7 +7793,7 @@ * goops.c (scm_sys_prep_layout_x): Bugfix: Only create layout for slots with instance allocation. - + * goops.c, goops.h (scm_class_extended_generic_with_setter): New class. (scm_compute_applicable_methods): Use scm_generic_function_methods. @@ -7828,7 +7828,7 @@ * Makefile.am (c-tokenize.o): Refer to source via $< so that vpath builds work. (EXTRA_DIST): Added version.h.in. - + 2002-12-21 Mikael Djurfeldt This change makes it possible for one thread to do lazy sweeping @@ -8009,7 +8009,7 @@ These changes remove scm_ints_disabled (which hasn't has any effect in Guile for quite some time). - + * async.c, error.h (scm_ints_disabled): Removed. * gc.c (scm_gc_for_newcell), init.c (scm_init_guile_1), @@ -8034,7 +8034,7 @@ threads, though. Signalling and error handling for threads is very likely broken. Work on making the implementation cleaner and more efficient is needed. - + * __scm.h (SCM_ALLOW_INTS_ONLY): Removed. (SCM_NONREC_CRITICAL_SECTION_START, SCM_NONREC_CRITICAL_SECTION_END, SCM_REC_CRITICAL_SECTION_START, @@ -8082,7 +8082,7 @@ * Makefile.am (version.h): Changed $^ --> $< in rule for version.h. - + 2002-12-08 Rob Browning * version.h.in (SCM_MICRO_VERSION): use @--@ substitution now. @@ -8107,13 +8107,13 @@ implements the rest on top of that. Guile's implementation is what the "coop-pthreads" package has been previously. Support for "coop" threads has been removed until I get time to add it again. - + * Makefile.am (libguile_la_SOURCES): Removed iselect.c. (noinst_HEADERS): Removed coop-threads.c, coop-threads.h, coop.c, null-threads.c, coop-pthreads.c. (modinclude_HEADERS): Removed coop-defs.h, coop-pthreads.h. Added pthread-threads.h. - + * validate.h (SCM_VALIDATE_THREAD): Moved to threads.h. * threads.h: Do not include "libguile/coop-defs.h". Include @@ -8139,7 +8139,7 @@ * pthread-threads.h: New, implement pthread-like API by deferring to pthread itself. - + * init.c (scm_init_guile_1): Do not call scm_init_iselect, which has been lost in the reorganization. @@ -8167,7 +8167,7 @@ case; Use trampolines. Other changes: - + * sort.c (scm_cmp_function): Choose subr2less for scm_tc7_subr_2o; (subr2oless): Removed. (scm_restricted_vector_sort_x): Use scm_return_first to keep the @@ -8262,13 +8262,13 @@ SCM_COPT_THREADS is defined. (SCM_SYSCALL): Use EINTR-expection version when SCM_COPT_THREADS is defined. - + * coop-pthreads.c: Some harmless renamings of internal stuff. (create_thread): New, generalized version of scm_call_with_new_thread. (scm_call_with_new_thread): Use it. (scm_spawn_thread): New, use create_thread. - + 2002-11-02 Marius Vollmer * coop-pthreads.c, coop-pthreads.h: Redone completely, you might @@ -8287,7 +8287,7 @@ (take_signal): Simplified, to avoid race conditions. (scm_sigaction_for_thread): Use new Scheme. Validate that thread hasn't exited yet. - + * async.c (scm_async_click): Reset pending_asyncs, handle signal_asyncs. Don't set cdr of a non-signal async to #f. (scm_i_queue_async_cell): Do not check cdr of cell for #f, queue @@ -8296,7 +8296,7 @@ exited. (scm_unmask_signals, decrease_block): Call scm_async_click after block_asyncs becomes zero. - + * __scm.h (SCM_ASYNC_CLICK): Check pending_asyncs instead of active_asyncs. @@ -8304,16 +8304,16 @@ fields. * root.c (root_mark): Mark them. (make_root): Initialize them. - + * iselect.c, iselect.h: Replaced GUILE_ISELECT with USE_COOP_THREADS. (scm_internal_select): Define one version for USE_COOP_THREADS and one for USE_NULL_THREADS. (scm_init_iselect): Likewise. - + * inline.h (scm_cell, scm_double_cell): Also allow USE_COPT_THREADS to not protect the slot initializers. - + * init.c (scm_init_guile_1): Call scm_init_thread_procs. This is because threads need to be initialized before the stack, but gsubrs such as scm_timed_condition_variable_wait can only be @@ -8362,7 +8362,7 @@ scm_cond_wait, scm_cond_signal, scm_cond_broadcast, scm_cond_destory): Do not define, they are now deprecated and handled by threads.{h,c}. - + * null-threads.c (scm_null_mutex, scm_null_cond): Define here. (scm_threads_init): Create smobs here, using the appropriate sizes. @@ -8404,7 +8404,7 @@ * goops.c (hell_mutex): Reimplemented using scm_make_mutex, etc. * coop-pthreads.h, coop-pthreads.c: New, but unfinished. - + 2002-10-21 Marius Vollmer * null-threads.c: Include . Also, use <...> for inclusion @@ -8483,7 +8483,7 @@ * scmsigs.c (scm_sigaction_for_thread): Store original handler in signal_handlers, not the closure that is used as the async. The closure is stored in signal_handler_cells, as previously. - + 2002-10-10 Marius Vollmer * root.h (scm_root_state): Added 'block_async' slot. @@ -8508,7 +8508,7 @@ (increase_block, decrease_block, scm_call_with_blocked_asyncs, scm_call_with_unblocked_asyncs, scm_c_call_with_blocked_asyncs, scm_c_call_with_unblocked_asyncs): New. - + * script.c (scm_compile_shell_switches): Do not set scm_mask_ints. Asyncs are enabled by default. @@ -8529,7 +8529,7 @@ (scm_system_async_mark_for_thread): Initialize cdr of handler cell with SCM_BOOL_F. * scmsigs.c (scm_sigaction_for_thread): Likewise. - + 2002-10-04 Rob Browning * guile.c (main): switch to scm_lt_dlset_preloaded_symbols; @@ -8575,7 +8575,7 @@ scm_set_switch_rate, scm_system_async_mark_from_signal_handler): Removed prototypes. (scm_i_queue_async_cell): New. - + * __scm.h (scm_asyncs_pending_p): Removed. (SCM_ASYNC_CLICK): Check scm_active_asyncs instead of scm_asyncs_pending_p. @@ -8622,7 +8622,7 @@ 2002-09-19 Han-Wen Nienhuys - * inline.h (scm_double_cell): move SET_GCMARK set out of if body. + * inline.h (scm_double_cell): move SET_GCMARK set out of if body. 2002-09-09 Han-Wen Nienhuys @@ -8643,7 +8643,7 @@ * gc-malloc.c (scm_gc_init_malloc): check user settings for sanity. - * gc-freelist.c (scm_init_freelist): check user settings for sanity. + * gc-freelist.c (scm_init_freelist): check user settings for sanity. * struct.h: change scm_structs_to_free to scm_i_structs_to_free @@ -8710,7 +8710,7 @@ 2002-08-23 Han-Wen Nienhuys * gc-segment.c (scm_i_get_new_heap_segment): Oops. We want segment - length *at* least SCM_MIN_HEAP_SEG_SIZE, not at most. + length *at* least SCM_MIN_HEAP_SEG_SIZE, not at most. 2002-08-22 Han-Wen Nienhuys @@ -8741,7 +8741,7 @@ function * ports.h: use scm_i_ prefix for port table and port table size. - + 2002-08-15 Mikael Djurfeldt * vports.c (scm_make_soft_port): Initialize pt variable. @@ -8756,12 +8756,12 @@ (scm_eval_string): Implement using scm_eval_string_in_module. (scm_c_eval_string_in_module): New. Thanks to Ralf Mattes for the suggestion! - + 2002-08-09 Han-Wen Nienhuys * gc-card.c ("sweep_card"): remove SCM_MISC_ERROR messages: print message and abort. - + * gc-mark.c ("scm_gc_mark_dependencies"): idem. * ports.c ("scm_new_port_table_entry"): return a boxed SCM in @@ -8785,7 +8785,7 @@ 2002-08-05 Han-Wen Nienhuys - * tags.h: remove GC bits documentation from the tags table. + * tags.h: remove GC bits documentation from the tags table. * read.c (INPUT_ERROR): Prepare for file:line:column error messages for errors in scm_lreadr() and friends. @@ -8793,14 +8793,14 @@ 2002-08-04 Han-Wen Nienhuys * gc-malloc.c (scm_malloc): use scm_realloc() (simplifies - implementation). + implementation). (scm_gc_calloc): new function 2002-08-04 Han-Wen Nienhuys * ports.c (scm_new_port_table_entry): init port entry to 0 completely. - + * ports.c (scm_new_port_table_entry): change function from scm_add_to_port_table. This prevents cells with null-pointers from being exposed to GC. @@ -8831,7 +8831,7 @@ 2002-07-24 Stefan Jahn - * continuations.h: ia64: Include before + * continuations.h: ia64: Include before . 2002-07-21 Dirk Herrmann @@ -8864,7 +8864,7 @@ * *.c: use SCM_VECTOR_SET everywhere, where a vector is written. Document cases where SCM_WRITABLE_VELTS() is used. - + * vectors.h (SCM_VELTS): prepare for write barrier, and let SCM_VELTS() return a const pointer (SCM_VECTOR_SET): add macro. diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 5a1afc84c..1d73fbfa0 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -314,7 +314,7 @@ 2006-12-24 Han-Wen Nienhuys * tests/numbers.test ("equal?"): add case for reduction of - rational numbers. + rational numbers. 2006-12-13 Kevin Ryde @@ -601,7 +601,7 @@ * tests/guardians.test: Adapted to new (original) semantics. test guardingobjects multiple times. - + 2005-06-12 Marius Vollmer * standalone/test-gh.c: Do nothing when deprecated things are @@ -627,7 +627,7 @@ * tests/unif.test (array-in-bounds?): Add a test failing in the current code. - + 2005-05-07 Kevin Ryde * tests/srfi-1.test (car+cdr, fold, last, list-index, list-tabulate, @@ -1054,7 +1054,7 @@ * standalone/test-conversion.c: Don't define SCM_T_INTMAX_MIN, etc, they are now provided by libuile.h. (test_int_sizes): New. - + 2004-07-06 Marius Vollmer * standalone/test-num2integral.c, standalone/test-unwind.c: @@ -1173,7 +1173,7 @@ real/big combinations, collect up tests under arg types for clarity. 2004-03-26 Eric Hanchrow - + * tests/numbers.test (modulo-expt): New tests. 2004-03-24 Dirk Herrmann @@ -1228,7 +1228,7 @@ * tests/r5rs_pitfall.scm: New. * Makefile.am (SCM_TESTS): Added it. - + 2004-01-11 Kevin Ryde * tests/exceptions.test (false-if-exception): Disable tests on @@ -1596,7 +1596,7 @@ * tests/numbers.test (truncate, round, asinh, acosh, atanh): Add some tests. - + 2003-06-19 Kevin Ryde * tests/posix.test: New file, exercising putenv, setenv, unsetenv. @@ -1625,7 +1625,7 @@ recent scm_logcount change. * tests/reader.test (reading): Test bad # error message is formattable. - + 2003-06-01 Dirk Herrmann * tests/pairs.test: Added. @@ -1684,7 +1684,7 @@ * tests/numbers.test (-): Add test for negative inum subtract bignum. (logcount): New tests, exercising some negatives. - + 2003-05-03 Marius Vollmer * tests/r5rs_pitfall.test: New. Thanks to Dale P. Smith for From b046219e511d7251f37df1a9fe6e62b12527b3ac Mon Sep 17 00:00:00 2001 From: Julian Graham Date: Thu, 15 May 2008 00:50:50 -0400 Subject: [PATCH 36/87] Scheme SRFI-18 implementation and tests file --- srfi/ChangeLog | 4 + srfi/srfi-18.scm | 379 +++++++++++++++++++++++++++ test-suite/ChangeLog | 4 + test-suite/tests/srfi-18.test | 477 ++++++++++++++++++++++++++++++++++ 4 files changed, 864 insertions(+) create mode 100644 srfi/srfi-18.scm create mode 100644 test-suite/tests/srfi-18.test diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 1f6c599a8..fe88665d0 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,7 @@ +2008-05-15 Julian Graham + + * srfi-18.scm: New file. + 2008-04-28 Ludovic Courtès * srfi-1.c (scm_srfi1_partition): Properly type-check LIST. diff --git a/srfi/srfi-18.scm b/srfi/srfi-18.scm new file mode 100644 index 000000000..0593f4ef8 --- /dev/null +++ b/srfi/srfi-18.scm @@ -0,0 +1,379 @@ +;;; srfi-18.scm --- Multithreading support + +;; Copyright (C) 2008 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 as published by the Free Software Foundation; either +;; version 2.1 of the License, or (at your option) any later version. +;; +;; This library is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; Lesser General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public +;; License along with this library; if not, write to the Free Software +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; Author: Julian Graham +;;; Date: 2008-04-11 + +;;; Commentary: + +;; This is an implementation of SRFI-18 (Multithreading support). +;; +;; All procedures defined in SRFI-18, which are not already defined in +;; the Guile core library, are exported. +;; +;; This module is fully documented in the Guile Reference Manual. + +;;; Code: + +(define-module (srfi srfi-18) + :use-module (srfi srfi-34) + :export ( + +;;; Threads + ;; current-thread <= in the core + ;; thread? <= in the core + make-thread + thread-name + thread-specific + thread-specific-set! + thread-start! + thread-yield! + thread-sleep! + thread-terminate! + thread-join! + +;;; Mutexes + ;; mutex? <= in the core + make-mutex + mutex-name + mutex-specific + mutex-specific-set! + mutex-state + mutex-lock! + mutex-unlock! + +;;; Condition variables + ;; condition-variable? <= in the core + make-condition-variable + condition-variable-name + condition-variable-specific + condition-variable-specific-set! + condition-variable-signal! + condition-variable-broadcast! + condition-variable-wait! + +;;; Time + current-time + time? + time->seconds + seconds->time + + current-exception-handler + with-exception-handler + raise + join-timeout-exception? + abandoned-mutex-exception? + terminated-thread-exception? + uncaught-exception? + uncaught-exception-reason + ) + :re-export (thread? mutex? condition-variable?) + :replace (current-time + make-thread + make-mutex + make-condition-variable + raise)) + +(cond-expand-provide (current-module) '(srfi-18)) + +(define (check-arg-type pred arg caller) + (if (pred arg) + arg + (scm-error 'wrong-type-arg caller + "Wrong type argument: ~S" (list arg) '()))) + +(define abandoned-mutex-exception (list 'abandoned-mutex-exception)) +(define join-timeout-exception (list 'join-timeout-exception)) +(define terminated-thread-exception (list 'terminated-thread-exception)) +(define uncaught-exception (list 'uncaught-exception)) + +(define mutex-owners (make-weak-key-hash-table)) +(define object-names (make-weak-key-hash-table)) +(define object-specifics (make-weak-key-hash-table)) +(define thread-start-conds (make-weak-key-hash-table)) +(define thread-exception-handlers (make-weak-key-hash-table)) + +;; EXCEPTIONS + +(define raise (@ (srfi srfi-34) raise)) +(define (initial-handler obj) + (srfi-18-exception-preserver (cons uncaught-exception obj))) + +(define thread->exception (make-object-property)) + +(define (srfi-18-exception-preserver obj) + (if (or (terminated-thread-exception? obj) + (uncaught-exception? obj)) + (set! (thread->exception (current-thread)) obj))) + +(define (srfi-18-exception-handler key . args) + + ;; SRFI 34 exceptions continue to bubble up no matter who handles them, so + ;; if one is caught at this level, it has already been taken care of by + ;; `initial-handler'. + + (and (not (eq? key 'srfi-34)) + (srfi-18-exception-preserver (if (null? args) + (cons uncaught-exception key) + (cons* uncaught-exception key args))))) + +(define (current-handler-stack) + (let ((ct (current-thread))) + (or (hashq-ref thread-exception-handlers ct) + (hashq-set! thread-exception-handlers ct (list initial-handler))))) + +(define (with-exception-handler handler thunk) + (let ((ct (current-thread)) + (hl (current-handler-stack))) + (check-arg-type procedure? handler "with-exception-handler") + (check-arg-type thunk? thunk "with-exception-handler") + (hashq-set! thread-exception-handlers ct (cons handler hl)) + (apply (@ (srfi srfi-34) with-exception-handler) + (list (lambda (obj) + (hashq-set! thread-exception-handlers ct hl) + (handler obj)) + (lambda () + (let ((r (thunk))) + (hashq-set! thread-exception-handlers ct hl) r)))))) + +(define (current-exception-handler) + (car (current-handler-stack))) + +(define (join-timeout-exception? obj) (eq? obj join-timeout-exception)) +(define (abandoned-mutex-exception? obj) (eq? obj abandoned-mutex-exception)) +(define (uncaught-exception? obj) + (and (pair? obj) (eq? (car obj) uncaught-exception))) +(define (uncaught-exception-reason exc) + (cdr (check-arg-type uncaught-exception? exc "uncaught-exception-reason"))) +(define (terminated-thread-exception? obj) + (eq? obj terminated-thread-exception)) + +;; THREADS + +;; Create a new thread and prevent it from starting using a condition variable. +;; Once started, install a top-level exception handler that rethrows any +;; exceptions wrapped in an uncaught-exception wrapper. + +(define make-thread + (let ((make-cond-wrapper (lambda (thunk lcond lmutex scond smutex) + (lambda () + (lock-mutex lmutex) + (signal-condition-variable lcond) + (lock-mutex smutex) + (unlock-mutex lmutex) + (wait-condition-variable scond smutex) + (unlock-mutex smutex) + (with-exception-handler initial-handler + thunk))))) + (lambda (thunk . name) + (let ((n (and (pair? name) (car name))) + + (lm (make-mutex 'launch-mutex)) + (lc (make-condition-variable 'launch-condition-variable)) + (sm (make-mutex 'start-mutex)) + (sc (make-condition-variable 'start-condition-variable))) + + (lock-mutex lm) + (let ((t (call-with-new-thread (make-cond-wrapper thunk lc lm sc sm) + srfi-18-exception-handler))) + (hashq-set! thread-start-conds t (cons sm sc)) + (and n (hashq-set! object-names t n)) + (wait-condition-variable lc lm) + (unlock-mutex lm) + t))))) + +(define (thread-name thread) + (hashq-ref object-names (check-arg-type thread? thread "thread-name"))) + +(define (thread-specific thread) + (hashq-ref object-specifics + (check-arg-type thread? thread "thread-specific"))) + +(define (thread-specific-set! thread obj) + (hashq-set! object-specifics + (check-arg-type thread? thread "thread-specific-set!") + obj) + *unspecified*) + +(define (thread-start! thread) + (let ((x (hashq-ref thread-start-conds + (check-arg-type thread? thread "thread-start!")))) + (and x (let ((smutex (car x)) + (scond (cdr x))) + (hashq-remove! thread-start-conds thread) + (lock-mutex smutex) + (signal-condition-variable scond) + (unlock-mutex smutex))) + thread)) + +(define (thread-yield!) (yield) *unspecified*) + +(define (thread-sleep! timeout) + (let* ((ct (time->seconds (current-time))) + (t (cond ((time? timeout) (- (time->seconds timeout) ct)) + ((number? timeout) (- timeout ct)) + (else (scm-error 'wrong-type-arg caller + "Wrong type argument: ~S" + (list timeout) + '())))) + (secs (inexact->exact (truncate t))) + (usecs (inexact->exact (truncate (* (- t secs) 1000))))) + (and (> secs 0) (sleep secs)) + (and (> usecs 0) (usleep usecs)) + *unspecified*)) + +;; A convenience function for installing exception handlers on SRFI-18 +;; primitives that resume the calling continuation after the handler is +;; invoked -- this resolves a behavioral incompatibility with Guile's +;; implementation of SRFI-34, which uses lazy-catch and rethrows handled +;; exceptions. (SRFI-18, "Primitives and exceptions") + +(define (wrap thunk) + (lambda (continuation) + (with-exception-handler (lambda (obj) + (apply (current-exception-handler) (list obj)) + (apply continuation (list))) + thunk))) + +;; A pass-thru to cancel-thread that first installs a handler that throws +;; terminated-thread exception, as per SRFI-18, + +(define (thread-terminate! thread) + (define (thread-terminate-inner!) + (let ((current-handler (thread-cleanup thread))) + (if (thunk? current-handler) + (set-thread-cleanup! thread + (lambda () + (with-exception-handler initial-handler + current-handler) + (srfi-18-exception-preserver + terminated-thread-exception))) + (set-thread-cleanup! thread + (lambda () (srfi-18-exception-preserver + terminated-thread-exception)))) + (cancel-thread thread) + *unspecified*)) + (thread-terminate-inner!)) + +(define (thread-join! thread . args) + (define thread-join-inner! + (wrap (lambda () + (let ((v (apply join-thread (cons thread args))) + (e (thread->exception thread))) + (if (and (= (length args) 1) (not v)) + (raise join-timeout-exception)) + (if e (raise e)) + v)))) + (call/cc thread-join-inner!)) + +;; MUTEXES +;; These functions are all pass-thrus to the existing Guile implementations. + +(define make-mutex + (lambda name + (let ((n (and (pair? name) (car name))) + (m ((@ (guile) make-mutex) + 'unchecked-unlock + 'allow-external-unlock + 'recursive))) + (and n (hashq-set! object-names m n)) m))) + +(define (mutex-name mutex) + (hashq-ref object-names (check-arg-type mutex? mutex "mutex-name"))) + +(define (mutex-specific mutex) + (hashq-ref object-specifics + (check-arg-type mutex? mutex "mutex-specific"))) + +(define (mutex-specific-set! mutex obj) + (hashq-set! object-specifics + (check-arg-type mutex? mutex "mutex-specific-set!") + obj) + *unspecified*) + +(define (mutex-state mutex) + (let ((owner (mutex-owner mutex))) + (if owner + (if (thread-exited? owner) 'abandoned owner) + (if (> (mutex-level mutex) 0) 'not-owned 'not-abandoned)))) + +(define (mutex-lock! mutex . args) + (define mutex-lock-inner! + (wrap (lambda () + (catch 'abandoned-mutex-error + (lambda () (apply lock-mutex (cons mutex args))) + (lambda (key . args) (raise abandoned-mutex-exception)))))) + (call/cc mutex-lock-inner!)) + +(define (mutex-unlock! mutex . args) + (apply unlock-mutex (cons mutex args))) + +;; CONDITION VARIABLES +;; These functions are all pass-thrus to the existing Guile implementations. + +(define make-condition-variable + (lambda name + (let ((n (and (pair? name) (car name))) + (m ((@ (guile) make-condition-variable)))) + (and n (hashq-set! object-names m n)) m))) + +(define (condition-variable-name condition-variable) + (hashq-ref object-names (check-arg-type condition-variable? + condition-variable + "condition-variable-name"))) + +(define (condition-variable-specific condition-variable) + (hashq-ref object-specifics (check-arg-type condition-variable? + condition-variable + "condition-variable-specific"))) + +(define (condition-variable-specific-set! condition-variable obj) + (hashq-set! object-specifics + (check-arg-type condition-variable? + condition-variable + "condition-variable-specific-set!") + obj) + *unspecified*) + +(define (condition-variable-signal! cond) + (signal-condition-variable cond) + *unspecified*) + +(define (condition-variable-broadcast! cond) + (broadcast-condition-variable cond) + *unspecified*) + +;; TIME + +(define current-time gettimeofday) +(define (time? obj) + (and (pair? obj) + (let ((co (car obj))) (and (integer? co) (>= co 0))) + (let ((co (cdr obj))) (and (integer? co) (>= co 0))))) + +(define (time->seconds time) + (and (check-arg-type time? time "time->seconds") + (+ (car time) (/ (cdr time) 1000000)))) + +(define (seconds->time x) + (and (check-arg-type number? x "seconds->time") + (let ((fx (truncate x))) + (cons (inexact->exact fx) + (inexact->exact (truncate (* (- x fx) 1000000))))))) + +;; srfi-18.scm ends here \ No newline at end of file diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 1d73fbfa0..5f9714281 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2008-05-15 Julian Graham + + * tests/srfi-18.test: New file. + 2008-05-14 Julian Graham * tests/threads.test (mutex-ownership, mutex-lock-levels): New diff --git a/test-suite/tests/srfi-18.test b/test-suite/tests/srfi-18.test new file mode 100644 index 000000000..d116768e0 --- /dev/null +++ b/test-suite/tests/srfi-18.test @@ -0,0 +1,477 @@ +;;;; srfi-18.test --- Test suite for Guile's SRFI-18 functions. -*- scheme -*- +;;;; Julian Graham, 2007-10-26 +;;;; +;;;; Copyright (C) 2007 Free Software Foundation, Inc. +;;;; +;;;; This program is free software; you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation; either version 2, or (at your option) +;;;; any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this software; see the file COPYING. If not, write to +;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;;;; Boston, MA 02110-1301 USA + +(define-module (test-suite test-srfi-18) + #:use-module (test-suite lib) + #:use-module (srfi srfi-18)) + +(with-test-prefix "current-thread" + + (pass-if "current-thread eq current-thread" + (eq? (current-thread) (current-thread)))) + +(with-test-prefix "thread?" + + (pass-if "current-thread is thread" + (thread? (current-thread))) + + (pass-if "foo not thread" + (not (thread? 'foo)))) + +(with-test-prefix "make-thread" + + (pass-if "make-thread creates new thread" + (let* ((n (length (all-threads))) + (t (make-thread (lambda () 'foo) 'make-thread-1)) + (r (> (length (all-threads)) n))) + (thread-terminate! t) r))) + +(with-test-prefix "thread-name" + + (pass-if "make-thread with name binds name" + (let* ((t (make-thread (lambda () 'foo) 'thread-name-1)) + (r (eq? (thread-name t) 'thread-name-1))) + (thread-terminate! t) r)) + + (pass-if "make-thread without name does not bind name" + (let* ((t (make-thread (lambda () 'foo))) + (r (not (thread-name t)))) + (thread-terminate! t) r))) + +(with-test-prefix "thread-specific" + + (pass-if "thread-specific is initially #f" + (let* ((t (make-thread (lambda () 'foo) 'thread-specific-1)) + (r (not (thread-specific t)))) + (thread-terminate! t) r)) + + (pass-if "thread-specific-set! can set value" + (let ((t (make-thread (lambda () 'foo) 'thread-specific-2))) + (thread-specific-set! t "hello") + (let ((r (equal? (thread-specific t) "hello"))) + (thread-terminate! t) r)))) + +(with-test-prefix "thread-start!" + + (pass-if "thread activates only after start" + (let* ((started #f) + (m (make-mutex 'thread-start-mutex)) + (t (make-thread (lambda () (set! started #t)) 'thread-start-1))) + (and (not started) (thread-start! t) (thread-join! t) started)))) + +(with-test-prefix "thread-yield!" + + (pass-if "thread yield suceeds" + (thread-yield!) #t)) + +(with-test-prefix "thread-sleep!" + + (pass-if "thread sleep with time" + (let ((future-time (seconds->time (+ (time->seconds (current-time)) 2)))) + (unspecified? (thread-sleep! future-time)))) + + (pass-if "thread sleep with number" + (let ((old-secs (car (current-time)))) + (unspecified? (thread-sleep! (+ (time->seconds (current-time))))))) + + (pass-if "thread does not sleep on past time" + (let ((past-time (seconds->time (- (time->seconds (current-time)) 2)))) + (unspecified? (thread-sleep! past-time))))) + +(with-test-prefix "thread-terminate!" + + (pass-if "termination destroys non-started thread" + (let ((t (make-thread (lambda () 'nothing) 'thread-terminate-1)) + (num-threads (length (all-threads))) + (success #f)) + (thread-terminate! t) + (with-exception-handler + (lambda (obj) (set! success (terminated-thread-exception? obj))) + (lambda () (thread-join! t))) + success)) + + (pass-if "termination destroys started thread" + (let* ((m1 (make-mutex 'thread-terminate-2a)) + (m2 (make-mutex 'thread-terminate-2b)) + (c (make-condition-variable 'thread-terminate-2)) + (t (make-thread (lambda () + (mutex-lock! m1) + (condition-variable-signal! c) + (mutex-unlock! m1) + (mutex-lock! m2)) + 'thread-terminate-2)) + (success #f)) + (mutex-lock! m1) + (mutex-lock! m2) + (thread-start! t) + (mutex-unlock! m1 c) + (thread-terminate! t) + (with-exception-handler + (lambda (obj) (set! success (terminated-thread-exception? obj))) + (lambda () (thread-join! t))) + success))) + +(with-test-prefix "thread-join!" + + (pass-if "join receives result of thread" + (let ((t (make-thread (lambda () 'foo) 'thread-join-1))) + (thread-start! t) + (eq? (thread-join! t) 'foo))) + + (pass-if "join receives timeout val if timeout expires" + (let* ((m (make-mutex 'thread-join-2)) + (t (make-thread (lambda () (mutex-lock! m)) 'thread-join-2))) + (mutex-lock! m) + (thread-start! t) + (let ((r (thread-join! t (current-time) 'bar))) + (thread-terminate! t) + (eq? r 'bar)))) + + (pass-if "join throws exception on timeout without timeout val" + (let* ((m (make-mutex 'thread-join-3)) + (t (make-thread (lambda () (mutex-lock! m)) 'thread-join-3)) + (success #f)) + (mutex-lock! m) + (thread-start! t) + (with-exception-handler + (lambda (obj) (set! success (join-timeout-exception? obj))) + (lambda () (thread-join! t (current-time)))) + (thread-terminate! t) + success)) + + (pass-if "join waits on timeout" + (let ((t (make-thread (lambda () (sleep 1) 'foo) 'thread-join-4))) + (thread-start! t) + (eq? (thread-join! t (+ (time->seconds (current-time)) 2)) 'foo)))) + +(with-test-prefix "mutex?" + + (pass-if "make-mutex creates mutex" + (mutex? (make-mutex))) + + (pass-if "symbol not mutex" + (not (mutex? 'foo)))) + +(with-test-prefix "mutex-name" + + (pass-if "make-mutex with name binds name" + (let* ((m (make-mutex 'mutex-name-1))) + (eq? (mutex-name m) 'mutex-name-1))) + + (pass-if "make-mutex without name does not bind name" + (let* ((m (make-mutex))) + (not (mutex-name m))))) + +(with-test-prefix "mutex-specific" + + (pass-if "mutex-specific is initially #f" + (let ((m (make-mutex 'mutex-specific-1))) + (not (mutex-specific m)))) + + (pass-if "mutex-specific-set! can set value" + (let ((m (make-mutex 'mutex-specific-2))) + (mutex-specific-set! m "hello") + (equal? (mutex-specific m) "hello")))) + +(with-test-prefix "mutex-state" + + (pass-if "mutex state is initially not-abandoned" + (let ((m (make-mutex 'mutex-state-1))) + (eq? (mutex-state m) 'not-abandoned))) + + (pass-if "mutex state of locked, owned mutex is owner thread" + (let ((m (make-mutex 'mutex-state-2))) + (mutex-lock! m) + (eq? (mutex-state m) (current-thread)))) + + (pass-if "mutex state of locked, unowned mutex is not-owned" + (let ((m (make-mutex 'mutex-state-3))) + (mutex-lock! m #f #f) + (eq? (mutex-state m) 'not-owned))) + + (pass-if "mutex state of unlocked, abandoned mutex is abandoned" + (let* ((m (make-mutex 'mutex-state-4)) + (t (make-thread (lambda () (mutex-lock! m))))) + (thread-start! t) + (thread-join! t) + (eq? (mutex-state m) 'abandoned)))) + +(with-test-prefix "mutex-lock!" + + (pass-if "mutex-lock! returns true on successful lock" + (let* ((m (make-mutex 'mutex-lock-1))) + (mutex-lock! m))) + + (pass-if "mutex-lock! returns false on timeout" + (let* ((m (make-mutex 'mutex-lock-2)) + (t (make-thread (lambda () (mutex-lock! m (current-time) #f))))) + (mutex-lock! m) + (thread-start! t) + (not (thread-join! t)))) + + (pass-if "mutex-lock! returns true when lock obtained within timeout" + (let* ((m (make-mutex 'mutex-lock-3)) + (t (make-thread (lambda () + (mutex-lock! m (+ (time->seconds (current-time)) + 100) + #f))))) + (mutex-lock! m) + (thread-start! t) + (mutex-unlock! m) + (thread-join! t))) + + (pass-if "can lock mutex for non-current thread" + (let* ((m1 (make-mutex 'mutex-lock-4a)) + (m2 (make-mutex 'mutex-lock-4b)) + (t (make-thread (lambda () (mutex-lock! m1)) 'mutex-lock-4))) + (mutex-lock! m1) + (thread-start! t) + (mutex-lock! m2 #f t) + (let ((success (eq? (mutex-state m2) t))) + (thread-terminate! t) success))) + + (pass-if "locking abandoned mutex throws exception" + (let* ((m (make-mutex 'mutex-lock-5)) + (t (make-thread (lambda () (mutex-lock! m)) 'mutex-lock-5)) + (success #f)) + (thread-start! t) + (thread-join! t) + (with-exception-handler + (lambda (obj) (set! success (abandoned-mutex-exception? obj))) + (lambda () (mutex-lock! m))) + (and success (eq? (mutex-state m) (current-thread))))) + + (pass-if "sleeping threads notified of abandonment" + (let* ((m1 (make-mutex 'mutex-lock-6a)) + (m2 (make-mutex 'mutex-lock-6b)) + (c (make-condition-variable 'mutex-lock-6)) + (t (make-thread (lambda () + (mutex-lock! m1) + (mutex-lock! m2) + (condition-variable-signal! c)))) + (success #f)) + (mutex-lock! m1) + (thread-start! t) + (with-exception-handler + (lambda (obj) (set! success (abandoned-mutex-exception? obj))) + (lambda () (mutex-unlock! m1 c) (mutex-lock! m2))) + success))) + +(with-test-prefix "mutex-unlock!" + + (pass-if "unlock changes mutex state" + (let* ((m (make-mutex 'mutex-unlock-1))) + (mutex-lock! m) + (mutex-unlock! m) + (eq? (mutex-state m) 'not-abandoned))) + + (pass-if "can unlock from any thread" + (let* ((m (make-mutex 'mutex-unlock-2)) + (t (make-thread (lambda () (mutex-unlock! m)) 'mutex-unlock-2))) + (mutex-lock! m) + (thread-start! t) + (thread-join! t) + (eq? (mutex-state m) 'not-abandoned))) + + (pass-if "mutex unlock is true when condition is signalled" + (let* ((m (make-mutex 'mutex-unlock-3)) + (c (make-condition-variable 'mutex-unlock-3)) + (t (make-thread (lambda () + (mutex-lock! m) + (condition-variable-signal! c) + (mutex-unlock! m))))) + (mutex-lock! m) + (thread-start! t) + (mutex-unlock! m c))) + + (pass-if "mutex unlock is false when condition times out" + (let* ((m (make-mutex 'mutex-unlock-4)) + (c (make-condition-variable 'mutex-unlock-4))) + (mutex-lock! m) + (not (mutex-unlock! m c (+ (time->seconds (current-time)) 1)))))) + +(with-test-prefix "condition-variable?" + + (pass-if "make-condition-variable creates condition variable" + (condition-variable? (make-condition-variable))) + + (pass-if "symbol not condition variable" + (not (condition-variable? 'foo)))) + +(with-test-prefix "condition-variable-name" + + (pass-if "make-condition-variable with name binds name" + (let* ((c (make-condition-variable 'condition-variable-name-1))) + (eq? (condition-variable-name c) 'condition-variable-name-1))) + + (pass-if "make-condition-variable without name does not bind name" + (let* ((c (make-condition-variable))) + (not (condition-variable-name c))))) + +(with-test-prefix "condition-variable-specific" + + (pass-if "condition-variable-specific is initially #f" + (let ((c (make-condition-variable 'condition-variable-specific-1))) + (not (condition-variable-specific c)))) + + (pass-if "condition-variable-specific-set! can set value" + (let ((c (make-condition-variable 'condition-variable-specific-1))) + (condition-variable-specific-set! c "hello") + (equal? (condition-variable-specific c) "hello")))) + +(with-test-prefix "condition-variable-signal!" + + (pass-if "condition-variable-signal! wakes up single thread" + (let* ((m (make-mutex 'condition-variable-signal-1)) + (c (make-condition-variable 'condition-variable-signal-1)) + (t (make-thread (lambda () + (mutex-lock! m) + (condition-variable-signal! c) + (mutex-unlock! m))))) + (mutex-lock! m) + (thread-start! t) + (mutex-unlock! m c)))) + +(with-test-prefix "condition-variable-broadcast!" + + (pass-if "condition-variable-broadcast! wakes up multiple threads" + (let* ((sem 0) + (c1 (make-condition-variable 'condition-variable-broadcast-1-a)) + (m1 (make-mutex 'condition-variable-broadcast-1-a)) + (c2 (make-condition-variable 'condition-variable-broadcast-1-b)) + (m2 (make-mutex 'condition-variable-broadcast-1-b)) + (inc-sem! (lambda () + (mutex-lock! m1) + (set! sem (+ sem 1)) + (condition-variable-broadcast! c1) + (mutex-unlock! m1))) + (dec-sem! (lambda () + (mutex-lock! m1) + (while (eqv? sem 0) (wait-condition-variable c1 m1)) + (set! sem (- sem 1)) + (mutex-unlock! m1))) + (t1 (make-thread (lambda () + (mutex-lock! m2) + (inc-sem!) + (mutex-unlock! m2 c2) + (inc-sem!)))) + (t2 (make-thread (lambda () + (mutex-lock! m2) + (inc-sem!) + (mutex-unlock! m2 c2) + (inc-sem!))))) + (thread-start! t1) + (thread-start! t2) + (dec-sem!) + (dec-sem!) + (mutex-lock! m2) + (condition-variable-broadcast! c2) + (mutex-unlock! m2) + (dec-sem!) + (dec-sem!)))) + +(with-test-prefix "time?" + + (pass-if "current-time is time" (time? (current-time))) + (pass-if "number is not time" (not (time? 123))) + (pass-if "symbol not time" (not (time? 'foo)))) + +(with-test-prefix "time->seconds" + + (pass-if "time->seconds makes time into rational" + (rational? (time->seconds (current-time)))) + + (pass-if "time->seconds is reversible" + (let ((t (current-time))) + (equal? t (seconds->time (time->seconds t)))))) + +(with-test-prefix "seconds->time" + + (pass-if "seconds->time makes rational into time" + (time? (seconds->time 123.456))) + + (pass-if "seconds->time is reversible" + (let ((t (time->seconds (current-time)))) + (equal? t (time->seconds (seconds->time t)))))) + +(with-test-prefix "current-exception-handler" + + (pass-if "current handler returned at top level" + (procedure? (current-exception-handler))) + + (pass-if "specified handler set under with-exception-handler" + (let ((h (lambda (key . args) 'nothing))) + (with-exception-handler h (lambda () (eq? (current-exception-handler) + h))))) + + (pass-if "multiple levels of handler nesting" + (let ((h (lambda (key . args) 'nothing)) + (i (current-exception-handler))) + (and (with-exception-handler h (lambda () + (eq? (current-exception-handler) h))) + (eq? (current-exception-handler) i)))) + + (pass-if "exception handler installation is thread-safe" + (let* ((h1 (current-exception-handler)) + (h2 (lambda (key . args) 'nothing-2)) + (m (make-mutex 'current-exception-handler-4)) + (c (make-condition-variable 'current-exception-handler-4)) + (t (make-thread (lambda () + (with-exception-handler + h2 (lambda () + (mutex-lock! m) + (condition-variable-signal! c) + (wait-condition-variable c m) + (and (eq? (current-exception-handler) h2) + (mutex-unlock! m))))) + 'current-exception-handler-4))) + (mutex-lock! m) + (thread-start! t) + (wait-condition-variable c m) + (and (eq? (current-exception-handler) h1) + (condition-variable-signal! c) + (mutex-unlock! m) + (thread-join! t))))) + +(with-test-prefix "uncaught-exception-reason" + + (pass-if "initial handler captures top level exception" + (let ((t (make-thread (lambda () (raise 'foo)))) + (success #f)) + (thread-start! t) + (with-exception-handler + (lambda (obj) + (and (uncaught-exception? obj) + (eq? (uncaught-exception-reason obj) 'foo) + (set! success #t))) + (lambda () (thread-join! t))) + success)) + + (pass-if "initial handler captures non-SRFI-18 throw" + (let ((t (make-thread (lambda () (throw 'foo)))) + (success #f)) + (thread-start! t) + (with-exception-handler + (lambda (obj) + (and (uncaught-exception? obj) + (eq? (uncaught-exception-reason obj) 'foo) + (set! success #t))) + (lambda () (thread-join! t))) + success))) From 102dbb6f6ccf69badcb2215259d755136b19fe89 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 14 May 2008 05:20:47 +0200 Subject: [PATCH 37/87] Add `SCM_INTERNAL' macro, use it. --- libguile/ChangeLog | 7 ++++ libguile/__scm.h | 9 +++++ libguile/alist.h | 4 +- libguile/arbiters.h | 4 +- libguile/async.h | 13 +++--- libguile/backtrace.h | 7 ++-- libguile/boolean.h | 4 +- libguile/chars.h | 4 +- libguile/continuations.h | 17 ++++---- libguile/coop-pthreads.h | 4 +- libguile/debug-malloc.h | 6 +-- libguile/debug.h | 6 +-- libguile/deprecation.h | 4 +- libguile/dynl.h | 4 +- libguile/dynwind.h | 8 ++-- libguile/environments.h | 6 +-- libguile/eq.h | 4 +- libguile/error.h | 4 +- libguile/eval.h | 18 ++++----- libguile/evalext.h | 4 +- libguile/extensions.h | 4 +- libguile/feature.h | 4 +- libguile/filesys.h | 4 +- libguile/fluids.h | 8 ++-- libguile/fports.h | 10 ++--- libguile/futures.h | 4 +- libguile/gc.h | 10 ++--- libguile/gdbint.h | 4 +- libguile/gettext.h | 6 +-- libguile/goops.h | 9 +++-- libguile/gsubr.h | 4 +- libguile/guardians.h | 10 ++--- libguile/hash.h | 4 +- libguile/hashtab.h | 11 +++--- libguile/hooks.h | 4 +- libguile/i18n.h | 2 +- libguile/init.h | 6 +-- libguile/ioext.h | 4 +- libguile/keywords.h | 4 +- libguile/lang.h | 4 +- libguile/list.h | 6 +-- libguile/load.h | 6 +-- libguile/macros.h | 6 +-- libguile/mallocs.h | 4 +- libguile/modules.h | 6 +-- libguile/net_db.h | 4 +- libguile/numbers.h | 32 +++++++-------- libguile/objects.h | 10 ++--- libguile/objprop.h | 4 +- libguile/options.h | 4 +- libguile/pairs.h | 2 +- libguile/ports.h | 14 +++---- libguile/posix.h | 6 +-- libguile/print.h | 6 +-- libguile/private-gc.h | 70 +++++++++++++++++++-------------- libguile/procprop.h | 6 +-- libguile/procs.h | 6 +-- libguile/properties.h | 4 +- libguile/ramap.h | 4 +- libguile/random.h | 10 ++--- libguile/rdelim.h | 4 +- libguile/read.h | 8 ++-- libguile/regex-posix.h | 4 +- libguile/root.h | 4 +- libguile/rw.h | 6 +-- libguile/scmsigs.h | 10 ++--- libguile/script.h | 4 +- libguile/simpos.h | 4 +- libguile/socket.h | 4 +- libguile/sort.h | 4 +- libguile/srcprop.h | 4 +- libguile/srfi-13.h | 6 +-- libguile/srfi-14.h | 6 +-- libguile/srfi-4.h | 12 +++--- libguile/stackchk.h | 4 +- libguile/stacks.h | 4 +- libguile/stime.h | 4 +- libguile/strings.h | 60 ++++++++++++++-------------- libguile/strorder.h | 4 +- libguile/strports.h | 4 +- libguile/struct.h | 8 ++-- libguile/symbols.h | 8 ++-- libguile/threads.h | 24 +++++------ libguile/throw.h | 4 +- libguile/unif.h | 10 ++--- libguile/values.h | 4 +- libguile/variable.h | 6 +-- libguile/vectors.h | 10 ++--- libguile/version.h.in | 4 +- libguile/vports.h | 4 +- libguile/weaks.h | 14 +++---- test-suite/ChangeLog | 5 +++ test-suite/standalone/test-gh.c | 2 +- 93 files changed, 381 insertions(+), 345 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5962f7e14..110b781fc 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,10 @@ +2008-05-31 Ludovic Courtès + + * __scm.h (SCM_INTERNAL): New macro. + * *.h: Use it to mark as internal `scm_i_' and `scm_init_' + functions that are not used by public macros or inline + functions. + 2008-05-14 Julian Graham * threads.c (fat_mutex)[recursive]: New field. diff --git a/libguile/__scm.h b/libguile/__scm.h index b198f9d6a..76b444857 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -97,6 +97,15 @@ #define SCM_LIKELY(_expr) SCM_EXPECT ((_expr), 1) #define SCM_UNLIKELY(_expr) SCM_EXPECT ((_expr), 0) +/* The SCM_INTERNAL macro makes it possible to explicitly declare a function + * as having "internal" linkage. */ +#if (defined __GNUC__) && \ + ((__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ == 3)) +# define SCM_INTERNAL __attribute__ ((__visibility__ ("internal"))) +#else +# define SCM_INTERNAL +#endif + /* {Supported Options} diff --git a/libguile/alist.h b/libguile/alist.h index 3d1784c7f..76cccba2b 100644 --- a/libguile/alist.h +++ b/libguile/alist.h @@ -3,7 +3,7 @@ #ifndef SCM_ALIST_H #define SCM_ALIST_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -42,7 +42,7 @@ SCM_API SCM scm_assoc_set_x (SCM alist, SCM key, SCM val); SCM_API SCM scm_assq_remove_x (SCM alist, SCM key); SCM_API SCM scm_assv_remove_x (SCM alist, SCM key); SCM_API SCM scm_assoc_remove_x (SCM alist, SCM key); -SCM_API void scm_init_alist (void); +SCM_INTERNAL void scm_init_alist (void); #endif /* SCM_ALIST_H */ diff --git a/libguile/arbiters.h b/libguile/arbiters.h index d04244926..7a7dfd3fa 100644 --- a/libguile/arbiters.h +++ b/libguile/arbiters.h @@ -3,7 +3,7 @@ #ifndef SCM_ARBITERS_H #define SCM_ARBITERS_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -29,7 +29,7 @@ SCM_API SCM scm_make_arbiter (SCM name); SCM_API SCM scm_try_arbiter (SCM arb); SCM_API SCM scm_release_arbiter (SCM arb); -SCM_API void scm_init_arbiters (void); +SCM_INTERNAL void scm_init_arbiters (void); #endif /* SCM_ARBITERS_H */ diff --git a/libguile/async.h b/libguile/async.h index a81a98d74..c01bde031 100644 --- a/libguile/async.h +++ b/libguile/async.h @@ -3,7 +3,7 @@ #ifndef SCM_ASYNC_H #define SCM_ASYNC_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2004, 2005, 2006, 2008 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 @@ -38,10 +38,11 @@ SCM_API SCM scm_async (SCM thunk); SCM_API SCM scm_async_mark (SCM a); SCM_API SCM scm_system_async_mark (SCM a); SCM_API SCM scm_system_async_mark_for_thread (SCM a, SCM thread); -SCM_API void scm_i_queue_async_cell (SCM cell, scm_i_thread *); -SCM_API int scm_i_setup_sleep (scm_i_thread *, - SCM obj, scm_i_pthread_mutex_t *m, int fd); -SCM_API void scm_i_reset_sleep (scm_i_thread *); +SCM_INTERNAL void scm_i_queue_async_cell (SCM cell, scm_i_thread *); +SCM_INTERNAL int scm_i_setup_sleep (scm_i_thread *, + SCM obj, scm_i_pthread_mutex_t *m, + int fd); +SCM_INTERNAL void scm_i_reset_sleep (scm_i_thread *); SCM_API SCM scm_run_asyncs (SCM list_of_a); SCM_API SCM scm_noop (SCM args); SCM_API SCM scm_call_with_blocked_asyncs (SCM proc); @@ -77,7 +78,7 @@ extern int scm_i_critical_section_level; scm_async_click (); \ } while (0) -SCM_API void scm_init_async (void); +SCM_INTERNAL void scm_init_async (void); #if (SCM_ENABLE_DEPRECATED == 1) diff --git a/libguile/backtrace.h b/libguile/backtrace.h index b4033dede..e11cb85de 100644 --- a/libguile/backtrace.h +++ b/libguile/backtrace.h @@ -3,7 +3,7 @@ #ifndef SCM_BACKTRACE_H #define SCM_BACKTRACE_H -/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1998,1999,2000,2001, 2004, 2006, 2008 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 @@ -27,7 +27,8 @@ SCM_API SCM scm_the_last_stack_fluid_var; SCM_API void scm_display_error_message (SCM message, SCM args, SCM port); -SCM_API void scm_i_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest); +SCM_INTERNAL void scm_i_display_error (SCM stack, SCM port, SCM subr, + SCM message, SCM args, SCM rest); SCM_API SCM scm_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args, SCM rest); SCM_API SCM scm_display_application (SCM frame, SCM port, SCM indent); SCM_API SCM scm_display_backtrace (SCM stack, SCM port, SCM first, SCM depth); @@ -38,7 +39,7 @@ SCM_API SCM scm_backtrace_with_highlights (SCM highlights); SCM_API SCM scm_set_print_params_x (SCM params); #endif -SCM_API void scm_init_backtrace (void); +SCM_INTERNAL void scm_init_backtrace (void); #endif /* SCM_BACKTRACE_H */ diff --git a/libguile/boolean.h b/libguile/boolean.h index 3dc82e1f6..1388c2fdc 100644 --- a/libguile/boolean.h +++ b/libguile/boolean.h @@ -3,7 +3,7 @@ #ifndef SCM_BOOLEAN_H #define SCM_BOOLEAN_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -43,7 +43,7 @@ SCM_API int scm_to_bool (SCM x); SCM_API SCM scm_not (SCM x); SCM_API SCM scm_boolean_p (SCM obj); -SCM_API void scm_init_boolean (void); +SCM_INTERNAL void scm_init_boolean (void); #endif /* SCM_BOOLEAN_H */ diff --git a/libguile/chars.h b/libguile/chars.h index 1a139e901..97c611af4 100644 --- a/libguile/chars.h +++ b/libguile/chars.h @@ -3,7 +3,7 @@ #ifndef SCM_CHARS_H #define SCM_CHARS_H -/* Copyright (C) 1995,1996,2000,2001,2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001,2004, 2006, 2008 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 @@ -62,7 +62,7 @@ SCM_API SCM scm_char_upcase (SCM chr); SCM_API SCM scm_char_downcase (SCM chr); SCM_API int scm_c_upcase (unsigned int c); SCM_API int scm_c_downcase (unsigned int c); -SCM_API void scm_init_chars (void); +SCM_INTERNAL void scm_init_chars (void); #endif /* SCM_CHARS_H */ diff --git a/libguile/continuations.h b/libguile/continuations.h index f6fb96aa2..1a648dd28 100644 --- a/libguile/continuations.h +++ b/libguile/continuations.h @@ -3,7 +3,7 @@ #ifndef SCM_CONTINUATIONS_H #define SCM_CONTINUATIONS_H -/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 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 @@ -90,14 +90,15 @@ SCM_API SCM scm_make_continuation (int *first); SCM_API void *scm_c_with_continuation_barrier (void *(*func)(void*), void *); SCM_API SCM scm_with_continuation_barrier (SCM proc); -SCM_API SCM scm_i_with_continuation_barrier (scm_t_catch_body body, - void *body_data, - scm_t_catch_handler handler, - void *handler_data, - scm_t_catch_handler pre_unwind_handler, - void *pre_unwind_handler_data); +SCM_INTERNAL SCM +scm_i_with_continuation_barrier (scm_t_catch_body body, + void *body_data, + scm_t_catch_handler handler, + void *handler_data, + scm_t_catch_handler pre_unwind_handler, + void *pre_unwind_handler_data); -SCM_API void scm_init_continuations (void); +SCM_INTERNAL void scm_init_continuations (void); #endif /* SCM_CONTINUATIONS_H */ diff --git a/libguile/coop-pthreads.h b/libguile/coop-pthreads.h index 913487452..cc1f75a9b 100644 --- a/libguile/coop-pthreads.h +++ b/libguile/coop-pthreads.h @@ -3,7 +3,7 @@ #ifndef SCM_COOP_PTHREADS_H #define SCM_COOP_PTHREADS_H -/* Copyright (C) 2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2002, 2006, 2008 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 @@ -70,7 +70,7 @@ SCM_API int scm_i_switch_counter; #define SCM_SET_THREAD_LOCAL_DATA(ptr) (scm_i_copt_set_thread_data (ptr)) SCM_API void *scm_i_copt_thread_data; -SCM_API void scm_i_copt_set_thread_data (void *data); +SCM_INTERNAL void scm_i_copt_set_thread_data (void *data); #endif /* SCM_COOP_PTHREAD_H */ diff --git a/libguile/debug-malloc.h b/libguile/debug-malloc.h index 444f06d71..1aa5221c6 100644 --- a/libguile/debug-malloc.h +++ b/libguile/debug-malloc.h @@ -3,7 +3,7 @@ #ifndef SCM_DEBUG_MALLOC_H #define SCM_DEBUG_MALLOC_H -/* Copyright (C) 2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2000,2001, 2006, 2008 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 @@ -32,8 +32,8 @@ SCM_API void scm_malloc_reregister (void *obj, void *new, const char *what); SCM_API SCM scm_malloc_stats (void); -SCM_API void scm_debug_malloc_prehistory (void); -SCM_API void scm_init_debug_malloc (void); +SCM_INTERNAL void scm_debug_malloc_prehistory (void); +SCM_INTERNAL void scm_init_debug_malloc (void); #endif /* SCM_DEBUG_MALLOC_H */ diff --git a/libguile/debug.h b/libguile/debug.h index 79afa4d53..607716230 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -3,7 +3,7 @@ #ifndef SCM_DEBUG_H #define SCM_DEBUG_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004 +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2004,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -150,8 +150,8 @@ SCM_API SCM scm_evaluator_traps (SCM setting); SCM_API SCM scm_debug_options (SCM setting); SCM_API SCM scm_make_debugobj (scm_t_debug_frame *debug); -SCM_API SCM scm_i_unmemoize_expr (SCM memoized); -SCM_API void scm_init_debug (void); +SCM_INTERNAL SCM scm_i_unmemoize_expr (SCM memoized); +SCM_INTERNAL void scm_init_debug (void); #ifdef GUILE_DEBUG SCM_API SCM scm_memcons (SCM car, SCM cdr, SCM env); diff --git a/libguile/deprecation.h b/libguile/deprecation.h index 53500eeca..78853277b 100644 --- a/libguile/deprecation.h +++ b/libguile/deprecation.h @@ -3,7 +3,7 @@ #ifndef SCM_DEPRECATION_H #define SCM_DEPRECATION_H -/* Copyright (C) 2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2006, 2008 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 @@ -41,7 +41,7 @@ SCM_API SCM scm_issue_deprecation_warning (SCM msgs); #endif SCM_API SCM scm_include_deprecated_features (void); -SCM_API void scm_init_deprecation (void); +SCM_INTERNAL void scm_init_deprecation (void); #endif /* SCM_DEPRECATION_H */ diff --git a/libguile/dynl.h b/libguile/dynl.h index 6936afd3d..72dc92ea4 100644 --- a/libguile/dynl.h +++ b/libguile/dynl.h @@ -3,7 +3,7 @@ #ifndef SCM_DYNL_H #define SCM_DYNL_H -/* Copyright (C) 1996,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1998,2000,2001, 2006, 2008 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 @@ -33,7 +33,7 @@ SCM_API SCM scm_dynamic_func (SCM symb, SCM dobj); SCM_API SCM scm_dynamic_call (SCM symb, SCM dobj); SCM_API SCM scm_dynamic_args_call (SCM symb, SCM dobj, SCM args); -SCM_API void scm_init_dynamic_linking (void); +SCM_INTERNAL void scm_init_dynamic_linking (void); #endif /* SCM_DYNL_H */ diff --git a/libguile/dynwind.h b/libguile/dynwind.h index 9e5390b10..dd39dae5a 100644 --- a/libguile/dynwind.h +++ b/libguile/dynwind.h @@ -3,7 +3,7 @@ #ifndef SCM_DYNWIND_H #define SCM_DYNWIND_H -/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2003,2004, 2006, 2008 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 @@ -36,9 +36,9 @@ SCM_API SCM scm_internal_dynamic_wind (scm_t_guard before, void *inner_data, void *guard_data); SCM_API void scm_dowinds (SCM to, long delta); -SCM_API void scm_i_dowinds (SCM to, long delta, - void (*turn_func) (void *), void *data); -SCM_API void scm_init_dynwind (void); +SCM_INTERNAL void scm_i_dowinds (SCM to, long delta, + void (*turn_func) (void *), void *data); +SCM_INTERNAL void scm_init_dynwind (void); SCM_API void scm_swap_bindings (SCM vars, SCM vals); diff --git a/libguile/environments.h b/libguile/environments.h index dd698b7b5..10d42a704 100644 --- a/libguile/environments.h +++ b/libguile/environments.h @@ -3,7 +3,7 @@ #ifndef SCM_ENVIRONMENTS_H #define SCM_ENVIRONMENTS_H -/* Copyright (C) 1999,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000, 2006, 2008 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 @@ -122,8 +122,8 @@ SCM_API SCM scm_environment_observe_weak (SCM env, SCM proc); SCM_API SCM scm_c_environment_observe (SCM env, scm_environment_observer proc, SCM data, int weak_p); SCM_API SCM scm_environment_unobserve (SCM token); -SCM_API void scm_environments_prehistory (void); -SCM_API void scm_init_environments (void); +SCM_INTERNAL void scm_environments_prehistory (void); +SCM_INTERNAL void scm_init_environments (void); diff --git a/libguile/eq.h b/libguile/eq.h index da5a71c9f..af6959fe8 100644 --- a/libguile/eq.h +++ b/libguile/eq.h @@ -3,7 +3,7 @@ #ifndef SCM_EQ_H #define SCM_EQ_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -29,7 +29,7 @@ SCM_API SCM scm_eq_p (SCM x, SCM y); SCM_API SCM scm_eqv_p (SCM x, SCM y); SCM_API SCM scm_equal_p (SCM x, SCM y); -SCM_API void scm_init_eq (void); +SCM_INTERNAL void scm_init_eq (void); #endif /* SCM_EQ_H */ diff --git a/libguile/error.h b/libguile/error.h index 7ba0c4b37..042fb4d14 100644 --- a/libguile/error.h +++ b/libguile/error.h @@ -3,7 +3,7 @@ #ifndef SCM_ERROR_H #define SCM_ERROR_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2002, 2006, 2008 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 @@ -57,7 +57,7 @@ SCM_API void scm_wrong_type_arg_msg (const char *subr, int pos, SCM_API void scm_memory_error (const char *subr) SCM_NORETURN; SCM_API void scm_misc_error (const char *subr, const char *message, SCM args) SCM_NORETURN; -SCM_API void scm_init_error (void); +SCM_INTERNAL void scm_init_error (void); #endif /* SCM_ERROR_H */ diff --git a/libguile/eval.h b/libguile/eval.h index 247cf164e..bf6279b82 100644 --- a/libguile/eval.h +++ b/libguile/eval.h @@ -3,7 +3,7 @@ #ifndef SCM_EVAL_H #define SCM_EVAL_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004 +/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002,2003,2004,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -152,7 +152,7 @@ SCM_API SCM scm_apply_0 (SCM proc, SCM args); SCM_API SCM scm_apply_1 (SCM proc, SCM arg1, SCM args); SCM_API SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args); SCM_API SCM scm_apply_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM args); -SCM_API SCM scm_i_call_closure_0 (SCM proc); +SCM_INTERNAL SCM scm_i_call_closure_0 (SCM proc); SCM_API scm_t_trampoline_0 scm_trampoline_0 (SCM proc); SCM_API scm_t_trampoline_1 scm_trampoline_1 (SCM proc); SCM_API scm_t_trampoline_2 scm_trampoline_2 (SCM proc); @@ -167,18 +167,18 @@ SCM_API SCM scm_force (SCM x); SCM_API SCM scm_promise_p (SCM x); SCM_API SCM scm_cons_source (SCM xorig, SCM x, SCM y); SCM_API SCM scm_copy_tree (SCM obj); -SCM_API SCM scm_i_eval_x (SCM exp, SCM env); -SCM_API SCM scm_i_eval (SCM exp, SCM env); +SCM_API SCM scm_i_eval_x (SCM exp, SCM env) /* not internal */; +SCM_INTERNAL SCM scm_i_eval (SCM exp, SCM env); SCM_API SCM scm_primitive_eval (SCM exp); SCM_API SCM scm_primitive_eval_x (SCM exp); SCM_API SCM scm_eval (SCM exp, SCM module); SCM_API SCM scm_eval_x (SCM exp, SCM module); -SCM_API void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/); -SCM_API void scm_i_print_isym (SCM /*isym*/, SCM /*port*/); -SCM_API SCM scm_i_unmemocopy_expr (SCM expr, SCM env); -SCM_API SCM scm_i_unmemocopy_body (SCM forms, SCM env); -SCM_API void scm_init_eval (void); +SCM_INTERNAL void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/); +SCM_INTERNAL void scm_i_print_isym (SCM /*isym*/, SCM /*port*/); +SCM_INTERNAL SCM scm_i_unmemocopy_expr (SCM expr, SCM env); +SCM_INTERNAL SCM scm_i_unmemocopy_body (SCM forms, SCM env); +SCM_INTERNAL void scm_init_eval (void); #if (SCM_ENABLE_DEPRECATED == 1) diff --git a/libguile/evalext.h b/libguile/evalext.h index e9b442e44..a6a4a9fdc 100644 --- a/libguile/evalext.h +++ b/libguile/evalext.h @@ -3,7 +3,7 @@ #ifndef SCM_EVALEXT_H #define SCM_EVALEXT_H -/* Copyright (C) 1998,1999,2000, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998,1999,2000, 2003, 2006, 2008 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 @@ -28,7 +28,7 @@ SCM_API SCM scm_defined_p (SCM sym, SCM env); SCM_API SCM scm_self_evaluating_p (SCM obj); -SCM_API void scm_init_evalext (void); +SCM_INTERNAL void scm_init_evalext (void); #if (SCM_ENABLE_DEPRECATED == 1) diff --git a/libguile/extensions.h b/libguile/extensions.h index 294dcad76..596b43ae0 100644 --- a/libguile/extensions.h +++ b/libguile/extensions.h @@ -3,7 +3,7 @@ #ifndef SCM_EXTENSIONS_H #define SCM_EXTENSIONS_H -/* Copyright (C) 2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2006, 2008 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 @@ -32,7 +32,7 @@ SCM_API void scm_c_register_extension (const char *lib, const char *init, SCM_API void scm_c_load_extension (const char *lib, const char *init); SCM_API SCM scm_load_extension (SCM lib, SCM init); -SCM_API void scm_init_extensions (void); +SCM_INTERNAL void scm_init_extensions (void); #endif /* SCM_EXTENSIONS_H */ diff --git a/libguile/feature.h b/libguile/feature.h index 9c61f8ce8..8c6371e94 100644 --- a/libguile/feature.h +++ b/libguile/feature.h @@ -3,7 +3,7 @@ #ifndef SCM_FEATURE_H #define SCM_FEATURE_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2007, 2008 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 @@ -28,7 +28,7 @@ SCM_API void scm_add_feature (const char* str); SCM_API SCM scm_program_arguments (void); SCM_API void scm_set_program_arguments (int argc, char **argv, char *first); SCM_API SCM scm_set_program_arguments_scm (SCM lst); -SCM_API void scm_init_feature (void); +SCM_INTERNAL void scm_init_feature (void); #endif /* SCM_FEATURE_H */ diff --git a/libguile/filesys.h b/libguile/filesys.h index 6534da909..a38a5b594 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -3,7 +3,7 @@ #ifndef SCM_FILESYS_H #define SCM_FILESYS_H -/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1997,1998,1999,2000,2001, 2006, 2008 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 @@ -65,7 +65,7 @@ SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile); SCM_API SCM scm_dirname (SCM filename); SCM_API SCM scm_basename (SCM filename, SCM suffix); -SCM_API void scm_init_filesys (void); +SCM_INTERNAL void scm_init_filesys (void); #endif /* SCM_FILESYS_H */ diff --git a/libguile/fluids.h b/libguile/fluids.h index cabce4617..c48a8c332 100644 --- a/libguile/fluids.h +++ b/libguile/fluids.h @@ -3,7 +3,7 @@ #ifndef SCM_FLUIDS_H #define SCM_FLUIDS_H -/* Copyright (C) 1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,2000,2001, 2006, 2008 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 @@ -82,10 +82,10 @@ SCM_API void *scm_c_with_dynamic_state (SCM state, void *(*func)(void *), void *data); SCM_API SCM scm_with_dynamic_state (SCM state, SCM proc); -SCM_API SCM scm_i_make_initial_dynamic_state (void); +SCM_INTERNAL SCM scm_i_make_initial_dynamic_state (void); -SCM_API void scm_fluids_prehistory (void); -SCM_API void scm_init_fluids (void); +SCM_INTERNAL void scm_fluids_prehistory (void); +SCM_INTERNAL void scm_init_fluids (void); #endif /* SCM_FLUIDS_H */ diff --git a/libguile/fports.h b/libguile/fports.h index 634106760..c737b1eaa 100644 --- a/libguile/fports.h +++ b/libguile/fports.h @@ -3,7 +3,7 @@ #ifndef SCM_FPORTS_H #define SCM_FPORTS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008 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 @@ -53,13 +53,13 @@ SCM_API void scm_evict_ports (int fd); SCM_API SCM scm_open_file (SCM filename, SCM modes); SCM_API SCM scm_fdes_to_port (int fdes, char *mode, SCM name); SCM_API SCM scm_file_port_p (SCM obj); -SCM_API void scm_init_fports (void); +SCM_INTERNAL void scm_init_fports (void); /* internal functions */ -SCM_API SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name); -SCM_API int scm_i_fport_truncate (SCM, SCM); -SCM_API SCM scm_i_fport_seek (SCM, SCM, int); +SCM_INTERNAL SCM scm_i_fdes_to_port (int fdes, long mode_bits, SCM name); +SCM_INTERNAL int scm_i_fport_truncate (SCM, SCM); +SCM_INTERNAL SCM scm_i_fport_seek (SCM, SCM, int); #endif /* SCM_FPORTS_H */ diff --git a/libguile/futures.h b/libguile/futures.h index dffb38db8..95916f33b 100644 --- a/libguile/futures.h +++ b/libguile/futures.h @@ -3,7 +3,7 @@ #ifndef SCM_FUTURES_H #define SCM_FUTURES_H -/* Copyright (C) 2002, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2002, 2003, 2006, 2008 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 @@ -73,7 +73,7 @@ SCM_API scm_t_bits scm_tc16_future; extern SCM *scm_loc_sys_thread_handler; -SCM_API SCM scm_i_make_future (SCM thunk); +SCM_INTERNAL SCM scm_i_make_future (SCM thunk); SCM_API SCM scm_make_future (SCM thunk); SCM_API SCM scm_future_ref (SCM future); diff --git a/libguile/gc.h b/libguile/gc.h index d3c995996..05412bccf 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -3,7 +3,7 @@ #ifndef SCM_GC_H #define SCM_GC_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2008 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 @@ -241,10 +241,10 @@ SCM_API int scm_debug_cells_gc_interval ; void scm_i_expensive_validation_check (SCM cell); #endif -SCM_API scm_i_pthread_mutex_t scm_i_gc_admin_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_gc_admin_mutex; #define scm_gc_running_p (SCM_I_CURRENT_THREAD->gc_running_p) -SCM_API scm_i_pthread_mutex_t scm_i_sweep_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_sweep_mutex; #ifdef __ia64__ void *scm_ia64_register_backing_store_base (void); @@ -320,7 +320,7 @@ SCM_API SCM scm_gc_live_object_stats (void); SCM_API SCM scm_gc (void); SCM_API void scm_gc_for_alloc (struct scm_t_cell_type_statistics *freelist); SCM_API SCM scm_gc_for_newcell (struct scm_t_cell_type_statistics *master, SCM *freelist); -SCM_API void scm_i_gc (const char *what); +SCM_INTERNAL void scm_i_gc (const char *what); SCM_API void scm_gc_mark (SCM p); SCM_API void scm_gc_mark_dependencies (SCM p); SCM_API void scm_mark_locations (SCM_STACKITEM x[], unsigned long n); @@ -384,7 +384,7 @@ SCM_API void scm_gc_unregister_roots (SCM *b, unsigned long n); SCM_API void scm_storage_prehistory (void); SCM_API int scm_init_storage (void); SCM_API void *scm_get_stack_base (void); -SCM_API void scm_init_gc (void); +SCM_INTERNAL void scm_init_gc (void); #if SCM_ENABLE_DEPRECATED == 1 diff --git a/libguile/gdbint.h b/libguile/gdbint.h index d6511f7ad..64b9559c9 100644 --- a/libguile/gdbint.h +++ b/libguile/gdbint.h @@ -3,7 +3,7 @@ #ifndef SCM_GDBINT_H #define SCM_GDBINT_H -/* Copyright (C) 1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,2000, 2006, 2008 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 @@ -28,7 +28,7 @@ SCM_API int scm_print_carefully_p; -SCM_API void scm_init_gdbint (void); +SCM_INTERNAL void scm_init_gdbint (void); #endif /* SCM_GDBINT_H */ diff --git a/libguile/gettext.h b/libguile/gettext.h index 4d91358e5..8a13307d5 100644 --- a/libguile/gettext.h +++ b/libguile/gettext.h @@ -3,7 +3,7 @@ #ifndef SCM_GETTEXT_H #define SCM_GETTEXT_H -/* Copyright (C) 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2004, 2006, 2008 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 @@ -28,9 +28,9 @@ SCM_API SCM scm_textdomain (SCM domainname); SCM_API SCM scm_bindtextdomain (SCM domainname, SCM directory); SCM_API SCM scm_bind_textdomain_codeset (SCM domainname, SCM encoding); -SCM_API int scm_i_to_lc_category (SCM category, int allow_lc_all); +SCM_INTERNAL int scm_i_to_lc_category (SCM category, int allow_lc_all); -SCM_API void scm_init_gettext (void); +SCM_INTERNAL void scm_init_gettext (void); #endif /* SCM_GETTEXT_H */ diff --git a/libguile/goops.h b/libguile/goops.h index 3fc87886f..80ba98549 100644 --- a/libguile/goops.h +++ b/libguile/goops.h @@ -3,7 +3,7 @@ #ifndef SCM_GOOPS_H #define SCM_GOOPS_H -/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008 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 @@ -254,7 +254,8 @@ SCM_API SCM scm_pure_generic_p (SCM obj); #endif SCM_API SCM scm_sys_compute_slots (SCM c); -SCM_API SCM scm_i_get_keyword (SCM key, SCM l, long len, SCM default_value, const char *subr); +SCM_INTERNAL SCM scm_i_get_keyword (SCM key, SCM l, long len, + SCM default_value, const char *subr); SCM_API SCM scm_get_keyword (SCM key, SCM l, SCM default_value); SCM_API SCM scm_sys_initialize_object (SCM obj, SCM initargs); SCM_API SCM scm_sys_prep_layout_x (SCM c); @@ -297,8 +298,8 @@ SCM_API SCM scm_make (SCM args); SCM_API SCM scm_find_method (SCM args); SCM_API SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs); -SCM_API SCM scm_init_goops_builtins (void); -SCM_API void scm_init_goops (void); +SCM_INTERNAL SCM scm_init_goops_builtins (void); +SCM_INTERNAL void scm_init_goops (void); #if (SCM_ENABLE_DEPRECATED == 1) diff --git a/libguile/gsubr.h b/libguile/gsubr.h index e7488052b..418564901 100644 --- a/libguile/gsubr.h +++ b/libguile/gsubr.h @@ -3,7 +3,7 @@ #ifndef SCM_GSUBR_H #define SCM_GSUBR_H -/* Copyright (C) 1995,1996,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 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 @@ -51,7 +51,7 @@ SCM_API SCM scm_c_define_gsubr_with_generic (const char *name, SCM (*fcn) (), SCM *gf); SCM_API SCM scm_gsubr_apply (SCM args); -SCM_API void scm_init_gsubr (void); +SCM_INTERNAL void scm_init_gsubr (void); #endif /* SCM_GSUBR_H */ diff --git a/libguile/guardians.h b/libguile/guardians.h index 735f960f8..295092edf 100644 --- a/libguile/guardians.h +++ b/libguile/guardians.h @@ -3,7 +3,7 @@ #ifndef SCM_GUARDIANS_H #define SCM_GUARDIANS_H -/* Copyright (C) 1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001, 2006, 2008 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 @@ -26,11 +26,11 @@ SCM_API SCM scm_make_guardian (void); -SCM_API void scm_i_init_guardians_for_gc (void); -SCM_API void scm_i_identify_inaccessible_guardeds (void); -SCM_API int scm_i_mark_inaccessible_guardeds (void); +SCM_INTERNAL void scm_i_init_guardians_for_gc (void); +SCM_INTERNAL void scm_i_identify_inaccessible_guardeds (void); +SCM_INTERNAL int scm_i_mark_inaccessible_guardeds (void); -SCM_API void scm_init_guardians (void); +SCM_INTERNAL void scm_init_guardians (void); #endif /* SCM_GUARDIANS_H */ diff --git a/libguile/hash.h b/libguile/hash.h index a2d00c203..bbf9b2562 100644 --- a/libguile/hash.h +++ b/libguile/hash.h @@ -3,7 +3,7 @@ #ifndef SCM_HASH_H #define SCM_HASH_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -34,7 +34,7 @@ SCM_API unsigned long scm_ihashv (SCM obj, unsigned long n); SCM_API SCM scm_hashv (SCM obj, SCM n); SCM_API unsigned long scm_ihash (SCM obj, unsigned long n); SCM_API SCM scm_hash (SCM obj, SCM n); -SCM_API void scm_init_hash (void); +SCM_INTERNAL void scm_init_hash (void); #endif /* SCM_HASH_H */ diff --git a/libguile/hashtab.h b/libguile/hashtab.h index 101735460..4220b8668 100644 --- a/libguile/hashtab.h +++ b/libguile/hashtab.h @@ -3,7 +3,7 @@ #ifndef SCM_HASHTAB_H #define SCM_HASHTAB_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008 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 @@ -96,8 +96,9 @@ SCM_API SCM scm_weak_key_hash_table_p (SCM h); SCM_API SCM scm_weak_value_hash_table_p (SCM h); SCM_API SCM scm_doubly_weak_hash_table_p (SCM h); -SCM_API void scm_i_rehash (SCM table, unsigned long (*hash_fn)(), void *closure, const char*func_name); -SCM_API void scm_i_scan_weak_hashtables (void); +SCM_INTERNAL void scm_i_rehash (SCM table, unsigned long (*hash_fn)(), + void *closure, const char *func_name); +SCM_INTERNAL void scm_i_scan_weak_hashtables (void); SCM_API SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned long (*hash_fn) (), SCM (*assoc_fn) (), void * closure); SCM_API SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned long (*hash_fn) (), SCM (*assoc_fn) (), void * closure); @@ -132,8 +133,8 @@ SCM_API SCM scm_hash_fold (SCM proc, SCM init, SCM hash); SCM_API SCM scm_hash_for_each (SCM proc, SCM hash); SCM_API SCM scm_hash_for_each_handle (SCM proc, SCM hash); SCM_API SCM scm_hash_map_to_list (SCM proc, SCM hash); -SCM_API void scm_hashtab_prehistory (void); -SCM_API void scm_init_hashtab (void); +SCM_INTERNAL void scm_hashtab_prehistory (void); +SCM_INTERNAL void scm_init_hashtab (void); #endif /* SCM_HASHTAB_H */ diff --git a/libguile/hooks.h b/libguile/hooks.h index 69972c3e7..49ea55350 100644 --- a/libguile/hooks.h +++ b/libguile/hooks.h @@ -3,7 +3,7 @@ #ifndef SCM_HOOKS_H #define SCM_HOOKS_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008 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 @@ -87,7 +87,7 @@ SCM_API SCM scm_reset_hook_x (SCM hook); SCM_API SCM scm_run_hook (SCM hook, SCM args); SCM_API void scm_c_run_hook (SCM hook, SCM args); SCM_API SCM scm_hook_to_list (SCM hook); -SCM_API void scm_init_hooks (void); +SCM_INTERNAL void scm_init_hooks (void); #endif /* SCM_HOOKS_H */ diff --git a/libguile/i18n.h b/libguile/i18n.h index 17dc240d8..57f1654a3 100644 --- a/libguile/i18n.h +++ b/libguile/i18n.h @@ -3,7 +3,7 @@ #ifndef SCM_I18N_H #define SCM_I18N_H -/* Copyright (C) 2006 Free Software Foundation, Inc. +/* Copyright (C) 2006, 2008 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 diff --git a/libguile/init.h b/libguile/init.h index ec083da52..3ae27d8cc 100644 --- a/libguile/init.h +++ b/libguile/init.h @@ -3,7 +3,7 @@ #ifndef SCM_INIT_H #define SCM_INIT_H -/* Copyright (C) 1995,1996,1997,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 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 @@ -26,7 +26,7 @@ #include "libguile/threads.h" -SCM_API scm_i_pthread_mutex_t scm_i_init_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_init_mutex; SCM_API int scm_initialized_p; SCM_API void scm_init_guile (void); @@ -37,7 +37,7 @@ SCM_API void scm_boot_guile (int argc, char **argv, char **argv), void *closure); -SCM_API void scm_i_init_guile (SCM_STACKITEM *base); +SCM_INTERNAL void scm_i_init_guile (SCM_STACKITEM *base); SCM_API void scm_load_startup_files (void); diff --git a/libguile/ioext.h b/libguile/ioext.h index 7ced2af32..18289ea3c 100644 --- a/libguile/ioext.h +++ b/libguile/ioext.h @@ -3,7 +3,7 @@ #ifndef SCM_IOEXT_H #define SCM_IOEXT_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 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 @@ -35,7 +35,7 @@ SCM_API SCM scm_isatty_p (SCM port); SCM_API SCM scm_fdopen (SCM fdes, SCM modes); SCM_API SCM scm_primitive_move_to_fdes (SCM port, SCM fd); SCM_API SCM scm_fdes_to_ports (SCM fd); -SCM_API void scm_init_ioext (void); +SCM_INTERNAL void scm_init_ioext (void); #endif /* SCM_IOEXT_H */ diff --git a/libguile/keywords.h b/libguile/keywords.h index d11c0e334..a80e31bff 100644 --- a/libguile/keywords.h +++ b/libguile/keywords.h @@ -3,7 +3,7 @@ #ifndef SCM_KEYWORDS_H #define SCM_KEYWORDS_H -/* Copyright (C) 1995,1996,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008 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 @@ -38,7 +38,7 @@ SCM_API int scm_is_keyword (SCM val); SCM_API SCM scm_from_locale_keyword (const char *str); SCM_API SCM scm_from_locale_keywordn (const char *str, size_t len); -SCM_API void scm_init_keywords (void); +SCM_INTERNAL void scm_init_keywords (void); #endif /* SCM_KEYWORDS_H */ diff --git a/libguile/lang.h b/libguile/lang.h index 886bb34ce..991e9ca76 100644 --- a/libguile/lang.h +++ b/libguile/lang.h @@ -3,7 +3,7 @@ #ifndef SCM_LANG_H #define SCM_LANG_H -/* Copyright (C) 1998, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2004, 2006, 2008 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 @@ -30,7 +30,7 @@ #define SCM_NILP(x) (scm_is_eq ((x), SCM_ELISP_NIL)) -SCM_API void scm_init_lang (void); +SCM_INTERNAL void scm_init_lang (void); #else /* ! SCM_ENABLE_ELISP */ diff --git a/libguile/list.h b/libguile/list.h index 749e65d50..733432d76 100644 --- a/libguile/list.h +++ b/libguile/list.h @@ -3,7 +3,7 @@ #ifndef SCM_LIST_H #define SCM_LIST_H -/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2005,2006 +/* Copyright (C) 1995,1996,1997,2000,2001,2003,2004,2005,2006,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -71,8 +71,8 @@ SCM_API SCM scm_filter_x (SCM pred, SCM list); /* Guile internal functions */ -SCM_API SCM scm_i_finite_list_copy (SCM /* a list known to be finite */); -SCM_API void scm_init_list (void); +SCM_INTERNAL SCM scm_i_finite_list_copy (SCM /* a list known to be finite */); +SCM_INTERNAL void scm_init_list (void); #endif /* SCM_LIST_H */ diff --git a/libguile/load.h b/libguile/load.h index 9b45d409a..57cc7e8ac 100644 --- a/libguile/load.h +++ b/libguile/load.h @@ -3,7 +3,7 @@ #ifndef SCM_LOAD_H #define SCM_LOAD_H -/* Copyright (C) 1995,1996,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008 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 @@ -26,7 +26,6 @@ SCM_API SCM scm_parse_path (SCM path, SCM tail); -SCM_API void scm_init_load_path (void); SCM_API SCM scm_primitive_load (SCM filename); SCM_API SCM scm_c_primitive_load (const char *filename); SCM_API SCM scm_sys_package_data_dir (void); @@ -36,7 +35,8 @@ SCM_API SCM scm_search_path (SCM path, SCM filename, SCM exts); SCM_API SCM scm_sys_search_load_path (SCM filename); SCM_API SCM scm_primitive_load_path (SCM filename); SCM_API SCM scm_c_primitive_load_path (const char *filename); -SCM_API void scm_init_load (void); +SCM_INTERNAL void scm_init_load_path (void); +SCM_INTERNAL void scm_init_load (void); #endif /* SCM_LOAD_H */ diff --git a/libguile/macros.h b/libguile/macros.h index 0ad8757de..e1de77ff9 100644 --- a/libguile/macros.h +++ b/libguile/macros.h @@ -3,7 +3,7 @@ #ifndef SCM_MACROS_H #define SCM_MACROS_H -/* Copyright (C) 1998,2000,2001,2002,2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1998,2000,2001,2002,2003, 2006, 2008 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 @@ -36,7 +36,7 @@ SCM_API scm_t_bits scm_tc16_macro; -SCM_API SCM scm_i_makbimacro (SCM code); +SCM_INTERNAL SCM scm_i_makbimacro (SCM code); SCM_API SCM scm_makmmacro (SCM code); SCM_API SCM scm_makacro (SCM code); SCM_API SCM scm_macro_p (SCM obj); @@ -46,7 +46,7 @@ SCM_API SCM scm_macro_transformer (SCM m); SCM_API SCM scm_make_synt (const char *name, SCM (*macroizer) (SCM), SCM (*fcn) ()); -SCM_API void scm_init_macros (void); +SCM_INTERNAL void scm_init_macros (void); #if SCM_ENABLE_DEPRECATED == 1 SCM_API SCM scm_makmacro (SCM code); diff --git a/libguile/mallocs.h b/libguile/mallocs.h index cae4d1f6b..f711ddb94 100644 --- a/libguile/mallocs.h +++ b/libguile/mallocs.h @@ -3,7 +3,7 @@ #ifndef SCM_MALLOCS_H #define SCM_MALLOCS_H -/* Copyright (C) 1995,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,2000, 2006, 2008 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 @@ -34,7 +34,7 @@ SCM_API scm_t_bits scm_tc16_malloc; SCM_API SCM scm_malloc_obj (size_t n); -SCM_API void scm_init_mallocs (void); +SCM_INTERNAL void scm_init_mallocs (void); #endif /* SCM_MALLOCS_H */ diff --git a/libguile/modules.h b/libguile/modules.h index 6e4f4d970..afac9f4e4 100644 --- a/libguile/modules.h +++ b/libguile/modules.h @@ -3,7 +3,7 @@ #ifndef SCM_MODULES_H #define SCM_MODULES_H -/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1998, 2000, 2001, 2002, 2003, 2006, 2007, 2008 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 @@ -116,8 +116,8 @@ SCM_API SCM scm_env_module (SCM env); SCM_API SCM scm_top_level_env (SCM thunk); SCM_API SCM scm_system_module_env_p (SCM env); -SCM_API void scm_modules_prehistory (void); -SCM_API void scm_init_modules (void); +SCM_INTERNAL void scm_modules_prehistory (void); +SCM_INTERNAL void scm_init_modules (void); #endif /* SCM_MODULES_H */ diff --git a/libguile/net_db.h b/libguile/net_db.h index ae8e8aa11..df1f03067 100644 --- a/libguile/net_db.h +++ b/libguile/net_db.h @@ -3,7 +3,7 @@ #ifndef SCM_NET_DB_H #define SCM_NET_DB_H -/* Copyright (C) 1995,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,2000,2001, 2006, 2008 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 @@ -34,7 +34,7 @@ SCM_API SCM scm_sethost (SCM arg); SCM_API SCM scm_setnet (SCM arg); SCM_API SCM scm_setproto (SCM arg); SCM_API SCM scm_setserv (SCM arg); -SCM_API void scm_init_net_db (void); +SCM_INTERNAL void scm_init_net_db (void); #endif /* SCM_NET_DB_H */ diff --git a/libguile/numbers.h b/libguile/numbers.h index 2c2fdcf07..e139dac7b 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -3,7 +3,7 @@ #ifndef SCM_NUMBERS_H #define SCM_NUMBERS_H -/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001,2002,2003,2004,2005, 2006, 2008 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 @@ -261,15 +261,15 @@ SCM_API SCM scm_exp (SCM z); SCM_API SCM scm_sqrt (SCM z); /* bignum internal functions */ -SCM_API SCM scm_i_mkbig (void); -SCM_API SCM scm_i_normbig (SCM x); -SCM_API int scm_i_bigcmp (SCM a, SCM b); -SCM_API SCM scm_i_dbl2big (double d); -SCM_API SCM scm_i_dbl2num (double d); -SCM_API double scm_i_big2dbl (SCM b); -SCM_API SCM scm_i_long2big (long n); -SCM_API SCM scm_i_ulong2big (unsigned long n); -SCM_API SCM scm_i_clonebig (SCM src_big, int same_sign_p); +SCM_INTERNAL SCM scm_i_mkbig (void); +SCM_API /* FIXME: not internal */ SCM scm_i_normbig (SCM x); +SCM_INTERNAL int scm_i_bigcmp (SCM a, SCM b); +SCM_INTERNAL SCM scm_i_dbl2big (double d); +SCM_INTERNAL SCM scm_i_dbl2num (double d); +SCM_API /* FIXME: not internal */ double scm_i_big2dbl (SCM b); +SCM_API /* FIXME: not internal */ SCM scm_i_long2big (long n); +SCM_API /* FIXME: not internal */ SCM scm_i_ulong2big (unsigned long n); +SCM_API /* FIXME: not internal */ SCM scm_i_clonebig (SCM src_big, int same_sign_p); /* ratio functions */ SCM_API SCM scm_rationalize (SCM x, SCM err); @@ -277,13 +277,13 @@ SCM_API SCM scm_numerator (SCM z); SCM_API SCM scm_denominator (SCM z); /* fraction internal functions */ -SCM_API double scm_i_fraction2double (SCM z); -SCM_API SCM scm_i_fraction_equalp (SCM x, SCM y); -SCM_API int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate); +SCM_INTERNAL double scm_i_fraction2double (SCM z); +SCM_INTERNAL SCM scm_i_fraction_equalp (SCM x, SCM y); +SCM_INTERNAL int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate); /* general internal functions */ -SCM_API void scm_i_print_double (double val, SCM port); -SCM_API void scm_i_print_complex (double real, double imag, SCM port); +SCM_INTERNAL void scm_i_print_double (double val, SCM port); +SCM_INTERNAL void scm_i_print_complex (double real, double imag, SCM port); /* conversion functions for integers */ @@ -480,7 +480,7 @@ SCM_API double scm_c_angle (SCM z); SCM_API int scm_is_number (SCM val); -SCM_API void scm_init_numbers (void); +SCM_INTERNAL void scm_init_numbers (void); #endif /* SCM_NUMBERS_H */ diff --git a/libguile/objects.h b/libguile/objects.h index fdd8e2891..68996d2a0 100644 --- a/libguile/objects.h +++ b/libguile/objects.h @@ -3,7 +3,7 @@ #ifndef SCM_OBJECTS_H #define SCM_OBJECTS_H -/* Copyright (C) 1996,1999,2000,2001, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1999,2000,2001, 2003, 2006, 2008 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 @@ -181,7 +181,7 @@ SCM_API SCM scm_metaclass_operator; /* Goops functions. */ SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep); -SCM_API void scm_i_inherit_applicable (SCM c); +SCM_INTERNAL void scm_i_inherit_applicable (SCM c); SCM_API void scm_make_port_classes (long ptobnum, char *type_name); SCM_API void scm_change_object_class (SCM, SCM, SCM); SCM_API SCM scm_memoize_method (SCM x, SCM args); @@ -205,9 +205,9 @@ SCM_API SCM scm_object_procedure (SCM obj); SCM_API SCM scm_make_class_object (SCM metaclass, SCM layout); SCM_API SCM scm_make_subclass_object (SCM c, SCM layout); -SCM_API SCM scm_i_make_class_object (SCM metaclass, SCM layout_string, - unsigned long flags); -SCM_API void scm_init_objects (void); +SCM_INTERNAL SCM scm_i_make_class_object (SCM metaclass, SCM layout_string, + unsigned long flags); +SCM_INTERNAL void scm_init_objects (void); #endif /* SCM_OBJECTS_H */ diff --git a/libguile/objprop.h b/libguile/objprop.h index edf2d9573..7e5365a74 100644 --- a/libguile/objprop.h +++ b/libguile/objprop.h @@ -3,7 +3,7 @@ #ifndef SCM_OBJPROP_H #define SCM_OBJPROP_H -/* Copyright (C) 1995,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,2000,2001, 2006, 2008 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 @@ -30,7 +30,7 @@ SCM_API SCM scm_object_properties (SCM obj); SCM_API SCM scm_set_object_properties_x (SCM obj, SCM plist); SCM_API SCM scm_object_property (SCM obj, SCM key); SCM_API SCM scm_set_object_property_x (SCM obj, SCM key, SCM val); -SCM_API void scm_init_objprop (void); +SCM_INTERNAL void scm_init_objprop (void); #endif /* SCM_OBJPROP_H */ diff --git a/libguile/options.h b/libguile/options.h index 5b9664958..4facdce01 100644 --- a/libguile/options.h +++ b/libguile/options.h @@ -3,7 +3,7 @@ #ifndef SCM_OPTIONS_H #define SCM_OPTIONS_H -/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 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 @@ -43,7 +43,7 @@ typedef struct scm_t_option SCM_API SCM scm_options_try (SCM args, scm_t_option options[], const char *s, int dry_run); SCM_API SCM scm_options (SCM, scm_t_option [], const char*); SCM_API void scm_init_opts (SCM (*) (SCM), scm_t_option []); -SCM_API void scm_init_options (void); +SCM_INTERNAL void scm_init_options (void); #endif /* SCM_OPTIONS_H */ diff --git a/libguile/pairs.h b/libguile/pairs.h index dd22ff36e..61af24efe 100644 --- a/libguile/pairs.h +++ b/libguile/pairs.h @@ -148,7 +148,7 @@ SCM_API SCM scm_i_chase_pairs (SCM x, scm_t_uint32 pattern); #define scm_caaadr(x) scm_i_chase_pairs ((x), SCM_I_AAAD_PAT) #define scm_caaaar(x) scm_i_chase_pairs ((x), SCM_I_AAAA_PAT) -SCM_API void scm_init_pairs (void); +SCM_INTERNAL void scm_init_pairs (void); #endif /* SCM_PAIRS_H */ diff --git a/libguile/ports.h b/libguile/ports.h index fb0ef4eee..084a55500 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -109,8 +109,8 @@ typedef struct } scm_t_port; -SCM_API scm_i_pthread_mutex_t scm_i_port_table_mutex; -SCM_API SCM scm_i_port_weak_hash; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_port_table_mutex; +SCM_INTERNAL SCM scm_i_port_weak_hash; #define SCM_READ_BUFFER_EMPTY_P(c_port) (c_port->read_pos >= c_port->read_end) @@ -195,7 +195,7 @@ typedef struct scm_t_ptob_descriptor SCM_API scm_t_ptob_descriptor *scm_ptobs; SCM_API long scm_numptob; -SCM_API long scm_i_port_table_room; +SCM_INTERNAL long scm_i_port_table_room; @@ -241,7 +241,7 @@ SCM_API void scm_dynwind_current_input_port (SCM port); SCM_API void scm_dynwind_current_output_port (SCM port); SCM_API void scm_dynwind_current_error_port (SCM port); SCM_API SCM scm_new_port_table_entry (scm_t_bits tag); -SCM_API void scm_i_remove_port (SCM port); +SCM_INTERNAL void scm_i_remove_port (SCM port); SCM_API void scm_grow_port_cbuf (SCM port, size_t requested); SCM_API SCM scm_pt_size (void); SCM_API SCM scm_pt_member (SCM member); @@ -288,7 +288,7 @@ SCM_API void scm_print_port_mode (SCM exp, SCM port); SCM_API void scm_ports_prehistory (void); SCM_API SCM scm_void_port (char * mode_str); SCM_API SCM scm_sys_make_void_port (SCM mode); -SCM_API void scm_init_ports (void); +SCM_INTERNAL void scm_init_ports (void); #if SCM_ENABLE_DEPRECATED==1 @@ -302,8 +302,8 @@ SCM_API SCM scm_pt_member (SCM member); /* internal */ -SCM_API long scm_i_mode_bits (SCM modes); -SCM_API void scm_i_dynwind_current_load_port (SCM port); +SCM_INTERNAL long scm_i_mode_bits (SCM modes); +SCM_INTERNAL void scm_i_dynwind_current_load_port (SCM port); #endif /* SCM_PORTS_H */ diff --git a/libguile/posix.h b/libguile/posix.h index 871bba850..d51da9479 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -3,7 +3,7 @@ #ifndef SCM_POSIX_H #define SCM_POSIX_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2006, 2008 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 @@ -84,9 +84,9 @@ SCM_API SCM scm_getpass (SCM prompt); SCM_API SCM scm_flock (SCM file, SCM operation); SCM_API SCM scm_sethostname (SCM name); SCM_API SCM scm_gethostname (void); -SCM_API void scm_init_posix (void); +SCM_INTERNAL void scm_init_posix (void); -SCM_API scm_i_pthread_mutex_t scm_i_locale_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_locale_mutex; #endif /* SCM_POSIX_H */ diff --git a/libguile/print.h b/libguile/print.h index 740aa281f..8974a7554 100644 --- a/libguile/print.h +++ b/libguile/print.h @@ -3,7 +3,7 @@ #ifndef SCM_PRINT_H #define SCM_PRINT_H -/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001, 2003, 2004, 2006, 2008 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 @@ -75,7 +75,7 @@ SCM_API scm_t_bits scm_tc16_port_with_ps; SCM_API SCM scm_print_options (SCM setting); SCM_API SCM scm_make_print_state (void); SCM_API void scm_free_print_state (SCM print_state); -SCM scm_i_port_with_print_state (SCM port, SCM print_state); +SCM_INTERNAL SCM scm_i_port_with_print_state (SCM port, SCM print_state); SCM_API void scm_intprint (scm_t_intmax n, int radix, SCM port); SCM_API void scm_uintprint (scm_t_uintmax n, int radix, SCM port); SCM_API void scm_ipruk (char *hdr, SCM ptr, SCM port); @@ -92,7 +92,7 @@ SCM_API SCM scm_printer_apply (SCM proc, SCM exp, SCM port, scm_print_state *); SCM_API SCM scm_port_with_print_state (SCM port, SCM pstate); SCM_API SCM scm_get_print_state (SCM port); SCM_API int scm_valid_oport_value_p (SCM val); -SCM_API void scm_init_print (void); +SCM_INTERNAL void scm_init_print (void); #ifdef GUILE_DEBUG SCM_API SCM scm_current_pstate (void); diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 34d789b30..ce60cbba3 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -1,7 +1,7 @@ /* * private-gc.h - private declarations for garbage collection. * - * Copyright (C) 2002, 03, 04, 05, 06, 07 Free Software Foundation, Inc. + * Copyright (C) 2002, 03, 04, 05, 06, 07, 08 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 @@ -163,10 +163,13 @@ typedef struct scm_sweep_statistics extern scm_t_cell_type_statistics scm_i_master_freelist; extern scm_t_cell_type_statistics scm_i_master_freelist2; +SCM_INTERNAL void scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist, scm_t_sweep_statistics sweep_stats, scm_t_sweep_statistics sweep_stats_1); +SCM_INTERNAL void scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist); +SCM_INTERNAL int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist); @@ -263,39 +266,46 @@ extern scm_t_heap_segment ** scm_i_heap_segment_table; extern size_t scm_i_heap_segment_table_size; -int scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list,scm_t_heap_segment*); -int scm_i_sweep_card (scm_t_cell * card, SCM *free_list, scm_t_heap_segment*); -void scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg); -char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */ +SCM_INTERNAL int scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list, + scm_t_heap_segment*); +SCM_INTERNAL int scm_i_sweep_card (scm_t_cell *card, SCM *free_list, + scm_t_heap_segment *); +SCM_INTERNAL void scm_i_card_statistics (scm_t_cell *p, SCM hashtab, + scm_t_heap_segment *seg); +SCM_INTERNAL char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */ -int scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested); -int scm_i_segment_card_count (scm_t_heap_segment * seg); -int scm_i_segment_cell_count (scm_t_heap_segment * seg); +SCM_INTERNAL int scm_i_initialize_heap_segment_data (scm_t_heap_segment *seg, + size_t requested); +SCM_INTERNAL int scm_i_segment_card_count (scm_t_heap_segment *seg); +SCM_INTERNAL int scm_i_segment_cell_count (scm_t_heap_segment *seg); -void scm_i_clear_segment_mark_space (scm_t_heap_segment *seg); -scm_t_heap_segment * scm_i_make_empty_heap_segment (scm_t_cell_type_statistics*); -SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg, - scm_t_sweep_statistics *sweep_stats); -void scm_i_sweep_segment (scm_t_heap_segment *seg, - scm_t_sweep_statistics *sweep_stats); +SCM_INTERNAL void scm_i_clear_segment_mark_space (scm_t_heap_segment *seg); +SCM_INTERNAL scm_t_heap_segment * +scm_i_make_empty_heap_segment (scm_t_cell_type_statistics*); +SCM_INTERNAL SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg, + scm_t_sweep_statistics *sweep_stats); +SCM_INTERNAL void scm_i_sweep_segment (scm_t_heap_segment *seg, + scm_t_sweep_statistics *sweep_stats); -void scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab); +SCM_INTERNAL void scm_i_heap_segment_statistics (scm_t_heap_segment *seg, + SCM tab); - -int scm_i_insert_segment (scm_t_heap_segment * seg); -long int scm_i_find_heap_segment_containing_object (SCM obj); -int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *, - scm_t_sweep_statistics, - policy_on_error); -void scm_i_clear_mark_space (void); -void scm_i_sweep_segments (void); -SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl, - scm_t_sweep_statistics *sweep_stats); -void scm_i_reset_segments (void); -void scm_i_sweep_all_segments (char const *reason, - scm_t_sweep_statistics *sweep_stats); -SCM scm_i_all_segments_statistics (SCM hashtab); -void scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist); + +SCM_INTERNAL int scm_i_insert_segment (scm_t_heap_segment *seg); +SCM_INTERNAL long int scm_i_find_heap_segment_containing_object (SCM obj); +SCM_INTERNAL int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *, + scm_t_sweep_statistics, + policy_on_error); +SCM_INTERNAL void scm_i_clear_mark_space (void); +SCM_INTERNAL void scm_i_sweep_segments (void); +SCM_INTERNAL SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl, + scm_t_sweep_statistics *sweep_stats); +SCM_INTERNAL void scm_i_reset_segments (void); +SCM_INTERNAL void scm_i_sweep_all_segments (char const *reason, + scm_t_sweep_statistics *sweep_stats); +SCM_INTERNAL SCM scm_i_all_segments_statistics (SCM hashtab); +SCM_INTERNAL void scm_i_make_initial_segment (int init_heap_size, + scm_t_cell_type_statistics *fl); extern long int scm_i_deprecated_memory_return; diff --git a/libguile/procprop.h b/libguile/procprop.h index dffdfd7bc..bf27dba0a 100644 --- a/libguile/procprop.h +++ b/libguile/procprop.h @@ -3,7 +3,7 @@ #ifndef SCM_PROCPROP_H #define SCM_PROCPROP_H -/* Copyright (C) 1995,1996,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 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 @@ -32,12 +32,12 @@ SCM_API SCM scm_sym_system_procedure; -SCM_API SCM scm_i_procedure_arity (SCM proc); +SCM_INTERNAL SCM scm_i_procedure_arity (SCM proc); SCM_API SCM scm_procedure_properties (SCM proc); SCM_API SCM scm_set_procedure_properties_x (SCM proc, SCM new_val); SCM_API SCM scm_procedure_property (SCM p, SCM k); SCM_API SCM scm_set_procedure_property_x (SCM p, SCM k, SCM v); -SCM_API void scm_init_procprop (void); +SCM_INTERNAL void scm_init_procprop (void); #endif /* SCM_PROCPROP_H */ diff --git a/libguile/procs.h b/libguile/procs.h index 060c8ee42..cf9cdf182 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -3,7 +3,7 @@ #ifndef SCM_PROCS_H #define SCM_PROCS_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 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 @@ -154,8 +154,8 @@ SCM_API SCM scm_procedure_with_setter_p (SCM obj); SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter); SCM_API SCM scm_procedure (SCM proc); SCM_API SCM scm_setter (SCM proc); -SCM_API void scm_init_subr_table (void); -SCM_API void scm_init_procs (void); +SCM_INTERNAL void scm_init_subr_table (void); +SCM_INTERNAL void scm_init_procs (void); #ifdef GUILE_DEBUG SCM_API SCM scm_make_cclo (SCM proc, SCM len); diff --git a/libguile/properties.h b/libguile/properties.h index 3f8cb6d75..54feb01d9 100644 --- a/libguile/properties.h +++ b/libguile/properties.h @@ -3,7 +3,7 @@ #ifndef SCM_PROPERTIES_H #define SCM_PROPERTIES_H -/* Copyright (C) 1995,1996,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 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 @@ -29,7 +29,7 @@ SCM_API SCM scm_primitive_property_ref (SCM prop, SCM obj); SCM_API SCM scm_primitive_property_set_x (SCM prop, SCM obj, SCM val); SCM_API SCM scm_primitive_property_del_x (SCM prop, SCM obj); -SCM_API void scm_init_properties (void); +SCM_INTERNAL void scm_init_properties (void); #endif /* SCM_PROPERTIES_H */ diff --git a/libguile/ramap.h b/libguile/ramap.h index 8383649c9..9d870389a 100644 --- a/libguile/ramap.h +++ b/libguile/ramap.h @@ -3,7 +3,7 @@ #ifndef SCM_RAMAP_H #define SCM_RAMAP_H -/* Copyright (C) 1995,1996,1997,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 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 @@ -47,7 +47,7 @@ SCM_API SCM scm_array_for_each (SCM proc, SCM ra0, SCM lra); SCM_API SCM scm_array_index_map_x (SCM ra, SCM proc); SCM_API SCM scm_raequal (SCM ra0, SCM ra1); SCM_API SCM scm_array_equal_p (SCM ra0, SCM ra1); -SCM_API void scm_init_ramap (void); +SCM_INTERNAL void scm_init_ramap (void); #endif /* SCM_RAMAP_H */ diff --git a/libguile/random.h b/libguile/random.h index 6ec43ff53..ae44092ab 100644 --- a/libguile/random.h +++ b/libguile/random.h @@ -3,7 +3,7 @@ #ifndef SCM_RANDOM_H #define SCM_RANDOM_H -/* Copyright (C) 1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000,2001, 2006, 2008 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 @@ -62,9 +62,9 @@ typedef struct scm_t_i_rstate { unsigned long c; } scm_t_i_rstate; -SCM_API unsigned long scm_i_uniform32 (scm_t_i_rstate *); -SCM_API void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n); -SCM_API scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *); +SCM_INTERNAL unsigned long scm_i_uniform32 (scm_t_i_rstate *); +SCM_INTERNAL void scm_i_init_rstate (scm_t_i_rstate *, const char *seed, int n); +SCM_INTERNAL scm_t_i_rstate *scm_i_copy_rstate (scm_t_i_rstate *); /* @@ -99,7 +99,7 @@ SCM_API SCM scm_random_hollow_sphere_x (SCM v, SCM state); SCM_API SCM scm_random_normal (SCM state); SCM_API SCM scm_random_normal_vector_x (SCM v, SCM state); SCM_API SCM scm_random_exp (SCM state); -SCM_API void scm_init_random (void); +SCM_INTERNAL void scm_init_random (void); #endif /* SCM_RANDOM_H */ diff --git a/libguile/rdelim.h b/libguile/rdelim.h index b211bb208..17efb4fe5 100644 --- a/libguile/rdelim.h +++ b/libguile/rdelim.h @@ -3,7 +3,7 @@ #ifndef SCM_RDELIM_H #define SCM_RDELIM_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 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 @@ -30,7 +30,7 @@ SCM_API SCM scm_read_line (SCM port); SCM_API SCM scm_write_line (SCM obj, SCM port); SCM_API SCM scm_init_rdelim_builtins (void); -SCM_API void scm_init_rdelim (void); +SCM_INTERNAL void scm_init_rdelim (void); #endif /* SCM_RDELIM_H */ diff --git a/libguile/read.h b/libguile/read.h index 128ba3d34..4253622da 100644 --- a/libguile/read.h +++ b/libguile/read.h @@ -3,7 +3,7 @@ #ifndef SCM_READ_H #define SCM_READ_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -56,11 +56,11 @@ SCM_API SCM scm_read (SCM port); SCM_API size_t scm_read_token (int ic, SCM * tok_buf, SCM port, int weird); SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc); -SCM_API void scm_i_input_error (const char *func, SCM port, - const char *message, SCM arg) +SCM_INTERNAL void scm_i_input_error (const char *func, SCM port, + const char *message, SCM arg) SCM_NORETURN; -SCM_API void scm_init_read (void); +SCM_INTERNAL void scm_init_read (void); #endif /* SCM_READ_H */ diff --git a/libguile/regex-posix.h b/libguile/regex-posix.h index c3821362a..2863b0562 100644 --- a/libguile/regex-posix.h +++ b/libguile/regex-posix.h @@ -3,7 +3,7 @@ #ifndef SCM_REGEX_POSIX_H #define SCM_REGEX_POSIX_H -/* Copyright (C) 1997,1998,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1997,1998,2000,2001, 2006, 2008 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 @@ -31,7 +31,7 @@ SCM_API scm_t_bits scm_tc16_regex; SCM_API SCM scm_make_regexp (SCM pat, SCM flags); SCM_API SCM scm_regexp_p (SCM x); SCM_API SCM scm_regexp_exec (SCM rx, SCM str, SCM start, SCM flags); -SCM_API void scm_init_regex_posix (void); +SCM_INTERNAL void scm_init_regex_posix (void); #endif /* SCM_REGEX_POSIX_H */ diff --git a/libguile/root.h b/libguile/root.h index 6c7800f5f..11f6b4f3a 100644 --- a/libguile/root.h +++ b/libguile/root.h @@ -3,7 +3,7 @@ #ifndef SCM_ROOT_H #define SCM_ROOT_H -/* Copyright (C) 1996,1998,2000,2001, 2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1996,1998,2000,2001, 2002, 2006, 2008 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 @@ -55,7 +55,7 @@ SCM_API SCM scm_internal_cwdr (scm_t_catch_body body, SCM_API SCM scm_call_with_dynamic_root (SCM thunk, SCM handler); SCM_API SCM scm_dynamic_root (void); SCM_API SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler); -SCM_API void scm_init_root (void); +SCM_INTERNAL void scm_init_root (void); #endif /* SCM_ROOT_H */ diff --git a/libguile/rw.h b/libguile/rw.h index 108104c33..b526051fc 100644 --- a/libguile/rw.h +++ b/libguile/rw.h @@ -3,7 +3,7 @@ #ifndef SCM_RW_H #define SCM_RW_H -/* Copyright (C) 2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2006, 2008 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 @@ -29,8 +29,8 @@ SCM_API SCM scm_read_string_x_partial (SCM str, SCM port_or_fdes, SCM start, SCM_API SCM scm_write_string_partial (SCM str, SCM port_or_fdes, SCM start, SCM end); -SCM_API SCM scm_init_rw_builtins (void); -SCM_API void scm_init_rw (void); +SCM_INTERNAL SCM scm_init_rw_builtins (void); +SCM_INTERNAL void scm_init_rw (void); #endif /* SCM_RW_H */ diff --git a/libguile/scmsigs.h b/libguile/scmsigs.h index 2aced3a3c..bcbf825d4 100644 --- a/libguile/scmsigs.h +++ b/libguile/scmsigs.h @@ -3,7 +3,7 @@ #ifndef SCM_SCMSIGS_H #define SCM_SCMSIGS_H -/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000, 2002, 2006, 2007, 2008 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 @@ -40,12 +40,12 @@ SCM_API SCM scm_pause (void); SCM_API SCM scm_sleep (SCM i); SCM_API SCM scm_usleep (SCM i); SCM_API SCM scm_raise (SCM sig); -SCM_API void scm_init_scmsigs (void); +SCM_INTERNAL void scm_init_scmsigs (void); -SCM_API void scm_i_close_signal_pipe (void); -SCM_API void scm_i_ensure_signal_delivery_thread (void); +SCM_INTERNAL void scm_i_close_signal_pipe (void); +SCM_INTERNAL void scm_i_ensure_signal_delivery_thread (void); -SCM_API scm_i_thread *scm_i_signal_delivery_thread; +SCM_INTERNAL scm_i_thread *scm_i_signal_delivery_thread; #endif /* SCM_SCMSIGS_H */ diff --git a/libguile/script.h b/libguile/script.h index 37ebddebc..6c02f8d8d 100644 --- a/libguile/script.h +++ b/libguile/script.h @@ -3,7 +3,7 @@ #ifndef SCM_SCRIPT_H #define SCM_SCRIPT_H -/* Copyright (C) 1997,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1997,1998,2000, 2006, 2008 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 @@ -36,7 +36,7 @@ SCM_API void scm_shell_usage (int fatal, char *message); SCM_API SCM scm_compile_shell_switches (int argc, char **argv); SCM_API void scm_shell (int argc, char **argv); SCM_API char *scm_usage_name; -SCM_API void scm_init_script (void); +SCM_INTERNAL void scm_init_script (void); #endif /* SCM_SCRIPT_H */ diff --git a/libguile/simpos.h b/libguile/simpos.h index 1ce207b1d..6df8bb1d2 100644 --- a/libguile/simpos.h +++ b/libguile/simpos.h @@ -3,7 +3,7 @@ #ifndef SCM_SIMPOS_H #define SCM_SIMPOS_H -/* Copyright (C) 1995,1996,1997,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000, 2006, 2008 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 @@ -31,7 +31,7 @@ SCM_API SCM scm_system_star (SCM cmds); SCM_API SCM scm_getenv (SCM nam); SCM_API SCM scm_primitive_exit (SCM status); SCM_API SCM scm_primitive__exit (SCM status); -SCM_API void scm_init_simpos (void); +SCM_INTERNAL void scm_init_simpos (void); #endif /* SCM_SIMPOS_H */ diff --git a/libguile/socket.h b/libguile/socket.h index 146d283dc..133dbf7c6 100644 --- a/libguile/socket.h +++ b/libguile/socket.h @@ -3,7 +3,7 @@ #ifndef SCM_SOCKET_H #define SCM_SOCKET_H -/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,2000,2001, 2004, 2005, 2006, 2008 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 @@ -52,7 +52,7 @@ SCM_API SCM scm_recv (SCM sockfd, SCM buff_or_size, SCM flags); SCM_API SCM scm_send (SCM sockfd, SCM message, SCM flags); SCM_API SCM scm_recvfrom (SCM sockfd, SCM buff_or_size, SCM flags, SCM offset, SCM length); SCM_API SCM scm_sendto (SCM sockfd, SCM message, SCM fam, SCM address, SCM args_and_flags); -SCM_API void scm_init_socket (void); +SCM_INTERNAL void scm_init_socket (void); /* Wrapping/unwrapping address objects. */ struct sockaddr; diff --git a/libguile/sort.h b/libguile/sort.h index b8bf4ce57..51f292a5c 100644 --- a/libguile/sort.h +++ b/libguile/sort.h @@ -3,7 +3,7 @@ #ifndef SCM_SORT_H #define SCM_SORT_H -/* Copyright (C) 1999,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1999,2000, 2006, 2008 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 @@ -39,7 +39,7 @@ SCM_API SCM scm_stable_sort (SCM ls, SCM less); SCM_API SCM scm_stable_sort_x (SCM ls, SCM less); SCM_API SCM scm_sort_list (SCM ls, SCM less); SCM_API SCM scm_sort_list_x (SCM ls, SCM less); -SCM_API void scm_init_sort (void); +SCM_INTERNAL void scm_init_sort (void); #endif /* SCM_SORT_H */ diff --git a/libguile/srcprop.h b/libguile/srcprop.h index 87e5fde0f..a467aa34e 100644 --- a/libguile/srcprop.h +++ b/libguile/srcprop.h @@ -3,7 +3,7 @@ #ifndef SCM_SRCPROP_H #define SCM_SRCPROP_H -/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 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 @@ -70,7 +70,7 @@ SCM_API SCM scm_set_source_property_x (SCM obj, SCM key, SCM datum); SCM_API SCM scm_source_properties (SCM obj); SCM_API SCM scm_set_source_properties_x (SCM obj, SCM props); SCM_API void scm_finish_srcprop (void); -SCM_API void scm_init_srcprop (void); +SCM_INTERNAL void scm_init_srcprop (void); #if SCM_ENABLE_DEPRECATED == 1 #define SRCBRKP(x) (scm_source_property_breakpoint_p (x)) diff --git a/libguile/srfi-13.h b/libguile/srfi-13.h index 833586adc..f8221ddc6 100644 --- a/libguile/srfi-13.h +++ b/libguile/srfi-13.h @@ -3,7 +3,7 @@ /* srfi-13.c --- SRFI-13 procedures for Guile * - * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc. + * Copyright (C) 2001, 2004, 2006, 2008 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 @@ -113,7 +113,7 @@ SCM_API SCM scm_string_split (SCM s, SCM chr); SCM_API SCM scm_string_filter (SCM s, SCM char_pred, SCM start, SCM end); SCM_API SCM scm_string_delete (SCM s, SCM char_pred, SCM start, SCM end); -SCM_API void scm_init_srfi_13 (void); -SCM_API void scm_init_srfi_13_14 (void); +SCM_INTERNAL void scm_init_srfi_13 (void); +SCM_INTERNAL void scm_init_srfi_13_14 (void); #endif /* SCM_SRFI_13_H */ diff --git a/libguile/srfi-14.h b/libguile/srfi-14.h index 516c51044..ea8027aac 100644 --- a/libguile/srfi-14.h +++ b/libguile/srfi-14.h @@ -3,7 +3,7 @@ /* srfi-14.c --- SRFI-14 procedures for Guile * - * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc. + * Copyright (C) 2001, 2004, 2006, 2008 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 @@ -106,7 +106,7 @@ SCM_API SCM scm_char_set_ascii; SCM_API SCM scm_char_set_empty; SCM_API SCM scm_char_set_full; -SCM_API void scm_srfi_14_compute_char_sets (void); -SCM_API void scm_init_srfi_14 (void); +SCM_INTERNAL void scm_srfi_14_compute_char_sets (void); +SCM_INTERNAL void scm_init_srfi_14 (void); #endif /* SCM_SRFI_14_H */ diff --git a/libguile/srfi-4.h b/libguile/srfi-4.h index 7abbac8a4..3c340d91e 100644 --- a/libguile/srfi-4.h +++ b/libguile/srfi-4.h @@ -2,7 +2,7 @@ #define SCM_SRFI_4_H /* srfi-4.c --- Homogeneous numeric vector datatypes. * - * Copyright (C) 2001, 2004, 2006 Free Software Foundation, Inc. + * Copyright (C) 2001, 2004, 2006, 2008 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 @@ -303,10 +303,10 @@ SCM_API double *scm_c64vector_writable_elements (SCM uvec, size_t *lenp, ssize_t *incp); -SCM_API SCM scm_i_generalized_vector_type (SCM vec); -SCM_API const char *scm_i_uniform_vector_tag (SCM uvec); -SCM_API scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec); -SCM_API scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec); +SCM_INTERNAL SCM scm_i_generalized_vector_type (SCM vec); +SCM_INTERNAL const char *scm_i_uniform_vector_tag (SCM uvec); +SCM_INTERNAL scm_i_t_array_ref scm_i_uniform_vector_ref_proc (SCM uvec); +SCM_INTERNAL scm_i_t_array_set scm_i_uniform_vector_set_proc (SCM uvec); #if SCM_ENABLE_DEPRECATED @@ -318,6 +318,6 @@ SCM_API size_t scm_uniform_element_size (SCM obj); #endif -SCM_API void scm_init_srfi_4 (void); +SCM_INTERNAL void scm_init_srfi_4 (void); #endif /* SCM_SRFI_4_H */ diff --git a/libguile/stackchk.h b/libguile/stackchk.h index 9a5c59f71..66582e929 100644 --- a/libguile/stackchk.h +++ b/libguile/stackchk.h @@ -3,7 +3,7 @@ #ifndef SCM_STACKCHK_H #define SCM_STACKCHK_H -/* Copyright (C) 1995,1996,1998,2000, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2003, 2006, 2008 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 @@ -60,7 +60,7 @@ SCM_API int scm_stack_checking_enabled_p; SCM_API void scm_report_stack_overflow (void); SCM_API long scm_stack_size (SCM_STACKITEM *start); SCM_API void scm_stack_report (void); -SCM_API void scm_init_stackchk (void); +SCM_INTERNAL void scm_init_stackchk (void); #endif /* SCM_STACKCHK_H */ diff --git a/libguile/stacks.h b/libguile/stacks.h index e44bb1cdf..53633bc14 100644 --- a/libguile/stacks.h +++ b/libguile/stacks.h @@ -3,7 +3,7 @@ #ifndef SCM_STACKS_H #define SCM_STACKS_H -/* Copyright (C) 1995,1996,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008 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 @@ -106,7 +106,7 @@ SCM_API SCM scm_frame_procedure_p (SCM frame); SCM_API SCM scm_frame_evaluating_args_p (SCM frame); SCM_API SCM scm_frame_overflow_p (SCM frame); -SCM_API void scm_init_stacks (void); +SCM_INTERNAL void scm_init_stacks (void); #endif /* SCM_STACKS_H */ diff --git a/libguile/stime.h b/libguile/stime.h index 52acc2f80..c64c60ea9 100644 --- a/libguile/stime.h +++ b/libguile/stime.h @@ -3,7 +3,7 @@ #ifndef SCM_STIME_H #define SCM_STIME_H -/* Copyright (C) 1995,1996,1997,1998,2000, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000, 2003, 2006, 2008 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 @@ -64,7 +64,7 @@ SCM_API SCM scm_tzset (void); SCM_API SCM scm_times (void); SCM_API SCM scm_strftime (SCM format, SCM stime); SCM_API SCM scm_strptime (SCM format, SCM string); -SCM_API void scm_init_stime (void); +SCM_INTERNAL void scm_init_stime (void); #endif /* SCM_STIME_H */ diff --git a/libguile/strings.h b/libguile/strings.h index f96457eb9..04ae552f9 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -3,7 +3,7 @@ #ifndef SCM_STRINGS_H #define SCM_STRINGS_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2004, 2005, 2006, 2008 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 @@ -110,47 +110,47 @@ SCM_API SCM scm_makfromstrs (int argc, char **argv); /* internal accessor functions. Arguments must be valid. */ -SCM_API SCM scm_i_make_string (size_t len, char **datap); -SCM_API SCM scm_i_substring (SCM str, size_t start, size_t end); -SCM_API SCM scm_i_substring_read_only (SCM str, size_t start, size_t end); -SCM_API SCM scm_i_substring_shared (SCM str, size_t start, size_t end); -SCM_API SCM scm_i_substring_copy (SCM str, size_t start, size_t end); -SCM_API size_t scm_i_string_length (SCM str); -SCM_API const char *scm_i_string_chars (SCM str); -SCM_API char *scm_i_string_writable_chars (SCM str); -SCM_API void scm_i_string_stop_writing (void); +SCM_INTERNAL SCM scm_i_make_string (size_t len, char **datap); +SCM_INTERNAL SCM scm_i_substring (SCM str, size_t start, size_t end); +SCM_INTERNAL SCM scm_i_substring_read_only (SCM str, size_t start, size_t end); +SCM_INTERNAL SCM scm_i_substring_shared (SCM str, size_t start, size_t end); +SCM_INTERNAL SCM scm_i_substring_copy (SCM str, size_t start, size_t end); +SCM_INTERNAL size_t scm_i_string_length (SCM str); +SCM_API /* FIXME: not internal */ const char *scm_i_string_chars (SCM str); +SCM_API /* FIXME: not internal */ char *scm_i_string_writable_chars (SCM str); +SCM_INTERNAL void scm_i_string_stop_writing (void); /* internal functions related to symbols. */ -SCM_API SCM scm_i_make_symbol (SCM name, scm_t_bits flags, - unsigned long hash, SCM props); -SCM_API SCM +SCM_INTERNAL SCM scm_i_make_symbol (SCM name, scm_t_bits flags, + unsigned long hash, SCM props); +SCM_INTERNAL SCM scm_i_c_make_symbol (const char *name, size_t len, scm_t_bits flags, unsigned long hash, SCM props); -SCM_API SCM +SCM_INTERNAL SCM scm_i_c_take_symbol (char *name, size_t len, scm_t_bits flags, unsigned long hash, SCM props); -SCM_API const char *scm_i_symbol_chars (SCM sym); -SCM_API size_t scm_i_symbol_length (SCM sym); -SCM_API SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end); +SCM_INTERNAL const char *scm_i_symbol_chars (SCM sym); +SCM_INTERNAL size_t scm_i_symbol_length (SCM sym); +SCM_INTERNAL SCM scm_i_symbol_substring (SCM sym, size_t start, size_t end); /* internal GC functions. */ -SCM_API SCM scm_i_string_mark (SCM str); -SCM_API SCM scm_i_stringbuf_mark (SCM buf); -SCM_API SCM scm_i_symbol_mark (SCM buf); -SCM_API void scm_i_string_free (SCM str); -SCM_API void scm_i_stringbuf_free (SCM buf); -SCM_API void scm_i_symbol_free (SCM sym); +SCM_INTERNAL SCM scm_i_string_mark (SCM str); +SCM_INTERNAL SCM scm_i_stringbuf_mark (SCM buf); +SCM_INTERNAL SCM scm_i_symbol_mark (SCM buf); +SCM_INTERNAL void scm_i_string_free (SCM str); +SCM_INTERNAL void scm_i_stringbuf_free (SCM buf); +SCM_INTERNAL void scm_i_symbol_free (SCM sym); /* internal utility functions. */ -SCM_API char **scm_i_allocate_string_pointers (SCM list); -SCM_API void scm_i_free_string_pointers (char **pointers); -SCM_API void scm_i_get_substring_spec (size_t len, - SCM start, size_t *cstart, - SCM end, size_t *cend); -SCM_API SCM scm_i_take_stringbufn (char *str, size_t len); +SCM_INTERNAL char **scm_i_allocate_string_pointers (SCM list); +SCM_INTERNAL void scm_i_free_string_pointers (char **pointers); +SCM_INTERNAL void scm_i_get_substring_spec (size_t len, + SCM start, size_t *cstart, + SCM end, size_t *cend); +SCM_INTERNAL SCM scm_i_take_stringbufn (char *str, size_t len); /* deprecated stuff */ @@ -167,7 +167,7 @@ SCM_API size_t scm_i_deprecated_string_length (SCM str); #endif -SCM_API void scm_init_strings (void); +SCM_INTERNAL void scm_init_strings (void); #endif /* SCM_STRINGS_H */ diff --git a/libguile/strorder.h b/libguile/strorder.h index 51168e05f..17118634e 100644 --- a/libguile/strorder.h +++ b/libguile/strorder.h @@ -3,7 +3,7 @@ #ifndef SCM_STRORDER_H #define SCM_STRORDER_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -36,7 +36,7 @@ SCM_API SCM scm_string_ci_less_p (SCM s1, SCM s2); SCM_API SCM scm_string_ci_leq_p (SCM s1, SCM s2); SCM_API SCM scm_string_ci_gr_p (SCM s1, SCM s2); SCM_API SCM scm_string_ci_geq_p (SCM s1, SCM s2); -SCM_API void scm_init_strorder (void); +SCM_INTERNAL void scm_init_strorder (void); #endif /* SCM_STRORDER_H */ diff --git a/libguile/strports.h b/libguile/strports.h index 2ca5fb572..58ca71f57 100644 --- a/libguile/strports.h +++ b/libguile/strports.h @@ -3,7 +3,7 @@ #ifndef SCM_STRPORTS_H #define SCM_STRPORTS_H -/* Copyright (C) 1995,1996,2000,2001,2002, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008 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 @@ -55,7 +55,7 @@ SCM_API SCM scm_c_eval_string (const char *expr); SCM_API SCM scm_c_eval_string_in_module (const char *expr, SCM module); SCM_API SCM scm_eval_string (SCM string); SCM_API SCM scm_eval_string_in_module (SCM string, SCM module); -SCM_API void scm_init_strports (void); +SCM_INTERNAL void scm_init_strports (void); #endif /* SCM_STRPORTS_H */ diff --git a/libguile/struct.h b/libguile/struct.h index 4b263d2e5..f00a8d844 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -3,7 +3,7 @@ #ifndef SCM_STRUCT_H #define SCM_STRUCT_H -/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008 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 @@ -79,7 +79,7 @@ SCM_API SCM scm_struct_table; #define SCM_STRUCT_GC_CHAIN(X) SCM_CELL_OBJECT_3 (X) #define SCM_SET_STRUCT_GC_CHAIN(X, Y) SCM_SET_CELL_OBJECT_3 (X, Y) -SCM_API SCM scm_i_structs_to_free; +SCM_INTERNAL SCM scm_i_structs_to_free; @@ -95,7 +95,7 @@ SCM_API SCM scm_struct_vtable_p (SCM x); SCM_API SCM scm_make_struct (SCM vtable, SCM tail_array_size, SCM init); SCM_API SCM scm_make_vtable (SCM fields, SCM printer); SCM_API SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init); -SCM_API SCM scm_i_struct_equalp (SCM s1, SCM s2); +SCM_INTERNAL SCM scm_i_struct_equalp (SCM s1, SCM s2); SCM_API SCM scm_struct_ref (SCM handle, SCM pos); SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val); SCM_API SCM scm_struct_vtable (SCM handle); @@ -106,7 +106,7 @@ SCM_API SCM scm_struct_vtable_name (SCM vtable); SCM_API SCM scm_set_struct_vtable_name_x (SCM vtable, SCM name); SCM_API void scm_print_struct (SCM exp, SCM port, scm_print_state *); SCM_API void scm_struct_prehistory (void); -SCM_API void scm_init_struct (void); +SCM_INTERNAL void scm_init_struct (void); #endif /* SCM_STRUCT_H */ diff --git a/libguile/symbols.h b/libguile/symbols.h index f70d65578..c2dc18363 100644 --- a/libguile/symbols.h +++ b/libguile/symbols.h @@ -3,7 +3,7 @@ #ifndef SCM_SYMBOLS_H #define SCM_SYMBOLS_H -/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2003, 2004, 2006, 2008 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 @@ -61,11 +61,11 @@ SCM_API SCM scm_take_locale_symboln (char *sym, size_t len); /* internal functions. */ -SCM_API unsigned long scm_i_hash_symbol (SCM obj, unsigned long n, +SCM_INTERNAL unsigned long scm_i_hash_symbol (SCM obj, unsigned long n, void *closure); -SCM_API void scm_symbols_prehistory (void); -SCM_API void scm_init_symbols (void); +SCM_INTERNAL void scm_symbols_prehistory (void); +SCM_INTERNAL void scm_init_symbols (void); #endif /* SCM_SYMBOLS_H */ diff --git a/libguile/threads.h b/libguile/threads.h index 8abe452bb..dea1a8e5d 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -137,23 +137,23 @@ SCM_API SCM scm_spawn_thread (scm_t_catch_body body, void *body_data, SCM_API void *scm_without_guile (void *(*func)(void *), void *data); SCM_API void *scm_with_guile (void *(*func)(void *), void *data); -SCM_API void *scm_i_with_guile_and_parent (void *(*func)(void *), void *data, - SCM parent); +SCM_INTERNAL void *scm_i_with_guile_and_parent (void *(*func)(void *), + void *data, SCM parent); extern int scm_i_thread_go_to_sleep; -void scm_i_thread_put_to_sleep (void); -void scm_i_thread_wake_up (void); -void scm_i_thread_invalidate_freelists (void); +SCM_INTERNAL void scm_i_thread_put_to_sleep (void); +SCM_INTERNAL void scm_i_thread_wake_up (void); +SCM_INTERNAL void scm_i_thread_invalidate_freelists (void); void scm_i_thread_sleep_for_gc (void); -void scm_threads_prehistory (SCM_STACKITEM *); -void scm_threads_init_first_thread (void); -SCM_API void scm_threads_mark_stacks (void); -SCM_API void scm_init_threads (void); -SCM_API void scm_init_thread_procs (void); -SCM_API void scm_init_threads_default_dynamic_state (void); +SCM_INTERNAL void scm_threads_prehistory (SCM_STACKITEM *); +SCM_INTERNAL void scm_threads_init_first_thread (void); +SCM_INTERNAL void scm_threads_mark_stacks (void); +SCM_INTERNAL void scm_init_threads (void); +SCM_INTERNAL void scm_init_thread_procs (void); +SCM_INTERNAL void scm_init_threads_default_dynamic_state (void); #define SCM_THREAD_SWITCHING_CODE \ @@ -211,7 +211,7 @@ SCM_API scm_i_pthread_key_t scm_i_thread_key; #define scm_i_set_last_debug_frame(f) \ (SCM_I_CURRENT_THREAD->last_debug_frame = (f)) -SCM_API scm_i_pthread_mutex_t scm_i_misc_mutex; +SCM_INTERNAL scm_i_pthread_mutex_t scm_i_misc_mutex; /* Convenience functions for working with the pthread API in guile mode. diff --git a/libguile/throw.h b/libguile/throw.h index 84b0aa9e4..3cd557285 100644 --- a/libguile/throw.h +++ b/libguile/throw.h @@ -3,7 +3,7 @@ #ifndef SCM_THROW_H #define SCM_THROW_H -/* Copyright (C) 1995,1996,1998,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 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 @@ -94,7 +94,7 @@ SCM_API SCM scm_lazy_catch (SCM tag, SCM thunk, SCM handler); SCM_API SCM scm_ithrow (SCM key, SCM args, int noreturn); SCM_API SCM scm_throw (SCM key, SCM args); -SCM_API void scm_init_throw (void); +SCM_INTERNAL void scm_init_throw (void); #endif /* SCM_THROW_H */ diff --git a/libguile/unif.h b/libguile/unif.h index 1ce3a8fa1..a09bfc921 100644 --- a/libguile/unif.h +++ b/libguile/unif.h @@ -3,7 +3,7 @@ #ifndef SCM_UNIF_H #define SCM_UNIF_H -/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008 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 @@ -162,9 +162,9 @@ SCM_API scm_t_bits scm_i_tc16_enclosed_array; #define SCM_I_ARRAY_DIMS(a) \ ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array))) -SCM_API SCM scm_i_make_ra (int ndim, int enclosed); -SCM_API SCM scm_i_cvref (SCM v, size_t p, int enclosed); -SCM_API SCM scm_i_read_array (SCM port, int c); +SCM_INTERNAL SCM scm_i_make_ra (int ndim, int enclosed); +SCM_INTERNAL SCM scm_i_cvref (SCM v, size_t p, int enclosed); +SCM_INTERNAL SCM scm_i_read_array (SCM port, int c); /* deprecated. */ @@ -183,7 +183,7 @@ SCM_API int scm_raprin1 (SCM exp, SCM port, scm_print_state *pstate); #endif -SCM_API void scm_init_unif (void); +SCM_INTERNAL void scm_init_unif (void); #endif /* SCM_UNIF_H */ diff --git a/libguile/values.h b/libguile/values.h index bc603c16b..f05ce9f8f 100644 --- a/libguile/values.h +++ b/libguile/values.h @@ -3,7 +3,7 @@ #ifndef SCM_VALUES_H #define SCM_VALUES_H -/* Copyright (C) 2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2000,2001, 2006, 2008 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 @@ -30,7 +30,7 @@ SCM_API SCM scm_values_vtable; && scm_is_eq (scm_struct_vtable (x), scm_values_vtable)) SCM_API SCM scm_values (SCM args); -SCM_API void scm_init_values (void); +SCM_INTERNAL void scm_init_values (void); #endif /* SCM_VALUES_H */ diff --git a/libguile/variable.h b/libguile/variable.h index 2f2e1a5c9..3f6398b9c 100644 --- a/libguile/variable.h +++ b/libguile/variable.h @@ -3,7 +3,7 @@ #ifndef SCM_VARIABLE_H #define SCM_VARIABLE_H -/* Copyright (C) 1995,1996,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2006, 2008 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 @@ -43,9 +43,9 @@ SCM_API SCM scm_variable_ref (SCM var); SCM_API SCM scm_variable_set_x (SCM var, SCM val); SCM_API SCM scm_variable_bound_p (SCM var); -SCM_API void scm_i_variable_print (SCM var, SCM port, scm_print_state *pstate); +SCM_INTERNAL void scm_i_variable_print (SCM var, SCM port, scm_print_state *pstate); -SCM_API void scm_init_variable (void); +SCM_INTERNAL void scm_init_variable (void); #endif /* SCM_VARIABLE_H */ diff --git a/libguile/vectors.h b/libguile/vectors.h index b1def0689..28a576c5c 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 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008 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 @@ -82,8 +82,8 @@ SCM_API void scm_generalized_vector_get_handle (SCM vec, #define SCM_I_VECTOR_WELTS(x) ((SCM *) SCM_CELL_WORD_1 (x)) #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8) -SCM_API void scm_i_vector_free (SCM vec); -SCM_API SCM scm_i_vector_equal_p (SCM x, SCM y); +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. @@ -99,9 +99,9 @@ SCM_API SCM scm_i_vector_equal_p (SCM x, SCM y); #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))) -SCM_API SCM scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill); +SCM_INTERNAL SCM scm_i_allocate_weak_vector (scm_t_bits type, SCM size, SCM fill); -SCM_API void scm_init_vectors (void); +SCM_INTERNAL void scm_init_vectors (void); #endif /* SCM_VECTORS_H */ diff --git a/libguile/version.h.in b/libguile/version.h.in index 1d8f27750..b565efd96 100644 --- a/libguile/version.h.in +++ b/libguile/version.h.in @@ -3,7 +3,7 @@ #ifndef SCM_VERSION_H #define SCM_VERSION_H -/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1998,1999,2000,2001, 2006, 2008 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 @@ -35,7 +35,7 @@ SCM_API SCM scm_minor_version (void); SCM_API SCM scm_micro_version (void); SCM_API SCM scm_effective_version (void); SCM_API SCM scm_version (void); -SCM_API void scm_init_version (void); +SCM_INTERNAL void scm_init_version (void); #endif /* SCM_VERSION_H */ diff --git a/libguile/vports.h b/libguile/vports.h index c25f90f45..365303bc1 100644 --- a/libguile/vports.h +++ b/libguile/vports.h @@ -3,7 +3,7 @@ #ifndef SCM_VPORTS_H #define SCM_VPORTS_H -/* Copyright (C) 1995,1996,2000, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000, 2006, 2008 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 @@ -27,7 +27,7 @@ SCM_API SCM scm_make_soft_port (SCM pv, SCM modes); -SCM_API void scm_init_vports (void); +SCM_INTERNAL void scm_init_vports (void); #endif /* SCM_VPORTS_H */ diff --git a/libguile/weaks.h b/libguile/weaks.h index bf854d558..34c44a97a 100644 --- a/libguile/weaks.h +++ b/libguile/weaks.h @@ -3,7 +3,7 @@ #ifndef SCM_WEAKS_H #define SCM_WEAKS_H -/* Copyright (C) 1995,1996,2000,2001, 2003, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,2000,2001, 2003, 2006, 2008 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 @@ -62,13 +62,13 @@ SCM_API SCM scm_make_doubly_weak_alist_vector (SCM k); SCM_API SCM scm_weak_key_alist_vector_p (SCM x); SCM_API SCM scm_weak_value_alist_vector_p (SCM x); SCM_API SCM scm_doubly_weak_alist_vector_p (SCM x); -SCM_API SCM scm_init_weaks_builtins (void); -SCM_API void scm_init_weaks (void); +SCM_INTERNAL SCM scm_init_weaks_builtins (void); +SCM_INTERNAL void scm_init_weaks (void); -SCM_API void scm_i_init_weak_vectors_for_gc (void); -SCM_API void scm_i_mark_weak_vector (SCM w); -SCM_API int scm_i_mark_weak_vectors_non_weaks (void); -SCM_API void scm_i_remove_weaks_from_weak_vectors (void); +SCM_INTERNAL void scm_i_init_weak_vectors_for_gc (void); +SCM_INTERNAL void scm_i_mark_weak_vector (SCM w); +SCM_INTERNAL int scm_i_mark_weak_vectors_non_weaks (void); +SCM_INTERNAL void scm_i_remove_weaks_from_weak_vectors (void); #endif /* SCM_WEAKS_H */ diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 5f9714281..dca61413d 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2008-05-31 Ludovic Courtès + + * standalone/test-gh.c (string_equal): Use `scm_c_string_length ()' + instead of `scm_i_string_length ()'. + 2008-05-15 Julian Graham * tests/srfi-18.test: New file. diff --git a/test-suite/standalone/test-gh.c b/test-suite/standalone/test-gh.c index 4d91cce41..b273b4499 100644 --- a/test-suite/standalone/test-gh.c +++ b/test-suite/standalone/test-gh.c @@ -31,7 +31,7 @@ string_equal (SCM str, char *lit) int len = strlen (lit); int result; - result = ((scm_i_string_length (str) == len) + result = ((scm_c_string_length (str) == len) && (!memcmp (scm_i_string_chars (str), lit, len))); scm_remember_upto_here_1 (str); return result; From 8c40b75d38d09040d9a09e1be9ddb478e56a8959 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 31 May 2008 23:19:55 +0200 Subject: [PATCH 38/87] Update `NEWS'. --- NEWS | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/NEWS b/NEWS index 5f84659c0..7f4670724 100644 --- a/NEWS +++ b/NEWS @@ -35,6 +35,16 @@ See `cancel-thread', `set-thread-cleanup!', and `thread-cleanup'. indicating length of the `scm_t_option' array. + +Changes in 1.8.6 (since 1.8.5) + +* Bugs fixed + +** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF + +This makes these internal functions technically not callable from +application code. + Changes in 1.8.5 (since 1.8.4) From e36280cb28f1041166ceb0941639c03e5c68fa70 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 1 Jun 2008 13:09:36 +0200 Subject: [PATCH 39/87] Fix SRFI-88 URL in the manual. --- doc/ref/ChangeLog | 4 ++++ doc/ref/srfi-modules.texi | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index de6409755..c31c5568a 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,7 @@ +2008-06-01 Ludovic Courtès + + * srfi-modules.texi (SRFI-88): Fix URL. + 2008-05-14 Julian Graham * api-scheduling.texi (Mutexes and Condition Variables): Add diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index ba8966d82..31ba498cf 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -3222,7 +3222,7 @@ Answer a hash value appropriate for equality predicate @code{equal?}, @cindex SRFI-88 @cindex keyword objects -@uref{http://srfi.schemers.org/srfi/srfi-88.html, SRFI-88} provides +@uref{http://srfi.schemers.org/srfi-88/srfi-88.html, SRFI-88} provides @dfn{keyword objects}, which are equivalent to Guile's keywords (@pxref{Keywords}). SRFI-88 keywords can be entered using the @dfn{postfix keyword syntax}, which consists of an identifier followed From fcbc08686c3341dd2dd5b429e13f41fc08e29db4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 2 Jun 2008 21:34:57 +0200 Subject: [PATCH 40/87] Support systems whose doesn't define `PRIiMAX'. --- test-suite/ChangeLog | 6 ++++++ test-suite/standalone/test-conversion.c | 4 +++- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index dca61413d..9b4cdd643 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2008-06-02 Ludovic Courtès + + * standalone/test-conversion.c: Support systems whose + doesn't define `PRIiMAX'. Reported by Peter + O'Gorman . + 2008-05-31 Ludovic Courtès * standalone/test-gh.c (string_equal): Use `scm_c_string_length ()' diff --git a/test-suite/standalone/test-conversion.c b/test-suite/standalone/test-conversion.c index b8dfab8ea..92835f244 100644 --- a/test-suite/standalone/test-conversion.c +++ b/test-suite/standalone/test-conversion.c @@ -27,7 +27,9 @@ #ifdef HAVE_INTTYPES_H # include -#elif (!defined PRIiMAX) +#endif + +#ifndef PRIiMAX # if (defined SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG >= 8) # define PRIiMAX "lli" # define PRIuMAX "llu" From 6eadcdab985018791a4a39e932109f444dc1d4fe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 2 Jun 2008 21:43:07 +0200 Subject: [PATCH 41/87] Work around `#define except' on Tru64. --- NEWS | 2 ++ libguile/ChangeLog | 6 ++++++ libguile/deprecated.c | 10 +++++----- 3 files changed, 13 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 7f4670724..a399f234a 100644 --- a/NEWS +++ b/NEWS @@ -45,6 +45,8 @@ Changes in 1.8.6 (since 1.8.5) This makes these internal functions technically not callable from application code. +** Fix build issue on Tru64 + Changes in 1.8.5 (since 1.8.4) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 110b781fc..1ca6dca71 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2008-06-02 Ludovic Courtès + + * deprecated.c (maybe_close_port): Rename EXCEPT to EXCEPT_SET + to workaround `#define except' on Tru64. Reported by Peter + O'Gorman . + 2008-05-31 Ludovic Courtès * __scm.h (SCM_INTERNAL): New macro. diff --git a/libguile/deprecated.c b/libguile/deprecated.c index bb17967f9..da1160852 100644 --- a/libguile/deprecated.c +++ b/libguile/deprecated.c @@ -2,7 +2,7 @@ deprecate something, move it here when that is feasible. */ -/* Copyright (C) 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 2003, 2004, 2006, 2008 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 @@ -319,14 +319,14 @@ scm_load_scheme_module (SCM name) static void maybe_close_port (void *data, SCM port) { - SCM except = (SCM)data; + SCM except_set = (SCM) data; - while (!scm_is_null (except)) + while (!scm_is_null (except_set)) { - SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except)); + SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except_set)); if (scm_is_eq (p, port)) return; - except = SCM_CDR (except); + except_set = SCM_CDR (except_set); } scm_close_port (port); From 589d9eb8140f323475b97459443be4e42a3a6590 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 2 Jun 2008 21:47:41 +0200 Subject: [PATCH 42/87] guile-config: Show `-L$libdir' before `-lguile'. --- NEWS | 1 + guile-config/ChangeLog | 5 +++++ guile-config/guile-config.in | 4 ++-- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index a399f234a..55302b72d 100644 --- a/NEWS +++ b/NEWS @@ -45,6 +45,7 @@ Changes in 1.8.6 (since 1.8.5) This makes these internal functions technically not callable from application code. +** `guile-config link' now prints `-L$libdir' before `-lguile' ** Fix build issue on Tru64 diff --git a/guile-config/ChangeLog b/guile-config/ChangeLog index f4286e331..d450f2536 100644 --- a/guile-config/ChangeLog +++ b/guile-config/ChangeLog @@ -1,3 +1,8 @@ +2008-06-02 Ludovic Courtès + + * guile-config.in (build-link): Show `-L' before `-lguile'. + Reported by Peter O'Gorman . + 2008-01-22 Neil Jerram * COPYING: Removed. diff --git a/guile-config/guile-config.in b/guile-config/guile-config.in index e5687da46..b782292d8 100644 --- a/guile-config/guile-config.in +++ b/guile-config/guile-config.in @@ -4,7 +4,7 @@ ;;;; guile-config --- utility for linking programs with Guile ;;;; Jim Blandy --- September 1997 ;;;; -;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006 Free Software Foundation, Inc. +;;;; Copyright (C) 1998, 2001, 2004, 2005, 2006, 2008 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 @@ -151,11 +151,11 @@ (display (string-join (list (get-build-info 'CFLAGS) - "-lguile -lltdl" (if (or (string=? libdir "/usr/lib") (string=? libdir "/usr/lib/")) "" (string-append "-L" (get-build-info 'libdir))) + "-lguile -lltdl" (string-join other-flags) ))) From 83bd8c1223c95551afee6d69f7a2a9a35792fb98 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 2 Jun 2008 21:47:53 +0200 Subject: [PATCH 43/87] Update `THANKS'. --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index a6be8f6e5..b00c2e310 100644 --- a/THANKS +++ b/THANKS @@ -68,6 +68,7 @@ For fixes or providing information which led to a fix: Hrvoje NikÅ¡ić Stefan Nordhausen Roland Orre + Peter O'Gorman Pieter Pareit Jack Pavlovsky Arno Peters From 95c6523b03387997d62c1bed57bd1a0864e30836 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 28 Jun 2008 20:31:01 +0200 Subject: [PATCH 44/87] Disable type-checking of `SCM_UNPACK' for the broken HP compilers. --- NEWS | 2 +- libguile/ChangeLog | 5 +++++ libguile/tags.h | 10 ++++++++-- 3 files changed, 14 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 55302b72d..f9c5f68da 100644 --- a/NEWS +++ b/NEWS @@ -46,7 +46,7 @@ This makes these internal functions technically not callable from application code. ** `guile-config link' now prints `-L$libdir' before `-lguile' -** Fix build issue on Tru64 +** Fix build issue on Tru64 and ia64-hp-hpux11.23 (`SCM_UNPACK' macro) Changes in 1.8.5 (since 1.8.4) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 1ca6dca71..c5bab5b41 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2008-06-28 Ludovic Courtès + + * tags.h (SCM_UNPACK): Disable type-checking for `__DECC' and + `__HP_cc'. Reported by Peter O'Gorman . + 2008-06-02 Ludovic Courtès * deprecated.c (maybe_close_port): Rename EXCEPT to EXCEPT_SET diff --git a/libguile/tags.h b/libguile/tags.h index 3f5483f3c..4e0700b52 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -3,7 +3,7 @@ #ifndef SCM_TAGS_H #define SCM_TAGS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -113,8 +113,14 @@ typedef unsigned long scm_t_bits; and that there is no performance hit. However, the alternative is compiled, and does generate a warning when used with the wrong pointer type. - */ + + The Tru64 and ia64-hp-hpux11.23 compilers fail on `case (0?0=0:x)' + statements, so for them type-checking is disabled. */ +#if defined __DECC || defined __HP_cc +# define SCM_UNPACK(x) ((scm_t_bits) (x)) +#else # define SCM_UNPACK(x) ((scm_t_bits) (0? (*(SCM*)0=(x)): x)) +#endif /* There is no typechecking on SCM_PACK, since all kinds of types From 994e8417d21d834a8e144e7903659c23de830c15 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 28 Jun 2008 20:32:17 +0200 Subject: [PATCH 45/87] Fix harmless typo in SRFI-19. --- srfi/ChangeLog | 5 +++++ srfi/srfi-19.scm | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) diff --git a/srfi/ChangeLog b/srfi/ChangeLog index fe88665d0..5c17089af 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,8 @@ +2008-06-28 Ludovic Courtès + + * srfi-19.scm (priv:read-tai-utc-data): Use `eof-object?' + instead of comparing LINE with `eof'. + 2008-05-15 Julian Graham * srfi-18.scm: New file. diff --git a/srfi/srfi-19.scm b/srfi/srfi-19.scm index 08302d0c8..96ef3448a 100644 --- a/srfi/srfi-19.scm +++ b/srfi/srfi-19.scm @@ -1,6 +1,6 @@ ;;; srfi-19.scm --- Time/Date Library -;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2008 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 @@ -193,7 +193,7 @@ (let ((port (open-input-file filename)) (table '())) (let loop ((line (read-line port))) - (if (not (eq? line eof)) + (if (not (eof-object? line)) (begin (let* ((data (read (open-input-string (string-append "(" line ")")))) From c8779dde04535333f8c2a7258a412420e9778e2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 28 Jun 2008 20:37:21 +0200 Subject: [PATCH 46/87] Fix doc typo regarding `use-syntax' and "syntax transformers". --- doc/ref/ChangeLog | 6 ++++++ doc/ref/api-modules.texi | 10 +++++----- 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index c31c5568a..9ead3aa8d 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,9 @@ +2008-06-28 Ludovic Courtès + + * api-modules.texi (Using Guile Modules): Substitute "syntax + transformer" to "system transformer". Reported by Sebastian + Tennant . + 2008-06-01 Ludovic Courtès * srfi-modules.texi (SRFI-88): Fix URL. diff --git a/doc/ref/api-modules.texi b/doc/ref/api-modules.texi index 94b93bdc1..9aeb08a44 100644 --- a/doc/ref/api-modules.texi +++ b/doc/ref/api-modules.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007 +@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2007, 2008 @c Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @@ -329,12 +329,12 @@ Signal error if module name is not resolvable. @c FIXME::martin: Is this correct, and is there more to say? -@c FIXME::martin: Define term and concept `system transformer' somewhere. +@c FIXME::martin: Define term and concept `syntax transformer' somewhere. @deffn syntax use-syntax module-name -Load the module @code{module-name} and use its system -transformer as the system transformer for the currently defined module, -as well as installing it as the current system transformer. +Load the module @code{module-name} and use its syntax +transformer as the syntax transformer for the currently defined module, +as well as installing it as the current syntax transformer. @end deffn @deffn syntax @@ module-name binding-name From 47871d5a161400e87999b7e28a85cb9022610238 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 28 Jun 2008 22:00:44 +0200 Subject: [PATCH 47/87] Modernize Automake files. --- ChangeLog | 4 ++++ configure.in | 2 +- libguile/ChangeLog | 4 ++++ libguile/Makefile.am | 12 ++++++------ srfi/ChangeLog | 3 +++ srfi/Makefile.am | 8 ++++---- 6 files changed, 22 insertions(+), 11 deletions(-) diff --git a/ChangeLog b/ChangeLog index dc49d16c8..7ee19af5d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2008-06-28 Ludovic Courtès + + * configure.in: Use Automake with `-Wall -Wno-override'. + 2008-05-07 Ludovic Courtès Guile 1.8.5 released. diff --git a/configure.in b/configure.in index 0afefad27..5f72d357c 100644 --- a/configure.in +++ b/configure.in @@ -41,7 +41,7 @@ AC_CONFIG_AUX_DIR([build-aux]) AC_CONFIG_MACRO_DIR([m4]) AC_CONFIG_SRCDIR(GUILE-VERSION) -AM_INIT_AUTOMAKE([gnu no-define check-news]) +AM_INIT_AUTOMAKE([gnu no-define check-news -Wall -Wno-override]) AC_COPYRIGHT(GUILE_CONFIGURE_COPYRIGHT) AC_CONFIG_SRCDIR([GUILE-VERSION]) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index c5bab5b41..8f3ccfc3c 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,9 @@ 2008-06-28 Ludovic Courtès + * Makefile.am (INCLUDES): Renamed to... + (AM_CPPFLAGS): this, to match current Automake conventions. + Users updated. + * tags.h (SCM_UNPACK): Disable type-checking for `__DECC' and `__HP_cc'. Reported by Peter O'Gorman . diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 487b8b274..6acdf1faf 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -32,8 +32,8 @@ DEFAULT_INCLUDES = ## Check for headers in $(srcdir)/.., so that #include ## will find MUMBLE.h in this dir when we're ## building. Also look for Gnulib headers in `lib'. -INCLUDES = -I$(top_srcdir) -I$(top_builddir) \ - -I$(top_srcdir)/lib -I$(top_builddir)/lib +AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir) \ + -I$(top_srcdir)/lib -I$(top_builddir)/lib ## The Gnulib Libtool archive. gnulib_library = $(top_builddir)/lib/libgnu.la @@ -53,7 +53,7 @@ gen_scmconfig_SOURCES = gen-scmconfig.c ## For some reason, OBJEXT does not include the dot gen-scmconfig.$(OBJEXT): gen-scmconfig.c if [ "$(cross_compiling)" = "yes" ]; then \ - $(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) -c -o $@ $<; \ + $(CC_FOR_BUILD) $(DEFS) $(DEFAULT_INCLUDES) $(AM_CPPFLAGS) -c -o $@ $<; \ else \ $(COMPILE) -c -o $@ $<; \ fi @@ -81,7 +81,7 @@ guile_filter_doc_snarfage_SOURCES = c-tokenize.c ## For some reason, OBJEXT does not include the dot c-tokenize.$(OBJEXT): c-tokenize.c if [ "$(cross_compiling)" = "yes" ]; then \ - $(CC_FOR_BUILD) $(DEFS) $(INCLUDES) -c -o $@ $<; \ + $(CC_FOR_BUILD) $(DEFS) $(AM_CPPFLAGS) -c -o $@ $<; \ else \ $(COMPILE) -c -o $@ $<; \ fi @@ -290,7 +290,7 @@ libpath.h: $(srcdir)/Makefile.in $(top_builddir)/config.status @mv libpath.tmp libpath.h -snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) SUFFIXES = .x .doc .c.x: @@ -340,7 +340,7 @@ schemelibdir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION) schemelib_DATA = guile-procedures.txt ## Add -MG to make the .x magic work with auto-dep code. -MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +MKDEP = gcc -M -MG $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) cpp_err_symbols.c: cpp_err_symbols.in cpp_cnvt.awk $(AWK) -f $(srcdir)/cpp_cnvt.awk < $(srcdir)/cpp_err_symbols.in > \ diff --git a/srfi/ChangeLog b/srfi/ChangeLog index 5c17089af..f35b25e16 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,5 +1,8 @@ 2008-06-28 Ludovic Courtès + * Makefile.am (INCLUDES): Renamed to... + (AM_CPPFLAGS): this, to match current Automake conventions. + * srfi-19.scm (priv:read-tai-utc-data): Use `eof-object?' instead of comparing LINE with `eof'. diff --git a/srfi/Makefile.am b/srfi/Makefile.am index 34c6ffb71..64858cd27 100644 --- a/srfi/Makefile.am +++ b/srfi/Makefile.am @@ -26,8 +26,8 @@ DEFS = @DEFS@ @EXTRA_DEFS@ ## Check for headers in $(srcdir)/.., so that #include ## will find MUMBLE.h in this dir when we're ## building. Also look for Gnulib headers in `lib'. -INCLUDES = -I.. -I$(srcdir)/.. \ - -I$(top_srcdir)/lib -I$(top_builddir)/lib +AM_CPPFLAGS = -I.. -I$(srcdir)/.. \ + -I$(top_srcdir)/lib -I$(top_builddir)/lib srfiincludedir = $(pkgincludedir)/srfi @@ -91,9 +91,9 @@ TAGS_FILES = $(srfi_DATA) GUILE_SNARF = ../libguile/guile-snarf -MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +MKDEP = gcc -M -MG $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) -snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) +snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS) SUFFIXES = .x .c.x: From e68f492a43a07a41c9ffbd08a0f3e7302a56c207 Mon Sep 17 00:00:00 2001 From: Julian Graham Date: Sat, 21 Jun 2008 00:55:17 -0400 Subject: [PATCH 48/87] srfi-modules.texi (SRFI-18): New sections. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Ludovic Courtès --- doc/ref/ChangeLog | 5 + doc/ref/srfi-modules.texi | 345 +++++++++++++++++++++++++++++++++++++- 2 files changed, 348 insertions(+), 2 deletions(-) diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 9ead3aa8d..1eb153987 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2008-06-30 Julian Graham + + * srfi-modules.texi (SRFI-18): New section. + (SRFI-19 Time): Mention SRFI-18's `current-time'. + 2008-06-28 Ludovic Courtès * api-modules.texi (Using Guile Modules): Substitute "syntax diff --git a/doc/ref/srfi-modules.texi b/doc/ref/srfi-modules.texi index 31ba498cf..b1fdde1c3 100644 --- a/doc/ref/srfi-modules.texi +++ b/doc/ref/srfi-modules.texi @@ -34,6 +34,7 @@ get the relevant SRFI documents from the SRFI home page * SRFI-14:: Character-set library. * SRFI-16:: case-lambda * SRFI-17:: Generalized set! +* SRFI-18:: Multithreading support * SRFI-19:: Time/Date library. * SRFI-26:: Specializing parameters * SRFI-31:: A special form `rec' for recursive evaluation @@ -1678,6 +1679,344 @@ The same as the Guile core @code{make-procedure-with-setter} @end defun +@node SRFI-18 +@subsection SRFI-18 - Multithreading support +@cindex SRFI-18 + +This is an implementation of the SRFI-18 threading and synchronization +library. The functions and variables described here are provided by + +@example +(use-modules (srfi srfi-18)) +@end example + +As a general rule, the data types and functions in this SRFI-18 +implementation are compatible with the types and functions in Guile's +core threading code. For example, mutexes created with the SRFI-18 +@code{make-mutex} function can be passed to the built-in Guile +function @code{lock-mutex} (@pxref{Mutexes and Condition Variables}), +and mutexes created with the built-in Guile function @code{make-mutex} +can be passed to the SRFI-18 function @code{mutex-lock!}. Cases in +which this does not hold true are noted in the following sections. + +@menu +* SRFI-18 Threads:: Executing code +* SRFI-18 Mutexes:: Mutual exclusion devices +* SRFI-18 Condition variables:: Synchronizing of groups of threads +* SRFI-18 Time:: Representation of times and durations +* SRFI-18 Exceptions:: Signalling and handling errors +@end menu + +@node SRFI-18 Threads +@subsubsection SRFI-18 Threads + +Threads created by SRFI-18 differ in two ways from threads created by +Guile's built-in thread functions. First, a thread created by SRFI-18 +@code{make-thread} begins in a blocked state and will not start +execution until @code{thread-start!} is called on it. Second, SRFI-18 +threads are constructed with a top-level exception handler that +captures any exceptions that are thrown on thread exit. In all other +regards, SRFI-18 threads are identical to normal Guile threads. + +@defun current-thread +Returns the thread that called this function. This is the same +procedure as the same-named built-in procedure @code{current-thread} +(@pxref{Threads}). +@end defun + +@defun thread? obj +Returns @code{#t} if @var{obj} is a thread, @code{#f} otherwise. This +is the same procedure as the same-named built-in procedure +@code{thread?} (@pxref{Threads}). +@end defun + +@defun make-thread thunk [name] +Call @code{thunk} in a new thread and with a new dynamic state, +returning the new thread and optionally assigning it the object name +@var{name}, which may be any Scheme object. + +Note that the name @code{make-thread} conflicts with the +@code{(ice-9 threads)} function @code{make-thread}. Applications +wanting to use both of these functions will need to refer to them by +different names. +@end defun + +@defun thread-name thread +Returns the name assigned to @var{thread} at the time of its creation, +or @code{#f} if it was not given a name. +@end defun + +@defun thread-specific thread +@defunx thread-specific-set! thread obj +Get or set the ``object-specific'' property of @var{thread}. In +Guile's implementation of SRFI-18, this value is stored as an object +property, and will be @code{#f} if not set. +@end defun + +@defun thread-start! thread +Unblocks @var{thread} and allows it to begin execution if it has not +done so already. +@end defun + +@defun thread-yield! +If one or more threads are waiting to execute, calling +@code{thread-yield!} forces an immediate context switch to one of them. +Otherwise, @code{thread-yield!} has no effect. @code{thread-yield!} +behaves identically to the Guile built-in function @code{yield}. +@end defun + +@defun thread-sleep! timeout +The current thread waits until the point specified by the time object +@var{timeout} is reached (@pxref{SRFI-18 Time}). This blocks the +thread only if @var{timeout} represents a point in the future. it is +an error for @var{timeout} to be @code{#f}. +@end defun + +@defun thread-terminate! thread +Causes an abnormal termination of @var{thread}. If @var{thread} is +not already terminated, all mutexes owned by @var{thread} become +unlocked/abandoned. If @var{thread} is the current thread, +@code{thread-terminate!} does not return. Otherwise +@code{thread-terminate!} returns an unspecified value; the termination +of @var{thread} will occur before @code{thread-terminate!} returns. +Subsequent attempts to join on @var{thread} will cause a ``terminated +thread exception'' to be raised. + +@code{thread-terminate!} is compatible with the thread cancellation +procedures in the core threads API (@pxref{Threads}) in that if a +cleanup handler has been installed for the target thread, it will be +called before the thread exits and its return value (or exception, if +any) will be stored for later retrieval via a call to +@code{thread-join!}. +@end defun + +@defun thread-join! thread [timeout [timeout-val]] +Wait for @var{thread} to terminate and return its exit value. When a +time value @var{timeout} is given, it specifies a point in time where +the waiting should be aborted. When the waiting is aborted, +@var{timeoutval} is returned if it is specified; otherwise, a +@code{join-timeout-exception} exception is raised +(@pxref{SRFI-18 Exceptions}). Exceptions may also be raised if the +thread was terminated by a call to @code{thread-terminate!} +(@code{terminated-thread-exception} will be raised) or if the thread +exited by raising an exception that was handled by the top-level +exception handler (@code{uncaught-exception} will be raised; the +original exception can be retrieved using +@code{uncaught-exception-reason}). +@end defun + + +@node SRFI-18 Mutexes +@subsubsection SRFI-18 Mutexes + +The behavior of Guile's built-in mutexes is parameterized via a set of +flags passed to the @code{make-mutex} procedure in the core +(@pxref{Mutexes and Condition Variables}). To satisfy the requirements +for mutexes specified by SRFI-18, the @code{make-mutex} procedure +described below sets the following flags: +@itemize @bullet +@item +@code{recursive}: the mutex can be locked recursively +@item +@code{unchecked-unlock}: attempts to unlock a mutex that is already +unlocked will not raise an exception +@item +@code{allow-external-unlock}: the mutex can be unlocked by any thread, +not just the thread that locked it originally +@end itemize + +@defun make-mutex [name] +Returns a new mutex, optionally assigning it the object name +@var{name}, which may be any Scheme object. The returned mutex will be +created with the configuration described above. Note that the name +@code{make-mutex} conflicts with Guile core function @code{make-mutex}. +Applications wanting to use both of these functions will need to refer +to them by different names. +@end defun + +@defun mutex-name mutex +Returns the name assigned to @var{mutex} at the time of its creation, +or @code{#f} if it was not given a name. +@end defun + +@defun mutex-specific mutex +@defunx mutex-specific-set! mutex obj +Get or set the ``object-specific'' property of @var{mutex}. In Guile's +implementation of SRFI-18, this value is stored as an object property, +and will be @code{#f} if not set. +@end defun + +@defun mutex-state mutex +Returns information about the state of @var{mutex}. Possible values +are: +@itemize @bullet +@item +thread @code{T}: the mutex is in the locked/owned state and thread T +is the owner of the mutex +@item +symbol @code{not-owned}: the mutex is in the locked/not-owned state +@item +symbol @code{abandoned}: the mutex is in the unlocked/abandoned state +@item +symbol @code{not-abandoned}: the mutex is in the +unlocked/not-abandoned state +@end itemize +@end defun + +@defun mutex-lock! mutex [timeout [thread]] +Lock @var{mutex}, optionally specifying a time object @var{timeout} +after which to abort the lock attempt and a thread @var{thread} giving +a new owner for @var{mutex} different than the current thread. This +procedure has the same behavior as the @code{lock-mutex} procedure in +the core library. +@end defun + +@defun mutex-unlock! mutex [condition-variable [timeout]] +Unlock @var{mutex}, optionally specifying a condition variable +@var{condition-variable} on which to wait, either indefinitely or, +optionally, until the time object @var{timeout} has passed, to be +signalled. This procedure has the same behavior as the +@code{unlock-mutex} procedure in the core library. +@end defun + + +@node SRFI-18 Condition variables +@subsubsection SRFI-18 Condition variables + +SRFI-18 does not specify a ``wait'' function for condition variables. +Waiting on a condition variable can be simulated using the SRFI-18 +@code{mutex-unlock!} function described in the previous section, or +Guile's built-in @code{wait-condition-variable} procedure can be used. + +@defun condition-variable? obj +Returns @code{#t} if @var{obj} is a condition variable, @code{#f} +otherwise. This is the same procedure as the same-named built-in +procedure +(@pxref{Mutexes and Condition Variables, @code{condition-variable?}}). +@end defun + +@defun make-condition-variable [name] +Returns a new condition variable, optionally assigning it the object +name @var{name}, which may be any Scheme object. This procedure +replaces a procedure of the same name in the core library. +@end defun + +@defun condition-variable-name condition-variable +Returns the name assigned to @var{thread} at the time of its creation, +or @code{#f} if it was not given a name. +@end defun + +@defun condition-variable-specific condition-variable +@defunx condition-variable-specific-set! condition-variable obj +Get or set the ``object-specific'' property of +@var{condition-variable}. In Guile's implementation of SRFI-18, this +value is stored as an object property, and will be @code{#f} if not +set. +@end defun + +@defun condition-variable-signal! condition-variable +@defunx condition-variable-broadcast! condition-variable +Wake up one thread that is waiting for @var{condition-variable}, in +the case of @code{condition-variable-signal!}, or all threads waiting +for it, in the case of @code{condition-variable-broadcast!}. The +behavior of these procedures is equivalent to that of the procedures +@code{signal-condition-variable} and +@code{broadcast-condition-variable} in the core library. +@end defun + + +@node SRFI-18 Time +@subsubsection SRFI-18 Time + +The SRFI-18 time functions manipulate time in two formats: a +``time object'' type that represents an absolute point in time in some +implementation-specific way; and the number of seconds since some +unspecified ``epoch''. In Guile's implementation, the epoch is the +Unix epoch, 00:00:00 UTC, January 1, 1970. + +@defun current-time +Return the current time as a time object. This procedure replaces +the procedure of the same name in the core library, which returns the +current time in seconds since the epoch. +@end defun + +@defun time? obj +Returns @code{#t} if @var{obj} is a time object, @code{#f} otherwise. +@end defun + +@defun time->seconds time +@defunx seconds->time seconds +Convert between time objects and numerical values representing the +number of seconds since the epoch. When converting from a time object +to seconds, the return value is the number of seconds between +@var{time} and the epoch. When converting from seconds to a time +object, the return value is a time object that represents a time +@var{seconds} seconds after the epoch. +@end defun + + +@node SRFI-18 Exceptions +@subsubsection SRFI-18 Exceptions + +SRFI-18 exceptions are identical to the exceptions provided by +Guile's implementation of SRFI-34. The behavior of exception +handlers invoked to handle exceptions thrown from SRFI-18 functions, +however, differs from the conventional behavior of SRFI-34 in that +the continuation of the handler is the same as that of the call to +the function. Handlers are called in a tail-recursive manner; the +exceptions do not ``bubble up''. + +@defun current-exception-handler +Returns the current exception handler. +@end defun + +@defun with-exception-handler handler thunk +Installs @var{handler} as the current exception handler and calls the +procedure @var{thunk} with no arguments, returning its value as the +value of the exception. @var{handler} must be a procedure that accepts +a single argument. The current exception handler at the time this +procedure is called will be restored after the call returns. +@end defun + +@defun raise obj +Raise @var{obj} as an exception. This is the same procedure as the +same-named procedure defined in SRFI 34. +@end defun + +@defun join-timeout-exception? obj +Returns @code{#t} if @var{obj} is an exception raised as the result of +performing a timed join on a thread that does not exit within the +specified timeout, @code{#f} otherwise. +@end defun + +@defun abandoned-mutex-exception? obj +Returns @code{#t} if @var{obj} is an exception raised as the result of +attempting to lock a mutex that has been abandoned by its owner thread, +@code{#f} otherwise. +@end defun + +@defun terminated-thread-exception? obj +Returns @code{#t} if @var{obj} is an exception raised as the result of +joining on a thread that exited as the result of a call to +@code{thread-terminate!}. +@end defun + +@defun uncaught-exception? obj +@defunx uncaught-exception-reason exc +@code{uncaught-exception?} returns @code{#t} if @var{obj} is an +exception thrown as the result of joining a thread that exited by +raising an exception that was handled by the top-level exception +handler installed by @code{make-thread}. When this occurs, the +original exception is preserved as part of the exception thrown by +@code{thread-join!} and can be accessed by calling +@code{uncaught-exception-reason} on that exception. Note that +because this exception-preservation mechanism is a side-effect of +@code{make-thread}, joining on threads that exited as described above +but were created by other means will not raise this +@code{uncaught-exception} error. +@end defun + + @node SRFI-19 @subsection SRFI-19 - Time/Date Library @cindex SRFI-19 @@ -1845,8 +2184,10 @@ Return the current time of the given @var{type}. The default @var{type} is @code{time-utc}. Note that the name @code{current-time} conflicts with the Guile core -@code{current-time} function (@pxref{Time}). Applications wanting to -use both will need to use a different name for one of them. +@code{current-time} function (@pxref{Time}) as well as the SRFI-18 +@code{current-time} function (@pxref{SRFI-18 Time}). Applications +wanting to use more than one of these functions will need to refer to +them by different names. @end defun @defun time-resolution [type] From 7b28af22c075b8339bec92b1abaa75689607db38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 30 Jun 2008 19:48:50 +0200 Subject: [PATCH 49/87] Add `NEWS' entry for SRFI-18. --- NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS b/NEWS index f9c5f68da..16b188086 100644 --- a/NEWS +++ b/NEWS @@ -11,6 +11,7 @@ Changes in 1.9.0: * New modules (see the manual for details) +** `(srfi srfi-18)', multithreading support ** The `(ice-9 i18n)' module provides internationalization support * Changes to the distribution From 3e28462ffb3038d9d8a026020702f4ea267bbca4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 4 Jul 2008 22:02:56 +0200 Subject: [PATCH 50/87] Fix `SCM_INTERNAL' with GCC 4.3. --- libguile/ChangeLog | 6 ++++++ libguile/__scm.h | 4 ++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 8f3ccfc3c..04d4e7c6a 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2008-07-04 Ludovic Courtès + + * __scm.h (SCM_INTERNAL): Add `extern' so that these symbols are + not considered as "common" by GCC 4.3. Reported by Patrick + Horgan . + 2008-06-28 Ludovic Courtès * Makefile.am (INCLUDES): Renamed to... diff --git a/libguile/__scm.h b/libguile/__scm.h index 76b444857..30077fd46 100644 --- a/libguile/__scm.h +++ b/libguile/__scm.h @@ -101,9 +101,9 @@ * as having "internal" linkage. */ #if (defined __GNUC__) && \ ((__GNUC__ >= 4) || (__GNUC__ == 3 && __GNUC_MINOR__ == 3)) -# define SCM_INTERNAL __attribute__ ((__visibility__ ("internal"))) +# define SCM_INTERNAL extern __attribute__ ((__visibility__ ("internal"))) #else -# define SCM_INTERNAL +# define SCM_INTERNAL extern #endif From a572acb2c2a51af368ca84db3e8b34ecae8ecc04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 4 Jul 2008 22:03:08 +0200 Subject: [PATCH 51/87] Update `THANKS'. --- THANKS | 1 + 1 file changed, 1 insertion(+) diff --git a/THANKS b/THANKS index b00c2e310..edb78f725 100644 --- a/THANKS +++ b/THANKS @@ -44,6 +44,7 @@ For fixes or providing information which led to a fix: Sven Hartrumpf Eric Hanchrow Sam Hocevar + Patrick Horgan Ales Hvezda Peter Ivanyi Wolfgang Jaehrling From b6137ed741eb0f14a4fb68c98879b91ec8250039 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 4 Jul 2008 22:22:06 +0200 Subject: [PATCH 52/87] Don't declare `scm_i_locale_mutex' as `SCM_INTERNAL'. --- libguile/ChangeLog | 4 ++++ libguile/posix.h | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 04d4e7c6a..f6fcdc61e 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,9 @@ 2008-07-04 Ludovic Courtès + * posix.h (scm_i_locale_mutex): Don't declare as `SCM_INTERNAL' + since it's needed by `libguile-i18n'. Reported by Patrick + Horgan . + * __scm.h (SCM_INTERNAL): Add `extern' so that these symbols are not considered as "common" by GCC 4.3. Reported by Patrick Horgan . diff --git a/libguile/posix.h b/libguile/posix.h index d51da9479..34e1fc77f 100644 --- a/libguile/posix.h +++ b/libguile/posix.h @@ -86,7 +86,7 @@ SCM_API SCM scm_sethostname (SCM name); SCM_API SCM scm_gethostname (void); SCM_INTERNAL void scm_init_posix (void); -SCM_INTERNAL scm_i_pthread_mutex_t scm_i_locale_mutex; +SCM_API scm_i_pthread_mutex_t scm_i_locale_mutex; #endif /* SCM_POSIX_H */ From 071bb6a84061dd8fba278219797fd376b0a54e10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 5 Jul 2008 20:10:44 +0200 Subject: [PATCH 53/87] Add `scm_c_symbol_length ()'. --- NEWS | 4 ++++ doc/ref/ChangeLog | 4 ++++ doc/ref/api-data.texi | 5 +++++ libguile/ChangeLog | 5 +++++ libguile/strings.c | 10 ++++++++++ libguile/strings.h | 1 + 6 files changed, 29 insertions(+) diff --git a/NEWS b/NEWS index 16b188086..c2c875195 100644 --- a/NEWS +++ b/NEWS @@ -39,6 +39,10 @@ indicating length of the `scm_t_option' array. Changes in 1.8.6 (since 1.8.5) +* New features (see the manual for details) + +** New convenience function `scm_c_symbol_length ()' + * Bugs fixed ** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 1eb153987..5812d656c 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,7 @@ +2008-07-05 Ludovic Courtès + + * api-data.texi (Symbol Primitives): Add `scm_c_symbol_length ()'. + 2008-06-30 Julian Graham * srfi-modules.texi (SRFI-18): New section. diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index b2b5b076f..e1db2a612 100755 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -4647,6 +4647,11 @@ immediately after creating the Scheme string. In certain cases, Guile can then use @var{str} directly as its internal representation. @end deftypefn +The size of a symbol can also be obtained from C: + +@deftypefn {C Function} size_t scm_c_symbol_length (SCM sym) +Return the number of characters in @var{sym}. +@end deftypefn Finally, some applications, especially those that generate new Scheme code dynamically, need to generate symbols for use in the generated diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f6fcdc61e..0223b0b41 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2008-07-05 Ludovic Courtès + + * strings.c (scm_c_symbol_length): New function. + * strings.h (scm_c_symbol_length): New declaration. + 2008-07-04 Ludovic Courtès * posix.h (scm_i_locale_mutex): Don't declare as `SCM_INTERNAL' diff --git a/libguile/strings.c b/libguile/strings.c index c322132fd..c9b08a05b 100644 --- a/libguile/strings.c +++ b/libguile/strings.c @@ -452,6 +452,16 @@ scm_i_symbol_length (SCM sym) return STRINGBUF_LENGTH (SYMBOL_STRINGBUF (sym)); } +size_t +scm_c_symbol_length (SCM sym) +#define FUNC_NAME "scm_c_symbol_length" +{ + SCM_VALIDATE_SYMBOL (1, sym); + + return STRINGBUF_LENGTH (SYMBOL_STRINGBUF (sym)); +} +#undef FUNC_NAME + const char * scm_i_symbol_chars (SCM sym) { diff --git a/libguile/strings.h b/libguile/strings.h index 04ae552f9..ca5f52cd2 100644 --- a/libguile/strings.h +++ b/libguile/strings.h @@ -90,6 +90,7 @@ SCM_API SCM scm_string_append (SCM args); SCM_API SCM scm_c_make_string (size_t len, SCM chr); SCM_API size_t scm_c_string_length (SCM str); +SCM_API size_t scm_c_symbol_length (SCM sym); SCM_API SCM scm_c_string_ref (SCM str, size_t pos); SCM_API void scm_c_string_set_x (SCM str, size_t pos, SCM chr); SCM_API SCM scm_c_substring (SCM str, size_t start, size_t end); From 3d8c00e725d363379200b90c582c0a83f17b2402 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sat, 5 Jul 2008 20:24:51 +0200 Subject: [PATCH 54/87] Update Gnulib files. --- m4/.cvsignore | 1 + m4/.gitignore | 2 ++ m4/gnulib-cache.m4 | 8 ++++++-- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/m4/.cvsignore b/m4/.cvsignore index 474f9d772..f77edf9d4 100644 --- a/m4/.cvsignore +++ b/m4/.cvsignore @@ -10,3 +10,4 @@ onceonly_2_57.m4 strcase.m4 string_h.m4 strings_h.m4 +onceonly.m4 diff --git a/m4/.gitignore b/m4/.gitignore index 5d6f4a485..b1014b383 100644 --- a/m4/.gitignore +++ b/m4/.gitignore @@ -6,3 +6,5 @@ include_next.m4 onceonly_2_57.m4 strcase.m4 strings_h.m4 +gnulib-comp.m4 +onceonly.m4 diff --git a/m4/gnulib-cache.m4 b/m4/gnulib-cache.m4 index a72d1dcea..032d19fb3 100644 --- a/m4/gnulib-cache.m4 +++ b/m4/gnulib-cache.m4 @@ -1,4 +1,4 @@ -# Copyright (C) 2004-2007 Free Software Foundation, Inc. +# Copyright (C) 2002-2008 Free Software Foundation, Inc. # # This file is free software, distributed under the terms of the GNU # General Public License. As a special exception to the GNU General @@ -19,7 +19,11 @@ # Specification in the form of a few gnulib-tool.m4 macro invocations: gl_LOCAL_DIR([]) -gl_MODULES([alloca extensions strcase]) +gl_MODULES([ + alloca + extensions + strcase +]) gl_AVOID([]) gl_SOURCE_BASE([lib]) gl_M4_BASE([m4]) From 4bdc8fb5acc750450819b53978665136eca6c171 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Jul 2008 19:53:49 +0200 Subject: [PATCH 55/87] Update to Autoconf 2.61. --- ChangeLog | 4 ++ configure.in | 136 ++++++++++++++++++++++++++++----------------------- 2 files changed, 79 insertions(+), 61 deletions(-) diff --git a/ChangeLog b/ChangeLog index 7ee19af5d..da26cbf45 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,7 @@ +2008-07-06 Ludovic Courtès + + * configure.in: Update to Autoconf 2.61. + 2008-06-28 Ludovic Courtès * configure.in: Use Automake with `-Wall -Wno-override'. diff --git a/configure.in b/configure.in index 5f72d357c..a6b409a68 100644 --- a/configure.in +++ b/configure.in @@ -25,7 +25,7 @@ Boston, MA 02110-1301, USA. ]]) -AC_PREREQ(2.59) +AC_PREREQ(2.61) dnl `patsubst' here deletes the newline which "echo" prints. We can't use dnl "echo -n" since -n is not portable (see autoconf manual "Limitations of @@ -49,7 +49,7 @@ AC_CONFIG_SRCDIR([GUILE-VERSION]) . $srcdir/GUILE-VERSION AM_MAINTAINER_MODE -AM_CONFIG_HEADER([config.h]) +AC_CONFIG_HEADERS([config.h]) AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/) #-------------------------------------------------------------------- @@ -62,8 +62,11 @@ AC_CONFIG_SUBDIRS(guile-readline) #-------------------------------------------------------------------- +AC_LANG([C]) + dnl Some more checks for Win32 -AC_CYGWIN +AC_CANONICAL_HOST + AC_LIBTOOL_WIN32_DLL AC_PROG_INSTALL @@ -75,7 +78,8 @@ AC_PROG_AWK dnl Gnulib. gl_INIT -AM_PROG_CC_STDC +AC_PROG_CC_C89 + # for per-target cflags in the libguile subdir AM_PROG_CC_C_O @@ -124,7 +128,7 @@ AC_ARG_ENABLE(debug-malloc, SCM_I_GSC_GUILE_DEBUG=0 AC_ARG_ENABLE(guile-debug, - [AC_HELP_STRING([--enable-guile-debug], + [AS_HELP_STRING([--enable-guile-debug], [include internal debugging functions])], if test "$enable_guile_debug" = y || test "$enable_guile_debug" = yes; then SCM_I_GSC_GUILE_DEBUG=1 @@ -143,7 +147,7 @@ AC_ARG_ENABLE(regex, enable_regex=yes) AC_ARG_ENABLE([discouraged], - AC_HELP_STRING([--disable-discouraged],[omit discouraged features])) + AS_HELP_STRING([--disable-discouraged],[omit discouraged features])) if test "$enable_discouraged" = no; then SCM_I_GSC_ENABLE_DISCOURAGED=0 @@ -152,7 +156,7 @@ else fi AC_ARG_ENABLE([deprecated], - AC_HELP_STRING([--disable-deprecated],[omit deprecated features])) + AS_HELP_STRING([--disable-deprecated],[omit deprecated features])) if test "$enable_deprecated" = no; then SCM_I_GSC_ENABLE_DEPRECATED=0 @@ -198,7 +202,7 @@ dnl For now, --without-64-calls allows Guile to build on OSs where it dnl wasn't building before. AC_MSG_CHECKING([whether to use system and library "64" calls]) AC_ARG_WITH([64-calls], - AC_HELP_STRING([--without-64-calls], + AS_HELP_STRING([--without-64-calls], [don't attempt to use system and library calls with "64" in their names]), [use_64_calls=$withval], [use_64_calls=yes @@ -727,24 +731,28 @@ AC_SEARCH_LIBS(crypt, crypt, # is a workaround for the failure of some systems to conform to C99. if test "$ac_cv_type_complex_double" = yes; then AC_MSG_CHECKING([for i]) - AC_TRY_COMPILE([ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #if HAVE_COMPLEX_H #include #endif complex double z; -],[ +]], [[ z = _Complex_I; -],[AC_DEFINE(GUILE_I,_Complex_I,[The imaginary unit (positive square root of -1).]) - AC_MSG_RESULT([_Complex_I])],[AC_TRY_COMPILE([ +]])], + [AC_DEFINE(GUILE_I,_Complex_I,[The imaginary unit (positive square root of -1).]) + AC_MSG_RESULT([_Complex_I])], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #if HAVE_COMPLEX_H #include #endif complex double z; -],[ +]],[[ z = 1.0fi; -],[AC_DEFINE(GUILE_I,1.0fi) - AC_MSG_RESULT([1.0fi])],[ac_cv_type_complex_double=no - AC_MSG_RESULT([not available])])]) +]])], + [AC_DEFINE(GUILE_I,1.0fi) + AC_MSG_RESULT([1.0fi])], + [ac_cv_type_complex_double=no + AC_MSG_RESULT([not available])])]) fi # glibc 2.3.6 (circa 2006) and various prior versions had a bug where @@ -755,7 +763,7 @@ if test "$ac_cv_type_complex_double" = yes; then AC_CACHE_CHECK([whether csqrt is usable], guile_cv_use_csqrt, - [AC_TRY_RUN([ + [AC_RUN_IFELSE([AC_LANG_SOURCE([[ #include /* "volatile" is meant to prevent gcc from calculating the sqrt as a constant, we want to test libc. */ @@ -768,7 +776,7 @@ main (void) return 0; /* good */ else return 1; /* bad */ -}], +}]])], [guile_cv_use_csqrt=yes], [guile_cv_use_csqrt="no, glibc 2.3 bug"], [guile_cv_use_csqrt="yes, hopefully (cross-compiling)"])]) @@ -785,8 +793,9 @@ AC_CHECK_LIB([gmp], [__gmpz_init], , [AC_MSG_ERROR([GNU MP not found, see README])]) # mpz_import is a macro so we need to include -AC_TRY_LINK([#include ], - [mpz_import (0, 0, 0, 0, 0, 0, 0);] , , +AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include ]], + [[mpz_import (0, 0, 0, 0, 0, 0, 0); ]])], + [], [AC_MSG_ERROR([At least GNU MP 4.1 is required, see README])]) dnl i18n tests @@ -864,11 +873,11 @@ AC_CHECK_MEMBERS([struct sockaddr.sin_len],,, AC_MSG_CHECKING(for __libc_stack_end) AC_CACHE_VAL(guile_cv_have_libc_stack_end, -[AC_TRY_LINK([#include -extern char *__libc_stack_end;], - [printf("%p", (char*) __libc_stack_end);], - guile_cv_have_libc_stack_end=yes, - guile_cv_have_libc_stack_end=no)]) +[AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include +extern char *__libc_stack_end;]], + [[printf("%p", (char*) __libc_stack_end);]])], + [guile_cv_have_libc_stack_end=yes], + [guile_cv_have_libc_stack_end=no])]) AC_MSG_RESULT($guile_cv_have_libc_stack_end) if test $guile_cv_have_libc_stack_end = yes; then @@ -881,9 +890,10 @@ dnl macro. With cygwin it may be in a DLL. AC_MSG_CHECKING(whether netdb.h declares h_errno) AC_CACHE_VAL(guile_cv_have_h_errno, -[AC_TRY_COMPILE([#include ], -[int a = h_errno;], -guile_cv_have_h_errno=yes, guile_cv_have_h_errno=no)]) + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include ]], + [[int a = h_errno;]])], + [guile_cv_have_h_errno=yes], + [guile_cv_have_h_errno=no])]) AC_MSG_RESULT($guile_cv_have_h_errno) if test $guile_cv_have_h_errno = yes; then AC_DEFINE(HAVE_H_ERRNO, 1, [Define if h_errno is declared in netdb.h.]) @@ -891,15 +901,16 @@ fi AC_MSG_CHECKING(whether uint32_t is defined) AC_CACHE_VAL(guile_cv_have_uint32_t, - [AC_TRY_COMPILE([#include + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[#include #if HAVE_STDINT_H #include #endif #ifndef HAVE_NETDB_H #include - #endif], - [uint32_t a;], - guile_cv_have_uint32_t=yes, guile_cv_have_uint32_t=no)]) + #endif]], + [[uint32_t a;]])], + [guile_cv_have_uint32_t=yes], + [guile_cv_have_uint32_t=no])]) AC_MSG_RESULT($guile_cv_have_uint32_t) if test $guile_cv_have_uint32_t = yes; then AC_DEFINE(HAVE_UINT32_T, 1, @@ -908,14 +919,15 @@ fi AC_MSG_CHECKING(for working IPv6 support) AC_CACHE_VAL(guile_cv_have_ipv6, -[AC_TRY_COMPILE([ +[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef HAVE_SYS_TYPES_H #include #endif #include -#include ], -[struct sockaddr_in6 a; a.sin6_family = AF_INET6;], -guile_cv_have_ipv6=yes, guile_cv_have_ipv6=no)]) +#include ]], +[[struct sockaddr_in6 a; a.sin6_family = AF_INET6;]])], +[guile_cv_have_ipv6=yes], +[guile_cv_have_ipv6=no])]) AC_MSG_RESULT($guile_cv_have_ipv6) if test $guile_cv_have_ipv6 = yes; then AC_DEFINE(HAVE_IPV6, 1, [Define if you want support for IPv6.]) @@ -924,13 +936,14 @@ fi # included in rfc2553 but not in older implementations, e.g., glibc 2.1.3. AC_MSG_CHECKING(whether sockaddr_in6 has sin6_scope_id) AC_CACHE_VAL(guile_cv_have_sin6_scope_id, -[AC_TRY_COMPILE([ +[AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #ifdef HAVE_SYS_TYPES_H #include #endif -#include ], -[struct sockaddr_in6 sok; sok.sin6_scope_id = 0;], -guile_cv_have_sin6_scope_id=yes, guile_cv_have_sin6_scope_id=no)]) +#include ]], +[[struct sockaddr_in6 sok; sok.sin6_scope_id = 0;]])], +[guile_cv_have_sin6_scope_id=yes], +[guile_cv_have_sin6_scope_id=no])]) AC_MSG_RESULT($guile_cv_have_sin6_scope_id) if test $guile_cv_have_sin6_scope_id = yes; then AC_DEFINE(HAVE_SIN6_SCOPE_ID, 1, @@ -947,7 +960,7 @@ AC_CHECK_MEMBERS([struct sockaddr_in6.sin6_len],,, AC_MSG_CHECKING(whether localtime caches TZ) AC_CACHE_VAL(guile_cv_localtime_cache, [if test x$ac_cv_func_tzset = xyes; then -AC_TRY_RUN([#include +AC_RUN_IFELSE([AC_LANG_SOURCE([[#include #if STDC_HEADERS # include #endif @@ -978,7 +991,9 @@ main() if (localtime (&now)->tm_hour != hour_unset) exit (1); exit (0); -}], guile_cv_localtime_cache=no, guile_cv_localtime_cache=yes, +}]])], +[guile_cv_localtime_cache=no], +[guile_cv_localtime_cache=yes], [# If we have tzset, assume the worst when cross-compiling. guile_cv_localtime_cache=yes]) else @@ -1099,12 +1114,12 @@ GUILE_STRUCT_UTIMBUF #-------------------------------------------------------------------- SCM_I_GSC_STACK_GROWS_UP=0 -AC_TRY_RUN(aux (l) unsigned long l; +AC_RUN_IFELSE([AC_LANG_SOURCE([[aux (l) unsigned long l; { int x; exit (l >= ((unsigned long)&x)); } - main () { int q; aux((unsigned long)&q); }, - [SCM_I_GSC_STACK_GROWS_UP=1], - [], - [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)]) + main () { int q; aux((unsigned long)&q); }]])], + [SCM_I_GSC_STACK_GROWS_UP=1], + [], + [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)]) AC_CHECK_SIZEOF(float) if test "$ac_cv_sizeof_float" -le "$ac_cv_sizeof_long"; then @@ -1114,12 +1129,12 @@ fi AC_MSG_CHECKING(for struct linger) AC_CACHE_VAL(scm_cv_struct_linger, - AC_TRY_COMPILE([ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include -#include ], - [struct linger lgr; lgr.l_linger = 100], - scm_cv_struct_linger="yes", - scm_cv_struct_linger="no")) +#include ]], + [[struct linger lgr; lgr.l_linger = 100]])], + [scm_cv_struct_linger="yes"], + [scm_cv_struct_linger="no"])) AC_MSG_RESULT($scm_cv_struct_linger) if test $scm_cv_struct_linger = yes; then AC_DEFINE(HAVE_STRUCT_LINGER, 1, @@ -1132,14 +1147,13 @@ fi # AC_MSG_CHECKING(for struct timespec) AC_CACHE_VAL(scm_cv_struct_timespec, - AC_TRY_COMPILE([ + AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ #include #if HAVE_PTHREAD_H #include -#endif], - [struct timespec t; t.tv_nsec = 100], - scm_cv_struct_timespec="yes", - scm_cv_struct_timespec="no")) +#endif]], [[struct timespec t; t.tv_nsec = 100]])], + [scm_cv_struct_timespec="yes"], + [scm_cv_struct_timespec="no"])) AC_MSG_RESULT($scm_cv_struct_timespec) if test $scm_cv_struct_timespec = yes; then AC_DEFINE(HAVE_STRUCT_TIMESPEC, 1, @@ -1259,8 +1273,7 @@ if test "$with_threads" = pthreads; then AC_MSG_CHECKING(whether pthread_attr_getstack works for the main thread) old_CFLAGS="$CFLAGS" CFLAGS="$PTHREAD_CFLAGS $CFLAGS" -AC_TRY_RUN( -[ +AC_RUN_IFELSE([AC_LANG_SOURCE([[ #if HAVE_PTHREAD_ATTR_GETSTACK #include @@ -1285,10 +1298,11 @@ int main () return 1; } #endif -], +]])], [works=yes AC_DEFINE(PTHREAD_ATTR_GETSTACK_WORKS, [1], [Define when pthread_att_get_stack works for the main thread])], -[works=no]) +[works=no], +[]) CFLAGS="$old_CFLAGS" AC_MSG_RESULT($works) From 61c8bf343cf5e0edccb8a1631e94c6f313c8cb4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Jul 2008 19:55:18 +0200 Subject: [PATCH 56/87] Update `INSTALL'. --- INSTALL | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/INSTALL b/INSTALL index 5458714e1..d3c5b40a9 100644 --- a/INSTALL +++ b/INSTALL @@ -2,7 +2,7 @@ Installation Instructions ************************* Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005, -2006 Free Software Foundation, Inc. +2006, 2007 Free Software Foundation, Inc. This file is free documentation; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. @@ -67,6 +67,9 @@ The simplest way to compile this package is: all sorts of other programs in order to regenerate files that came with the distribution. + 6. Often, you can also type `make uninstall' to remove the installed + files again. + Compilers and Options ===================== From 8722d99a45ce09fbacad4a7bc6dff790bbf0af54 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 6 Jul 2008 23:58:15 +0200 Subject: [PATCH 57/87] Use `-q' when running standalone tests. --- test-suite/ChangeLog | 6 ++++++ test-suite/standalone/test-asmobs | 2 +- test-suite/standalone/test-bad-identifiers | 2 +- test-suite/standalone/test-require-extension | 10 +++++----- test-suite/standalone/test-system-cmds | 2 +- 5 files changed, 14 insertions(+), 8 deletions(-) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 9b4cdd643..4c0d992b8 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,9 @@ +2008-07-06 Ludovic Courtès + + * standalone/test-asmobs, standalone/test-bad-identifiers, + standalone/test-require-extension, standalone/test-system-cmds: + Invoke `guile' with `-q'. + 2008-06-02 Ludovic Courtès * standalone/test-conversion.c: Support systems whose diff --git a/test-suite/standalone/test-asmobs b/test-suite/standalone/test-asmobs index 19557e0f1..2ea75d9bf 100755 --- a/test-suite/standalone/test-asmobs +++ b/test-suite/standalone/test-asmobs @@ -1,5 +1,5 @@ #!/bin/sh -exec guile -s "$0" "$@" +exec guile -q -s "$0" "$@" !# (load-extension "libtest-asmobs" "libtest_asmobs_init") diff --git a/test-suite/standalone/test-bad-identifiers b/test-suite/standalone/test-bad-identifiers index 6462dbdbe..e7af5a1d1 100755 --- a/test-suite/standalone/test-bad-identifiers +++ b/test-suite/standalone/test-bad-identifiers @@ -1,5 +1,5 @@ #!/bin/sh -exec guile -s "$0" "$@" +exec guile -q -s "$0" "$@" !# ;; The use of certain identifiers as variable or parameter names has diff --git a/test-suite/standalone/test-require-extension b/test-suite/standalone/test-require-extension index 730137b55..69f18589a 100755 --- a/test-suite/standalone/test-require-extension +++ b/test-suite/standalone/test-require-extension @@ -7,12 +7,12 @@ set -e # (Note the syntax "! guile -c ..." isn't used here, because that doesn't # work on Solaris 10.) # -guile -c '(require-extension 7)' 2>/dev/null && exit 1 -guile -c '(require-extension (blarg))' 2>/dev/null && exit 1 -guile -c '(require-extension (srfi "foo"))' 2>/dev/null && exit 1 +guile -q -c '(require-extension 7)' 2>/dev/null && exit 1 +guile -q -c '(require-extension (blarg))' 2>/dev/null && exit 1 +guile -q -c '(require-extension (srfi "foo"))' 2>/dev/null && exit 1 # expect these to succeed -guile -c '(require-extension (srfi 1)) (exit (procedure? take-right))' -guile -c '(require-extension (srfi))' +guile -q -c '(require-extension (srfi 1)) (exit (procedure? take-right))' +guile -q -c '(require-extension (srfi))' exit 0 diff --git a/test-suite/standalone/test-system-cmds b/test-suite/standalone/test-system-cmds index d0e4a6991..f5007297e 100755 --- a/test-suite/standalone/test-system-cmds +++ b/test-suite/standalone/test-system-cmds @@ -1,5 +1,5 @@ #!/bin/sh -exec guile -s "$0" "$@" +exec guile -q -s "$0" "$@" !# (define (test-system-cmd) From c0a658c4db8bb6aa85834a43a62c11ad5a8371ed Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sat, 12 Jul 2008 19:22:59 +0100 Subject: [PATCH 58/87] Improved MIPS/Linux gc_os_dep.c definitions From Thiemo Seufer : * gc_os_dep.c (CPP_WORDSZ, ALIGN_DOUBLE, DATAEND, DYNAMIC_LOADING): Added #defines. (_fdata, _end): Added declarations. (DATASTART): Use _fdata instead of __data_start. (STACKBOTTOM): Changed from 0x80000000 to 0x7fff8000. --- THANKS | 1 + libguile/gc_os_dep.c | 23 +++++++++++------------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/THANKS b/THANKS index edb78f725..cda8b5ee9 100644 --- a/THANKS +++ b/THANKS @@ -82,6 +82,7 @@ For fixes or providing information which led to a fix: Werner Scheinast Bill Schottstaedt Frank Schwidom + Thiemo Seufer Scott Shedden Alex Shinn Daniel Skarda diff --git a/libguile/gc_os_dep.c b/libguile/gc_os_dep.c index a8534ef43..4223803c3 100644 --- a/libguile/gc_os_dep.c +++ b/libguile/gc_os_dep.c @@ -1008,19 +1008,18 @@ scm_get_stack_base () # ifdef MIPS # define MACH_TYPE "MIPS" -/* # define STACKBOTTOM ((ptr_t)0x7fff8000) sometimes also works. */ # ifdef LINUX - /* This was developed for a linuxce style platform. Probably */ - /* needs to be tweaked for workstation class machines. */ -# define OS_TYPE "LINUX" - extern int __data_start; -# define DATASTART ((ptr_t)(&__data_start)) -# define ALIGNMENT 4 -# define USE_GENERIC_PUSH_REGS 1 -# define STACKBOTTOM 0x80000000 - /* In many cases, this should probably use LINUX_STACKBOTTOM */ - /* instead. But some kernel versions seem to give the wrong */ - /* value from /proc. */ +# define CPP_WORDSZ _MIPS_SZPTR +# define OS_TYPE "LINUX" +# define ALIGNMENT 4 +# define ALIGN_DOUBLE + extern int _fdata; +# define DATASTART ((ptr_t)(&_fdata)) + extern int _end; +# define DATAEND ((ptr_t)(&_end)) +# define STACKBOTTOM ((ptr_t)0x7fff8000) +# define USE_GENERIC_PUSH_REGS 1 +# define DYNAMIC_LOADING # endif /* Linux */ # ifdef ULTRIX # define HEURISTIC2 From 4696a66693fe88f87abc6313027cbd1563dc350c Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 11 Jul 2008 23:30:19 +0100 Subject: [PATCH 59/87] Improve stack direction test * configure.in: Update stack direction test to be like that in Autoconf _AC_LIBOBJ_ALLOCA and Gnulib; specifically in involving a function calling itself. --- NEWS | 1 + configure.in | 41 +++++++++++++++++++++++++++++++++++------ 2 files changed, 36 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index c2c875195..f7c0701fa 100644 --- a/NEWS +++ b/NEWS @@ -52,6 +52,7 @@ application code. ** `guile-config link' now prints `-L$libdir' before `-lguile' ** Fix build issue on Tru64 and ia64-hp-hpux11.23 (`SCM_UNPACK' macro) +** Fix build issue on mips, mipsel, powerpc and ia64 (stack direction) Changes in 1.8.5 (since 1.8.4) diff --git a/configure.in b/configure.in index a6b409a68..27fbe302c 100644 --- a/configure.in +++ b/configure.in @@ -1111,15 +1111,44 @@ GUILE_STRUCT_UTIMBUF # # Which way does the stack grow? # +# Following code comes from Autoconf 2.61's internal _AC_LIBOBJ_ALLOCA +# macro (/usr/share/autoconf/autoconf/functions.m4). Gnulib has +# very similar code, so in future we could look at using that. +# +# An important detail is that the code involves find_stack_direction +# calling _itself_ - which means that find_stack_direction (or at +# least the second find_stack_direction() call) cannot be inlined. +# If the code could be inlined, that might cause the test to give +# an incorrect answer. #-------------------------------------------------------------------- SCM_I_GSC_STACK_GROWS_UP=0 -AC_RUN_IFELSE([AC_LANG_SOURCE([[aux (l) unsigned long l; - { int x; exit (l >= ((unsigned long)&x)); } - main () { int q; aux((unsigned long)&q); }]])], - [SCM_I_GSC_STACK_GROWS_UP=1], - [], - [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)]) +AC_CACHE_CHECK([stack direction], + [SCM_I_GSC_STACK_GROWS_UP], +[AC_RUN_IFELSE([AC_LANG_SOURCE( +[AC_INCLUDES_DEFAULT +int +find_stack_direction () +{ + static char *addr = 0; + auto char dummy; + if (addr == 0) + { + addr = &dummy; + return find_stack_direction (); + } + else + return (&dummy > addr) ? 1 : -1; +} + +int +main () +{ + return find_stack_direction () < 0; +}])], + [SCM_I_GSC_STACK_GROWS_UP=1], + [], + [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)])]) AC_CHECK_SIZEOF(float) if test "$ac_cv_sizeof_float" -le "$ac_cv_sizeof_long"; then From 450be18dfffd496ef14e1c921953e6f179727ab4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 17 Jul 2008 00:17:56 +0200 Subject: [PATCH 60/87] Handle lack of `struct dirent64' and `readdir64_r ()' on HP-UX 11.11. --- ChangeLog | 5 +++++ NEWS | 1 + configure.in | 34 ++++++++++++++++++++++++++++++++-- libguile/ChangeLog | 10 ++++++++++ libguile/_scm.h | 12 ++++++++++-- libguile/gen-scmconfig.c | 13 +++++++++++++ libguile/gen-scmconfig.h.in | 1 + 7 files changed, 72 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index da26cbf45..1237ed133 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2008-07-16 Ludovic Courtès + + * configure.in: Look for `struct dirent64' and `readdir64_r ()', + not available on HP-UX 11.11. + 2008-07-06 Ludovic Courtès * configure.in: Update to Autoconf 2.61. diff --git a/NEWS b/NEWS index f7c0701fa..627a8cd14 100644 --- a/NEWS +++ b/NEWS @@ -53,6 +53,7 @@ application code. ** `guile-config link' now prints `-L$libdir' before `-lguile' ** Fix build issue on Tru64 and ia64-hp-hpux11.23 (`SCM_UNPACK' macro) ** Fix build issue on mips, mipsel, powerpc and ia64 (stack direction) +** Fix build issue on hppa2.0w-hp-hpux11.11 (`dirent64' and `readdir64_r') Changes in 1.8.5 (since 1.8.4) diff --git a/configure.in b/configure.in index 27fbe302c..eabc82491 100644 --- a/configure.in +++ b/configure.in @@ -583,9 +583,38 @@ AC_SUBST([SCM_I_GSC_NEEDS_STDINT_H]) AC_SUBST([SCM_I_GSC_NEEDS_INTTYPES_H]) AC_HEADER_STDC -AC_HEADER_DIRENT AC_HEADER_TIME AC_HEADER_SYS_WAIT +AC_HEADER_DIRENT + +# Reason for checking: +# +# HP-UX 11.11 (at least) doesn't provide `struct dirent64', even +# with `_LARGEFILE64_SOURCE', so check whether it's available. +# +AC_CHECK_MEMBER([struct dirent64.d_name], + [SCM_I_GSC_HAVE_STRUCT_DIRENT64=1], [SCM_I_GSC_HAVE_STRUCT_DIRENT64=0], + [ #ifndef _LARGEFILE64_SOURCE + # define _LARGEFILE64_SOURCE + #endif + + /* Per Autoconf manual. */ + #include + #ifdef HAVE_DIRENT_H + # include + #else + # define dirent direct + # ifdef HAVE_SYS_NDIR_H + # include + # endif + # ifdef HAVE_SYS_DIR_H + # include + # endif + # ifdef HAVE_NDIR_H + # include + # endif + #endif ]) +AC_SUBST([SCM_I_GSC_HAVE_STRUCT_DIRENT64]) # Reasons for testing: # complex.h - new in C99 @@ -684,6 +713,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # pipe - not in mingw # _pipe - specific to mingw, taking 3 args # readdir_r - recent posix, not on old systems +# readdir64_r - not available on HP-UX 11.11 # stat64 - SuS largefile stuff, not on old systems # sysconf - not on old systems # truncate - not in mingw @@ -692,7 +722,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # strcoll_l, newlocale - GNU extensions (glibc), also available on Darwin # nl_langinfo - X/Open, not available on Windows. # -AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo]) +AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readdir64_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strcoll strcoll_l newlocale nl_langinfo]) # Reasons for testing: # netdb.h - not in mingw diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 0223b0b41..4219e1af6 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,13 @@ +2008-07-16 Ludovic Courtès + + * gen-scmconfig.h.in (SCM_I_GSC_HAVE_STRUCT_DIRENT64): New. + * gen-scmconfig.c (main): Produce definitions of + `SCM_HAVE_STRUCT_DIRENT64' and `SCM_HAVE_READDIR64_R'. + * _scm.h (dirent_or_dirent64): Depend on + `SCM_HAVE_STRUCT_DIRENT64', for the sake of HP-UX 11.11. + (readdir_r_or_readdir64_r): Depend on `SCM_HAVE_READDIR64_R', + for HP-UX 11.11. + 2008-07-05 Ludovic Courtès * strings.c (scm_c_symbol_length): New function. diff --git a/libguile/_scm.h b/libguile/_scm.h index 4d6ded68e..6b728be2b 100644 --- a/libguile/_scm.h +++ b/libguile/_scm.h @@ -113,7 +113,11 @@ #endif /* These names are a bit long, but they make it clear what they represent. */ -#define dirent_or_dirent64 CHOOSE_LARGEFILE(dirent,dirent64) +#if SCM_HAVE_STRUCT_DIRENT64 == 1 +# define dirent_or_dirent64 CHOOSE_LARGEFILE(dirent,dirent64) +#else +# define dirent_or_dirent64 dirent +#endif #define fstat_or_fstat64 CHOOSE_LARGEFILE(fstat,fstat64) #define ftruncate_or_ftruncate64 CHOOSE_LARGEFILE(ftruncate,ftruncate64) #define lseek_or_lseek64 CHOOSE_LARGEFILE(lseek,lseek64) @@ -121,7 +125,11 @@ #define off_t_or_off64_t CHOOSE_LARGEFILE(off_t,off64_t) #define open_or_open64 CHOOSE_LARGEFILE(open,open64) #define readdir_or_readdir64 CHOOSE_LARGEFILE(readdir,readdir64) -#define readdir_r_or_readdir64_r CHOOSE_LARGEFILE(readdir_r,readdir64_r) +#if SCM_HAVE_READDIR64_R == 1 +# define readdir_r_or_readdir64_r CHOOSE_LARGEFILE(readdir_r,readdir64_r) +#else +# define readdir_r_or_readdir64_r readdir_r +#endif #define stat_or_stat64 CHOOSE_LARGEFILE(stat,stat64) #define truncate_or_truncate64 CHOOSE_LARGEFILE(truncate,truncate64) #define scm_from_off_t_or_off64_t CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64) diff --git a/libguile/gen-scmconfig.c b/libguile/gen-scmconfig.c index 788b45144..6d3fea679 100644 --- a/libguile/gen-scmconfig.c +++ b/libguile/gen-scmconfig.c @@ -387,6 +387,19 @@ main (int argc, char *argv[]) pf ("#define SCM_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER %d /* 0 or 1 */\n", SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER); + pf ("\n\n/*** File system access ***/\n"); + + pf ("/* Define to 1 if `struct dirent64' is available. */\n"); + pf ("#define SCM_HAVE_STRUCT_DIRENT64 %d /* 0 or 1 */\n", + SCM_I_GSC_HAVE_STRUCT_DIRENT64); + + pf ("/* Define to 1 if `readdir64_r ()' is available. */\n"); +#ifdef HAVE_READDIR64_R + pf ("#define SCM_HAVE_READDIR64_R 1 /* 0 or 1 */\n"); +#else + pf ("#define SCM_HAVE_READDIR64_R 0 /* 0 or 1 */\n"); +#endif + #if USE_DLL_IMPORT pf ("\n"); pf ("/* Define some additional CPP macros on Win32 platforms. */\n"); diff --git a/libguile/gen-scmconfig.h.in b/libguile/gen-scmconfig.h.in index cdc59b047..1be95af94 100644 --- a/libguile/gen-scmconfig.h.in +++ b/libguile/gen-scmconfig.h.in @@ -30,6 +30,7 @@ #define SCM_I_GSC_USE_NULL_THREADS @SCM_I_GSC_USE_NULL_THREADS@ #define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_ONCE_INIT@ #define SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER @SCM_I_GSC_NEED_BRACES_ON_PTHREAD_MUTEX_INITIALIZER@ +#define SCM_I_GSC_HAVE_STRUCT_DIRENT64 @SCM_I_GSC_HAVE_STRUCT_DIRENT64@ /* Local Variables: From 2b3df509f68ac68d91cc25b4718f8cf6069b97e9 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 17 Jul 2008 22:02:01 +0100 Subject: [PATCH 61/87] ChangeLog for "Improved MIPS/Linux gc_os_dep.c definitions" --- libguile/ChangeLog | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 4219e1af6..fd867c6d5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,13 @@ +2008-07-17 Neil Jerram + + From Thiemo Seufer : + + * gc_os_dep.c (CPP_WORDSZ, ALIGN_DOUBLE, DATAEND, + DYNAMIC_LOADING): Added #defines. + (_fdata, _end): Added declarations. + (DATASTART): Use _fdata instead of __data_start. + (STACKBOTTOM): Changed from 0x80000000 to 0x7fff8000. + 2008-07-16 Ludovic Courtès * gen-scmconfig.h.in (SCM_I_GSC_HAVE_STRUCT_DIRENT64): New. From 0d751d472091421d91c097342c849cd52386f6ca Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 17 Jul 2008 22:03:49 +0100 Subject: [PATCH 62/87] ChangeLog for "Improve stack direction test" --- ChangeLog | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/ChangeLog b/ChangeLog index 1237ed133..cad6adb32 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2008-07-17 Neil Jerram + + * configure.in: Update stack direction test to be like that in + Autoconf _AC_LIBOBJ_ALLOCA and Gnulib; specifically in involving a + function calling itself. + 2008-07-16 Ludovic Courtès * configure.in: Look for `struct dirent64' and `readdir64_r ()', From 091baf9edfb8330226524b99c3bf623499516bf7 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Fri, 11 Jul 2008 17:53:43 +0100 Subject: [PATCH 63/87] Single stepping through code from Emacs When you use GDS to evaluate Scheme code from Emacs, you can now use `C-u' to indicate that you want to single step through that code. See `Evaluating Scheme Code' in the manual for more details. * scheme-using.texi (Evaluating Scheme Code): Document use of `C-u' prefix with evaluation commands. * gds-scheme.el (gds-eval-region, gds-eval-expression) (gds-eval-defun, gds-eval-last-sexp): Support `C-u' prefix, meaning that user wants to single step through the code. * gds-client.scm (handle-nondebug-protocol): Add support for setting a trap on code that is about to be evaluated. --- NEWS | 6 +++++ doc/ref/ChangeLog | 5 ++++ doc/ref/scheme-using.texi | 8 +++++++ emacs/ChangeLog | 6 +++++ emacs/gds-scheme.el | 50 +++++++++++++++++++++++++-------------- ice-9/ChangeLog | 5 ++++ ice-9/gds-client.scm | 7 +++++- 7 files changed, 68 insertions(+), 19 deletions(-) diff --git a/NEWS b/NEWS index 627a8cd14..82fe29c2f 100644 --- a/NEWS +++ b/NEWS @@ -43,6 +43,12 @@ Changes in 1.8.6 (since 1.8.5) ** New convenience function `scm_c_symbol_length ()' +** Single stepping through code from Emacs + +When you use GDS to evaluate Scheme code from Emacs, you can now use +`C-u' to indicate that you want to single step through that code. See +`Evaluating Scheme Code' in the manual for more details. + * Bugs fixed ** Internal `scm_i_' functions now have "hidden" linkage with GCC/ELF diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index 5812d656c..e4ae0b1ae 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,8 @@ +2008-07-17 Neil Jerram + + * scheme-using.texi (Evaluating Scheme Code): Document use of + `C-u' prefix with evaluation commands. + 2008-07-05 Ludovic Courtès * api-data.texi (Symbol Primitives): Add `scm_c_symbol_length ()'. diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi index 092fb4e39..96273b7d0 100644 --- a/doc/ref/scheme-using.texi +++ b/doc/ref/scheme-using.texi @@ -988,6 +988,14 @@ region contains a balanced expression, or try to expand the region so that it does; it uses the region exactly as it is. @end table +If you type @kbd{C-u} before one of these commands, GDS will +immediately pop up a Scheme stack buffer, showing the requested +evaluation, so that you can single step through it. (This is achieved +by setting a @code{} trap at the start of the requested +evaluation; see @ref{Source Traps} for more on how those work.) The +Scheme stack display, and the options for continuing through the code, +are described in the next two sections. + @node Displaying the Scheme Stack @subsection Displaying the Scheme Stack diff --git a/emacs/ChangeLog b/emacs/ChangeLog index 5a4365ff5..fb9d78999 100644 --- a/emacs/ChangeLog +++ b/emacs/ChangeLog @@ -1,3 +1,9 @@ +2008-07-17 Neil Jerram + + * gds-scheme.el (gds-eval-region, gds-eval-expression) + (gds-eval-defun, gds-eval-last-sexp): Support `C-u' prefix, + meaning that user wants to single step through the code. + 2007-02-06 Clinton Ebadi * gds-scheme.el (gds-display-results): Use save-selected-window diff --git a/emacs/gds-scheme.el b/emacs/gds-scheme.el index a03a07ba5..db0e6cd41 100755 --- a/emacs/gds-scheme.el +++ b/emacs/gds-scheme.el @@ -279,9 +279,12 @@ region's code." (setq line (count-lines (point-min) (point)))) (cons line column))) -(defun gds-eval-region (start end) - "Evaluate the current region." - (interactive "r") +(defun gds-eval-region (start end &optional debugp) + "Evaluate the current region. If invoked with `C-u' prefix (or, in +a program, with optional DEBUGP arg non-nil), pause and pop up the +stack at the start of the evaluation, so that the user can single-step +through the code." + (interactive "r\nP") (or gds-client (gds-auto-associate-buffer) (call-interactively 'gds-associate-buffer)) @@ -289,24 +292,29 @@ region's code." (port-name (gds-port-name start end)) (lc (gds-line-and-column start))) (let ((code (buffer-substring-no-properties start end))) - (gds-send (format "eval (region . %S) %s %S %d %d %S" + (gds-send (format "eval (region . %S) %s %S %d %d %S %s" (gds-abbreviated code) (if module (prin1-to-string module) "#f") port-name (car lc) (cdr lc) - code) + code + (if debugp '(debug) '(none))) gds-client)))) -(defun gds-eval-expression (expr &optional correlator) - "Evaluate the supplied EXPR (a string)." - (interactive "sEvaluate expression: \nP") +(defun gds-eval-expression (expr &optional correlator debugp) + "Evaluate the supplied EXPR (a string). If invoked with `C-u' +prefix (or, in a program, with optional DEBUGP arg non-nil), pause and +pop up the stack at the start of the evaluation, so that the user can +single-step through the code." + (interactive "sEvaluate expression: \ni\nP") (or gds-client (gds-auto-associate-buffer) (call-interactively 'gds-associate-buffer)) (set-text-properties 0 (length expr) nil expr) - (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S" + (gds-send (format "eval (%S . %S) #f \"Emacs expression\" 0 0 %S %s" (or correlator 'expression) (gds-abbreviated expr) - expr) + expr + (if debugp '(debug) '(none))) gds-client)) (defconst gds-abbreviated-length 35) @@ -325,19 +333,25 @@ region's code." (concat (substring code 0 (- gds-abbreviated-length 3)) "...") code)) -(defun gds-eval-defun () - "Evaluate the defun (top-level form) at point." - (interactive) +(defun gds-eval-defun (&optional debugp) + "Evaluate the defun (top-level form) at point. If invoked with +`C-u' prefix (or, in a program, with optional DEBUGP arg non-nil), +pause and pop up the stack at the start of the evaluation, so that the +user can single-step through the code." + (interactive "P") (save-excursion (end-of-defun) (let ((end (point))) (beginning-of-defun) - (gds-eval-region (point) end)))) + (gds-eval-region (point) end debugp)))) -(defun gds-eval-last-sexp () - "Evaluate the sexp before point." - (interactive) - (gds-eval-region (save-excursion (backward-sexp) (point)) (point))) +(defun gds-eval-last-sexp (&optional debugp) + "Evaluate the sexp before point. If invoked with `C-u' prefix (or, +in a program, with optional DEBUGP arg non-nil), pause and pop up the +stack at the start of the evaluation, so that the user can single-step +through the code." + (interactive "P") + (gds-eval-region (save-excursion (backward-sexp) (point)) (point) debugp)) ;;;; Help. diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index a399dc69b..9007c0044 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,8 @@ +2008-07-17 Neil Jerram + + * gds-client.scm (handle-nondebug-protocol): Add support for + setting a trap on code that is about to be evaluated. + 2008-04-14 Neil Jerram * gds-client.scm (gds-debug-trap): Ensure that frame index passed diff --git a/ice-9/gds-client.scm b/ice-9/gds-client.scm index 903e803e5..d3d6146e9 100755 --- a/ice-9/gds-client.scm +++ b/ice-9/gds-client.scm @@ -354,7 +354,7 @@ Thanks!\n\n" ((eval) (set! last-lazy-trap-context #f) - (apply (lambda (correlator module port-name line column code) + (apply (lambda (correlator module port-name line column code flags) (with-input-from-string code (lambda () (set-port-filename! (current-input-port) port-name) @@ -384,6 +384,11 @@ Thanks!\n\n" ;; it to the list. (begin (for-each-breakpoint setup-after-read x) + (if (and (pair? x) + (memq 'debug flags)) + (install-trap (make + #:expression x + #:behaviour gds-debug-trap))) (loop (cons x exprs) (read)))))) (lambda (key . args) (write-form `(eval-results From 76dae881582bf316967e21d3bdf44e3ead7d69f7 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Sun, 3 Aug 2008 00:18:33 +0100 Subject: [PATCH 64/87] Fix misleading output from `(help rationalize)' * numbers.c (scm_rationalize): Update docstring to match the manual (which is more correct). Change argument "err" to "eps", also to match the manual. --- NEWS | 1 + libguile/ChangeLog | 6 ++++++ libguile/numbers.c | 20 +++++++++++++++----- 3 files changed, 22 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 82fe29c2f..514d67ce8 100644 --- a/NEWS +++ b/NEWS @@ -60,6 +60,7 @@ application code. ** Fix build issue on Tru64 and ia64-hp-hpux11.23 (`SCM_UNPACK' macro) ** Fix build issue on mips, mipsel, powerpc and ia64 (stack direction) ** Fix build issue on hppa2.0w-hp-hpux11.11 (`dirent64' and `readdir64_r') +** Fix misleading output from `(help rationalize)' Changes in 1.8.5 (since 1.8.4) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index fd867c6d5..b4d3f87b1 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2008-08-02 Neil Jerram + + * numbers.c (scm_rationalize): Update docstring to match the + manual (which is more correct). Change argument "err" to "eps", + also to match the manual. + 2008-07-17 Neil Jerram From Thiemo Seufer : diff --git a/libguile/numbers.c b/libguile/numbers.c index 4a458c4a1..fc57bf5c8 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -5599,8 +5599,18 @@ SCM_DEFINE (scm_inexact_to_exact, "inexact->exact", 1, 0, 0, #undef FUNC_NAME SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, - (SCM x, SCM err), - "Return an exact number that is within @var{err} of @var{x}.") + (SCM x, SCM eps), + "Returns the @emph{simplest} rational number differing\n" + "from @var{x} by no more than @var{eps}.\n" + "\n" + "As required by @acronym{R5RS}, @code{rationalize} only returns an\n" + "exact result when both its arguments are exact. Thus, you might need\n" + "to use @code{inexact->exact} on the arguments.\n" + "\n" + "@lisp\n" + "(rationalize (inexact->exact 1.2) 1/100)\n" + "@result{} 6/5\n" + "@end lisp") #define FUNC_NAME s_scm_rationalize { if (SCM_I_INUMP (x)) @@ -5632,7 +5642,7 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, converges after less than a dozen iterations. */ - err = scm_abs (err); + eps = scm_abs (eps); while (++i < 1000000) { a = scm_sum (scm_product (a1, tt), a2); /* a = a1*tt + a2 */ @@ -5640,11 +5650,11 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, if (scm_is_false (scm_zero_p (b)) && /* b != 0 */ scm_is_false (scm_gr_p (scm_abs (scm_difference (ex, scm_divide (a, b))), - err))) /* abs(x-a/b) <= err */ + eps))) /* abs(x-a/b) <= eps */ { SCM res = scm_sum (int_part, scm_divide (a, b)); if (scm_is_false (scm_exact_p (x)) - || scm_is_false (scm_exact_p (err))) + || scm_is_false (scm_exact_p (eps))) return scm_exact_to_inexact (res); else return res; From 5ea8e76e85c04757bc0d114f45637a37395ca7f1 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 7 Aug 2008 23:24:31 +0200 Subject: [PATCH 65/87] Fix build failure on Debian hppa architecture (bad stack growth detection) * configure.in (SCM_I_GSC_STACK_GROWS_UP): Remove use of AC_CACHE_CHECK, which was inadvertently causing SCM_I_GSC_STACK_GROWS_UP _always_ to be 0. --- ChangeLog | 6 ++++++ NEWS | 1 + configure.in | 6 ++---- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/ChangeLog b/ChangeLog index cad6adb32..b58755cbb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2008-08-07 Neil Jerram + + * configure.in (SCM_I_GSC_STACK_GROWS_UP): Remove use of + AC_CACHE_CHECK, which was inadvertently causing + SCM_I_GSC_STACK_GROWS_UP _always_ to be 0. + 2008-07-17 Neil Jerram * configure.in: Update stack direction test to be like that in diff --git a/NEWS b/NEWS index 514d67ce8..fb5712a1e 100644 --- a/NEWS +++ b/NEWS @@ -61,6 +61,7 @@ application code. ** Fix build issue on mips, mipsel, powerpc and ia64 (stack direction) ** Fix build issue on hppa2.0w-hp-hpux11.11 (`dirent64' and `readdir64_r') ** Fix misleading output from `(help rationalize)' +** Fix build failure on Debian hppa architecture (bad stack growth detection) Changes in 1.8.5 (since 1.8.4) diff --git a/configure.in b/configure.in index eabc82491..ede0d15c1 100644 --- a/configure.in +++ b/configure.in @@ -1153,9 +1153,7 @@ GUILE_STRUCT_UTIMBUF #-------------------------------------------------------------------- SCM_I_GSC_STACK_GROWS_UP=0 -AC_CACHE_CHECK([stack direction], - [SCM_I_GSC_STACK_GROWS_UP], -[AC_RUN_IFELSE([AC_LANG_SOURCE( +AC_RUN_IFELSE([AC_LANG_SOURCE( [AC_INCLUDES_DEFAULT int find_stack_direction () @@ -1178,7 +1176,7 @@ main () }])], [SCM_I_GSC_STACK_GROWS_UP=1], [], - [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)])]) + [AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h)]) AC_CHECK_SIZEOF(float) if test "$ac_cv_sizeof_float" -le "$ac_cv_sizeof_long"; then From c95514b3b41c8e335ada863f8abb99cc4af9abe1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 14 Aug 2008 00:15:03 +0200 Subject: [PATCH 66/87] Remove the now useless `qthreads.m4'. --- guile-config/qthreads.m4 | 165 --------------------------------------- 1 file changed, 165 deletions(-) delete mode 100644 guile-config/qthreads.m4 diff --git a/guile-config/qthreads.m4 b/guile-config/qthreads.m4 deleted file mode 100644 index 8aeba1748..000000000 --- a/guile-config/qthreads.m4 +++ /dev/null @@ -1,165 +0,0 @@ -dnl Autoconf macros for configuring the QuickThreads package -dnl Jim Blandy --- July 1998 -dnl -dnl Copyright (C) 1998, 1999, 2006 Free Software Foundation, Inc. -dnl -dnl This file is part of GUILE. -dnl -dnl GUILE is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as -dnl published by the Free Software Foundation; either version 2, or -dnl (at your option) any later version. -dnl -dnl GUILE is distributed in the hope that it will be useful, but -dnl WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -dnl GNU General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public -dnl License along with GUILE; see the file COPYING. If not, write -dnl to the Free Software Foundation, Inc., 51 Franklin Street, Fifth -dnl Floor, Boston, MA 02110-1301 USA - - - -dnl QTHREADS_CONFIGURE configures the QuickThreads package. The QT -dnl sources should be in $srcdir/qt. If configuration succeeds, this -dnl macro creates the appropriate symlinks in the qt object directory, -dnl and sets the following variables, used in building libqthreads.a: -dnl QTHREAD_LTLIBS --- set to libqthreads.la if configuration -dnl succeeds, or the empty string if configuration fails. -dnl qtmd_h, qtmds_s, qtmdc_c, qtdmdb_s --- the names of the machine- -dnl dependent source files. -dnl qthread_asflags --- flags to pass to the compiler when processing -dnl assembly-language files. -dnl -dnl It also sets the following variables, which describe how clients -dnl can link against libqthreads.a: -dnl THREAD_PACKAGE --- set to "QT" if configuration succeeds, or -dnl the empty string if configuration fails. -dnl THREAD_LIBS_LOCAL --- linker options for use in this source tree -dnl THREAD_LIBS_INSTALLED --- linker options for use after this package -dnl is installed -dnl It would be nice if all thread configuration packages for Guile -dnl followed the same conventions. -dnl -dnl All of the above variables will be substituted into Makefiles in -dnl the usual autoconf fashion. -dnl -dnl We distinguish between THREAD_LIBS_LOCAL and -dnl THREAD_LIBS_INSTALLED because the thread library might be in -dnl this tree, and be built using libtool. This means that: -dnl 1) when building other executables in this tree, one must -dnl pass the relative path to the ../libfoo.la file, but -dnl 2) once the whole package has been installed, users should -dnl link using -lfoo. -dnl Normally, we only care about the first case, but since the -dnl guile-config script needs to give users all the flags they need -dnl to link programs against guile, the GUILE_WITH_THREADS macro -dnl needs to supply the second piece of information as well. -dnl -dnl This whole thing is a little confused about what ought to be -dnl done in the top-level configure script, and what ought to be -dnl taken care of in the subdirectory. For example, qtmds_s and -dnl friends really ought not to be even mentioned in the top-level -dnl configure script, but here they are. - -AC_DEFUN([QTHREADS_CONFIGURE],[ - AC_REQUIRE([AC_PROG_LN_S]) - - AC_MSG_CHECKING(QuickThreads configuration) - - changequote(,)dnl We use [ and ] in a regexp in the case - - THREAD_PACKAGE=QT - qthread_asflags='' - case "$host" in - i[3456]86-*-*) - port_name=i386 - qtmd_h=md/i386.h - qtmds_s=md/i386.s - qtmdc_c=md/null.c - qtdmdb_s= - case "$host" in - *-*-netbsd* ) - ## NetBSD needs to be told to pass the assembly code through - ## the C preprocessor. Other GCC installations seem to do - ## this by default, but NetBSD's doesn't. We could get the - ## same effect by giving the file a name ending with .S - ## instead of .s, but I don't see how to tell automake to do - ## that. - qthread_asflags='-x assembler-with-cpp' - ;; - esac - ;; - mips-sgi-irix[56]*) - port_name=irix - qtmd_h=md/mips.h - qtmds_s=md/mips-irix5.s - qtmdc_c=md/null.c - qtdmdb_s=md/mips_b.s - ;; - mips-*-*) - port_name=mips - qtmd_h=md/mips.h - qtmds_s=md/mips.s - qtmdc_c=md/null.c - qtdmdb_s=md/mips_b.s - ;; - sparc-*-sunos*) - port_name=sparc-sunos - qtmd_h=md/sparc.h - qtmds_s=md/_sparc.s - qtmdc_c=md/null.c - qtdmdb_s=md/_sparc_b.s - ;; - sparc*-*-*) - port_name=sparc - qtmd_h=md/sparc.h - qtmds_s=md/sparc.s - qtmdc_c=md/null.c - qtdmdb_s=md/sparc_b.s - ;; - alpha*-*-*) - port_name=alpha - qtmd_h=md/axp.h - qtmds_s=md/axp.s - qtmdc_c=md/null.c - qtdmdb_s=md/axp_b.s - ;; - arm*-*-*) - port_name=arm - qtmd_h=md/arm.h - qtmds_s=md/arm.s - qtmdc_c=md/null.c - qtdmdb_s= - ;; - *) - echo "Unknown configuration; threads package disabled" - THREAD_PACKAGE="" - ;; - esac - changequote([, ]) - - # Did configuration succeed? - if test -n "$THREAD_PACKAGE"; then - AC_MSG_RESULT($port_name) - QTHREAD_LTLIBS=libqthreads.la - THREAD_LIBS_LOCAL="../qt/libqthreads.la" - THREAD_LIBS_INSTALLED="-lqthreads" - else - AC_MSG_RESULT(none; disabled) - fi - - AC_SUBST(QTHREAD_LTLIBS) - AC_SUBST(qtmd_h) - AC_SUBST(qtmds_s) - AC_SUBST(qtmdc_c) - AC_SUBST(qtdmdb_s) - AC_SUBST(qthread_asflags) - AC_SUBST(THREAD_PACKAGE) - AC_SUBST(THREAD_LIBS_LOCAL) - AC_SUBST(THREAD_LIBS_INSTALLED) -]) - -dnl qthreads.m4 ends here From 2072309c1c39cf193687cd895348d2f817537a3e Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 14 Aug 2008 01:51:24 -0300 Subject: [PATCH 67/87] Whitespace and formatting fixes. Conflicts: libguile/gc-freelist.c libguile/gc-segment.c libguile/gc.h --- libguile/gc-freelist.c | 12 ++---------- libguile/gc-segment.c | 19 ++++++------------- libguile/gc.c | 1 - libguile/private-gc.h | 15 --------------- 4 files changed, 8 insertions(+), 39 deletions(-) diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c index 83c20f867..ff939e0ae 100644 --- a/libguile/gc-freelist.c +++ b/libguile/gc-freelist.c @@ -26,9 +26,6 @@ scm_t_cell_type_statistics scm_i_master_freelist; scm_t_cell_type_statistics scm_i_master_freelist2; - - - /* In older versions of GUILE GC there was extensive support for @@ -38,8 +35,6 @@ the list. Mark bits are now separate, and checking for sane cell access can be done much more easily by simply checking if the mark bit is unset before allocation. --hwn - - */ #if (SCM_ENABLE_DEPRECATED == 1) @@ -69,9 +64,6 @@ SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1 #endif /* defined (GUILE_DEBUG) */ #endif /* deprecated */ - - - /* Adjust FREELIST variables to decide wether or not to allocate more heap in the next GC run based on SWEEP_STATS on SWEEP_STATS_1 (statistics collected after the two last full GC). */ @@ -156,7 +148,6 @@ scm_gc_init_freelist (void) if (scm_max_segment_size <= 0) scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE; - scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist); scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2); @@ -188,5 +179,6 @@ scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist) int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist) { - return SCM_MAX (freelist->collected,freelist->collected_1) < freelist->min_yield; + return SCM_MAX (freelist->collected, freelist->collected_1) + < freelist->min_yield; } diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index b26f1bd56..5c674de19 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -24,10 +24,6 @@ #include "libguile/gc.h" #include "libguile/private-gc.h" - - - - size_t scm_max_segment_size; scm_t_heap_segment * @@ -63,8 +59,6 @@ scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab) } } - - /* Fill SEGMENT with memory both for data and mark bits. @@ -387,9 +381,6 @@ scm_i_all_segments_statistics (SCM tab) return tab; } - - - /* Determine whether the given value does actually represent a cell in some heap segment. If this is the case, the number of the heap @@ -494,13 +485,14 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, float min_cells = (f * h - sweep_stats.collected) / (1.0 - f); /* Make heap grow with factor 1.5 */ - len = freelist->heap_size / 2; + len = freelist->heap_size / 2; #ifdef DEBUGINFO fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells); #endif - + if (len < min_cells) - len = (unsigned long) min_cells; + len = (unsigned long) min_cells; + len *= sizeof (scm_t_cell); /* force new sampling */ freelist->collected = LONG_MAX; @@ -508,6 +500,7 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, if (len > scm_max_segment_size) len = scm_max_segment_size; + if (len < SCM_MIN_HEAP_SEG_SIZE) len = SCM_MIN_HEAP_SEG_SIZE; @@ -541,7 +534,7 @@ scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *free if (init_heap_size < 1) { - init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1; + init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1; } if (scm_i_initialize_heap_segment_data (seg, init_heap_size)) diff --git a/libguile/gc.c b/libguile/gc.c index 2139e6a54..46d6b51e5 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -543,7 +543,6 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells) /* out of fresh cells. Try to get some new ones. */ - did_gc = 1; scm_i_gc ("cells"); diff --git a/libguile/private-gc.h b/libguile/private-gc.h index ce60cbba3..7180f2b0b 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -73,12 +73,9 @@ #define SCM_DEFAULT_MAX_SEGMENT_SIZE (20*1024*1024L) - - #define SCM_MIN_HEAP_SEG_SIZE (8 * SCM_GC_SIZEOF_CARD) #define SCM_HEAP_SEG_SIZE (16384L * sizeof (scm_t_cell)) - #define SCM_DOUBLECELL_ALIGNED_P(x) (((2 * sizeof (scm_t_cell) - 1) & SCM_UNPACK (x)) == 0) @@ -101,7 +98,6 @@ typedef enum { return_on_error, abort_on_error } policy_on_error; A struct holding GC statistics on a particular type of cells. */ typedef struct scm_t_cell_type_statistics { - /* heap segment where the last cell was allocated */ @@ -195,25 +191,17 @@ int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist); /* gc-mark */ - - void scm_mark_all (void); - - /* gc-segment: */ - - - /* Cells are stored in a heap-segment: it is a contiguous chunk of memory, that associated with one freelist. */ - typedef struct scm_t_heap_segment { /* @@ -255,12 +243,10 @@ typedef struct scm_t_heap_segment /* - A table of segment records is kept that records the upper and lower extents of the segment; this is used during the conservative phase of gc to identify probably gc roots (because they point into valid segments at reasonable offsets). - */ extern scm_t_heap_segment ** scm_i_heap_segment_table; extern size_t scm_i_heap_segment_table_size; @@ -309,7 +295,6 @@ SCM_INTERNAL void scm_i_make_initial_segment (int init_heap_size, extern long int scm_i_deprecated_memory_return; - /* global init funcs. */ From 01621bf62ec16cb62260f0b7c9e926793718fd6d Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 14 Aug 2008 02:16:41 -0300 Subject: [PATCH 68/87] Include min-yields in gc-stats output. --- libguile/gc.c | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/libguile/gc.c b/libguile/gc.c index 46d6b51e5..78cd4b50b 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -246,6 +246,8 @@ SCM_SYMBOL (sym_cells_marked, "cells-marked"); SCM_SYMBOL (sym_cells_swept, "cells-swept"); SCM_SYMBOL (sym_malloc_yield, "malloc-yield"); SCM_SYMBOL (sym_cell_yield, "cell-yield"); +SCM_SYMBOL (sym_min_cell_yield, "min-cell-yield"); +SCM_SYMBOL (sym_min_double_cell_yield, "min-double-cell-yield"); SCM_SYMBOL (sym_protected_objects, "protected-objects"); SCM_SYMBOL (sym_total_cells_allocated, "total-cells-allocated"); @@ -316,6 +318,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, unsigned long int local_scm_gc_times; unsigned long int local_scm_gc_mark_time_taken; unsigned long int local_protected_obj_count; + unsigned long int local_min_cell_yield; + unsigned long int local_min_double_cell_yield; double local_scm_gc_cells_swept; double local_scm_gc_cells_marked; double local_scm_total_cells_allocated; @@ -327,8 +331,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, /* temporarily store the numbers, so as not to cause GC. */ - - bounds = malloc (sizeof (unsigned long) * table_size * 2); + bounds = malloc (sizeof (unsigned long) * table_size * 2); if (!bounds) abort(); for (i = table_size; i--; ) @@ -346,6 +349,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, local_scm_heap_size = SCM_HEAP_SIZE; local_scm_cells_allocated = scm_cells_allocated; + local_min_cell_yield = scm_i_master_freelist.min_yield; + local_min_double_cell_yield = scm_i_master_freelist2.min_yield; local_scm_gc_time_taken = scm_gc_time_taken; local_scm_gc_mark_time_taken = scm_gc_mark_time_taken; @@ -398,8 +403,11 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_from_long (local_scm_gc_cell_yield_percentage)), scm_cons (sym_protected_objects, scm_from_ulong (local_protected_obj_count)), + scm_cons (sym_min_cell_yield, + scm_from_ulong (local_min_cell_yield)), + scm_cons (sym_min_double_cell_yield, + scm_from_ulong (local_min_double_cell_yield)), scm_cons (sym_heap_segments, heap_segs), - SCM_UNDEFINED); SCM_CRITICAL_SECTION_END; From 51ef99f7fa9fb766fbb48619fc5863ab9914591d Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 02:18:51 -0300 Subject: [PATCH 69/87] Fix memory corruption issue with hell[] array: realloc/calloc need to factor in sizeof(scm_t_bits) --- libguile/goops.c | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/libguile/goops.c b/libguile/goops.c index abb96abce..cc610fa9c 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -25,6 +25,7 @@ */ #include +#include #include "libguile/_scm.h" #include "libguile/alist.h" @@ -1705,11 +1706,10 @@ go_to_hell (void *o) { SCM obj = SCM_PACK ((scm_t_bits) o); scm_lock_mutex (hell_mutex); - if (n_hell == hell_size) + if (n_hell >= hell_size) { - long new_size = 2 * hell_size; - hell = scm_realloc (hell, new_size); - hell_size = new_size; + hell_size *= 2; + hell = scm_realloc (hell, hell_size * sizeof(scm_t_bits)); } hell[n_hell++] = SCM_STRUCT_DATA (obj); scm_unlock_mutex (hell_mutex); @@ -2995,7 +2995,7 @@ scm_init_goops_builtins (void) list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method)); - hell = scm_malloc (hell_size); + hell = scm_calloc (hell_size * sizeof(scm_t_bits)); hell_mutex = scm_permanent_object (scm_make_mutex ()); create_basic_classes (); From b61b5d0ebea924ee4b3930b2cba72e282d4751c7 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 12:28:19 -0300 Subject: [PATCH 70/87] Do not include private-gc.h in srfi-60. --- srfi/srfi-60.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/srfi/srfi-60.c b/srfi/srfi-60.c index f631c6447..b90306a8e 100644 --- a/srfi/srfi-60.c +++ b/srfi/srfi-60.c @@ -18,7 +18,6 @@ */ #include -#include "libguile/private-gc.h" /* for SCM_MIN */ #include "srfi-60.h" @@ -332,7 +331,9 @@ SCM_DEFINE (scm_srfi60_integer_to_list, "integer->list", 1, 1, 0, long nn = SCM_I_INUM (n); for (i = 0; i < ll; i++) { - unsigned long shift = SCM_MIN (i, (unsigned long) SCM_LONG_BIT-1); + unsigned long shift = + (i < ((unsigned long) SCM_LONG_BIT-1)) + ? i : ((unsigned long) SCM_LONG_BIT-1); int bit = (nn >> shift) & 1; ret = scm_cons (scm_from_bool (bit), ret); } From 569aa529d5379f3c942fa6eb01e8a1ad48ba9f77 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 02:58:17 -0300 Subject: [PATCH 71/87] Use word_2 to store mark bits for freeing structs and vtables in the correct order. This ensures that we only use GC Marks during the actual GC Mark. --- libguile/struct.c | 10 +++++----- libguile/struct.h | 9 +++++++++ 2 files changed, 14 insertions(+), 5 deletions(-) diff --git a/libguile/struct.c b/libguile/struct.c index 2d36303b4..ad88ac844 100644 --- a/libguile/struct.c +++ b/libguile/struct.c @@ -364,7 +364,7 @@ scm_free_structs (void *dummy1 SCM_UNUSED, { SCM vtable = SCM_STRUCT_VTABLE (chain); if (SCM_STRUCT_GC_CHAIN (vtable) != 0 && vtable != chain) - SCM_SET_GC_MARK (vtable); + SCM_SET_STRUCT_MARK (vtable); chain = SCM_STRUCT_GC_CHAIN (chain); } /* Free unmarked structs. */ @@ -374,9 +374,9 @@ scm_free_structs (void *dummy1 SCM_UNUSED, { SCM obj = chain; chain = SCM_STRUCT_GC_CHAIN (chain); - if (SCM_GC_MARK_P (obj)) + if (SCM_STRUCT_MARK_P (obj)) { - SCM_CLEAR_GC_MARK (obj); + SCM_CLEAR_STRUCT_MARK (obj); SCM_SET_STRUCT_GC_CHAIN (obj, newchain); newchain = obj; } @@ -897,8 +897,8 @@ scm_struct_prehistory () { scm_i_structs_to_free = SCM_EOL; scm_c_hook_add (&scm_before_sweep_c_hook, scm_struct_gc_init, 0, 0); - /* With the new lazy sweep GC, the point at which the entire heap is - swept is just before the mark phase. */ + /* With lazy sweep GC, the point at which the entire heap is swept + is just before the mark phase. */ scm_c_hook_add (&scm_before_mark_c_hook, scm_free_structs, 0, 0); } diff --git a/libguile/struct.h b/libguile/struct.h index f00a8d844..10c0d65c3 100644 --- a/libguile/struct.h +++ b/libguile/struct.h @@ -79,6 +79,15 @@ SCM_API SCM scm_struct_table; #define SCM_STRUCT_GC_CHAIN(X) SCM_CELL_OBJECT_3 (X) #define SCM_SET_STRUCT_GC_CHAIN(X, Y) SCM_SET_CELL_OBJECT_3 (X, Y) + +/* For clearing structs. We can't use the regular GC mark bits, as + meddling with them at random times would mess up the invariants of + the garbage collector. + */ +#define SCM_STRUCT_MARK_P(X) SCM_CELL_WORD_2 (X) +#define SCM_SET_STRUCT_MARK(X) SCM_SET_CELL_WORD_2 (X, 0x1) +#define SCM_CLEAR_STRUCT_MARK(X) SCM_SET_CELL_WORD_2 (X, 0x0) + SCM_INTERNAL SCM scm_i_structs_to_free; From e89b7b36259edb20f60efc0e3e11fa83e5b35b89 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 02:58:36 -0300 Subject: [PATCH 72/87] Remove unused macro UNMARKED_CELL_P() --- libguile/hashtab.c | 2 -- 1 file changed, 2 deletions(-) diff --git a/libguile/hashtab.c b/libguile/hashtab.c index 85e4bb0ab..2d28d65b7 100644 --- a/libguile/hashtab.c +++ b/libguile/hashtab.c @@ -215,8 +215,6 @@ hashtable_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED) return 1; } -#define UNMARKED_CELL_P(x) (SCM_NIMP(x) && !SCM_GC_MARK_P (x)) - /* keep track of hash tables that need to shrink after scan */ static SCM to_rehash = SCM_EOL; From d09752ffd17688b33a1e828cf4c11f66b86c3c3c Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 11:57:27 -0300 Subject: [PATCH 73/87] Introduce scm_i_marking to detect when GC mark bits are touched outside of marking stage. --- libguile/gc-mark.c | 10 ++++++++-- libguile/gc.h | 2 ++ libguile/private-gc.h | 5 +++++ 3 files changed, 15 insertions(+), 2 deletions(-) diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 77f3ec2af..9fcf205ad 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -73,6 +73,7 @@ scm_mark_all (void) long j; int loops; + scm_i_marking = 1; scm_i_init_weak_vectors_for_gc (); scm_i_init_guardians_for_gc (); @@ -139,8 +140,6 @@ scm_mark_all (void) break; } - /* fprintf (stderr, "%d loops\n", loops); */ - /* Remove all unmarked entries from the weak vectors. */ scm_i_remove_weaks_from_weak_vectors (); @@ -148,6 +147,7 @@ scm_mark_all (void) /* Bring hashtables upto date. */ scm_i_scan_weak_hashtables (); + scm_i_marking = 0; } /* {Mark/Sweep} @@ -169,6 +169,12 @@ scm_gc_mark (SCM ptr) scm_gc_mark_dependencies (ptr); } +void +ensure_marking (void) +{ + assert (scm_i_marking); +} + /* Mark the dependencies of an object. diff --git a/libguile/gc.h b/libguile/gc.h index 05412bccf..939f80071 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -155,6 +155,8 @@ typedef unsigned long scm_t_c_bvec_long; /* testing and changing GC marks */ #define SCM_GC_MARK_P(x) SCM_GC_CELL_GET_BIT (x) + +void ensure_marking(void); #define SCM_SET_GC_MARK(x) SCM_GC_CELL_SET_BIT (x) #define SCM_CLEAR_GC_MARK(x) SCM_GC_CELL_CLEAR_BIT (x) diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 7180f2b0b..26e980cb2 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -191,6 +191,11 @@ int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist); /* gc-mark */ + +/* this can be used to ensure that set/clear gc marks only happen when + allowed. */ +int scm_i_marking; + void scm_mark_all (void); /* From b474ac33ee0e47ab14306c218cb060667f9af2db Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 13:27:17 -0300 Subject: [PATCH 74/87] Remove comments about removed variables. --- libguile/private-gc.h | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 26e980cb2..744bc8372 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -32,18 +32,6 @@ * 64 bit machine. The units of the _SIZE parameters are bytes. * Cons pairs and object headers occupy one heap cell. * - * SCM_INIT_HEAP_SIZE is the initial size of heap. If this much heap is - * allocated initially the heap will grow by half its current size - * each subsequent time more heap is needed. - * - * If SCM_INIT_HEAP_SIZE heap cannot be allocated initially, SCM_HEAP_SEG_SIZE - * will be used, and the heap will grow by SCM_HEAP_SEG_SIZE when more - * heap is needed. SCM_HEAP_SEG_SIZE must fit into type size_t. This code - * is in scm_init_storage() and alloc_some_heap() in sys.c - * - * If SCM_INIT_HEAP_SIZE can be allocated initially, the heap will grow by - * SCM_EXPHEAP(scm_heap_size) when more heap is needed. - * * SCM_MIN_HEAP_SEG_SIZE is minimum size of heap to accept when more heap * is needed. */ From 82ae1b8eb3413e6be6bd2aa032986fc7782e85ac Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 13:57:23 -0300 Subject: [PATCH 75/87] Garbage collection cleanup. * New file gc-segment-table.c: hold code for the segment table. * Remove data that might be out of date; remove scm_i_adjust_min_yield(). We don't store min_yields, since they are only accurate at one point in time (when the sweep finishes). We decide the min yield at that point from min_yield_fraction and freelist->collected / freelist->swept * Introduce scm_i_gc_heap_size_delta() replacing scm_i_gc_grow_heap_p(). * Remove foo_1 fields containing penultimate results. * After GC, count mark bit vector to discover number of live objects. This simplifies hairy updates. * Many formatting and layout cleanups. * Fix in scm_i_sweep_card(): return the length of free_list returned, rather than number of deleted objects. * For mtrigger GCs: do not also run a full sweep after the gc() call, as this is inconsistent with lazy sweeping. * Remove scm_i_make_initial_segment(). * Use calloc in scm_i_make_empty_heap_segment() to save on initialization code. * New function scm_i_sweep_for_freelist() which sweeps, with proper statistic variable updates. * New segments are conceptually blocks with 100% reclaimable cells. * Remove some useless constants/comments: SCM_HEAP_SIZE, SCM_INIT_HEAP_SIZE, SCM_EXPHEAP, SCM_HEAP_SEG_SIZE * Do not increment scm_cells_allocated() from the scm_[double]cell(). This would be a race condition. * Move some deprecation checks in separate functions to not distract from main code flow. --- libguile/Makefile.am | 8 +- libguile/gc-card.c | 111 +++--- libguile/gc-freelist.c | 150 ++++---- libguile/gc-malloc.c | 24 +- libguile/gc-mark.c | 8 +- libguile/gc-segment-table.c | 293 +++++++++++++++ libguile/gc-segment.c | 685 +++++++++++------------------------- libguile/gc.c | 287 +++++++-------- libguile/gc.h | 2 - libguile/inline.h | 10 - libguile/private-gc.h | 92 +++-- 11 files changed, 817 insertions(+), 853 deletions(-) create mode 100644 libguile/gc-segment-table.c diff --git a/libguile/Makefile.am b/libguile/Makefile.am index 6acdf1faf..a68ebbaa2 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -108,7 +108,7 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ deprecated.c discouraged.c dynwind.c eq.c error.c \ eval.c evalext.c extensions.c feature.c fluids.c fports.c \ futures.c gc.c gc-mark.c gc-segment.c gc-malloc.c gc-card.c \ - gc-freelist.c gc_os_dep.c gdbint.c gettext.c \ + gc-freelist.c gc_os_dep.c gdbint.c gettext.c gc-segment-table.c \ gh_data.c gh_eval.c gh_funcs.c \ gh_init.c gh_io.c gh_list.c gh_predicates.c goops.c gsubr.c \ guardians.c hash.c hashtab.c hooks.c init.c inline.c \ @@ -135,7 +135,7 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \ dynl.x dynwind.x eq.x error.x eval.x evalext.x \ extensions.x feature.x fluids.x fports.x futures.x gc.x gc-mark.x \ gc-segment.x gc-malloc.x gc-card.x gettext.x goops.x \ - gsubr.x guardians.x \ + gsubr.x guardians.x gc-segment-table.x \ hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x \ list.x load.x macros.x mallocs.x modules.x numbers.x objects.x \ objprop.x options.x pairs.x ports.x print.x procprop.x procs.x \ @@ -152,8 +152,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \ deprecated.doc discouraged.doc dynl.doc dynwind.doc \ eq.doc error.doc eval.doc evalext.doc \ extensions.doc feature.doc fluids.doc fports.doc futures.doc \ - gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \ - gc-malloc.doc gc-card.doc gettext.doc \ + gc.doc goops.doc gsubr.doc gc-mark.doc gc-segment.doc \ + gc-malloc.doc gc-card.doc gettext.doc gc-segment-table.doc \ guardians.doc hash.doc hashtab.doc \ hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc \ list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc \ diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 7fa1c7cb3..2a22fc544 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -15,31 +15,31 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ - +#include #include #include #include "libguile/_scm.h" -#include "libguile/eval.h" -#include "libguile/numbers.h" -#include "libguile/stime.h" -#include "libguile/stackchk.h" -#include "libguile/struct.h" -#include "libguile/smob.h" -#include "libguile/unif.h" #include "libguile/async.h" +#include "libguile/deprecation.h" +#include "libguile/eval.h" +#include "libguile/gc.h" +#include "libguile/hashtab.h" +#include "libguile/numbers.h" #include "libguile/ports.h" +#include "libguile/private-gc.h" #include "libguile/root.h" +#include "libguile/smob.h" +#include "libguile/srfi-4.h" +#include "libguile/stackchk.h" +#include "libguile/stime.h" #include "libguile/strings.h" +#include "libguile/struct.h" +#include "libguile/tags.h" +#include "libguile/unif.h" +#include "libguile/validate.h" #include "libguile/vectors.h" #include "libguile/weaks.h" -#include "libguile/hashtab.h" -#include "libguile/tags.h" -#include "libguile/private-gc.h" -#include "libguile/validate.h" -#include "libguile/deprecation.h" -#include "libguile/gc.h" -#include "libguile/srfi-4.h" #include "libguile/private-gc.h" @@ -50,27 +50,23 @@ long int scm_i_deprecated_memory_return; */ SCM scm_i_structs_to_free; - /* Init all the free cells in CARD, prepending to *FREE_LIST. - Return: number of free cells found in this card. + Return: FREE_COUNT, the number of cells collected. This is + typically the length of the *FREE_LIST, but for some special cases, + we do not actually free the cell. To make the numbers match up, we + do increase the FREE_COUNT. It would be cleaner to have a separate function sweep_value(), but that is too slow (functions with switch statements can't be inlined). - - - NOTE: - This function is quite efficient. However, for many types of cells, - allocation and a de-allocation involves calling malloc() and - free(). - - This is costly for small objects (due to malloc/free overhead.) - (should measure this). + For many types of cells, allocation and a de-allocation involves + calling malloc() and free(). This is costly for small objects (due + to malloc/free overhead.) (should measure this). It might also be bad for threads: if several threads are allocating strings concurrently, then mallocs for both threads may have to @@ -82,15 +78,16 @@ SCM scm_i_structs_to_free; --hwn. */ int -scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) +scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg) #define FUNC_NAME "sweep_card" { - scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p); - scm_t_cell * end = p + SCM_GC_CARD_N_CELLS; + scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(card); + scm_t_cell *end = card + SCM_GC_CARD_N_CELLS; + scm_t_cell *p = card; int span = seg->span; - int offset =SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); - int free_count = 0; - + int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); + int free_count = 0; + /* I tried something fancy with shifting by one bit every word from the bitvec in turn, but it wasn't any faster, but quite a bit @@ -101,7 +98,7 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) SCM scmptr = PTR2SCM (p); if (SCM_C_BVEC_GET (bitvec, offset)) continue; - + free_count++; switch (SCM_TYP7 (scmptr)) { case scm_tcs_struct: @@ -184,7 +181,7 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) /* Keep "revealed" ports alive. */ if (scm_revealed_count (scmptr) > 0) continue; - + /* Yes, I really do mean scm_ptobs[k].free */ /* rather than ftobs[k].close. .close */ /* is for explicit CLOSE-PORT by user */ @@ -214,7 +211,6 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) switch SCM_TYP16 (scmptr) { case scm_tc_free_cell: - free_count --; break; default: { @@ -258,9 +254,8 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell); SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list)); *free_list = scmptr; - free_count ++; } - + return free_count; } #undef FUNC_NAME @@ -270,17 +265,17 @@ scm_i_sweep_card (scm_t_cell * p, SCM *free_list, scm_t_heap_segment*seg) Like sweep, but no complicated logic to do the sweeping. */ int -scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list, - scm_t_heap_segment*seg) +scm_i_init_card_freelist (scm_t_cell *card, SCM *free_list, + scm_t_heap_segment *seg) { int span = seg->span; scm_t_cell *end = card + SCM_GC_CARD_N_CELLS; scm_t_cell *p = end - span; - - scm_t_c_bvec_long * bvec_ptr = (scm_t_c_bvec_long* ) seg->bounds[1]; + int collected = 0; + scm_t_c_bvec_long *bvec_ptr = (scm_t_c_bvec_long*) seg->bounds[1]; int idx = (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; - bvec_ptr += idx *SCM_GC_CARD_BVEC_SIZE_IN_LONGS; + bvec_ptr += idx * SCM_GC_CARD_BVEC_SIZE_IN_LONGS; SCM_GC_SET_CELL_BVEC (card, bvec_ptr); /* @@ -292,11 +287,41 @@ scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list, SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell); SCM_SET_FREE_CELL_CDR (scmptr, PTR2SCM (*free_list)); *free_list = scmptr; + collected ++; } - return SCM_GC_CARD_N_CELLS - SCM_MAX(span, SCM_GC_CARD_N_HEADER_CELLS); + return collected; } +/* + Classic MIT Hack, see e.g. http://www.tekpool.com/?cat=9 + */ +int scm_i_uint_bit_count(unsigned int u) +{ + unsigned int u_count = u + - ((u >> 1) & 033333333333) + - ((u >> 2) & 011111111111); + return + ((u_count + (u_count >> 3)) + & 030707070707) % 63; +} + +/* + Amount of cells marked in this cell, measured in 1-cells. + */ +int +scm_i_card_marked_count (scm_t_cell *card, int span) +{ + scm_t_c_bvec_long* bvec = SCM_GC_CARD_BVEC (card); + scm_t_c_bvec_long* bvec_end = (bvec + SCM_GC_CARD_BVEC_SIZE_IN_LONGS); + + int count = 0; + while (bvec < bvec_end) { + count += scm_i_uint_bit_count(*bvec); + bvec ++; + } + return count * span; +} void scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg) diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c index ff939e0ae..491512055 100644 --- a/libguile/gc-freelist.c +++ b/libguile/gc-freelist.c @@ -64,75 +64,53 @@ SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1 #endif /* defined (GUILE_DEBUG) */ #endif /* deprecated */ -/* Adjust FREELIST variables to decide wether or not to allocate more heap in - the next GC run based on SWEEP_STATS on SWEEP_STATS_1 (statistics - collected after the two last full GC). */ -void -scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist, - scm_t_sweep_statistics sweep_stats, - scm_t_sweep_statistics sweep_stats_1) -{ - /* min yield is adjusted upwards so that next predicted total yield - * (allocated cells actually freed by GC) becomes - * `min_yield_fraction' of total heap size. Note, however, that - * the absolute value of min_yield will correspond to `collected' - * on one master (the one which currently is triggering GC). - * - * The reason why we look at total yield instead of cells collected - * on one list is that we want to take other freelists into account. - * On this freelist, we know that (local) yield = collected cells, - * but that's probably not the case on the other lists. - * - * (We might consider computing a better prediction, for example - * by computing an average over multiple GC:s.) - */ - if (freelist->min_yield_fraction) - { - /* Pick largest of last two yields. */ - long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100) - - (long) SCM_MAX (sweep_stats.collected, - sweep_stats_1.collected)); -#ifdef DEBUGINFO - fprintf (stderr, " after GC = %lu, delta = %ld\n", - (unsigned long) scm_cells_allocated, - (long) delta); -#endif - if (delta > 0) - freelist->min_yield += delta; - } -} - - static void scm_init_freelist (scm_t_cell_type_statistics *freelist, - int span, - int min_yield) + int span, + int min_yield_percentage) { - if (min_yield < 1) - min_yield = 1; - if (min_yield > 99) - min_yield = 99; + if (min_yield_percentage < 1) + min_yield_percentage = 1; + if (min_yield_percentage > 99) + min_yield_percentage = 99; freelist->heap_segment_idx = -1; - freelist->min_yield = 0; - freelist->min_yield_fraction = min_yield; + freelist->min_yield_fraction = min_yield_percentage / 100.0; freelist->span = span; + freelist->swept = 0; freelist->collected = 0; - freelist->collected_1 = 0; - freelist->heap_size = 0; + freelist->heap_total_cells = 0; } #if (SCM_ENABLE_DEPRECATED == 1) - size_t scm_default_init_heap_size_1; - int scm_default_min_yield_1; - size_t scm_default_init_heap_size_2; - int scm_default_min_yield_2; - size_t scm_default_max_segment_size; +size_t scm_default_init_heap_size_1; +int scm_default_min_yield_1; +size_t scm_default_init_heap_size_2; +int scm_default_min_yield_2; +size_t scm_default_max_segment_size; + +static void +check_deprecated_heap_vars (void) { + if (scm_default_init_heap_size_1 || + scm_default_min_yield_1|| + scm_default_init_heap_size_2|| + scm_default_min_yield_2|| + scm_default_max_segment_size) + { + scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead."); + } +} +#else +static void check_deprecated_heap_vars (void) { } #endif void scm_gc_init_freelist (void) { + const char *error_message = + "Could not allocate initial heap of %uld.\n" + "Try adjusting GUILE_INIT_SEGMENT_SIZE_%d\n"; + int init_heap_size_1 = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1); int init_heap_size_2 @@ -147,38 +125,62 @@ scm_gc_init_freelist (void) if (scm_max_segment_size <= 0) scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE; - - scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist); - scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2); - -#if (SCM_ENABLE_DEPRECATED == 1) - if ( scm_default_init_heap_size_1 || - scm_default_min_yield_1|| - scm_default_init_heap_size_2|| - scm_default_min_yield_2|| - scm_default_max_segment_size) - { - scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead."); - } -#endif + + if (scm_i_get_new_heap_segment (&scm_i_master_freelist, + init_heap_size_1, return_on_error) == -1) { + fprintf (stderr, error_message, init_heap_size_1, 1); + abort(); + } + if (scm_i_get_new_heap_segment (&scm_i_master_freelist2, + init_heap_size_2, return_on_error) == -1) { + fprintf (stderr, error_message, init_heap_size_2, 2); + abort(); + } + + check_deprecated_heap_vars(); } + void scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist) { - freelist->collected_1 = freelist->collected; freelist->collected = 0; - + freelist->swept = 0; /* at the end we simply start with the lowest segment again. */ freelist->heap_segment_idx = -1; } -int -scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist) + +/* + Returns how many more cells we should allocate according to our + policy. May return negative if we don't need to allocate more. + + + The new yield should at least equal gc fraction of new heap size, i.e. + + c + dh > f * (h + dh) + + c : collected + f : min yield fraction + h : heap size + dh : size of new heap segment + + this gives dh > (f * h - c) / (1 - f). +*/ +float +scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist) { - return SCM_MAX (freelist->collected, freelist->collected_1) - < freelist->min_yield; + float f = freelist->min_yield_fraction; + float collected = freelist->collected; + float swept = freelist->swept; + float delta = ((f * swept - collected) / (1.0 - f)); + + assert(freelist->heap_total_cells >= freelist->collected); + assert(freelist->swept == freelist->heap_total_cells); + assert(swept >= collected); + + return delta; } diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index dd98ad74a..2dc9f0fc1 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -84,8 +84,8 @@ scm_gc_init_malloc (void) { scm_mtrigger = scm_getenv_int ("GUILE_INIT_MALLOC_LIMIT", SCM_DEFAULT_INIT_MALLOC_LIMIT); - scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC", - SCM_DEFAULT_MALLOC_MINYIELD); + scm_i_minyield_malloc = scm_getenv_int ("GUILE_MIN_YIELD_MALLOC", + SCM_DEFAULT_MALLOC_MINYIELD); if (scm_i_minyield_malloc >= 100) scm_i_minyield_malloc = 99; @@ -105,7 +105,6 @@ void * scm_realloc (void *mem, size_t size) { void *ptr; - scm_t_sweep_statistics sweep_stats; SCM_SYSCALL (ptr = realloc (mem, size)); if (ptr) @@ -114,7 +113,9 @@ scm_realloc (void *mem, size_t size) scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex); scm_gc_running_p = 1; - scm_i_sweep_all_segments ("realloc", &sweep_stats); + // We don't want these sweep statistics to influence results for + // cell GC, so we don't collect statistics. + scm_i_sweep_all_segments ("realloc", NULL); SCM_SYSCALL (ptr = realloc (mem, size)); if (ptr) @@ -125,7 +126,7 @@ scm_realloc (void *mem, size_t size) } scm_i_gc ("realloc"); - scm_i_sweep_all_segments ("realloc", &sweep_stats); + scm_i_sweep_all_segments ("realloc", NULL); scm_gc_running_p = 0; scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex); @@ -231,19 +232,22 @@ increase_mtrigger (size_t size, const char *what) { unsigned long prev_alloced; float yield; - scm_t_sweep_statistics sweep_stats; scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex); scm_gc_running_p = 1; - prev_alloced = mallocated; + prev_alloced = mallocated; + + /* The GC will finish the pending sweep. For that reason, we + don't execute a complete sweep after GC, although that might + free some more memory. + */ scm_i_gc (what); - scm_i_sweep_all_segments ("mtrigger", &sweep_stats); yield = (((float) prev_alloced - (float) scm_mallocated) / (float) prev_alloced); - scm_gc_malloc_yield_percentage = (int) (100 * yield); + scm_gc_malloc_yield_percentage = (int) (100 * yield); #ifdef DEBUGINFO fprintf (stderr, "prev %lud , now %lud, yield %4.2lf, want %d", @@ -271,7 +275,7 @@ increase_mtrigger (size_t size, const char *what) if (no_overflow_trigger >= (float) ULONG_MAX) scm_mtrigger = ULONG_MAX; else - scm_mtrigger = (unsigned long) no_overflow_trigger; + scm_mtrigger = (unsigned long) no_overflow_trigger; #ifdef DEBUGINFO fprintf (stderr, "Mtrigger sweep: ineffective. New trigger %d\n", diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 9fcf205ad..d8f1ecec2 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -183,7 +183,7 @@ Prefetching: Should prefetch objects before marking, i.e. if marking a cell, we should prefetch the car, and then mark the cdr. This will improve CPU -cache misses, because the car is more likely to be in core when we +cache misses, because the car is more likely to be in cache when we finish the cdr. See http://www.hpl.hp.com/techreports/2000/HPL-2000-99.pdf, reducing @@ -415,10 +415,8 @@ scm_gc_mark_dependencies (SCM p) } } - if (SCM_GC_MARK_P (ptr)) - { + if (SCM_GC_MARK_P (ptr)) return; - } SCM_SET_GC_MARK (ptr); @@ -428,8 +426,6 @@ scm_gc_mark_dependencies (SCM p) #undef FUNC_NAME - - /* Mark a region conservatively */ void scm_mark_locations (SCM_STACKITEM x[], unsigned long n) diff --git a/libguile/gc-segment-table.c b/libguile/gc-segment-table.c new file mode 100644 index 000000000..d627e9c1f --- /dev/null +++ b/libguile/gc-segment-table.c @@ -0,0 +1,293 @@ +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 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 as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + */ + +#include +#include +#include + +#include "libguile/_scm.h" +#include "libguile/pairs.h" +#include "libguile/gc.h" +#include "libguile/private-gc.h" + + +/* + Heap segment table. + + The table is sorted by the address of the data itself. This makes + for easy lookups. This is not portable: according to ANSI C, + pointers can only be compared within the same object (i.e. the same + block of malloced memory.). For machines with weird architectures, + this should be revised. + + (Apparently, for this reason 1.6 and earlier had macros for pointer + comparison. ) + + perhaps it is worthwhile to remove the 2nd level of indirection in + the table, but this certainly makes for cleaner code. +*/ +scm_t_heap_segment **scm_i_heap_segment_table; +size_t scm_i_heap_segment_table_size; +static scm_t_cell *lowest_cell; +static scm_t_cell *highest_cell; + + +/* + RETURN: index of inserted segment. + */ +int +scm_i_insert_segment (scm_t_heap_segment *seg) +{ + size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *); + SCM_SYSCALL(scm_i_heap_segment_table + = ((scm_t_heap_segment **) + realloc ((char *)scm_i_heap_segment_table, size))); + + /* + We can't alloc 4 more bytes. This is hopeless. + */ + if (!scm_i_heap_segment_table) + { + fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n"); + abort (); + } + + if (!lowest_cell) + { + lowest_cell = seg->bounds[0]; + highest_cell = seg->bounds[1]; + } + else + { + lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]); + highest_cell = SCM_MAX (highest_cell, seg->bounds[1]); + } + + + { + int i = 0; + int j = 0; + + while (i < scm_i_heap_segment_table_size + && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0]) + i++; + + /* + We insert a new entry; if that happens to be before the + "current" segment of a freelist, we must move the freelist index + as well. + */ + if (scm_i_master_freelist.heap_segment_idx >= i) + scm_i_master_freelist.heap_segment_idx ++; + if (scm_i_master_freelist2.heap_segment_idx >= i) + scm_i_master_freelist2.heap_segment_idx ++; + + for (j = scm_i_heap_segment_table_size; j > i; --j) + scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1]; + + scm_i_heap_segment_table[i] = seg; + scm_i_heap_segment_table_size ++; + + return i; + } +} + + +/* + Determine whether the given value does actually represent a cell in + some heap segment. If this is the case, the number of the heap + segment is returned. Otherwise, -1 is returned. Binary search is + used to determine the heap segment that contains the cell. + + I think this function is too long to be inlined. --hwn +*/ +int +scm_i_find_heap_segment_containing_object (SCM obj) +{ + if (!CELL_P (obj)) + return -1; + + if ((scm_t_cell *) obj < lowest_cell || (scm_t_cell *) obj >= highest_cell) + return -1; + + { + scm_t_cell *ptr = SCM2PTR (obj); + unsigned int i = 0; + unsigned int j = scm_i_heap_segment_table_size - 1; + + if (ptr < scm_i_heap_segment_table[i]->bounds[0]) + return -1; + else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) + return -1; + else + { + while (i < j) + { + if (ptr < scm_i_heap_segment_table[i]->bounds[1]) + { + break; + } + else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr) + { + i = j; + break; + } + else + { + unsigned long int k = (i + j) / 2; + + if (k == i) + return -1; + else if (ptr < scm_i_heap_segment_table[k]->bounds[1]) + { + j = k; + ++i; + if (ptr < scm_i_heap_segment_table[i]->bounds[0]) + return -1; + } + else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr) + { + i = k; + --j; + if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) + return -1; + } + } + } + + if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2) + return -1; + else if (SCM_GC_IN_CARD_HEADERP (ptr)) + return -1; + else + return i; + } + } +} + + +int +scm_i_marked_count (void) +{ + int i = 0; + int c = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + c += scm_i_heap_segment_marked_count (scm_i_heap_segment_table[i]); + } + return c; +} + + +SCM +scm_i_sweep_some_segments (scm_t_cell_type_statistics *freelist, + scm_t_sweep_statistics *sweep_stats) +{ + int i = freelist->heap_segment_idx; + SCM collected = SCM_EOL; + + if (i == -1) /* huh? --hwn */ + i++; + + for (; + i < scm_i_heap_segment_table_size; i++) + { + if (scm_i_heap_segment_table[i]->freelist != freelist) + continue; + + collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i], + sweep_stats, + DEFAULT_SWEEP_AMOUNT); + + if (collected != SCM_EOL) /* Don't increment i */ + break; + } + + freelist->heap_segment_idx = i; + + return collected; +} + +void +scm_i_reset_segments (void) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_t_heap_segment *seg = scm_i_heap_segment_table[i]; + seg->next_free_card = seg->bounds[0]; + } +} + + + + +/* + Return a hashtab with counts of live objects, with tags as keys. + */ +SCM +scm_i_all_segments_statistics (SCM tab) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_t_heap_segment *seg = scm_i_heap_segment_table[i]; + scm_i_heap_segment_statistics (seg, tab); + } + + return tab; +} + + +unsigned long* +scm_i_segment_table_info(int* size) +{ + *size = scm_i_heap_segment_table_size; + unsigned long *bounds = malloc (sizeof (unsigned long) * *size * 2); + int i; + if (!bounds) + abort(); + for (i = *size; i-- > 0; ) + { + bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0]; + bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1]; + } + return bounds; +} + + +void +scm_i_sweep_all_segments (char const *reason, + scm_t_sweep_statistics *sweep_stats) +{ + unsigned i= 0; + for (i = 0; i < scm_i_heap_segment_table_size; i++) + { + scm_i_sweep_segment (scm_i_heap_segment_table[i], sweep_stats); + } +} + + +void +scm_i_clear_mark_space (void) +{ + int i = 0; + for (; i < scm_i_heap_segment_table_size; i++) + { + scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]); + } +} diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 5c674de19..16b5ce613 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -26,478 +26,18 @@ size_t scm_max_segment_size; -scm_t_heap_segment * -scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl) -{ - scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment)); - - if (!shs) - { - fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n"); - abort (); - } - - shs->bounds[0] = NULL; - shs->bounds[1] = NULL; - shs->malloced = NULL; - shs->span = fl->span; - shs->freelist = fl; - shs->next_free_card = NULL; - - return shs; -} - - -void -scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab) -{ - scm_t_cell *p = seg->bounds[0]; - while (p < seg->bounds[1]) - { - scm_i_card_statistics (p, tab, seg); - p += SCM_GC_CARD_N_CELLS; - } -} - -/* - Fill SEGMENT with memory both for data and mark bits. - - RETURN: 1 on success, 0 failure - */ -int -scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested) -{ - /* - round upwards - */ - int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); - int card_count =1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count; - - /* - one card extra due to alignment - */ - size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD - + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG - ; - scm_t_c_bvec_long * bvec_ptr = 0; - scm_t_cell * memory = 0; - - /* - We use calloc to alloc the heap. On GNU libc this is - equivalent to mmapping /dev/zero - */ - SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed)); - - if (memory == NULL) - return 0; - - segment->malloced = memory; - segment->bounds[0] = SCM_GC_CARD_UP (memory); - segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS; - - segment->freelist->heap_size += scm_i_segment_cell_count (segment); - - bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1]; - - /* - Don't init the mem or the bitvector. This is handled by lazy - sweeping. - */ - - segment->next_free_card = segment->bounds[0]; - segment->first_time = 1; - return 1; -} - -int -scm_i_segment_card_count (scm_t_heap_segment * seg) -{ - return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; -} - -/* - Return the number of available single-cell data cells. - */ -int -scm_i_segment_cell_count (scm_t_heap_segment * seg) -{ - return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) - + ((seg->span == 2) ? -1 : 0); -} - -void -scm_i_clear_segment_mark_space (scm_t_heap_segment *seg) -{ - scm_t_cell * markspace = seg->bounds[1]; - - memset (markspace, 0x00, - scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG); -} - -/* Sweep cards from SEG until we've gathered THRESHOLD cells. On return, - SWEEP_STATS contains the number of cells that have been visited and - collected. A freelist is returned, potentially empty. */ -SCM -scm_i_sweep_some_cards (scm_t_heap_segment *seg, - scm_t_sweep_statistics *sweep_stats) -{ - SCM cells = SCM_EOL; - int threshold = 512; - int collected = 0; - int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment* ) - = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card; - - scm_t_cell * next_free = seg->next_free_card; - int cards_swept = 0; - - while (collected < threshold && next_free < seg->bounds[1]) - { - collected += (*sweeper) (next_free, &cells, seg); - next_free += SCM_GC_CARD_N_CELLS; - cards_swept ++; - } - - sweep_stats->swept = cards_swept * seg->span - * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); - - if (!seg->first_time) - { - /* scm_cells_allocated -= collected * seg->span; */ - sweep_stats->collected = collected * seg->span; - } - else - sweep_stats->collected = 0; - - seg->freelist->collected += collected * seg->span; - - if(next_free == seg->bounds[1]) - { - seg->first_time = 0; - } - - seg->next_free_card = next_free; - return cells; -} - - -/* - Force a sweep of this entire segment. This doesn't modify sweep - statistics, it just frees the memory pointed to by to-be-swept - cells. - - Implementation is slightly ugh. - - FIXME: if you do scm_i_sweep_segment(), and then allocate from this - segment again, the statistics are off. - */ -void -scm_i_sweep_segment (scm_t_heap_segment *seg, - scm_t_sweep_statistics *sweep_stats) -{ - scm_t_sweep_statistics sweep; - scm_t_cell * p = seg->next_free_card; - - scm_i_sweep_statistics_init (sweep_stats); - - scm_i_sweep_statistics_init (&sweep); - while (scm_i_sweep_some_cards (seg, &sweep) != SCM_EOL) - { - scm_i_sweep_statistics_sum (sweep_stats, sweep); - scm_i_sweep_statistics_init (&sweep); - } - - seg->next_free_card =p; -} - -void -scm_i_sweep_all_segments (char const *reason, - scm_t_sweep_statistics *sweep_stats) -{ - unsigned i= 0; - - scm_i_sweep_statistics_init (sweep_stats); - for (i = 0; i < scm_i_heap_segment_table_size; i++) - { - scm_t_sweep_statistics sweep; - - scm_i_sweep_segment (scm_i_heap_segment_table[i], &sweep); - scm_i_sweep_statistics_sum (sweep_stats, sweep); - } -} - - -/* - Heap segment table. - - The table is sorted by the address of the data itself. This makes - for easy lookups. This is not portable: according to ANSI C, - pointers can only be compared within the same object (i.e. the same - block of malloced memory.). For machines with weird architectures, - this should be revised. - - (Apparently, for this reason 1.6 and earlier had macros for pointer - comparison. ) - - perhaps it is worthwhile to remove the 2nd level of indirection in - the table, but this certainly makes for cleaner code. -*/ -scm_t_heap_segment ** scm_i_heap_segment_table; -size_t scm_i_heap_segment_table_size; -scm_t_cell *lowest_cell; -scm_t_cell *highest_cell; - - -void -scm_i_clear_mark_space (void) -{ - int i = 0; - for (; i < scm_i_heap_segment_table_size; i++) - { - scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]); - } -} - - -/* - RETURN: index of inserted segment. - */ -int -scm_i_insert_segment (scm_t_heap_segment * seg) -{ - size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *); - SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **) - realloc ((char *)scm_i_heap_segment_table, size))); - - /* - We can't alloc 4 more bytes. This is hopeless. - */ - if (!scm_i_heap_segment_table) - { - fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n"); - abort (); - } - - if (!lowest_cell) - { - lowest_cell = seg->bounds[0]; - highest_cell = seg->bounds[1]; - } - else - { - lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]); - highest_cell = SCM_MAX (highest_cell, seg->bounds[1]); - } - - - { - int i = 0; - int j = 0; - - while (i < scm_i_heap_segment_table_size - && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0]) - i++; - - /* - We insert a new entry; if that happens to be before the - "current" segment of a freelist, we must move the freelist index - as well. - */ - if (scm_i_master_freelist.heap_segment_idx >= i) - scm_i_master_freelist.heap_segment_idx ++; - if (scm_i_master_freelist2.heap_segment_idx >= i) - scm_i_master_freelist2.heap_segment_idx ++; - - for (j = scm_i_heap_segment_table_size; j > i; --j) - scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1]; - - scm_i_heap_segment_table [i] = seg; - scm_i_heap_segment_table_size ++; - - return i; - } -} - -SCM -scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl, - scm_t_sweep_statistics *sweep_stats) -{ - int i = fl->heap_segment_idx; - SCM collected = SCM_EOL; - - scm_i_sweep_statistics_init (sweep_stats); - if (i == -1) - i++; - - for (; - i < scm_i_heap_segment_table_size; i++) - { - scm_t_sweep_statistics sweep; - - if (scm_i_heap_segment_table[i]->freelist != fl) - continue; - - scm_i_sweep_statistics_init (&sweep); - collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i], - &sweep); - - scm_i_sweep_statistics_sum (sweep_stats, sweep); - - if (collected != SCM_EOL) /* Don't increment i */ - break; - } - - fl->heap_segment_idx = i; - - return collected; -} - - -void -scm_i_reset_segments (void) -{ - int i = 0; - for (; i < scm_i_heap_segment_table_size; i++) - { - scm_t_heap_segment * seg = scm_i_heap_segment_table[i]; - seg->next_free_card = seg->bounds[0]; - } -} - -/* - Return a hashtab with counts of live objects, with tags as keys. - */ - - -SCM -scm_i_all_segments_statistics (SCM tab) -{ - int i = 0; - for (; i < scm_i_heap_segment_table_size; i++) - { - scm_t_heap_segment * seg = scm_i_heap_segment_table[i]; - scm_i_heap_segment_statistics (seg, tab); - } - - return tab; -} - -/* - Determine whether the given value does actually represent a cell in - some heap segment. If this is the case, the number of the heap - segment is returned. Otherwise, -1 is returned. Binary search is - used to determine the heap segment that contains the cell. - - - I think this function is too long to be inlined. --hwn -*/ -long int -scm_i_find_heap_segment_containing_object (SCM obj) -{ - if (!CELL_P (obj)) - return -1; - - if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell) - return -1; - - - { - scm_t_cell * ptr = SCM2PTR (obj); - unsigned long int i = 0; - unsigned long int j = scm_i_heap_segment_table_size - 1; - - if (ptr < scm_i_heap_segment_table[i]->bounds[0]) - return -1; - else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) - return -1; - else - { - while (i < j) - { - if (ptr < scm_i_heap_segment_table[i]->bounds[1]) - { - break; - } - else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr) - { - i = j; - break; - } - else - { - unsigned long int k = (i + j) / 2; - - if (k == i) - return -1; - else if (ptr < scm_i_heap_segment_table[k]->bounds[1]) - { - j = k; - ++i; - if (ptr < scm_i_heap_segment_table[i]->bounds[0]) - return -1; - } - else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr) - { - i = k; - --j; - if (scm_i_heap_segment_table[j]->bounds[1] <= ptr) - return -1; - } - } - } - - if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2) - return -1; - else if (SCM_GC_IN_CARD_HEADERP (ptr)) - return -1; - else - return i; - } - } -} - - /* Important entry point: try to grab some memory, and make it into a segment; return the index of the segment. SWEEP_STATS should contain - global GC sweep statistics collected since the last full GC. */ + global GC sweep statistics collected since the last full GC. + + Returns the index of the segment. If error_policy != + abort_on_error, we return -1 on failure. +*/ int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, - scm_t_sweep_statistics sweep_stats, + size_t len, policy_on_error error_policy) { - size_t len; - - { - /* Assure that the new segment is predicted to be large enough. - * - * New yield should at least equal GC fraction of new heap size, i.e. - * - * y + dh > f * (h + dh) - * - * y : yield - * f : min yield fraction - * h : heap size - * dh : size of new heap segment - * - * This gives dh > (f * h - y) / (1 - f) - */ - float f = freelist->min_yield_fraction / 100.0; - float h = SCM_HEAP_SIZE; - float min_cells = (f * h - sweep_stats.collected) / (1.0 - f); - - /* Make heap grow with factor 1.5 */ - len = freelist->heap_size / 2; -#ifdef DEBUGINFO - fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells); -#endif - - if (len < min_cells) - len = (unsigned long) min_cells; - - len *= sizeof (scm_t_cell); - /* force new sampling */ - freelist->collected = LONG_MAX; - } - if (len > scm_max_segment_size) len = scm_max_segment_size; @@ -505,15 +45,13 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, len = SCM_MIN_HEAP_SEG_SIZE; { - scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); + scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist); /* Allocate with decaying ambition. */ while (len >= SCM_MIN_HEAP_SEG_SIZE) { if (scm_i_initialize_heap_segment_data (seg, len)) - { - return scm_i_insert_segment (seg); - } + return scm_i_insert_segment (seg); len /= 2; } @@ -527,30 +65,207 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, return -1; } -void -scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist) -{ - scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist); - if (init_heap_size < 1) +scm_t_heap_segment * +scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl) +{ + scm_t_heap_segment *shs = calloc (1, sizeof (scm_t_heap_segment)); + + if (!shs) { - init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1; + fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n"); + abort (); } - - if (scm_i_initialize_heap_segment_data (seg, init_heap_size)) + + shs->span = fl->span; + shs->freelist = fl; + + return shs; +} + +void +scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab) +{ + scm_t_cell *p = seg->bounds[0]; + while (p < seg->bounds[1]) { - freelist->heap_segment_idx = scm_i_insert_segment (seg); + scm_i_card_statistics (p, tab, seg); + p += SCM_GC_CARD_N_CELLS; } +} + +/* + count number of marked bits, so we know how much cells are live. + */ +int +scm_i_heap_segment_marked_count (scm_t_heap_segment *seg) +{ + scm_t_c_bvec_long *bvec = (scm_t_c_bvec_long *) seg->bounds[1]; + scm_t_c_bvec_long *bvec_end = + (bvec + + scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS); + + int count = 0; + while (bvec < bvec_end) { + count += scm_i_uint_bit_count(*bvec); + bvec ++; + } + return count * seg->span; +} + +int +scm_i_segment_card_number (scm_t_heap_segment *seg, + scm_t_cell *card) +{ + return (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; +} + +/* + Fill SEGMENT with memory both for data and mark bits. + + RETURN: 1 on success, 0 failure + */ +int +scm_i_initialize_heap_segment_data (scm_t_heap_segment *segment, size_t requested) +{ + /* + round upwards + */ + int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); + int card_count = 1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count; /* - Why the fuck try twice? --hwn + one card extra due to alignment + */ + size_t mem_needed = (1 + card_count) * SCM_GC_SIZEOF_CARD + + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG; + scm_t_cell *memory = 0; + + /* + We use calloc to alloc the heap, so it is nicely initialized. */ - if (!seg->malloced) + SCM_SYSCALL (memory = (scm_t_cell *) calloc (1, mem_needed)); + + if (memory == NULL) + return 0; + + segment->malloced = memory; + segment->bounds[0] = SCM_GC_CARD_UP (memory); + segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS; + segment->freelist->heap_total_cells += scm_i_segment_cell_count (segment); + + /* + Don't init the mem or the bitvector. This is handled by lazy + sweeping. + */ + segment->next_free_card = segment->bounds[0]; + segment->first_time = 1; + return 1; +} + +int +scm_i_segment_card_count (scm_t_heap_segment *seg) +{ + return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; +} + +/* + Return the number of available single-cell data cells. + */ +int +scm_i_segment_cell_count (scm_t_heap_segment *seg) +{ + return scm_i_segment_card_count (seg) + * scm_i_segment_cells_per_card (seg); +} + +int +scm_i_segment_cells_per_card (scm_t_heap_segment *seg) +{ + return (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS + + ((seg->span == 2) ? -1 : 0)); +} + +void +scm_i_clear_segment_mark_space (scm_t_heap_segment *seg) +{ + scm_t_cell *markspace = seg->bounds[1]; + + memset (markspace, 0x00, + scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG); +} + + +/* + Force a sweep of this entire segment. + */ +void +scm_i_sweep_segment (scm_t_heap_segment *seg, + scm_t_sweep_statistics *sweep_stats) +{ + int infinity = 1 << 30; + scm_t_cell *remember = seg->next_free_card; + while (scm_i_sweep_some_cards (seg, sweep_stats, infinity) != SCM_EOL) + ; + seg->next_free_card = remember; +} + + +/* Sweep cards from SEG until we've gathered THRESHOLD cells. On + return, SWEEP_STATS, if non-NULL, contains the number of cells that + have been visited and collected. A freelist is returned, + potentially empty. */ +SCM +scm_i_sweep_some_cards (scm_t_heap_segment *seg, + scm_t_sweep_statistics *sweep_stats, + int threshold) +{ + SCM cells = SCM_EOL; + int collected = 0; + int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment *) + = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card; + + scm_t_cell *next_free = seg->next_free_card; + int cards_swept = 0; + while (collected < threshold && next_free < seg->bounds[1]) { - scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE); + collected += (*sweeper) (next_free, &cells, seg); + next_free += SCM_GC_CARD_N_CELLS; + cards_swept ++; } - if (freelist->min_yield_fraction) - freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction - / 100); + if (sweep_stats != NULL) + { + int swept = cards_swept + * ((SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) + - seg->span + 1); + int collected_cells = collected * seg->span; + sweep_stats->swept += swept; + sweep_stats->collected += collected_cells; + } + + if (next_free == seg->bounds[1]) + { + seg->first_time = 0; + } + + seg->next_free_card = next_free; + return cells; } + + + +SCM +scm_i_sweep_for_freelist (scm_t_cell_type_statistics *freelist) +{ + scm_t_sweep_statistics stats = { 0 }; + SCM result = scm_i_sweep_some_segments (freelist, &stats); + + scm_i_gc_sweep_stats.collected += stats.collected; + scm_i_gc_sweep_stats.swept += stats.swept; + + freelist->collected += stats.collected; + freelist->swept += stats.swept; + return result; +} + diff --git a/libguile/gc.c b/libguile/gc.c index 78cd4b50b..8c0417cf9 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -212,8 +212,7 @@ unsigned long scm_last_cells_allocated = 0; unsigned long scm_mallocated = 0; /* Global GC sweep statistics since the last full GC. */ -static scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 }; -static scm_t_sweep_statistics scm_i_gc_sweep_stats_1 = { 0, 0 }; +scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 }; /* Total count of cells marked/swept. */ static double scm_gc_cells_marked_acc = 0.; @@ -221,7 +220,6 @@ static double scm_gc_cells_swept_acc = 0.; static double scm_gc_cells_allocated_acc = 0.; static unsigned long scm_gc_time_taken = 0; -static unsigned long t_before_gc; static unsigned long scm_gc_mark_time_taken = 0; static unsigned long scm_gc_times = 0; @@ -246,8 +244,6 @@ SCM_SYMBOL (sym_cells_marked, "cells-marked"); SCM_SYMBOL (sym_cells_swept, "cells-swept"); SCM_SYMBOL (sym_malloc_yield, "malloc-yield"); SCM_SYMBOL (sym_cell_yield, "cell-yield"); -SCM_SYMBOL (sym_min_cell_yield, "min-cell-yield"); -SCM_SYMBOL (sym_min_double_cell_yield, "min-double-cell-yield"); SCM_SYMBOL (sym_protected_objects, "protected-objects"); SCM_SYMBOL (sym_total_cells_allocated, "total-cells-allocated"); @@ -318,45 +314,32 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, unsigned long int local_scm_gc_times; unsigned long int local_scm_gc_mark_time_taken; unsigned long int local_protected_obj_count; - unsigned long int local_min_cell_yield; - unsigned long int local_min_double_cell_yield; double local_scm_gc_cells_swept; double local_scm_gc_cells_marked; double local_scm_total_cells_allocated; SCM answer; unsigned long *bounds = 0; - int table_size = scm_i_heap_segment_table_size; + int table_size = 0; SCM_CRITICAL_SECTION_START; - /* - temporarily store the numbers, so as not to cause GC. - */ - bounds = malloc (sizeof (unsigned long) * table_size * 2); - if (!bounds) - abort(); - for (i = table_size; i--; ) - { - bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0]; - bounds[2*i+1] = (unsigned long)scm_i_heap_segment_table[i]->bounds[1]; - } - + bounds = scm_i_segment_table_info (&table_size); /* Below, we cons to produce the resulting list. We want a snapshot of * the heap situation before consing. */ local_scm_mtrigger = scm_mtrigger; local_scm_mallocated = scm_mallocated; - local_scm_heap_size = SCM_HEAP_SIZE; + local_scm_heap_size = + (scm_i_master_freelist.heap_total_cells + scm_i_master_freelist2.heap_total_cells); - local_scm_cells_allocated = scm_cells_allocated; - local_min_cell_yield = scm_i_master_freelist.min_yield; - local_min_double_cell_yield = scm_i_master_freelist2.min_yield; + local_scm_cells_allocated = + scm_cells_allocated + scm_i_gc_sweep_stats.collected; local_scm_gc_time_taken = scm_gc_time_taken; local_scm_gc_mark_time_taken = scm_gc_mark_time_taken; local_scm_gc_times = scm_gc_times; local_scm_gc_malloc_yield_percentage = scm_gc_malloc_yield_percentage; - local_scm_gc_cell_yield_percentage= scm_gc_cell_yield_percentage; + local_scm_gc_cell_yield_percentage = scm_gc_cell_yield_percentage; local_protected_obj_count = protected_obj_count; local_scm_gc_cells_swept = (double) scm_gc_cells_swept_acc @@ -366,7 +349,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, -(double) scm_i_gc_sweep_stats.collected; local_scm_total_cells_allocated = scm_gc_cells_allocated_acc - + (double) (scm_cells_allocated - scm_last_cells_allocated); + + (double) scm_i_gc_sweep_stats.collected; for (i = table_size; i--;) { @@ -374,6 +357,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_from_ulong (bounds[2*i+1])), heap_segs); } + /* njrev: can any of these scm_cons's or scm_list_n signal a memory error? If so we need a frame here. */ answer = @@ -403,10 +387,6 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_from_long (local_scm_gc_cell_yield_percentage)), scm_cons (sym_protected_objects, scm_from_ulong (local_protected_obj_count)), - scm_cons (sym_min_cell_yield, - scm_from_ulong (local_min_cell_yield)), - scm_cons (sym_min_double_cell_yield, - scm_from_ulong (local_min_double_cell_yield)), scm_cons (sym_heap_segments, heap_segs), SCM_UNDEFINED); SCM_CRITICAL_SECTION_END; @@ -416,63 +396,26 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, } #undef FUNC_NAME -/* Update the global sweeping/collection statistics by adding SWEEP_STATS to - SCM_I_GC_SWEEP_STATS and updating related variables. */ -static inline void -gc_update_stats (scm_t_sweep_statistics sweep_stats) +/* + Update nice-to-know-statistics. + */ +static void +gc_end_stats () { /* CELLS SWEPT is another word for the number of cells that were examined during GC. YIELD is the number that we cleaned out. MARKED is the number that weren't cleaned. */ - - scm_gc_cell_yield_percentage = (sweep_stats.collected * 100) / SCM_HEAP_SIZE; - - scm_i_sweep_statistics_sum (&scm_i_gc_sweep_stats, sweep_stats); - - if ((scm_i_gc_sweep_stats.collected > scm_i_gc_sweep_stats.swept) - || (scm_cells_allocated < sweep_stats.collected)) - { - printf ("internal GC error, please report to `" - PACKAGE_BUGREPORT "'\n"); - abort (); - } + scm_gc_cell_yield_percentage = (scm_i_gc_sweep_stats.collected * 100) / + (scm_i_master_freelist.heap_total_cells + scm_i_master_freelist2.heap_total_cells); scm_gc_cells_allocated_acc += - (double) (scm_cells_allocated - scm_last_cells_allocated); - - scm_cells_allocated -= sweep_stats.collected; - scm_last_cells_allocated = scm_cells_allocated; -} - -static void -gc_start_stats (const char *what SCM_UNUSED) -{ - t_before_gc = scm_c_get_internal_run_time (); - - scm_gc_malloc_collected = 0; -} - -static void -gc_end_stats (scm_t_sweep_statistics sweep_stats) -{ - unsigned long t = scm_c_get_internal_run_time (); - - scm_gc_time_taken += (t - t_before_gc); - - /* Reset the number of cells swept/collected since the last full GC. */ - scm_i_gc_sweep_stats_1 = scm_i_gc_sweep_stats; - scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0; - - gc_update_stats (sweep_stats); - - scm_gc_cells_marked_acc += (double) scm_i_gc_sweep_stats.swept - - (double) scm_i_gc_sweep_stats.collected; + (double) scm_i_gc_sweep_stats.collected; + scm_gc_cells_marked_acc += (double) scm_cells_allocated; scm_gc_cells_swept_acc += (double) scm_i_gc_sweep_stats.swept; ++scm_gc_times; } - SCM_DEFINE (scm_object_address, "object-address", 1, 0, 0, (SCM obj), "Return an integer that for the lifetime of @var{obj} is uniquely\n" @@ -519,57 +462,50 @@ scm_gc_for_newcell (scm_t_cell_type_statistics *freelist, SCM *free_cells) { SCM cell; int did_gc = 0; - scm_t_sweep_statistics sweep_stats; scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex); scm_gc_running_p = 1; - - *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats); - gc_update_stats (sweep_stats); - - if (*free_cells == SCM_EOL && scm_i_gc_grow_heap_p (freelist)) + + *free_cells = scm_i_sweep_for_freelist (freelist); + if (*free_cells == SCM_EOL) { - freelist->heap_segment_idx = - scm_i_get_new_heap_segment (freelist, - scm_i_gc_sweep_stats, - abort_on_error); + float delta = scm_i_gc_heap_size_delta (freelist); + if (delta > 0.0) + { + size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell); + freelist->heap_segment_idx = + scm_i_get_new_heap_segment (freelist, bytes, abort_on_error); - *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats); - gc_update_stats (sweep_stats); + *free_cells = scm_i_sweep_for_freelist (freelist); + } } - + if (*free_cells == SCM_EOL) { - /* - with the advent of lazy sweep, GC yield is only known just - before doing the GC. - */ - scm_i_adjust_min_yield (freelist, - scm_i_gc_sweep_stats, - scm_i_gc_sweep_stats_1); - /* out of fresh cells. Try to get some new ones. */ + char reason[] = "0-cells"; + reason[0] += freelist->span; + did_gc = 1; - scm_i_gc ("cells"); + scm_i_gc (reason); - *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats); - gc_update_stats (sweep_stats); + *free_cells = scm_i_sweep_for_freelist (freelist); } if (*free_cells == SCM_EOL) { /* failed getting new cells. Get new juice or die. - */ + */ + float delta = scm_i_gc_heap_size_delta (freelist); + assert (delta > 0.0); + size_t bytes = ((unsigned long) delta) * sizeof (scm_t_cell); freelist->heap_segment_idx = - scm_i_get_new_heap_segment (freelist, - scm_i_gc_sweep_stats, - abort_on_error); + scm_i_get_new_heap_segment (freelist, bytes, abort_on_error); - *free_cells = scm_i_sweep_some_segments (freelist, &sweep_stats); - gc_update_stats (sweep_stats); + *free_cells = scm_i_sweep_for_freelist (freelist); } if (*free_cells == SCM_EOL) @@ -595,46 +531,9 @@ scm_t_c_hook scm_before_sweep_c_hook; scm_t_c_hook scm_after_sweep_c_hook; scm_t_c_hook scm_after_gc_c_hook; -/* Must be called while holding scm_i_sweep_mutex. - */ - -void -scm_i_gc (const char *what) +static void +scm_check_deprecated_memory_return() { - scm_t_sweep_statistics sweep_stats; - - scm_i_thread_put_to_sleep (); - - scm_c_hook_run (&scm_before_gc_c_hook, 0); - -#ifdef DEBUGINFO - fprintf (stderr,"gc reason %s\n", what); - - fprintf (stderr, - scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist)) - ? "*" - : (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m")); -#endif - - gc_start_stats (what); - - /* - Set freelists to NULL so scm_cons() always triggers gc, causing - the assertion above to fail. - */ - *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL; - *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL; - - /* - Let's finish the sweep. The conservative GC might point into the - garbage, and marking that would create a mess. - */ - scm_i_sweep_all_segments ("GC", &sweep_stats); - - /* Invariant: the number of cells collected (i.e., freed) must always be - lower than or equal to the number of cells "swept" (i.e., visited). */ - assert (sweep_stats.collected <= sweep_stats.swept); - if (scm_mallocated < scm_i_deprecated_memory_return) { /* The byte count of allocated objects has underflowed. This is @@ -649,14 +548,65 @@ scm_i_gc (const char *what) abort (); } scm_mallocated -= scm_i_deprecated_memory_return; + scm_i_deprecated_memory_return = 0; +} +/* Must be called while holding scm_i_sweep_mutex. + + This function is fairly long, but it touches various global + variables. To not obscure the side effects on global variables, + this function has not been split up. + */ +void +scm_i_gc (const char *what) +{ + unsigned long t_before_gc = 0; - /* Mark */ + scm_i_thread_put_to_sleep (); + + scm_c_hook_run (&scm_before_gc_c_hook, 0); +#ifdef DEBUGINFO + fprintf (stderr,"gc reason %s\n", what); + fprintf (stderr, + scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist)) + ? "*" + : (scm_is_null (*SCM_FREELIST_LOC (scm_i_freelist2)) ? "o" : "m")); +#endif + + t_before_gc = scm_c_get_internal_run_time (); + scm_gc_malloc_collected = 0; + + /* + Set freelists to NULL so scm_cons() always triggers gc, causing + the assertion above to fail. + */ + *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL; + *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL; + + /* + Let's finish the sweep. The conservative GC might point into the + garbage, and marking that would create a mess. + */ + scm_i_sweep_all_segments ("GC", &scm_i_gc_sweep_stats); + scm_check_deprecated_memory_return(); + + /* Sanity check our numbers. */ + assert (scm_cells_allocated == scm_i_marked_count ()); + assert (scm_i_gc_sweep_stats.swept + == (scm_i_master_freelist.heap_total_cells + + scm_i_master_freelist2.heap_total_cells)); + assert (scm_i_gc_sweep_stats.collected + scm_cells_allocated + == scm_i_gc_sweep_stats.swept); + + /* Mark */ scm_c_hook_run (&scm_before_mark_c_hook, 0); + scm_mark_all (); scm_gc_mark_time_taken += (scm_c_get_internal_run_time () - t_before_gc); + scm_cells_allocated = scm_i_marked_count (); + /* Sweep TODO: the after_sweep hook should probably be moved to just before @@ -682,15 +632,35 @@ scm_i_gc (const char *what) distinct classes of hook functions since this can prevent some bad interference when several modules adds gc hooks. */ - scm_c_hook_run (&scm_before_sweep_c_hook, 0); - scm_gc_sweep (); + + /* + Nothing here: lazy sweeping. + */ + scm_i_reset_segments (); + + *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL; + *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL; + + /* Invalidate the freelists of other threads. */ + scm_i_thread_invalidate_freelists (); + assert(scm_cells_allocated == scm_i_marked_count ()); + scm_c_hook_run (&scm_after_sweep_c_hook, 0); - gc_end_stats (sweep_stats); + gc_end_stats (); + assert(scm_cells_allocated == scm_i_marked_count ()); + scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0; + scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist); + scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2); + + /* Arguably, this statistic is fairly useless: marking will dominate + the time taken. + */ + scm_gc_time_taken += (scm_c_get_internal_run_time () - t_before_gc); + assert(scm_cells_allocated == scm_i_marked_count ()); scm_i_thread_wake_up (); - /* For debugging purposes, you could do scm_i_sweep_all_segments("debug"), but then the remains of the @@ -975,8 +945,6 @@ scm_init_storage () scm_gc_init_freelist(); scm_gc_init_malloc (); - j = SCM_HEAP_SEG_SIZE; - #if 0 /* We can't have a cleanup handler since we have no thread to run it in. */ @@ -1121,21 +1089,6 @@ void scm_gc_sweep (void) #define FUNC_NAME "scm_gc_sweep" { - scm_i_deprecated_memory_return = 0; - - scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist); - scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist2); - - /* - NOTHING HERE: LAZY SWEEPING ! - */ - scm_i_reset_segments (); - - *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL; - *SCM_FREELIST_LOC (scm_i_freelist2) = SCM_EOL; - - /* Invalidate the freelists of other threads. */ - scm_i_thread_invalidate_freelists (); } #undef FUNC_NAME diff --git a/libguile/gc.h b/libguile/gc.h index 939f80071..3bdc3cc3c 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -285,8 +285,6 @@ SCM_API int scm_gc_malloc_yield_percentage; SCM_API unsigned long scm_mallocated; SCM_API unsigned long scm_mtrigger; - - SCM_API SCM scm_after_gc_hook; SCM_API scm_t_c_hook scm_before_gc_c_hook; diff --git a/libguile/inline.h b/libguile/inline.h index 8fa9a8cfb..a9b3dc544 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -119,13 +119,6 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) *freelist = SCM_FREE_CELL_CDR (*freelist); } - /* - We update scm_cells_allocated from this function. If we don't - update this explicitly, we will have to walk a freelist somewhere - later on, which seems a lot more expensive. - */ - scm_cells_allocated += 1; - #if (SCM_DEBUG_CELL_ACCESSES == 1) if (scm_debug_cell_accesses_p) { @@ -152,7 +145,6 @@ scm_cell (scm_t_bits car, scm_t_bits cdr) threading. What if another thread is doing GC at this point ... ? */ - #endif @@ -190,8 +182,6 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, *freelist = SCM_FREE_CELL_CDR (*freelist); } - scm_cells_allocated += 2; - /* Initialize the type slot last so that the cell is ignored by the GC until it is completely initialized. This is only relevant when the GC can actually run during this code, which it can't diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 744bc8372..0e860b0ed 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -54,6 +54,12 @@ #define SCM_DEFAULT_MIN_YIELD_1 40 #define SCM_DEFAULT_INIT_HEAP_SIZE_2 32*1024 +/* + How many cells to collect during one sweep call. This is the pool + size of each thread. + */ +#define DEFAULT_SWEEP_AMOUNT 512 + /* The following value may seem large, but note that if we get to GC at * all, this means that we have a numerically intensive application */ @@ -72,18 +78,21 @@ #define SCM_GC_IN_CARD_HEADERP(x) \ (scm_t_cell *) (x) < SCM_GC_CELL_CARD (x) + SCM_GC_CARD_N_HEADER_CELLS - +int scm_i_uint_bit_count (unsigned int u); int scm_getenv_int (const char *var, int def); typedef enum { return_on_error, abort_on_error } policy_on_error; -/* gc-freelist*/ +/* gc-freelist */ /* FREELIST: A struct holding GC statistics on a particular type of cells. + + Counts in cells are mainly for heap statistics, and for + double-cells, they are still measured in single-cell units. */ typedef struct scm_t_cell_type_statistics { /* @@ -91,29 +100,22 @@ typedef struct scm_t_cell_type_statistics { */ int heap_segment_idx; - /* minimum yield on this list in order not to grow the heap + /* defines min_yield as fraction of total heap size */ - long min_yield; - - /* defines min_yield as percent of total heap size - */ - int min_yield_fraction; + float min_yield_fraction; /* number of cells per object on this list */ int span; - /* number of collected cells during last GC */ + /* number of collected cells during last GC. */ unsigned long collected; - /* number of collected cells during penultimate GC */ - unsigned long collected_1; - - /* total number of cells in heap segments - * belonging to this list. - */ - unsigned long heap_size; - + unsigned long swept; + /* + Total number of cells in heap segments belonging to this list. + */ + unsigned long heap_total_cells; } scm_t_cell_type_statistics; @@ -124,24 +126,11 @@ typedef struct scm_sweep_statistics unsigned swept; /* Number of cells collected during the sweep operation. This number must - alsways be lower than or equal to SWEPT. */ + always be lower than or equal to SWEPT. */ unsigned collected; } scm_t_sweep_statistics; -#define scm_i_sweep_statistics_init(_stats) \ - do \ - { \ - (_stats)->swept = (_stats)->collected = 0; \ - } \ - while (0) - -#define scm_i_sweep_statistics_sum(_sum, _addition) \ - do \ - { \ - (_sum)->swept += (_addition).swept; \ - (_sum)->collected += (_addition).collected; \ - } \ - while (0) +SCM_INTERNAL scm_t_sweep_statistics scm_i_gc_sweep_stats; extern scm_t_cell_type_statistics scm_i_master_freelist; @@ -153,12 +142,8 @@ void scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist, scm_t_sweep_statistics sweep_stats_1); SCM_INTERNAL void scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist); -SCM_INTERNAL -int scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist); - - -#define SCM_HEAP_SIZE \ - (scm_i_master_freelist.heap_size + scm_i_master_freelist2.heap_size) +SCM_INTERNAL float +scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist); #define SCM_MAX(A, B) ((A) > (B) ? (A) : (B)) @@ -213,10 +198,9 @@ typedef struct scm_t_heap_segment (not that we do that, but anyway.) */ + void *malloced; - void* malloced; - - scm_t_cell * next_free_card; + scm_t_cell *next_free_card; /* address of the head-of-freelist pointer for this segment's cells. All segments usually point to the same one, scm_i_freelist. */ @@ -225,16 +209,12 @@ typedef struct scm_t_heap_segment /* number of cells per object in this segment */ int span; - /* Is this the first time that the cells are accessed? */ int first_time; - } scm_t_heap_segment; - - /* A table of segment records is kept that records the upper and lower extents of the segment; this is used during the conservative @@ -249,20 +229,28 @@ SCM_INTERNAL int scm_i_init_card_freelist (scm_t_cell * card, SCM *free_list, scm_t_heap_segment*); SCM_INTERNAL int scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *); +SCM_INTERNAL int scm_i_card_marked_count (scm_t_cell *card, int span); SCM_INTERNAL void scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg); SCM_INTERNAL char const *scm_i_tag_name (scm_t_bits tag); /* MOVEME */ SCM_INTERNAL int scm_i_initialize_heap_segment_data (scm_t_heap_segment *seg, size_t requested); + +SCM_INTERNAL int scm_i_segment_cells_per_card (scm_t_heap_segment *seg); +SCM_INTERNAL int scm_i_segment_card_number (scm_t_heap_segment *seg, + scm_t_cell *card); SCM_INTERNAL int scm_i_segment_card_count (scm_t_heap_segment *seg); SCM_INTERNAL int scm_i_segment_cell_count (scm_t_heap_segment *seg); - +SCM_INTERNAL int scm_i_heap_segment_marked_count (scm_t_heap_segment *seg); + SCM_INTERNAL void scm_i_clear_segment_mark_space (scm_t_heap_segment *seg); SCM_INTERNAL scm_t_heap_segment * scm_i_make_empty_heap_segment (scm_t_cell_type_statistics*); +SCM_INTERNAL SCM scm_i_sweep_for_freelist (scm_t_cell_type_statistics *seg); SCM_INTERNAL SCM scm_i_sweep_some_cards (scm_t_heap_segment *seg, - scm_t_sweep_statistics *sweep_stats); + scm_t_sweep_statistics *sweep_stats, + int threshold); SCM_INTERNAL void scm_i_sweep_segment (scm_t_heap_segment *seg, scm_t_sweep_statistics *sweep_stats); @@ -271,10 +259,11 @@ SCM_INTERNAL void scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM_INTERNAL int scm_i_insert_segment (scm_t_heap_segment *seg); -SCM_INTERNAL long int scm_i_find_heap_segment_containing_object (SCM obj); -SCM_INTERNAL int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *, - scm_t_sweep_statistics, +SCM_INTERNAL int scm_i_find_heap_segment_containing_object (SCM obj); +SCM_INTERNAL int scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, + size_t length, policy_on_error); +SCM_INTERNAL int scm_i_marked_count (void); SCM_INTERNAL void scm_i_clear_mark_space (void); SCM_INTERNAL void scm_i_sweep_segments (void); SCM_INTERNAL SCM scm_i_sweep_some_segments (scm_t_cell_type_statistics *fl, @@ -283,8 +272,7 @@ SCM_INTERNAL void scm_i_reset_segments (void); SCM_INTERNAL void scm_i_sweep_all_segments (char const *reason, scm_t_sweep_statistics *sweep_stats); SCM_INTERNAL SCM scm_i_all_segments_statistics (SCM hashtab); -SCM_INTERNAL void scm_i_make_initial_segment (int init_heap_size, - scm_t_cell_type_statistics *fl); +SCM_INTERNAL unsigned long *scm_i_segment_table_info(int *size); extern long int scm_i_deprecated_memory_return; From 40945e5e9f5b1ecbd9a5d9f8713e25898e056198 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 15:03:48 -0300 Subject: [PATCH 76/87] Add a statistic for tracking how many cells are marked conservatively. This allows an informed choice for deciding how many segments to create. After startup, ~2% of the cells are scanned conservatively. --- libguile/gc-mark.c | 4 ++-- libguile/gc-segment-table.c | 2 ++ libguile/gc-segment.c | 1 + libguile/gc.c | 7 ++++++- libguile/private-gc.h | 1 + 5 files changed, 12 insertions(+), 3 deletions(-) diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index d8f1ecec2..50cd844c9 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -78,7 +78,7 @@ scm_mark_all (void) scm_i_init_guardians_for_gc (); scm_i_clear_mark_space (); - + scm_i_find_heap_calls = 0; /* Mark every thread's stack and registers */ scm_threads_mark_stacks (); @@ -404,7 +404,7 @@ scm_gc_mark_dependencies (SCM p) { /* We are in debug mode. Check the ptr exhaustively. */ - valid_cell = valid_cell && (scm_i_find_heap_segment_containing_object (ptr) >= 0); + valid_cell = valid_cell && scm_in_heap_p (ptr); } #endif diff --git a/libguile/gc-segment-table.c b/libguile/gc-segment-table.c index d627e9c1f..4b809ae4b 100644 --- a/libguile/gc-segment-table.c +++ b/libguile/gc-segment-table.c @@ -115,12 +115,14 @@ scm_i_insert_segment (scm_t_heap_segment *seg) I think this function is too long to be inlined. --hwn */ + int scm_i_find_heap_segment_containing_object (SCM obj) { if (!CELL_P (obj)) return -1; + scm_i_find_heap_calls ++; if ((scm_t_cell *) obj < lowest_cell || (scm_t_cell *) obj >= highest_cell) return -1; diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 16b5ce613..0668d1561 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -44,6 +44,7 @@ scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, if (len < SCM_MIN_HEAP_SEG_SIZE) len = SCM_MIN_HEAP_SEG_SIZE; + /* todo: consider having a more flexible lower bound. */ { scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist); diff --git a/libguile/gc.c b/libguile/gc.c index 8c0417cf9..95b3318cc 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -210,7 +210,7 @@ unsigned long scm_mtrigger; unsigned long scm_cells_allocated = 0; unsigned long scm_last_cells_allocated = 0; unsigned long scm_mallocated = 0; - +long int scm_i_find_heap_calls = 0; /* Global GC sweep statistics since the last full GC. */ scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 }; @@ -241,6 +241,7 @@ SCM_SYMBOL (sym_gc_time_taken, "gc-time-taken"); SCM_SYMBOL (sym_gc_mark_time_taken, "gc-mark-time-taken"); SCM_SYMBOL (sym_times, "gc-times"); SCM_SYMBOL (sym_cells_marked, "cells-marked"); +SCM_SYMBOL (sym_cells_marked_conservatively, "cells-marked-conservatively"); SCM_SYMBOL (sym_cells_swept, "cells-swept"); SCM_SYMBOL (sym_malloc_yield, "malloc-yield"); SCM_SYMBOL (sym_cell_yield, "cell-yield"); @@ -314,6 +315,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, unsigned long int local_scm_gc_times; unsigned long int local_scm_gc_mark_time_taken; unsigned long int local_protected_obj_count; + unsigned long int local_conservative_scan_count; double local_scm_gc_cells_swept; double local_scm_gc_cells_marked; double local_scm_total_cells_allocated; @@ -327,6 +329,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, /* Below, we cons to produce the resulting list. We want a snapshot of * the heap situation before consing. */ + local_conservative_scan_count = scm_i_find_heap_calls; local_scm_mtrigger = scm_mtrigger; local_scm_mallocated = scm_mallocated; local_scm_heap_size = @@ -369,6 +372,8 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_from_double (local_scm_total_cells_allocated)), scm_cons (sym_heap_size, scm_from_ulong (local_scm_heap_size)), + scm_cons (sym_cells_marked_conservatively, + scm_from_ulong (local_conservative_scan_count)), scm_cons (sym_mallocated, scm_from_ulong (local_scm_mallocated)), scm_cons (sym_mtrigger, diff --git a/libguile/private-gc.h b/libguile/private-gc.h index 0e860b0ed..d738665e7 100644 --- a/libguile/private-gc.h +++ b/libguile/private-gc.h @@ -275,6 +275,7 @@ SCM_INTERNAL SCM scm_i_all_segments_statistics (SCM hashtab); SCM_INTERNAL unsigned long *scm_i_segment_table_info(int *size); extern long int scm_i_deprecated_memory_return; +extern long int scm_i_find_heap_calls; /* global init funcs. From 676d9cc55311d9c44205423a794a026e98c35ee1 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 15:20:55 -0300 Subject: [PATCH 77/87] If realloc() fails in scm_realloc, then do a complete GC with complete sweep directly. --- libguile/gc-malloc.c | 22 +++++++++------------- libguile/gc.c | 2 +- 2 files changed, 10 insertions(+), 14 deletions(-) diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 2dc9f0fc1..4e06f2f69 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -113,21 +113,17 @@ scm_realloc (void *mem, size_t size) scm_i_scm_pthread_mutex_lock (&scm_i_sweep_mutex); scm_gc_running_p = 1; - // We don't want these sweep statistics to influence results for - // cell GC, so we don't collect statistics. - scm_i_sweep_all_segments ("realloc", NULL); - - SCM_SYSCALL (ptr = realloc (mem, size)); - if (ptr) - { - scm_gc_running_p = 0; - scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex); - return ptr; - } - scm_i_gc ("realloc"); + + /* + We don't want these sweep statistics to influence results for + cell GC, so we don't collect statistics. + + realloc() failed, so we're really desparate to free memory. Run a + full sweep. + */ scm_i_sweep_all_segments ("realloc", NULL); - + scm_gc_running_p = 0; scm_i_pthread_mutex_unlock (&scm_i_sweep_mutex); diff --git a/libguile/gc.c b/libguile/gc.c index 95b3318cc..ce333305a 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -664,7 +664,7 @@ scm_i_gc (const char *what) the time taken. */ scm_gc_time_taken += (scm_c_get_internal_run_time () - t_before_gc); - assert(scm_cells_allocated == scm_i_marked_count ()); + scm_i_thread_wake_up (); /* For debugging purposes, you could do From 5bfb683e124887f5953e25d036531d146acee1f6 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Sat, 16 Aug 2008 15:34:04 -0300 Subject: [PATCH 78/87] Make marked conservatively statistic accumulative. --- libguile/gc.c | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/libguile/gc.c b/libguile/gc.c index ce333305a..a29c86029 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -216,6 +216,7 @@ scm_t_sweep_statistics scm_i_gc_sweep_stats = { 0, 0 }; /* Total count of cells marked/swept. */ static double scm_gc_cells_marked_acc = 0.; +static double scm_gc_cells_marked_conservatively_acc = 0.; static double scm_gc_cells_swept_acc = 0.; static double scm_gc_cells_allocated_acc = 0.; @@ -315,9 +316,9 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, unsigned long int local_scm_gc_times; unsigned long int local_scm_gc_mark_time_taken; unsigned long int local_protected_obj_count; - unsigned long int local_conservative_scan_count; double local_scm_gc_cells_swept; double local_scm_gc_cells_marked; + double local_scm_gc_cells_marked_conservatively; double local_scm_total_cells_allocated; SCM answer; unsigned long *bounds = 0; @@ -329,7 +330,6 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, /* Below, we cons to produce the resulting list. We want a snapshot of * the heap situation before consing. */ - local_conservative_scan_count = scm_i_find_heap_calls; local_scm_mtrigger = scm_mtrigger; local_scm_mallocated = scm_mallocated; local_scm_heap_size = @@ -348,8 +348,10 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, (double) scm_gc_cells_swept_acc + (double) scm_i_gc_sweep_stats.swept; local_scm_gc_cells_marked = scm_gc_cells_marked_acc - +(double) scm_i_gc_sweep_stats.swept - -(double) scm_i_gc_sweep_stats.collected; + + (double) scm_i_gc_sweep_stats.swept + - (double) scm_i_gc_sweep_stats.collected; + local_scm_gc_cells_marked_conservatively + = scm_gc_cells_marked_conservatively_acc; local_scm_total_cells_allocated = scm_gc_cells_allocated_acc + (double) scm_i_gc_sweep_stats.collected; @@ -373,7 +375,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_cons (sym_heap_size, scm_from_ulong (local_scm_heap_size)), scm_cons (sym_cells_marked_conservatively, - scm_from_ulong (local_conservative_scan_count)), + scm_from_ulong (local_scm_gc_cells_marked_conservatively)), scm_cons (sym_mallocated, scm_from_ulong (local_scm_mallocated)), scm_cons (sym_mtrigger, @@ -416,6 +418,7 @@ gc_end_stats () scm_gc_cells_allocated_acc += (double) scm_i_gc_sweep_stats.collected; scm_gc_cells_marked_acc += (double) scm_cells_allocated; + scm_gc_cells_marked_conservatively_acc += (double) scm_i_find_heap_calls; scm_gc_cells_swept_acc += (double) scm_i_gc_sweep_stats.swept; ++scm_gc_times; @@ -597,6 +600,9 @@ scm_i_gc (const char *what) scm_check_deprecated_memory_return(); /* Sanity check our numbers. */ + + /* If this was not true, someone touched mark bits outside of the + mark phase. */ assert (scm_cells_allocated == scm_i_marked_count ()); assert (scm_i_gc_sweep_stats.swept == (scm_i_master_freelist.heap_total_cells @@ -649,12 +655,10 @@ scm_i_gc (const char *what) /* Invalidate the freelists of other threads. */ scm_i_thread_invalidate_freelists (); - assert(scm_cells_allocated == scm_i_marked_count ()); scm_c_hook_run (&scm_after_sweep_c_hook, 0); gc_end_stats (); - assert(scm_cells_allocated == scm_i_marked_count ()); scm_i_gc_sweep_stats.collected = scm_i_gc_sweep_stats.swept = 0; scm_i_gc_sweep_freelist_reset (&scm_i_master_freelist); From 408bcd99d3ec8eef04a44f24cd97dd32428d00c8 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Mon, 18 Aug 2008 11:02:43 -0300 Subject: [PATCH 79/87] Fix sizeof() nitpick for goops corruption. --- libguile/goops.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/goops.c b/libguile/goops.c index cc610fa9c..8f298c539 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1709,7 +1709,7 @@ go_to_hell (void *o) if (n_hell >= hell_size) { hell_size *= 2; - hell = scm_realloc (hell, hell_size * sizeof(scm_t_bits)); + hell = scm_realloc (hell, hell_size * sizeof(*hell)); } hell[n_hell++] = SCM_STRUCT_DATA (obj); scm_unlock_mutex (hell_mutex); From bb764c0e3c6969bc34154b9212eb0cd04b5f8f87 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 19 Aug 2008 19:08:29 +0200 Subject: [PATCH 80/87] Complete fix of `hell' allocation in GOOPS. --- libguile/goops.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/goops.c b/libguile/goops.c index 8f298c539..c09932c08 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -2995,7 +2995,7 @@ scm_init_goops_builtins (void) list_of_no_method = scm_permanent_object (scm_list_1 (sym_no_method)); - hell = scm_calloc (hell_size * sizeof(scm_t_bits)); + hell = scm_calloc (hell_size * sizeof (*hell)); hell_mutex = scm_permanent_object (scm_make_mutex ()); create_basic_classes (); From 4a1db3a91ff5f2b8947d144f4ed3486d1960b34c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 19 Aug 2008 19:13:39 +0200 Subject: [PATCH 81/87] Add ChangeLog and NEWS entry for the GOOPS `class-redefinition' memory corruption fix. --- NEWS | 1 + libguile/ChangeLog | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/NEWS b/NEWS index fb5712a1e..c2bed1740 100644 --- a/NEWS +++ b/NEWS @@ -57,6 +57,7 @@ This makes these internal functions technically not callable from application code. ** `guile-config link' now prints `-L$libdir' before `-lguile' +** Fix memory corruption involving GOOPS' `class-redefinition' ** Fix build issue on Tru64 and ia64-hp-hpux11.23 (`SCM_UNPACK' macro) ** Fix build issue on mips, mipsel, powerpc and ia64 (stack direction) ** Fix build issue on hppa2.0w-hp-hpux11.11 (`dirent64' and `readdir64_r') diff --git a/libguile/ChangeLog b/libguile/ChangeLog index b4d3f87b1..15e6b4cd5 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,10 @@ +2008-08-19 Han-Wen Nienhuys + Ludovic Courtès + + * goops.c (scm_init_goops_builtins, go_to_hell): Fix allocation + of `hell' by passing "hell_size * sizeof (*hell)" instead of + "hell_size" to `scm_malloc ()' and `scm_realloc ()'. + 2008-08-02 Neil Jerram * numbers.c (scm_rationalize): Update docstring to match the From 82d8d6d9e8ac6a2c36534d6085cd3f96d6278856 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 20 Aug 2008 00:44:20 +0200 Subject: [PATCH 82/87] Add test case for the GOOPS `class-redefinition' memory corruption. --- test-suite/ChangeLog | 5 +++ test-suite/tests/goops.test | 75 ++++++++++++++++++++++++++++++++++++- 2 files changed, 78 insertions(+), 2 deletions(-) diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 4c0d992b8..0d6b54c9a 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,8 @@ +2008-08-19 Ludovic Courtès + + * tests/goops.test (object update)[changing class, `hell' in + `goops.c' grows as expected]: New tests. + 2008-07-06 Ludovic Courtès * standalone/test-asmobs, standalone/test-bad-identifiers, diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test index e4c2df906..713132a43 100644 --- a/test-suite/tests/goops.test +++ b/test-suite/tests/goops.test @@ -18,7 +18,8 @@ ;;;; Boston, MA 02110-1301 USA (define-module (test-suite test-goops) - #:use-module (test-suite lib)) + #:use-module (test-suite lib) + #:autoload (srfi srfi-1) (unfold)) (pass-if "GOOPS loads" (false-if-exception @@ -277,7 +278,77 @@ (y #:accessor y #:init-value 456) (z #:accessor z #:init-value 789)) (current-module)) - (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module)))) + (eval '(and (= (y foo) 456) (= (z foo) 789)) (current-module))) + + (pass-if "changing class" + (let* ((c1 (class () (the-slot #:init-keyword #:value))) + (c2 (class () (the-slot #:init-keyword #:value) + (the-other-slot #:init-value 888))) + (o1 (make c1 #:value 777))) + (and (is-a? o1 c1) + (not (is-a? o1 c2)) + (equal? (slot-ref o1 'the-slot) 777) + (let ((o2 (change-class o1 c2))) + (and (eq? o1 o2) + (is-a? o2 c2) + (not (is-a? o2 c1)) + (equal? (slot-ref o2 'the-slot) 777)))))) + + (pass-if "`hell' in `goops.c' grows as expected" + ;; This snippet yielded a segfault prior to the 2008-08-19 `goops.c' + ;; fix (i.e., Guile 1.8.5 and earlier). The root of the problem was + ;; that `go_to_hell ()' would not reallocate enough room for the `hell' + ;; array, leading to out-of-bounds accesses. + + (let* ((parent-class (class () + #:name ')) + (classes + (unfold (lambda (i) (>= i 20)) + (lambda (i) + (make-class (list parent-class) + '((the-slot #:init-value #:value) + (the-other-slot)) + #:name (string->symbol + (string-append "string i) + ">")))) + (lambda (i) + (+ 1 i)) + 0)) + (objects + (map (lambda (class) + (make class #:value 777)) + classes))) + + (define-method (change-class (foo parent-class) + (new )) + ;; Called by `scm_change_object_class ()', via `purgatory ()'. + (if (null? classes) + (next-method) + (let ((class (car classes)) + (object (car objects))) + (set! classes (cdr classes)) + (set! objects (cdr objects)) + + ;; Redefine the class so that its instances are eventually + ;; passed to `scm_change_object_class ()'. This leads to + ;; nested `scm_change_object_class ()' calls, which increases + ;; the size of HELL and increments N_HELL. + (class-redefinition class + (make-class '() (class-slots class) + #:name (class-name class))) + + ;; Use `slot-ref' to trigger the `scm_change_object_class ()' + ;; and `go_to_hell ()' calls. + (slot-ref object 'the-slot) + + (next-method)))) + + + ;; Initiate the whole `change-class' chain. + (let* ((class (car classes)) + (object (change-class (car objects) class))) + (is-a? object class))))) (with-test-prefix "object comparison" (pass-if "default method" From 417566ebc9dc51fc65b490a96213059e17994dde Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 20 Aug 2008 19:31:46 +0200 Subject: [PATCH 83/87] Never define `_GNU_SOURCE' explicitly since `AC_USE_SYSTEM_EXTENSIONS' takes care of it. Conflicts: ChangeLog configure.in libguile/eval.c libguile/srfi-14.c libguile/threads.c --- libguile/ChangeLog | 6 ++++++ libguile/eval.c | 2 -- libguile/filesys.c | 1 - libguile/gc.c | 2 -- libguile/numbers.c | 3 --- libguile/posix.c | 2 +- libguile/stime.c | 3 +-- libguile/threads.c | 2 -- 8 files changed, 8 insertions(+), 13 deletions(-) diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 15e6b4cd5..518dcd466 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,9 @@ +2008-08-20 Ludovic Courtès + + * eval.c, filesys.c, gc.c, numbers.c, stime.c, threads.c: Don't + define `_GNU_SOURCE' explicitly as it's now defined in + thanks to `AC_USE_SYSTEM_EXTENSIONS'. + 2008-08-19 Han-Wen Nienhuys Ludovic Courtès diff --git a/libguile/eval.c b/libguile/eval.c index 764935883..4defade1f 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -18,8 +18,6 @@ -#define _GNU_SOURCE - /* SECTION: This code is compiled once. */ diff --git a/libguile/filesys.c b/libguile/filesys.c index 0e90105ec..6536df849 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -19,7 +19,6 @@ /* See stime.c for comments on why _POSIX_C_SOURCE is not always defined. */ -#define _GNU_SOURCE /* ask glibc for everything */ #define _LARGEFILE64_SOURCE /* ask for stat64 etc */ #ifdef __hpux #define _POSIX_C_SOURCE 199506L /* for readdir_r */ diff --git a/libguile/gc.c b/libguile/gc.c index a29c86029..ce3cb54f8 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -15,8 +15,6 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ -#define _GNU_SOURCE - /* #define DEBUGINFO */ #if HAVE_CONFIG_H diff --git a/libguile/numbers.c b/libguile/numbers.c index fc57bf5c8..20eb16a26 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -40,9 +40,6 @@ */ -/* tell glibc (2.3) to give prototype for C99 trunc(), csqrt(), etc */ -#define _GNU_SOURCE - #if HAVE_CONFIG_H # include #endif diff --git a/libguile/posix.c b/libguile/posix.c index 76dcd3d10..0bad2ee20 100644 --- a/libguile/posix.c +++ b/libguile/posix.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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 diff --git a/libguile/stime.c b/libguile/stime.c index 8487b91ca..fa8b5851d 100644 --- a/libguile/stime.c +++ b/libguile/stime.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2003, 2004, 2005, 2006, 2007, 2008 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 @@ -31,7 +31,6 @@ what it takes away, and decide from that whether to use it, instead of hard coding __hpux. */ -#define _GNU_SOURCE /* ask glibc for everything, in particular strptime */ #ifndef _REENTRANT # define _REENTRANT /* ask solaris for gmtime_r prototype */ #endif diff --git a/libguile/threads.c b/libguile/threads.c index bf4ab165b..84c7bce7f 100644 --- a/libguile/threads.c +++ b/libguile/threads.c @@ -18,8 +18,6 @@ -#define _GNU_SOURCE - #include "libguile/_scm.h" #if HAVE_UNISTD_H From 103dc4d4d297ed7522e36415869f60d81f9cbc5a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 21 Aug 2008 22:23:59 +0200 Subject: [PATCH 84/87] Add Gnulib-provided files for convenience. These come from Gnulib's Git commit ae3a0d62f26d8156b403e40d6007475006f3136f, dated 2008-08-19. --- ChangeLog | 5 + autogen.sh | 3 - build-aux/link-warning.h | 28 +++ lib/.gitignore | 7 - lib/Makefile.am | 119 ++++++++++ lib/alloca.c | 489 +++++++++++++++++++++++++++++++++++++++ lib/alloca.in.h | 56 +++++ lib/dummy.c | 42 ++++ lib/strcasecmp.c | 63 +++++ lib/strings.in.h | 86 +++++++ lib/strncasecmp.c | 63 +++++ m4/.gitignore | 10 - m4/alloca.m4 | 46 ++++ m4/extensions.m4 | 82 +++++++ m4/gnulib-common.m4 | 91 ++++++++ m4/gnulib-comp.m4 | 192 +++++++++++++++ m4/gnulib-tool.m4 | 57 +++++ m4/include_next.m4 | 110 +++++++++ m4/strcase.m4 | 44 ++++ m4/strings_h.m4 | 33 +++ 20 files changed, 1606 insertions(+), 20 deletions(-) create mode 100644 build-aux/link-warning.h delete mode 100644 lib/.gitignore create mode 100644 lib/Makefile.am create mode 100644 lib/alloca.c create mode 100644 lib/alloca.in.h create mode 100644 lib/dummy.c create mode 100644 lib/strcasecmp.c create mode 100644 lib/strings.in.h create mode 100644 lib/strncasecmp.c delete mode 100644 m4/.gitignore create mode 100644 m4/alloca.m4 create mode 100644 m4/extensions.m4 create mode 100644 m4/gnulib-common.m4 create mode 100644 m4/gnulib-comp.m4 create mode 100644 m4/gnulib-tool.m4 create mode 100644 m4/include_next.m4 create mode 100644 m4/strcase.m4 create mode 100644 m4/strings_h.m4 diff --git a/ChangeLog b/ChangeLog index b58755cbb..acbaccb3b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2008-08-21 Ludovic Courtès + + * autogen.sh: Don't use `gnulib-tool', use the Gnulib files + available in the repository. + 2008-08-07 Neil Jerram * configure.in (SCM_I_GSC_STACK_GROWS_UP): Remove use of diff --git a/autogen.sh b/autogen.sh index d125d9f48..47656cb3a 100755 --- a/autogen.sh +++ b/autogen.sh @@ -19,13 +19,10 @@ libtool --version echo "" ${M4:-/usr/bin/m4} --version echo "" -gnulib-tool --version -echo "" ###################################################################### ### update infrastructure -gnulib-tool --update && \ autoreconf -i --force --verbose echo "guile-readline..." diff --git a/build-aux/link-warning.h b/build-aux/link-warning.h new file mode 100644 index 000000000..fda01941a --- /dev/null +++ b/build-aux/link-warning.h @@ -0,0 +1,28 @@ +/* GL_LINK_WARNING("literal string") arranges to emit the literal string as + a linker warning on most glibc systems. + We use a linker warning rather than a preprocessor warning, because + #warning cannot be used inside macros. */ +#ifndef GL_LINK_WARNING + /* This works on platforms with GNU ld and ELF object format. + Testing __GLIBC__ is sufficient for asserting that GNU ld is in use. + Testing __ELF__ guarantees the ELF object format. + Testing __GNUC__ is necessary for the compound expression syntax. */ +# if defined __GLIBC__ && defined __ELF__ && defined __GNUC__ +# define GL_LINK_WARNING(message) \ + GL_LINK_WARNING1 (__FILE__, __LINE__, message) +# define GL_LINK_WARNING1(file, line, message) \ + GL_LINK_WARNING2 (file, line, message) /* macroexpand file and line */ +# define GL_LINK_WARNING2(file, line, message) \ + GL_LINK_WARNING3 (file ":" #line ": warning: " message) +# define GL_LINK_WARNING3(message) \ + ({ static const char warning[sizeof (message)] \ + __attribute__ ((__unused__, \ + __section__ (".gnu.warning"), \ + __aligned__ (1))) \ + = message "\n"; \ + (void)0; \ + }) +# else +# define GL_LINK_WARNING(message) ((void) 0) +# endif +#endif diff --git a/lib/.gitignore b/lib/.gitignore deleted file mode 100644 index c7d7f8793..000000000 --- a/lib/.gitignore +++ /dev/null @@ -1,7 +0,0 @@ -Makefile.am -alloca.c -alloca.in.h -dummy.c -strcasecmp.c -strings.in.h -strncasecmp.c diff --git a/lib/Makefile.am b/lib/Makefile.am new file mode 100644 index 000000000..b24137326 --- /dev/null +++ b/lib/Makefile.am @@ -0,0 +1,119 @@ +## DO NOT EDIT! GENERATED AUTOMATICALLY! +## Process this file with automake to produce Makefile.in. +# Copyright (C) 2002-2008 Free Software Foundation, Inc. +# +# This file is free software, distributed under the terms of the GNU +# General Public License. As a special exception to the GNU General +# Public License, this file may be distributed as part of a program +# that contains a configuration script generated by Autoconf, under +# the same distribution terms as the rest of that program. +# +# Generated by gnulib-tool. +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --aux-dir=build-aux --lgpl --libtool --macro-prefix=gl alloca extensions strcase + +AUTOMAKE_OPTIONS = 1.5 gnits + +noinst_HEADERS = +noinst_LIBRARIES = +noinst_LTLIBRARIES = +EXTRA_DIST = +BUILT_SOURCES = +SUFFIXES = +MOSTLYCLEANFILES = core *.stackdump +MOSTLYCLEANDIRS = +CLEANFILES = +DISTCLEANFILES = +MAINTAINERCLEANFILES = + +AM_CPPFLAGS = + +noinst_LTLIBRARIES += libgnu.la + +libgnu_la_SOURCES = +libgnu_la_LIBADD = $(gl_LTLIBOBJS) +libgnu_la_DEPENDENCIES = $(gl_LTLIBOBJS) +EXTRA_libgnu_la_SOURCES = +libgnu_la_LDFLAGS = $(AM_LDFLAGS) + +## begin gnulib module alloca + + +EXTRA_DIST += alloca.c + +EXTRA_libgnu_la_SOURCES += alloca.c + +libgnu_la_LIBADD += @LTALLOCA@ +libgnu_la_DEPENDENCIES += @LTALLOCA@ +## end gnulib module alloca + +## begin gnulib module alloca-opt + +BUILT_SOURCES += $(ALLOCA_H) + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +alloca.h: alloca.in.h + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + cat $(srcdir)/alloca.in.h; \ + } > $@-t + mv -f $@-t $@ +MOSTLYCLEANFILES += alloca.h alloca.h-t + +EXTRA_DIST += alloca.in.h + +## end gnulib module alloca-opt + +## begin gnulib module link-warning + +LINK_WARNING_H=$(top_srcdir)/build-aux/link-warning.h + +EXTRA_DIST += $(top_srcdir)/build-aux/link-warning.h + +## end gnulib module link-warning + +## begin gnulib module strcase + + +EXTRA_DIST += strcasecmp.c strncasecmp.c + +EXTRA_libgnu_la_SOURCES += strcasecmp.c strncasecmp.c + +## end gnulib module strcase + +## begin gnulib module strings + +BUILT_SOURCES += strings.h + +# We need the following in order to create when the system +# doesn't have one that works with the given compiler. +strings.h: strings.in.h + rm -f $@-t $@ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's/@''INCLUDE_NEXT''@/$(INCLUDE_NEXT)/g' \ + -e 's|@''NEXT_STRINGS_H''@|$(NEXT_STRINGS_H)|g' \ + -e 's|@''HAVE_STRCASECMP''@|$(HAVE_STRCASECMP)|g' \ + -e 's|@''HAVE_DECL_STRNCASECMP''@|$(HAVE_DECL_STRNCASECMP)|g' \ + -e '/definition of GL_LINK_WARNING/r $(LINK_WARNING_H)' \ + < $(srcdir)/strings.in.h; \ + } > $@-t + mv $@-t $@ +MOSTLYCLEANFILES += strings.h strings.h-t + +EXTRA_DIST += strings.in.h + +## end gnulib module strings + +## begin gnulib module dummy + +libgnu_la_SOURCES += dummy.c + +## end gnulib module dummy + + +mostlyclean-local: mostlyclean-generic + @for dir in '' $(MOSTLYCLEANDIRS); do \ + if test -n "$$dir" && test -d $$dir; then \ + echo "rmdir $$dir"; rmdir $$dir; \ + fi; \ + done; \ + : diff --git a/lib/alloca.c b/lib/alloca.c new file mode 100644 index 000000000..3a1f4e273 --- /dev/null +++ b/lib/alloca.c @@ -0,0 +1,489 @@ +/* alloca.c -- allocate automatically reclaimed memory + (Mostly) portable public-domain implementation -- D A Gwyn + + This implementation of the PWB library alloca function, + which is used to allocate space off the run-time stack so + that it is automatically reclaimed upon procedure exit, + was inspired by discussions with J. Q. Johnson of Cornell. + J.Otto Tennant contributed the Cray support. + + There are some preprocessor constants that can + be defined when compiling for your specific system, for + improved efficiency; however, the defaults should be okay. + + The general concept of this implementation is to keep + track of all alloca-allocated blocks, and reclaim any + that are found to be deeper in the stack than the current + invocation. This heuristic does not reclaim storage as + soon as it becomes invalid, but it will do so eventually. + + As a special case, alloca(0) reclaims storage without + allocating any. It is a good idea to use alloca(0) in + your main control loop, etc. to force garbage collection. */ + +#include + +#include + +#include +#include + +#ifdef emacs +# include "lisp.h" +# include "blockinput.h" +# ifdef EMACS_FREE +# undef free +# define free EMACS_FREE +# endif +#else +# define memory_full() abort () +#endif + +/* If compiling with GCC 2, this file's not needed. */ +#if !defined (__GNUC__) || __GNUC__ < 2 + +/* If someone has defined alloca as a macro, + there must be some other way alloca is supposed to work. */ +# ifndef alloca + +# ifdef emacs +# ifdef static +/* actually, only want this if static is defined as "" + -- this is for usg, in which emacs must undefine static + in order to make unexec workable + */ +# ifndef STACK_DIRECTION +you +lose +-- must know STACK_DIRECTION at compile-time +/* Using #error here is not wise since this file should work for + old and obscure compilers. */ +# endif /* STACK_DIRECTION undefined */ +# endif /* static */ +# endif /* emacs */ + +/* If your stack is a linked list of frames, you have to + provide an "address metric" ADDRESS_FUNCTION macro. */ + +# if defined (CRAY) && defined (CRAY_STACKSEG_END) +long i00afunc (); +# define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) +# else +# define ADDRESS_FUNCTION(arg) &(arg) +# endif + +/* Define STACK_DIRECTION if you know the direction of stack + growth for your system; otherwise it will be automatically + deduced at run-time. + + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ + +# ifndef STACK_DIRECTION +# define STACK_DIRECTION 0 /* Direction unknown. */ +# endif + +# if STACK_DIRECTION != 0 + +# define STACK_DIR STACK_DIRECTION /* Known at compile-time. */ + +# else /* STACK_DIRECTION == 0; need run-time code. */ + +static int stack_dir; /* 1 or -1 once known. */ +# define STACK_DIR stack_dir + +static void +find_stack_direction (void) +{ + static char *addr = NULL; /* Address of first `dummy', once known. */ + auto char dummy; /* To get stack address. */ + + if (addr == NULL) + { /* Initial entry. */ + addr = ADDRESS_FUNCTION (dummy); + + find_stack_direction (); /* Recurse once. */ + } + else + { + /* Second entry. */ + if (ADDRESS_FUNCTION (dummy) > addr) + stack_dir = 1; /* Stack grew upward. */ + else + stack_dir = -1; /* Stack grew downward. */ + } +} + +# endif /* STACK_DIRECTION == 0 */ + +/* An "alloca header" is used to: + (a) chain together all alloca'ed blocks; + (b) keep track of stack depth. + + It is very important that sizeof(header) agree with malloc + alignment chunk size. The following default should work okay. */ + +# ifndef ALIGN_SIZE +# define ALIGN_SIZE sizeof(double) +# endif + +typedef union hdr +{ + char align[ALIGN_SIZE]; /* To force sizeof(header). */ + struct + { + union hdr *next; /* For chaining headers. */ + char *deep; /* For stack depth measure. */ + } h; +} header; + +static header *last_alloca_header = NULL; /* -> last alloca header. */ + +/* Return a pointer to at least SIZE bytes of storage, + which will be automatically reclaimed upon exit from + the procedure that called alloca. Originally, this space + was supposed to be taken from the current stack frame of the + caller, but that method cannot be made to work for some + implementations of C, for example under Gould's UTX/32. */ + +void * +alloca (size_t size) +{ + auto char probe; /* Probes stack depth: */ + register char *depth = ADDRESS_FUNCTION (probe); + +# if STACK_DIRECTION == 0 + if (STACK_DIR == 0) /* Unknown growth direction. */ + find_stack_direction (); +# endif + + /* Reclaim garbage, defined as all alloca'd storage that + was allocated from deeper in the stack than currently. */ + + { + register header *hp; /* Traverses linked list. */ + +# ifdef emacs + BLOCK_INPUT; +# endif + + for (hp = last_alloca_header; hp != NULL;) + if ((STACK_DIR > 0 && hp->h.deep > depth) + || (STACK_DIR < 0 && hp->h.deep < depth)) + { + register header *np = hp->h.next; + + free (hp); /* Collect garbage. */ + + hp = np; /* -> next header. */ + } + else + break; /* Rest are not deeper. */ + + last_alloca_header = hp; /* -> last valid storage. */ + +# ifdef emacs + UNBLOCK_INPUT; +# endif + } + + if (size == 0) + return NULL; /* No allocation required. */ + + /* Allocate combined header + user data storage. */ + + { + /* Address of header. */ + register header *new; + + size_t combined_size = sizeof (header) + size; + if (combined_size < sizeof (header)) + memory_full (); + + new = malloc (combined_size); + + if (! new) + memory_full (); + + new->h.next = last_alloca_header; + new->h.deep = depth; + + last_alloca_header = new; + + /* User storage begins just after header. */ + + return (void *) (new + 1); + } +} + +# if defined (CRAY) && defined (CRAY_STACKSEG_END) + +# ifdef DEBUG_I00AFUNC +# include +# endif + +# ifndef CRAY_STACK +# define CRAY_STACK +# ifndef CRAY2 +/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */ +struct stack_control_header + { + long shgrow:32; /* Number of times stack has grown. */ + long shaseg:32; /* Size of increments to stack. */ + long shhwm:32; /* High water mark of stack. */ + long shsize:32; /* Current size of stack (all segments). */ + }; + +/* The stack segment linkage control information occurs at + the high-address end of a stack segment. (The stack + grows from low addresses to high addresses.) The initial + part of the stack segment linkage control information is + 0200 (octal) words. This provides for register storage + for the routine which overflows the stack. */ + +struct stack_segment_linkage + { + long ss[0200]; /* 0200 overflow words. */ + long sssize:32; /* Number of words in this segment. */ + long ssbase:32; /* Offset to stack base. */ + long:32; + long sspseg:32; /* Offset to linkage control of previous + segment of stack. */ + long:32; + long sstcpt:32; /* Pointer to task common address block. */ + long sscsnm; /* Private control structure number for + microtasking. */ + long ssusr1; /* Reserved for user. */ + long ssusr2; /* Reserved for user. */ + long sstpid; /* Process ID for pid based multi-tasking. */ + long ssgvup; /* Pointer to multitasking thread giveup. */ + long sscray[7]; /* Reserved for Cray Research. */ + long ssa0; + long ssa1; + long ssa2; + long ssa3; + long ssa4; + long ssa5; + long ssa6; + long ssa7; + long sss0; + long sss1; + long sss2; + long sss3; + long sss4; + long sss5; + long sss6; + long sss7; + }; + +# else /* CRAY2 */ +/* The following structure defines the vector of words + returned by the STKSTAT library routine. */ +struct stk_stat + { + long now; /* Current total stack size. */ + long maxc; /* Amount of contiguous space which would + be required to satisfy the maximum + stack demand to date. */ + long high_water; /* Stack high-water mark. */ + long overflows; /* Number of stack overflow ($STKOFEN) calls. */ + long hits; /* Number of internal buffer hits. */ + long extends; /* Number of block extensions. */ + long stko_mallocs; /* Block allocations by $STKOFEN. */ + long underflows; /* Number of stack underflow calls ($STKRETN). */ + long stko_free; /* Number of deallocations by $STKRETN. */ + long stkm_free; /* Number of deallocations by $STKMRET. */ + long segments; /* Current number of stack segments. */ + long maxs; /* Maximum number of stack segments so far. */ + long pad_size; /* Stack pad size. */ + long current_address; /* Current stack segment address. */ + long current_size; /* Current stack segment size. This + number is actually corrupted by STKSTAT to + include the fifteen word trailer area. */ + long initial_address; /* Address of initial segment. */ + long initial_size; /* Size of initial segment. */ + }; + +/* The following structure describes the data structure which trails + any stack segment. I think that the description in 'asdef' is + out of date. I only describe the parts that I am sure about. */ + +struct stk_trailer + { + long this_address; /* Address of this block. */ + long this_size; /* Size of this block (does not include + this trailer). */ + long unknown2; + long unknown3; + long link; /* Address of trailer block of previous + segment. */ + long unknown5; + long unknown6; + long unknown7; + long unknown8; + long unknown9; + long unknown10; + long unknown11; + long unknown12; + long unknown13; + long unknown14; + }; + +# endif /* CRAY2 */ +# endif /* not CRAY_STACK */ + +# ifdef CRAY2 +/* Determine a "stack measure" for an arbitrary ADDRESS. + I doubt that "lint" will like this much. */ + +static long +i00afunc (long *address) +{ + struct stk_stat status; + struct stk_trailer *trailer; + long *block, size; + long result = 0; + + /* We want to iterate through all of the segments. The first + step is to get the stack status structure. We could do this + more quickly and more directly, perhaps, by referencing the + $LM00 common block, but I know that this works. */ + + STKSTAT (&status); + + /* Set up the iteration. */ + + trailer = (struct stk_trailer *) (status.current_address + + status.current_size + - 15); + + /* There must be at least one stack segment. Therefore it is + a fatal error if "trailer" is null. */ + + if (trailer == 0) + abort (); + + /* Discard segments that do not contain our argument address. */ + + while (trailer != 0) + { + block = (long *) trailer->this_address; + size = trailer->this_size; + if (block == 0 || size == 0) + abort (); + trailer = (struct stk_trailer *) trailer->link; + if ((block <= address) && (address < (block + size))) + break; + } + + /* Set the result to the offset in this segment and add the sizes + of all predecessor segments. */ + + result = address - block; + + if (trailer == 0) + { + return result; + } + + do + { + if (trailer->this_size <= 0) + abort (); + result += trailer->this_size; + trailer = (struct stk_trailer *) trailer->link; + } + while (trailer != 0); + + /* We are done. Note that if you present a bogus address (one + not in any segment), you will get a different number back, formed + from subtracting the address of the first block. This is probably + not what you want. */ + + return (result); +} + +# else /* not CRAY2 */ +/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP. + Determine the number of the cell within the stack, + given the address of the cell. The purpose of this + routine is to linearize, in some sense, stack addresses + for alloca. */ + +static long +i00afunc (long address) +{ + long stkl = 0; + + long size, pseg, this_segment, stack; + long result = 0; + + struct stack_segment_linkage *ssptr; + + /* Register B67 contains the address of the end of the + current stack segment. If you (as a subprogram) store + your registers on the stack and find that you are past + the contents of B67, you have overflowed the segment. + + B67 also points to the stack segment linkage control + area, which is what we are really interested in. */ + + stkl = CRAY_STACKSEG_END (); + ssptr = (struct stack_segment_linkage *) stkl; + + /* If one subtracts 'size' from the end of the segment, + one has the address of the first word of the segment. + + If this is not the first segment, 'pseg' will be + nonzero. */ + + pseg = ssptr->sspseg; + size = ssptr->sssize; + + this_segment = stkl - size; + + /* It is possible that calling this routine itself caused + a stack overflow. Discard stack segments which do not + contain the target address. */ + + while (!(this_segment <= address && address <= stkl)) + { +# ifdef DEBUG_I00AFUNC + fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl); +# endif + if (pseg == 0) + break; + stkl = stkl - pseg; + ssptr = (struct stack_segment_linkage *) stkl; + size = ssptr->sssize; + pseg = ssptr->sspseg; + this_segment = stkl - size; + } + + result = address - this_segment; + + /* If you subtract pseg from the current end of the stack, + you get the address of the previous stack segment's end. + This seems a little convoluted to me, but I'll bet you save + a cycle somewhere. */ + + while (pseg != 0) + { +# ifdef DEBUG_I00AFUNC + fprintf (stderr, "%011o %011o\n", pseg, size); +# endif + stkl = stkl - pseg; + ssptr = (struct stack_segment_linkage *) stkl; + size = ssptr->sssize; + pseg = ssptr->sspseg; + result += size; + } + return (result); +} + +# endif /* not CRAY2 */ +# endif /* CRAY */ + +# endif /* no alloca */ +#endif /* not GCC version 2 */ diff --git a/lib/alloca.in.h b/lib/alloca.in.h new file mode 100644 index 000000000..3d4f88b35 --- /dev/null +++ b/lib/alloca.in.h @@ -0,0 +1,56 @@ +/* Memory allocation on the stack. + + Copyright (C) 1995, 1999, 2001-2004, 2006-2008 Free Software + Foundation, Inc. + + This program is free software; you can redistribute it and/or modify it + under the terms of the GNU Lesser General Public License as published + by the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, + USA. */ + +/* Avoid using the symbol _ALLOCA_H here, as Bison assumes _ALLOCA_H + means there is a real alloca function. */ +#ifndef _GL_ALLOCA_H +#define _GL_ALLOCA_H + +/* alloca (N) returns a pointer to N bytes of memory + allocated on the stack, which will last until the function returns. + Use of alloca should be avoided: + - inside arguments of function calls - undefined behaviour, + - in inline functions - the allocation may actually last until the + calling function returns, + - for huge N (say, N >= 65536) - you never know how large (or small) + the stack is, and when the stack cannot fulfill the memory allocation + request, the program just crashes. + */ + +#ifndef alloca +# ifdef __GNUC__ +# define alloca __builtin_alloca +# elif defined _AIX +# define alloca __alloca +# elif defined _MSC_VER +# include +# define alloca _alloca +# elif defined __DECC && defined __VMS +# define alloca __ALLOCA +# else +# include +# ifdef __cplusplus +extern "C" +# endif +void *alloca (size_t); +# endif +#endif + +#endif /* _GL_ALLOCA_H */ diff --git a/lib/dummy.c b/lib/dummy.c new file mode 100644 index 000000000..37fff11da --- /dev/null +++ b/lib/dummy.c @@ -0,0 +1,42 @@ +/* A dummy file, to prevent empty libraries from breaking builds. + Copyright (C) 2004, 2007 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program. If not, see . */ + +/* Some systems, reportedly OpenBSD and Mac OS X, refuse to create + libraries without any object files. You might get an error like: + + > ar cru .libs/libgl.a + > ar: no archive members specified + + Compiling this file, and adding its object file to the library, will + prevent the library from being empty. */ + +/* Some systems, such as Solaris with cc 5.0, refuse to work with libraries + that don't export any symbol. You might get an error like: + + > cc ... libgnu.a + > ild: (bad file) garbled symbol table in archive ../gllib/libgnu.a + + Compiling this file, and adding its object file to the library, will + prevent the library from exporting no symbols. */ + +#ifdef __sun +/* This declaration ensures that the library will export at least 1 symbol. */ +int gl_dummy_symbol; +#else +/* This declaration is solely to ensure that after preprocessing + this file is never empty. */ +typedef int dummy; +#endif diff --git a/lib/strcasecmp.c b/lib/strcasecmp.c new file mode 100644 index 000000000..708132507 --- /dev/null +++ b/lib/strcasecmp.c @@ -0,0 +1,63 @@ +/* Case-insensitive string comparison function. + Copyright (C) 1998-1999, 2005-2007 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include + +/* Specification. */ +#include + +#include +#include + +#define TOLOWER(Ch) (isupper (Ch) ? tolower (Ch) : (Ch)) + +/* Compare strings S1 and S2, ignoring case, returning less than, equal to or + greater than zero if S1 is lexicographically less than, equal to or greater + than S2. + Note: This function does not work with multibyte strings! */ + +int +strcasecmp (const char *s1, const char *s2) +{ + const unsigned char *p1 = (const unsigned char *) s1; + const unsigned char *p2 = (const unsigned char *) s2; + unsigned char c1, c2; + + if (p1 == p2) + return 0; + + do + { + c1 = TOLOWER (*p1); + c2 = TOLOWER (*p2); + + if (c1 == '\0') + break; + + ++p1; + ++p2; + } + while (c1 == c2); + + if (UCHAR_MAX <= INT_MAX) + return c1 - c2; + else + /* On machines where 'char' and 'int' are types of the same size, the + difference of two 'unsigned char' values - including the sign bit - + doesn't fit in an 'int'. */ + return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0); +} diff --git a/lib/strings.in.h b/lib/strings.in.h new file mode 100644 index 000000000..987501271 --- /dev/null +++ b/lib/strings.in.h @@ -0,0 +1,86 @@ +/* A substitute . + + Copyright (C) 2007 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#ifndef _GL_STRINGS_H + +/* The include_next requires a split double-inclusion guard. */ +#@INCLUDE_NEXT@ @NEXT_STRINGS_H@ + +#ifndef _GL_STRINGS_H +#define _GL_STRINGS_H + + +/* The definition of GL_LINK_WARNING is copied here. */ + + +#ifdef __cplusplus +extern "C" { +#endif + + +/* Compare strings S1 and S2, ignoring case, returning less than, equal to or + greater than zero if S1 is lexicographically less than, equal to or greater + than S2. + Note: This function does not work in multibyte locales. */ +#if ! @HAVE_STRCASECMP@ +extern int strcasecmp (char const *s1, char const *s2); +#endif +#if defined GNULIB_POSIXCHECK +/* strcasecmp() does not work with multibyte strings: + POSIX says that it operates on "strings", and "string" in POSIX is defined + as a sequence of bytes, not of characters. */ +# undef strcasecmp +# define strcasecmp(a,b) \ + (GL_LINK_WARNING ("strcasecmp cannot work correctly on character strings " \ + "in multibyte locales - " \ + "use mbscasecmp if you care about " \ + "internationalization, or use c_strcasecmp (from " \ + "gnulib module c-strcase) if you want a locale " \ + "independent function"), \ + strcasecmp (a, b)) +#endif + +/* Compare no more than N bytes of strings S1 and S2, ignoring case, + returning less than, equal to or greater than zero if S1 is + lexicographically less than, equal to or greater than S2. + Note: This function cannot work correctly in multibyte locales. */ +#if ! @HAVE_DECL_STRNCASECMP@ +extern int strncasecmp (char const *s1, char const *s2, size_t n); +#endif +#if defined GNULIB_POSIXCHECK +/* strncasecmp() does not work with multibyte strings: + POSIX says that it operates on "strings", and "string" in POSIX is defined + as a sequence of bytes, not of characters. */ +# undef strncasecmp +# define strncasecmp(a,b,n) \ + (GL_LINK_WARNING ("strncasecmp cannot work correctly on character " \ + "strings in multibyte locales - " \ + "use mbsncasecmp or mbspcasecmp if you care about " \ + "internationalization, or use c_strncasecmp (from " \ + "gnulib module c-strcase) if you want a locale " \ + "independent function"), \ + strncasecmp (a, b, n)) +#endif + + +#ifdef __cplusplus +} +#endif + +#endif /* _GL_STRING_H */ +#endif /* _GL_STRING_H */ diff --git a/lib/strncasecmp.c b/lib/strncasecmp.c new file mode 100644 index 000000000..3386ce2a8 --- /dev/null +++ b/lib/strncasecmp.c @@ -0,0 +1,63 @@ +/* strncasecmp.c -- case insensitive string comparator + Copyright (C) 1998-1999, 2005-2007 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#include + +/* Specification. */ +#include + +#include +#include + +#define TOLOWER(Ch) (isupper (Ch) ? tolower (Ch) : (Ch)) + +/* Compare no more than N bytes of strings S1 and S2, ignoring case, + returning less than, equal to or greater than zero if S1 is + lexicographically less than, equal to or greater than S2. + Note: This function cannot work correctly in multibyte locales. */ + +int +strncasecmp (const char *s1, const char *s2, size_t n) +{ + register const unsigned char *p1 = (const unsigned char *) s1; + register const unsigned char *p2 = (const unsigned char *) s2; + unsigned char c1, c2; + + if (p1 == p2 || n == 0) + return 0; + + do + { + c1 = TOLOWER (*p1); + c2 = TOLOWER (*p2); + + if (--n == 0 || c1 == '\0') + break; + + ++p1; + ++p2; + } + while (c1 == c2); + + if (UCHAR_MAX <= INT_MAX) + return c1 - c2; + else + /* On machines where 'char' and 'int' are types of the same size, the + difference of two 'unsigned char' values - including the sign bit - + doesn't fit in an 'int'. */ + return (c1 > c2 ? 1 : c1 < c2 ? -1 : 0); +} diff --git a/m4/.gitignore b/m4/.gitignore deleted file mode 100644 index b1014b383..000000000 --- a/m4/.gitignore +++ /dev/null @@ -1,10 +0,0 @@ -alloca.m4 -extensions.m4 -gnulib-common.m4 -gnulib-tool.m4 -include_next.m4 -onceonly_2_57.m4 -strcase.m4 -strings_h.m4 -gnulib-comp.m4 -onceonly.m4 diff --git a/m4/alloca.m4 b/m4/alloca.m4 new file mode 100644 index 000000000..95f54a6d4 --- /dev/null +++ b/m4/alloca.m4 @@ -0,0 +1,46 @@ +# alloca.m4 serial 8 +dnl Copyright (C) 2002-2004, 2006, 2007 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FUNC_ALLOCA], +[ + dnl Work around a bug of AC_EGREP_CPP in autoconf-2.57. + AC_REQUIRE([AC_PROG_CPP]) + AC_REQUIRE([AC_PROG_EGREP]) + + AC_REQUIRE([AC_FUNC_ALLOCA]) + if test $ac_cv_func_alloca_works = no; then + gl_PREREQ_ALLOCA + fi + + # Define an additional variable used in the Makefile substitution. + if test $ac_cv_working_alloca_h = yes; then + AC_CACHE_CHECK([for alloca as a compiler built-in], [gl_cv_rpl_alloca], [ + AC_EGREP_CPP([Need own alloca], [ +#if defined __GNUC__ || defined _AIX || defined _MSC_VER + Need own alloca +#endif + ], [gl_cv_rpl_alloca=yes], [gl_cv_rpl_alloca=no]) + ]) + if test $gl_cv_rpl_alloca = yes; then + dnl OK, alloca can be implemented through a compiler built-in. + AC_DEFINE([HAVE_ALLOCA], 1, + [Define to 1 if you have 'alloca' after including , + a header that may be supplied by this distribution.]) + ALLOCA_H=alloca.h + else + dnl alloca exists as a library function, i.e. it is slow and probably + dnl a memory leak. Don't define HAVE_ALLOCA in this case. + ALLOCA_H= + fi + else + ALLOCA_H=alloca.h + fi + AC_SUBST([ALLOCA_H]) +]) + +# Prerequisites of lib/alloca.c. +# STACK_DIRECTION is already handled by AC_FUNC_ALLOCA. +AC_DEFUN([gl_PREREQ_ALLOCA], [:]) diff --git a/m4/extensions.m4 b/m4/extensions.m4 new file mode 100644 index 000000000..917af9480 --- /dev/null +++ b/m4/extensions.m4 @@ -0,0 +1,82 @@ +# serial 5 -*- Autoconf -*- +# Enable extensions on systems that normally disable them. + +# Copyright (C) 2003, 2006-2008 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This definition of AC_USE_SYSTEM_EXTENSIONS is stolen from CVS +# Autoconf. Perhaps we can remove this once we can assume Autoconf +# 2.62 or later everywhere, but since CVS Autoconf mutates rapidly +# enough in this area it's likely we'll need to redefine +# AC_USE_SYSTEM_EXTENSIONS for quite some time. + +# AC_USE_SYSTEM_EXTENSIONS +# ------------------------ +# Enable extensions on systems that normally disable them, +# typically due to standards-conformance issues. +# Remember that #undef in AH_VERBATIM gets replaced with #define by +# AC_DEFINE. The goal here is to define all known feature-enabling +# macros, then, if reports of conflicts are made, disable macros that +# cause problems on some platforms (such as __EXTENSIONS__). +AC_DEFUN([AC_USE_SYSTEM_EXTENSIONS], +[AC_BEFORE([$0], [AC_COMPILE_IFELSE])dnl +AC_BEFORE([$0], [AC_RUN_IFELSE])dnl + + AC_CHECK_HEADER([minix/config.h], [MINIX=yes], [MINIX=]) + if test "$MINIX" = yes; then + AC_DEFINE([_POSIX_SOURCE], [1], + [Define to 1 if you need to in order for `stat' and other + things to work.]) + AC_DEFINE([_POSIX_1_SOURCE], [2], + [Define to 2 if the system does not provide POSIX.1 features + except with this defined.]) + AC_DEFINE([_MINIX], [1], + [Define to 1 if on MINIX.]) + fi + + AH_VERBATIM([__EXTENSIONS__], +[/* Enable extensions on AIX 3, Interix. */ +#ifndef _ALL_SOURCE +# undef _ALL_SOURCE +#endif +/* Enable GNU extensions on systems that have them. */ +#ifndef _GNU_SOURCE +# undef _GNU_SOURCE +#endif +/* Enable threading extensions on Solaris. */ +#ifndef _POSIX_PTHREAD_SEMANTICS +# undef _POSIX_PTHREAD_SEMANTICS +#endif +/* Enable extensions on HP NonStop. */ +#ifndef _TANDEM_SOURCE +# undef _TANDEM_SOURCE +#endif +/* Enable general extensions on Solaris. */ +#ifndef __EXTENSIONS__ +# undef __EXTENSIONS__ +#endif +]) + AC_CACHE_CHECK([whether it is safe to define __EXTENSIONS__], + [ac_cv_safe_to_define___extensions__], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([[ +# define __EXTENSIONS__ 1 + ]AC_INCLUDES_DEFAULT])], + [ac_cv_safe_to_define___extensions__=yes], + [ac_cv_safe_to_define___extensions__=no])]) + test $ac_cv_safe_to_define___extensions__ = yes && + AC_DEFINE([__EXTENSIONS__]) + AC_DEFINE([_ALL_SOURCE]) + AC_DEFINE([_GNU_SOURCE]) + AC_DEFINE([_POSIX_PTHREAD_SEMANTICS]) + AC_DEFINE([_TANDEM_SOURCE]) +])# AC_USE_SYSTEM_EXTENSIONS + +# gl_USE_SYSTEM_EXTENSIONS +# ------------------------ +# Enable extensions on systems that normally disable them, +# typically due to standards-conformance issues. +AC_DEFUN([gl_USE_SYSTEM_EXTENSIONS], + [AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS])]) diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 new file mode 100644 index 000000000..34d91c728 --- /dev/null +++ b/m4/gnulib-common.m4 @@ -0,0 +1,91 @@ +# gnulib-common.m4 serial 5 +dnl Copyright (C) 2007-2008 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +# gl_COMMON +# is expanded unconditionally through gnulib-tool magic. +AC_DEFUN([gl_COMMON], [ + dnl Use AC_REQUIRE here, so that the code is expanded once only. + AC_REQUIRE([gl_COMMON_BODY]) +]) +AC_DEFUN([gl_COMMON_BODY], [ + AH_VERBATIM([isoc99_inline], +[/* Work around a bug in Apple GCC 4.0.1 build 5465: In C99 mode, it supports + the ISO C 99 semantics of 'extern inline' (unlike the GNU C semantics of + earlier versions), but does not display it by setting __GNUC_STDC_INLINE__. + __APPLE__ && __MACH__ test for MacOS X. + __APPLE_CC__ tests for the Apple compiler and its version. + __STDC_VERSION__ tests for the C99 mode. */ +#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined __cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__ +# define __GNUC_STDC_INLINE__ 1 +#endif]) +]) + +# gl_MODULE_INDICATOR([modulename]) +# defines a C macro indicating the presence of the given module. +AC_DEFUN([gl_MODULE_INDICATOR], +[ + AC_DEFINE([GNULIB_]translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___]), [1], + [Define to 1 when using the gnulib module ]$1[.]) +]) + +# m4_foreach_w +# is a backport of autoconf-2.59c's m4_foreach_w. +# Remove this macro when we can assume autoconf >= 2.60. +m4_ifndef([m4_foreach_w], + [m4_define([m4_foreach_w], + [m4_foreach([$1], m4_split(m4_normalize([$2]), [ ]), [$3])])]) + +# AC_PROG_MKDIR_P +# is a backport of autoconf-2.60's AC_PROG_MKDIR_P. +# Remove this macro when we can assume autoconf >= 2.60. +m4_ifdef([AC_PROG_MKDIR_P], [], [ + AC_DEFUN([AC_PROG_MKDIR_P], + [AC_REQUIRE([AM_PROG_MKDIR_P])dnl defined by automake + MKDIR_P='$(mkdir_p)' + AC_SUBST([MKDIR_P])])]) + +# AC_C_RESTRICT +# This definition overrides the AC_C_RESTRICT macro from autoconf 2.60..2.61, +# so that mixed use of GNU C and GNU C++ and mixed use of Sun C and Sun C++ +# works. +# This definition can be removed once autoconf >= 2.62 can be assumed. +AC_DEFUN([AC_C_RESTRICT], +[AC_CACHE_CHECK([for C/C++ restrict keyword], ac_cv_c_restrict, + [ac_cv_c_restrict=no + # The order here caters to the fact that C++ does not require restrict. + for ac_kw in __restrict __restrict__ _Restrict restrict; do + AC_COMPILE_IFELSE([AC_LANG_PROGRAM( + [[typedef int * int_ptr; + int foo (int_ptr $ac_kw ip) { + return ip[0]; + }]], + [[int s[1]; + int * $ac_kw t = s; + t[0] = 0; + return foo(t)]])], + [ac_cv_c_restrict=$ac_kw]) + test "$ac_cv_c_restrict" != no && break + done + ]) + AH_VERBATIM([restrict], +[/* Define to the equivalent of the C99 'restrict' keyword, or to + nothing if this is not supported. Do not define if restrict is + supported directly. */ +#undef restrict +/* Work around a bug in Sun C++: it does not support _Restrict, even + though the corresponding Sun C compiler does, which causes + "#define restrict _Restrict" in the previous line. Perhaps some future + version of Sun C++ will work with _Restrict; if so, it'll probably + define __RESTRICT, just as Sun C does. */ +#if defined __SUNPRO_CC && !defined __RESTRICT +# define _Restrict +#endif]) + case $ac_cv_c_restrict in + restrict) ;; + no) AC_DEFINE([restrict], []) ;; + *) AC_DEFINE_UNQUOTED([restrict], [$ac_cv_c_restrict]) ;; + esac +]) diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 new file mode 100644 index 000000000..7256de8c6 --- /dev/null +++ b/m4/gnulib-comp.m4 @@ -0,0 +1,192 @@ +# DO NOT EDIT! GENERATED AUTOMATICALLY! +# Copyright (C) 2002-2008 Free Software Foundation, Inc. +# +# This file is free software, distributed under the terms of the GNU +# General Public License. As a special exception to the GNU General +# Public License, this file may be distributed as part of a program +# that contains a configuration script generated by Autoconf, under +# the same distribution terms as the rest of that program. +# +# Generated by gnulib-tool. +# +# This file represents the compiled summary of the specification in +# gnulib-cache.m4. It lists the computed macro invocations that need +# to be invoked from configure.ac. +# In projects using CVS, this file can be treated like other built files. + + +# This macro should be invoked from ./configure.in, in the section +# "Checks for programs", right after AC_PROG_CC, and certainly before +# any checks for libraries, header files, types and library functions. +AC_DEFUN([gl_EARLY], +[ + m4_pattern_forbid([^gl_[A-Z]])dnl the gnulib macro namespace + m4_pattern_allow([^gl_ES$])dnl a valid locale name + m4_pattern_allow([^gl_LIBOBJS$])dnl a variable + m4_pattern_allow([^gl_LTLIBOBJS$])dnl a variable + AC_REQUIRE([AC_PROG_RANLIB]) + AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) +]) + +# This macro should be invoked from ./configure.in, in the section +# "Check for header files, types and library functions". +AC_DEFUN([gl_INIT], +[ + AM_CONDITIONAL([GL_COND_LIBTOOL], [true]) + gl_cond_libtool=true + m4_pushdef([AC_LIBOBJ], m4_defn([gl_LIBOBJ])) + m4_pushdef([AC_REPLACE_FUNCS], m4_defn([gl_REPLACE_FUNCS])) + m4_pushdef([AC_LIBSOURCES], m4_defn([gl_LIBSOURCES])) + m4_pushdef([gl_LIBSOURCES_LIST], []) + m4_pushdef([gl_LIBSOURCES_DIR], []) + gl_COMMON + gl_source_base='lib' +changequote(,)dnl +LTALLOCA=`echo "$ALLOCA" | sed 's/\.[^.]* /.lo /g;s/\.[^.]*$/.lo/'` +changequote([, ])dnl +AC_SUBST([LTALLOCA]) + gl_FUNC_ALLOCA + gl_STRCASE + gl_HEADER_STRINGS_H + m4_ifval(gl_LIBSOURCES_LIST, [ + m4_syscmd([test ! -d ]m4_defn([gl_LIBSOURCES_DIR])[ || + for gl_file in ]gl_LIBSOURCES_LIST[ ; do + if test ! -r ]m4_defn([gl_LIBSOURCES_DIR])[/$gl_file ; then + echo "missing file ]m4_defn([gl_LIBSOURCES_DIR])[/$gl_file" >&2 + exit 1 + fi + done])dnl + m4_if(m4_sysval, [0], [], + [AC_FATAL([expected source file, required through AC_LIBSOURCES, not found])]) + ]) + m4_popdef([gl_LIBSOURCES_DIR]) + m4_popdef([gl_LIBSOURCES_LIST]) + m4_popdef([AC_LIBSOURCES]) + m4_popdef([AC_REPLACE_FUNCS]) + m4_popdef([AC_LIBOBJ]) + AC_CONFIG_COMMANDS_PRE([ + gl_libobjs= + gl_ltlibobjs= + if test -n "$gl_LIBOBJS"; then + # Remove the extension. + sed_drop_objext='s/\.o$//;s/\.obj$//' + for i in `for i in $gl_LIBOBJS; do echo "$i"; done | sed "$sed_drop_objext" | sort | uniq`; do + gl_libobjs="$gl_libobjs $i.$ac_objext" + gl_ltlibobjs="$gl_ltlibobjs $i.lo" + done + fi + AC_SUBST([gl_LIBOBJS], [$gl_libobjs]) + AC_SUBST([gl_LTLIBOBJS], [$gl_ltlibobjs]) + ]) + gltests_libdeps= + gltests_ltlibdeps= + m4_pushdef([AC_LIBOBJ], m4_defn([gltests_LIBOBJ])) + m4_pushdef([AC_REPLACE_FUNCS], m4_defn([gltests_REPLACE_FUNCS])) + m4_pushdef([AC_LIBSOURCES], m4_defn([gltests_LIBSOURCES])) + m4_pushdef([gltests_LIBSOURCES_LIST], []) + m4_pushdef([gltests_LIBSOURCES_DIR], []) + gl_COMMON + gl_source_base='tests' + m4_ifval(gltests_LIBSOURCES_LIST, [ + m4_syscmd([test ! -d ]m4_defn([gltests_LIBSOURCES_DIR])[ || + for gl_file in ]gltests_LIBSOURCES_LIST[ ; do + if test ! -r ]m4_defn([gltests_LIBSOURCES_DIR])[/$gl_file ; then + echo "missing file ]m4_defn([gltests_LIBSOURCES_DIR])[/$gl_file" >&2 + exit 1 + fi + done])dnl + m4_if(m4_sysval, [0], [], + [AC_FATAL([expected source file, required through AC_LIBSOURCES, not found])]) + ]) + m4_popdef([gltests_LIBSOURCES_DIR]) + m4_popdef([gltests_LIBSOURCES_LIST]) + m4_popdef([AC_LIBSOURCES]) + m4_popdef([AC_REPLACE_FUNCS]) + m4_popdef([AC_LIBOBJ]) + AC_CONFIG_COMMANDS_PRE([ + gltests_libobjs= + gltests_ltlibobjs= + if test -n "$gltests_LIBOBJS"; then + # Remove the extension. + sed_drop_objext='s/\.o$//;s/\.obj$//' + for i in `for i in $gltests_LIBOBJS; do echo "$i"; done | sed "$sed_drop_objext" | sort | uniq`; do + gltests_libobjs="$gltests_libobjs $i.$ac_objext" + gltests_ltlibobjs="$gltests_ltlibobjs $i.lo" + done + fi + AC_SUBST([gltests_LIBOBJS], [$gltests_libobjs]) + AC_SUBST([gltests_LTLIBOBJS], [$gltests_ltlibobjs]) + ]) +]) + +# Like AC_LIBOBJ, except that the module name goes +# into gl_LIBOBJS instead of into LIBOBJS. +AC_DEFUN([gl_LIBOBJ], [ + AS_LITERAL_IF([$1], [gl_LIBSOURCES([$1.c])])dnl + gl_LIBOBJS="$gl_LIBOBJS $1.$ac_objext" +]) + +# Like AC_REPLACE_FUNCS, except that the module name goes +# into gl_LIBOBJS instead of into LIBOBJS. +AC_DEFUN([gl_REPLACE_FUNCS], [ + m4_foreach_w([gl_NAME], [$1], [AC_LIBSOURCES(gl_NAME[.c])])dnl + AC_CHECK_FUNCS([$1], , [gl_LIBOBJ($ac_func)]) +]) + +# Like AC_LIBSOURCES, except the directory where the source file is +# expected is derived from the gnulib-tool parameterization, +# and alloca is special cased (for the alloca-opt module). +# We could also entirely rely on EXTRA_lib..._SOURCES. +AC_DEFUN([gl_LIBSOURCES], [ + m4_foreach([_gl_NAME], [$1], [ + m4_if(_gl_NAME, [alloca.c], [], [ + m4_define([gl_LIBSOURCES_DIR], [lib]) + m4_append([gl_LIBSOURCES_LIST], _gl_NAME, [ ]) + ]) + ]) +]) + +# Like AC_LIBOBJ, except that the module name goes +# into gltests_LIBOBJS instead of into LIBOBJS. +AC_DEFUN([gltests_LIBOBJ], [ + AS_LITERAL_IF([$1], [gltests_LIBSOURCES([$1.c])])dnl + gltests_LIBOBJS="$gltests_LIBOBJS $1.$ac_objext" +]) + +# Like AC_REPLACE_FUNCS, except that the module name goes +# into gltests_LIBOBJS instead of into LIBOBJS. +AC_DEFUN([gltests_REPLACE_FUNCS], [ + m4_foreach_w([gl_NAME], [$1], [AC_LIBSOURCES(gl_NAME[.c])])dnl + AC_CHECK_FUNCS([$1], , [gltests_LIBOBJ($ac_func)]) +]) + +# Like AC_LIBSOURCES, except the directory where the source file is +# expected is derived from the gnulib-tool parameterization, +# and alloca is special cased (for the alloca-opt module). +# We could also entirely rely on EXTRA_lib..._SOURCES. +AC_DEFUN([gltests_LIBSOURCES], [ + m4_foreach([_gl_NAME], [$1], [ + m4_if(_gl_NAME, [alloca.c], [], [ + m4_define([gltests_LIBSOURCES_DIR], [tests]) + m4_append([gltests_LIBSOURCES_LIST], _gl_NAME, [ ]) + ]) + ]) +]) + +# This macro records the list of files which have been installed by +# gnulib-tool and may be removed by future gnulib-tool invocations. +AC_DEFUN([gl_FILE_LIST], [ + build-aux/link-warning.h + lib/alloca.c + lib/alloca.in.h + lib/dummy.c + lib/strcasecmp.c + lib/strings.in.h + lib/strncasecmp.c + m4/alloca.m4 + m4/extensions.m4 + m4/gnulib-common.m4 + m4/include_next.m4 + m4/strcase.m4 + m4/strings_h.m4 +]) diff --git a/m4/gnulib-tool.m4 b/m4/gnulib-tool.m4 new file mode 100644 index 000000000..4438d4886 --- /dev/null +++ b/m4/gnulib-tool.m4 @@ -0,0 +1,57 @@ +# gnulib-tool.m4 serial 2 +dnl Copyright (C) 2004-2005 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl The following macros need not be invoked explicitly. +dnl Invoking them does nothing except to declare default arguments +dnl for "gnulib-tool --import". + +dnl Usage: gl_LOCAL_DIR([DIR]) +AC_DEFUN([gl_LOCAL_DIR], []) + +dnl Usage: gl_MODULES([module1 module2 ...]) +AC_DEFUN([gl_MODULES], []) + +dnl Usage: gl_AVOID([module1 module2 ...]) +AC_DEFUN([gl_AVOID], []) + +dnl Usage: gl_SOURCE_BASE([DIR]) +AC_DEFUN([gl_SOURCE_BASE], []) + +dnl Usage: gl_M4_BASE([DIR]) +AC_DEFUN([gl_M4_BASE], []) + +dnl Usage: gl_PO_BASE([DIR]) +AC_DEFUN([gl_PO_BASE], []) + +dnl Usage: gl_DOC_BASE([DIR]) +AC_DEFUN([gl_DOC_BASE], []) + +dnl Usage: gl_TESTS_BASE([DIR]) +AC_DEFUN([gl_TESTS_BASE], []) + +dnl Usage: gl_WITH_TESTS +AC_DEFUN([gl_WITH_TESTS], []) + +dnl Usage: gl_LIB([LIBNAME]) +AC_DEFUN([gl_LIB], []) + +dnl Usage: gl_LGPL or gl_LGPL([VERSION]) +AC_DEFUN([gl_LGPL], []) + +dnl Usage: gl_MAKEFILE_NAME([FILENAME]) +AC_DEFUN([gl_MAKEFILE_NAME], []) + +dnl Usage: gl_LIBTOOL +AC_DEFUN([gl_LIBTOOL], []) + +dnl Usage: gl_MACRO_PREFIX([PREFIX]) +AC_DEFUN([gl_MACRO_PREFIX], []) + +dnl Usage: gl_PO_DOMAIN([DOMAIN]) +AC_DEFUN([gl_PO_DOMAIN], []) + +dnl Usage: gl_VC_FILES([BOOLEAN]) +AC_DEFUN([gl_VC_FILES], []) diff --git a/m4/include_next.m4 b/m4/include_next.m4 new file mode 100644 index 000000000..a842e2a23 --- /dev/null +++ b/m4/include_next.m4 @@ -0,0 +1,110 @@ +# include_next.m4 serial 6 +dnl Copyright (C) 2006-2008 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl From Paul Eggert and Derek Price. + +AC_DEFUN([gl_INCLUDE_NEXT], +[ + AC_LANG_PREPROC_REQUIRE() + AC_CACHE_CHECK([whether the preprocessor supports include_next], + [gl_cv_have_include_next], + [rm -rf conftestd1 conftestd2 + mkdir conftestd1 conftestd2 + cat < conftestd1/conftest.h +#define DEFINED_IN_CONFTESTD1 +#include_next +#ifdef DEFINED_IN_CONFTESTD2 +int foo; +#else +#error "include_next doesn't work" +#endif +EOF + cat < conftestd2/conftest.h +#ifndef DEFINED_IN_CONFTESTD1 +#error "include_next test doesn't work" +#endif +#define DEFINED_IN_CONFTESTD2 +EOF + save_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$CPPFLAGS -Iconftestd1 -Iconftestd2" + AC_COMPILE_IFELSE([#include ], + [gl_cv_have_include_next=yes], + [gl_cv_have_include_next=no]) + CPPFLAGS="$save_CPPFLAGS" + rm -rf conftestd1 conftestd2 + ]) + if test $gl_cv_have_include_next = yes; then + + dnl FIXME: Remove HAVE_INCLUDE_NEXT and update everything that uses it + dnl to use @INCLUDE_NEXT@ instead. + AC_DEFINE([HAVE_INCLUDE_NEXT], 1, + [Define if your compiler supports the #include_next directive.]) + + INCLUDE_NEXT=include_next + else + INCLUDE_NEXT=include + fi + AC_SUBST([INCLUDE_NEXT]) +]) + +# gl_CHECK_NEXT_HEADERS(HEADER1 HEADER2 ...) +# ------------------------------------------ +# For each arg foo.h, if #include_next works, define NEXT_FOO_H to be +# ''; otherwise define it to be +# '"///usr/include/foo.h"', or whatever other absolute file name is suitable. +# That way, a header file with the following line: +# #@INCLUDE_NEXT@ @NEXT_FOO_H@ +# behaves (after sed substitution) as if it contained +# #include_next +# even if the compiler does not support include_next. +# The three "///" are to pacify Sun C 5.8, which otherwise would say +# "warning: #include of /usr/include/... may be non-portable". +# Use `""', not `<>', so that the /// cannot be confused with a C99 comment. +# Note: This macro assumes that the header file is not empty after +# preprocessing, i.e. it does not only define preprocessor macros but also +# provides some type/enum definitions or function/variable declarations. +AC_DEFUN([gl_CHECK_NEXT_HEADERS], +[ + AC_REQUIRE([gl_INCLUDE_NEXT]) + AC_CHECK_HEADERS_ONCE([$1]) + + m4_foreach_w([gl_HEADER_NAME], [$1], + [AS_VAR_PUSHDEF([gl_next_header], + [gl_cv_next_]m4_quote(m4_defn([gl_HEADER_NAME]))) + if test $gl_cv_have_include_next = yes; then + AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>']) + else + AC_CACHE_CHECK( + [absolute name of <]m4_quote(m4_defn([gl_HEADER_NAME]))[>], + m4_quote(m4_defn([gl_next_header])), + [AS_VAR_PUSHDEF([gl_header_exists], + [ac_cv_header_]m4_quote(m4_defn([gl_HEADER_NAME]))) + if test AS_VAR_GET(gl_header_exists) = yes; then + AC_LANG_CONFTEST( + [AC_LANG_SOURCE( + [[#include <]]m4_dquote(m4_defn([gl_HEADER_NAME]))[[>]] + )]) + dnl eval is necessary to expand ac_cpp. + dnl Ultrix and Pyramid sh refuse to redirect output of eval, + dnl so use subshell. + AS_VAR_SET([gl_next_header], + ['"'`(eval "$ac_cpp conftest.$ac_ext") 2>&AS_MESSAGE_LOG_FD | + sed -n '\#/]m4_quote(m4_defn([gl_HEADER_NAME]))[#{ + s#.*"\(.*/]m4_quote(m4_defn([gl_HEADER_NAME]))[\)".*#\1# + s#^/[^/]#//&# + p + q + }'`'"']) + else + AS_VAR_SET([gl_next_header], ['<'gl_HEADER_NAME'>']) + fi + AS_VAR_POPDEF([gl_header_exists])]) + fi + AC_SUBST( + AS_TR_CPP([NEXT_]m4_quote(m4_defn([gl_HEADER_NAME]))), + [AS_VAR_GET([gl_next_header])]) + AS_VAR_POPDEF([gl_next_header])]) +]) diff --git a/m4/strcase.m4 b/m4/strcase.m4 new file mode 100644 index 000000000..79c525c11 --- /dev/null +++ b/m4/strcase.m4 @@ -0,0 +1,44 @@ +# strcase.m4 serial 9 +dnl Copyright (C) 2002, 2005-2008 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_STRCASE], +[ + gl_FUNC_STRCASECMP + gl_FUNC_STRNCASECMP +]) + +AC_DEFUN([gl_FUNC_STRCASECMP], +[ + AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS]) + AC_REPLACE_FUNCS(strcasecmp) + if test $ac_cv_func_strcasecmp = no; then + HAVE_STRCASECMP=0 + gl_PREREQ_STRCASECMP + fi +]) + +AC_DEFUN([gl_FUNC_STRNCASECMP], +[ + AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS]) + AC_REPLACE_FUNCS(strncasecmp) + if test $ac_cv_func_strncasecmp = no; then + gl_PREREQ_STRNCASECMP + fi + AC_CHECK_DECLS(strncasecmp) + if test $ac_cv_have_decl_strncasecmp = no; then + HAVE_DECL_STRNCASECMP=0 + fi +]) + +# Prerequisites of lib/strcasecmp.c. +AC_DEFUN([gl_PREREQ_STRCASECMP], [ + : +]) + +# Prerequisites of lib/strncasecmp.c. +AC_DEFUN([gl_PREREQ_STRNCASECMP], [ + : +]) diff --git a/m4/strings_h.m4 b/m4/strings_h.m4 new file mode 100644 index 000000000..03ac182f3 --- /dev/null +++ b/m4/strings_h.m4 @@ -0,0 +1,33 @@ +# Configure a replacement for . + +# Copyright (C) 2007 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_HEADER_STRINGS_H], +[ + dnl Use AC_REQUIRE here, so that the default behavior below is expanded + dnl once only, before all statements that occur in other macros. + AC_REQUIRE([gl_HEADER_STRINGS_H_BODY]) +]) + +AC_DEFUN([gl_HEADER_STRINGS_H_BODY], +[ + AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS]) + gl_CHECK_NEXT_HEADERS([strings.h]) +]) + +AC_DEFUN([gl_STRINGS_MODULE_INDICATOR], +[ + dnl Use AC_REQUIRE here, so that the default settings are expanded once only. + AC_REQUIRE([gl_HEADER_STRINGS_H_DEFAULTS]) + GNULIB_[]m4_translit([$1],[abcdefghijklmnopqrstuvwxyz./-],[ABCDEFGHIJKLMNOPQRSTUVWXYZ___])=1 +]) + +AC_DEFUN([gl_HEADER_STRINGS_H_DEFAULTS], +[ + dnl Assume proper GNU behavior unless another module says otherwise. + HAVE_STRCASECMP=1; AC_SUBST([HAVE_STRCASECMP]) + HAVE_DECL_STRNCASECMP=1; AC_SUBST([HAVE_DECL_STRNCASECMP]) +]) From 1f5844000e11a4efda65c34fcd9af4e5f152b537 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 21 Aug 2008 23:16:20 -0300 Subject: [PATCH 85/87] Style nitpicks: space before () in function call. --- libguile/gc-card.c | 26 +++++++++++++------------- libguile/gc-freelist.c | 12 ++++++------ libguile/gc-malloc.c | 10 +++++----- libguile/gc-mark.c | 12 ++++++------ libguile/gc-segment-table.c | 6 +++--- libguile/gc-segment.c | 2 +- libguile/gc.c | 16 ++++++++-------- 7 files changed, 42 insertions(+), 42 deletions(-) diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 2a22fc544..d1e08f336 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -58,14 +58,14 @@ SCM scm_i_structs_to_free; we do not actually free the cell. To make the numbers match up, we do increase the FREE_COUNT. - It would be cleaner to have a separate function sweep_value(), but + It would be cleaner to have a separate function sweep_value (), but that is too slow (functions with switch statements can't be inlined). NOTE: For many types of cells, allocation and a de-allocation involves - calling malloc() and free(). This is costly for small objects (due + calling malloc () and free (). This is costly for small objects (due to malloc/free overhead.) (should measure this). It might also be bad for threads: if several threads are allocating @@ -81,7 +81,7 @@ int scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg) #define FUNC_NAME "sweep_card" { - scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(card); + scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC (card); scm_t_cell *end = card + SCM_GC_CARD_N_CELLS; scm_t_cell *p = card; int span = seg->span; @@ -175,7 +175,7 @@ scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg) if (!(k < scm_numptob)) { fprintf (stderr, "undefined port type"); - abort(); + abort (); } #endif /* Keep "revealed" ports alive. */ @@ -220,7 +220,7 @@ scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg) if (!(k < scm_numsmob)) { fprintf (stderr, "undefined smob type"); - abort(); + abort (); } #endif if (scm_smobs[k].free) @@ -238,7 +238,7 @@ scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg) SCM_SMOBNAME (k)); scm_i_deprecated_memory_return += mm; #else - abort(); + abort (); #endif } } @@ -248,7 +248,7 @@ scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg) break; default: fprintf (stderr, "unknown type"); - abort(); + abort (); } SCM_GC_SET_CELL_WORD (scmptr, 0, scm_tc_free_cell); @@ -296,7 +296,7 @@ scm_i_init_card_freelist (scm_t_cell *card, SCM *free_list, /* Classic MIT Hack, see e.g. http://www.tekpool.com/?cat=9 */ -int scm_i_uint_bit_count(unsigned int u) +int scm_i_uint_bit_count (unsigned int u) { unsigned int u_count = u - ((u >> 1) & 033333333333) @@ -317,7 +317,7 @@ scm_i_card_marked_count (scm_t_cell *card, int span) int count = 0; while (bvec < bvec_end) { - count += scm_i_uint_bit_count(*bvec); + count += scm_i_uint_bit_count (*bvec); bvec ++; } return count * span; @@ -326,7 +326,7 @@ scm_i_card_marked_count (scm_t_cell *card, int span) void scm_i_card_statistics (scm_t_cell *p, SCM hashtab, scm_t_heap_segment *seg) { - scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC(p); + scm_t_c_bvec_long *bitvec = SCM_GC_CARD_BVEC (p); scm_t_cell * end = p + SCM_GC_CARD_N_CELLS; int span = seg->span; int offset = SCM_MAX (SCM_GC_CARD_N_HEADER_CELLS, span); @@ -436,7 +436,7 @@ scm_i_tag_name (scm_t_bits tag) case scm_tc7_smob: /* scm_tc_free_cell is smob 0, the name field in that scm_smobs[] entry should be ok for our return here */ - return scm_smobs[SCM_TC2SMOBNUM(tag)].name; + return scm_smobs[SCM_TC2SMOBNUM (tag)].name; } return NULL; @@ -468,7 +468,7 @@ int scm_dbg_gc_marked_p (SCM obj) { if (!SCM_IMP (obj)) - return SCM_GC_MARK_P(obj); + return SCM_GC_MARK_P (obj); else return 0; } @@ -477,7 +477,7 @@ scm_t_cell * scm_dbg_gc_get_card (SCM obj) { if (!SCM_IMP (obj)) - return SCM_GC_CELL_CARD(obj); + return SCM_GC_CELL_CARD (obj); else return NULL; } diff --git a/libguile/gc-freelist.c b/libguile/gc-freelist.c index 491512055..861af5765 100644 --- a/libguile/gc-freelist.c +++ b/libguile/gc-freelist.c @@ -129,15 +129,15 @@ scm_gc_init_freelist (void) if (scm_i_get_new_heap_segment (&scm_i_master_freelist, init_heap_size_1, return_on_error) == -1) { fprintf (stderr, error_message, init_heap_size_1, 1); - abort(); + abort (); } if (scm_i_get_new_heap_segment (&scm_i_master_freelist2, init_heap_size_2, return_on_error) == -1) { fprintf (stderr, error_message, init_heap_size_2, 2); - abort(); + abort (); } - check_deprecated_heap_vars(); + check_deprecated_heap_vars (); } @@ -178,9 +178,9 @@ scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist) float swept = freelist->swept; float delta = ((f * swept - collected) / (1.0 - f)); - assert(freelist->heap_total_cells >= freelist->collected); - assert(freelist->swept == freelist->heap_total_cells); - assert(swept >= collected); + assert (freelist->heap_total_cells >= freelist->collected); + assert (freelist->swept == freelist->heap_total_cells); + assert (swept >= collected); return delta; } diff --git a/libguile/gc-malloc.c b/libguile/gc-malloc.c index 4e06f2f69..2f6ea21d8 100644 --- a/libguile/gc-malloc.c +++ b/libguile/gc-malloc.c @@ -119,7 +119,7 @@ scm_realloc (void *mem, size_t size) We don't want these sweep statistics to influence results for cell GC, so we don't collect statistics. - realloc() failed, so we're really desparate to free memory. Run a + realloc () failed, so we're really desparate to free memory. Run a full sweep. */ scm_i_sweep_all_segments ("realloc", NULL); @@ -314,7 +314,7 @@ scm_gc_malloc (size_t size, const char *what) again in scm_gc_register_collectable_memory. We don't really want the second GC since it will not find new garbage. - Note: this is a theoretical peeve. In reality, malloc() never + Note: this is a theoretical peeve. In reality, malloc () never returns NULL. Usually, memory is overcommitted, and when you try to write it the program is killed with signal 11. --hwn */ @@ -342,10 +342,10 @@ scm_gc_realloc (void *mem, size_t old_size, size_t new_size, const char *what) /* - scm_realloc() may invalidate the block pointed to by WHERE, eg. by + scm_realloc () may invalidate the block pointed to by WHERE, eg. by unmapping it from memory or altering the contents. Since - increase_mtrigger() might trigger a GC that would scan - MEM, it is crucial that this call precedes realloc(). + increase_mtrigger () might trigger a GC that would scan + MEM, it is crucial that this call precedes realloc (). */ decrease_mtrigger (old_size, what); diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 50cd844c9..d72caf1ac 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -339,10 +339,10 @@ scm_gc_mark_dependencies (SCM p) if (!(i < scm_numptob)) { fprintf (stderr, "undefined port type"); - abort(); + abort (); } #endif - if (SCM_PTAB_ENTRY(ptr)) + if (SCM_PTAB_ENTRY (ptr)) scm_gc_mark (SCM_FILENAME (ptr)); if (scm_ptobs[i].mark) { @@ -366,7 +366,7 @@ scm_gc_mark_dependencies (SCM p) if (!(i < scm_numsmob)) { fprintf (stderr, "undefined smob type"); - abort(); + abort (); } #endif if (scm_smobs[i].mark) @@ -380,7 +380,7 @@ scm_gc_mark_dependencies (SCM p) break; default: fprintf (stderr, "unknown type"); - abort(); + abort (); } /* @@ -411,7 +411,7 @@ scm_gc_mark_dependencies (SCM p) if (!valid_cell) { fprintf (stderr, "rogue pointer in heap"); - abort(); + abort (); } } @@ -503,7 +503,7 @@ scm_deprecated_newcell2 (void) void -scm_gc_init_mark(void) +scm_gc_init_mark (void) { #if SCM_ENABLE_DEPRECATED == 1 scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0); diff --git a/libguile/gc-segment-table.c b/libguile/gc-segment-table.c index 4b809ae4b..d0d70fdad 100644 --- a/libguile/gc-segment-table.c +++ b/libguile/gc-segment-table.c @@ -53,7 +53,7 @@ int scm_i_insert_segment (scm_t_heap_segment *seg) { size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *); - SCM_SYSCALL(scm_i_heap_segment_table + SCM_SYSCALL (scm_i_heap_segment_table = ((scm_t_heap_segment **) realloc ((char *)scm_i_heap_segment_table, size))); @@ -256,13 +256,13 @@ scm_i_all_segments_statistics (SCM tab) unsigned long* -scm_i_segment_table_info(int* size) +scm_i_segment_table_info (int* size) { *size = scm_i_heap_segment_table_size; unsigned long *bounds = malloc (sizeof (unsigned long) * *size * 2); int i; if (!bounds) - abort(); + abort (); for (i = *size; i-- > 0; ) { bounds[2*i] = (unsigned long)scm_i_heap_segment_table[i]->bounds[0]; diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 0668d1561..921459fca 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -108,7 +108,7 @@ scm_i_heap_segment_marked_count (scm_t_heap_segment *seg) int count = 0; while (bvec < bvec_end) { - count += scm_i_uint_bit_count(*bvec); + count += scm_i_uint_bit_count (*bvec); bvec ++; } return count * seg->span; diff --git a/libguile/gc.c b/libguile/gc.c index ce3cb54f8..a293400fa 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -387,7 +387,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0, scm_cons (sym_cells_swept, scm_from_double (local_scm_gc_cells_swept)), scm_cons (sym_malloc_yield, - scm_from_long(local_scm_gc_malloc_yield_percentage)), + scm_from_long (local_scm_gc_malloc_yield_percentage)), scm_cons (sym_cell_yield, scm_from_long (local_scm_gc_cell_yield_percentage)), scm_cons (sym_protected_objects, @@ -538,7 +538,7 @@ scm_t_c_hook scm_after_sweep_c_hook; scm_t_c_hook scm_after_gc_c_hook; static void -scm_check_deprecated_memory_return() +scm_check_deprecated_memory_return () { if (scm_mallocated < scm_i_deprecated_memory_return) { @@ -584,7 +584,7 @@ scm_i_gc (const char *what) scm_gc_malloc_collected = 0; /* - Set freelists to NULL so scm_cons() always triggers gc, causing + Set freelists to NULL so scm_cons () always triggers gc, causing the assertion above to fail. */ *SCM_FREELIST_LOC (scm_i_freelist) = SCM_EOL; @@ -595,7 +595,7 @@ scm_i_gc (const char *what) garbage, and marking that would create a mess. */ scm_i_sweep_all_segments ("GC", &scm_i_gc_sweep_stats); - scm_check_deprecated_memory_return(); + scm_check_deprecated_memory_return (); /* Sanity check our numbers. */ @@ -670,7 +670,7 @@ scm_i_gc (const char *what) scm_i_thread_wake_up (); /* For debugging purposes, you could do - scm_i_sweep_all_segments("debug"), but then the remains of the + scm_i_sweep_all_segments ("debug"), but then the remains of the cell aren't left to analyse. */ } @@ -774,7 +774,7 @@ scm_permanent_object (SCM obj) */ /* Implementation note: For every object X, there is a counter which - scm_gc_protect_object(X) increments and scm_gc_unprotect_object(X) decrements. + scm_gc_protect_object (X) increments and scm_gc_unprotect_object (X) decrements. */ @@ -949,7 +949,7 @@ scm_init_storage () while (j) scm_sys_protects[--j] = SCM_BOOL_F; - scm_gc_init_freelist(); + scm_gc_init_freelist (); scm_gc_init_malloc (); #if 0 @@ -1071,7 +1071,7 @@ void * scm_ia64_ar_bsp (const void *ctx) { uint64_t bsp; - __uc_get_ar_bsp(ctx, &bsp); + __uc_get_ar_bsp (ctx, &bsp); return (void *) bsp; } # endif /* hpux */ From 4b7513463d20acca02ed233583fef958352f2c71 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Thu, 21 Aug 2008 23:21:57 -0300 Subject: [PATCH 86/87] Fix 2 indentation nitpicks. --- libguile/gc-card.c | 9 +++++---- libguile/gc-segment.c | 9 +++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/libguile/gc-card.c b/libguile/gc-card.c index d1e08f336..3511533ab 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -316,10 +316,11 @@ scm_i_card_marked_count (scm_t_cell *card, int span) scm_t_c_bvec_long* bvec_end = (bvec + SCM_GC_CARD_BVEC_SIZE_IN_LONGS); int count = 0; - while (bvec < bvec_end) { - count += scm_i_uint_bit_count (*bvec); - bvec ++; - } + while (bvec < bvec_end) + { + count += scm_i_uint_bit_count (*bvec); + bvec ++; + } return count * span; } diff --git a/libguile/gc-segment.c b/libguile/gc-segment.c index 921459fca..4f7b6d59a 100644 --- a/libguile/gc-segment.c +++ b/libguile/gc-segment.c @@ -107,10 +107,11 @@ scm_i_heap_segment_marked_count (scm_t_heap_segment *seg) scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS); int count = 0; - while (bvec < bvec_end) { - count += scm_i_uint_bit_count (*bvec); - bvec ++; - } + while (bvec < bvec_end) + { + count += scm_i_uint_bit_count (*bvec); + bvec ++; + } return count * seg->span; } From 582a4997abc8b34ac6caf374fda8ea3ac65bd571 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 25 Aug 2008 11:20:02 +0200 Subject: [PATCH 87/87] Use $(GCC_CFLAGS) for `-Werror' et al. so that it's not used to compile Gnulib code. --- ChangeLog | 6 ++++++ configure.in | 6 ++++-- libguile/ChangeLog | 5 +++++ libguile/Makefile.am | 6 ++++-- srfi/ChangeLog | 4 ++++ srfi/Makefile.am | 2 ++ test-suite/ChangeLog | 4 ++++ test-suite/standalone/Makefile.am | 2 +- 8 files changed, 30 insertions(+), 5 deletions(-) diff --git a/ChangeLog b/ChangeLog index acbaccb3b..9d3c44817 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2008-08-25 Ludovic Courtès + + * configure.in (GCC_CFLAGS): New variable. Store GCC flags like + `-Werror' inside it so that they are not used when compiling + Gnulib modules. + 2008-08-21 Ludovic Courtès * autogen.sh: Don't use `gnulib-tool', use the Gnulib files diff --git a/configure.in b/configure.in index ede0d15c1..fcccb2048 100644 --- a/configure.in +++ b/configure.in @@ -1417,17 +1417,19 @@ case "$GCC" in ## less than exasperating. ## -Wpointer-arith was here too, but something changed in gcc/glibc ## and it became equally exasperating (gcc 2.95 and/or glibc 2.1.2). - CFLAGS="$CFLAGS -Wall -Wmissing-prototypes" + GCC_CFLAGS="-Wall -Wmissing-prototypes" # Do this here so we don't screw up any of the tests above that might # not be "warning free" if test "${GUILE_ERROR_ON_WARNING}" = yes then - CFLAGS="${CFLAGS} -Werror" + GCC_CFLAGS="${GCC_CFLAGS} -Werror" enable_compile_warnings=no fi ;; esac +AC_SUBST(GCC_CFLAGS) + ## If we're creating a shared library (using libtool!), then we'll ## need to generate a list of .lo files corresponding to the .o files ## given in LIBOBJS. We'll call it LIBLOBJS. diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 518dcd466..a3c9767f9 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,8 @@ +2008-08-25 Ludovic Courtès + + * Makefile.am (AM_CFLAGS): New. + (guile_CFLAGS, libguile_la_CFLAGS): Use it. + 2008-08-20 Ludovic Courtès * eval.c, filesys.c, gc.c, numbers.c, stime.c, threads.c: Don't diff --git a/libguile/Makefile.am b/libguile/Makefile.am index a68ebbaa2..579ae89a2 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -35,6 +35,8 @@ DEFAULT_INCLUDES = AM_CPPFLAGS = -I$(top_srcdir) -I$(top_builddir) \ -I$(top_srcdir)/lib -I$(top_builddir)/lib +AM_CFLAGS = $(GCC_CFLAGS) + ## The Gnulib Libtool archive. gnulib_library = $(top_builddir)/lib/libgnu.la @@ -97,11 +99,11 @@ guile_filter_doc_snarfage$(EXEEXT): $(guile_filter_doc_snarfage_OBJECTS) $(guile guile_SOURCES = guile.c -guile_CFLAGS = $(GUILE_CFLAGS) +guile_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS) guile_LDADD = libguile.la guile_LDFLAGS = @DLPREOPEN@ $(GUILE_CFLAGS) -libguile_la_CFLAGS = $(GUILE_CFLAGS) +libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS) libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \ chars.c continuations.c convert.c debug.c deprecation.c \ diff --git a/srfi/ChangeLog b/srfi/ChangeLog index f35b25e16..5cba7e7b5 100644 --- a/srfi/ChangeLog +++ b/srfi/ChangeLog @@ -1,3 +1,7 @@ +2008-08-25 Ludovic Courtès + + * Makefile.am (AM_CFLAGS): New. + 2008-06-28 Ludovic Courtès * Makefile.am (INCLUDES): Renamed to... diff --git a/srfi/Makefile.am b/srfi/Makefile.am index 64858cd27..bb69bbbf2 100644 --- a/srfi/Makefile.am +++ b/srfi/Makefile.am @@ -29,6 +29,8 @@ DEFS = @DEFS@ @EXTRA_DEFS@ AM_CPPFLAGS = -I.. -I$(srcdir)/.. \ -I$(top_srcdir)/lib -I$(top_builddir)/lib +AM_CFLAGS = $(GCC_CFLAGS) + srfiincludedir = $(pkgincludedir)/srfi # These headers are visible as diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 0d6b54c9a..1c2ff80f2 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,7 @@ +2008-08-25 Ludovic Courtès + + * standalone/Makefile.am (test_cflags): Add `$(GCC_CFLAGS)'. + 2008-08-19 Ludovic Courtès * tests/goops.test (object update)[changing class, `hell' in diff --git a/test-suite/standalone/Makefile.am b/test-suite/standalone/Makefile.am index ae68d5fe1..adbe0c84f 100644 --- a/test-suite/standalone/Makefile.am +++ b/test-suite/standalone/Makefile.am @@ -34,7 +34,7 @@ test_cflags = \ -I$(top_srcdir)/test-suite/standalone \ -I$(top_srcdir) \ -I$(top_srcdir)/lib -I$(top_builddir)/lib \ - $(EXTRA_DEFS) $(GUILE_CFLAGS) + $(EXTRA_DEFS) $(GUILE_CFLAGS) $(GCC_CFLAGS) AM_LDFLAGS = $(GUILE_CFLAGS)