Merge branch 'master' into boehm-demers-weiser-gc

Conflicts:
	libguile/Makefile.am
	libguile/bytevectors.c
	libguile/gc-card.c
	libguile/gc-mark.c
	libguile/programs.c
	libguile/srcprop.c
	libguile/srfi-14.c
	libguile/symbols.c
	libguile/threads.c
	libguile/unif.c
	libguile/vm.c

.gitignore

@@ -12,7 +12,6 @@ config.guess
 config.status
 config.log
 config.h
-guile-readline-config.h
 *.doc
 *.x
 *.lo
@@ -65,8 +64,6 @@ pre-inst-guile-env
 stamp-h1
 guile-procedures.txt
 guile-config/guile-config
-guile-readline/guile-readline-config.h
-guile-readline/guile-readline-config.h.in
 *.go
 TAGS
 /meta/guile-2.0.pc
@@ -75,6 +72,8 @@ gdb-pre-inst-guile
 cscope.out
 cscope.files
 *.log
+gds-test.debug
+gds-test.transcript
 INSTALL
 *.aux
 *.cp

AUTHORS

@@ -206,8 +206,34 @@ In the subdirectory doc, changes to:
 Many changes throughout.
 
 Neil Jerram:
+In the subdirectory emacs, wrote:
+    gds.el              gds-scheme.el           gds-server.el
+    gds-test.el         gds-test.sh		gds-test.stdin
+    gds-tutorial.txt	gds-faq.txt
 In the subdirectory ice-9, wrote:
-    buffered-input.scm
+    buffered-input.scm	gds-client.scm      gds-server.scm
+In the subdirectory ice-9/debugging, wrote:
+    example-fns.scm     ice-9-debugger-extensions.scm
+    steps.scm         	trace.scm	    traps.scm
+    trc.scm
+In the subdirectory lang/elisp, wrote:
+    base.scm	        example.el	    interface.scm
+    transform.scm	variables.scm
+In the subdirectory lang/elisp/internals, wrote:
+    evaluation.scm      format.scm	    fset.scm
+    lambda.scm		load.scm	    null.scm
+    set.scm		signal.scm	    time.scm
+    trace.scm
+In the subdirectory lang/elisp/primitives, wrote:
+    buffers.scm	        char-table.scm      features.scm
+    fns.scm		format.scm	    guile.scm
+    keymaps.scm		lists.scm	    load.scm
+    match.scm		numbers.scm	    pure.scm
+    read.scm		signal.scm	    strings.scm
+    symprop.scm		syntax.scm	    system.scm
+    time.scm
+In the subdirectory srfi, wrote:
+    srfi-34.scm
 In the subdirectory doc, wrote:
     deprecated.texi   goops.texi    scheme-ideas.texi
     scheme-reading.texi
@@ -227,6 +253,7 @@ In the subdirectory doc, changes to:
     scm.texi        scripts.texi    script-getopt.texi
 In the subdirectory doc/maint, wrote:
     docstring.el
+Many other changes throughout.
 
 Thien-Thi Nguyen:
 In the top-level directory, wrote:

Makefile.am

@@ -42,6 +42,9 @@ DISTCLEANFILES = check-guile.log
 
 dist-hook: gen-ChangeLog
 
+clean-local:
+	rm -rf cache/
+
 gen_start_rev = 61db429e251bfd2f75cb4632972e0238056eb24b
 .PHONY: gen-ChangeLog
 gen-ChangeLog:

NEWS

@@ -8,100 +8,25 @@ Please send Guile bug reports to bug-guile@gnu.org.
 (During the 1.9 series, we will keep an incremental NEWS for the latest
 prerelease, and a full NEWS corresponding to 1.8 -> 2.0.)
 
-Changes in 1.9.2 (since the 1.9.1 prerelease):
+Changes in 1.9.3 (since the 1.9.2 prerelease):
 
-** VM speed improvements
+** Removed deprecated uniform array procedures: scm_make_uve,
+   scm_array_prototype, scm_list_to_uniform_array,
+   scm_dimensions_to_uniform_array, scm_make_ra, scm_shap2ra, scm_cvref,
+   scm_ra_set_contp, scm_aind, scm_raprin1
 
-Closures now copy the free variables that they need into a flat vector
+These functions have been deprecated since early 2005.
-instead of capturing all heap-allocated variables. This speeds up access
-to free variables, avoids unnecessary garbage retention, and allows all
-variables to be allocated on the stack.
 
-Variables which are `set!' are now allocated on the stack, but in
+** scm_array_p has one argument, not two
-"boxes". This allows a more uniform local variable allocation
-discipline, and allows faster access to these variables.
 
-The VM has new special-case operations, `add1' and `sub1'.
+Use of the second argument produced a deprecation warning, so it is
+unlikely that any code out there actually used this functionality.
 
-** VM robustness improvements
+** Removed deprecated uniform array procedures:
+   dimensions->uniform-array, list->uniform-array, array-prototype
 
-The maximum number of live local variables has been increased from 256
+Instead, use make-typed-array, list->typed-array, or array-type,
-to 65535.
+respectively.
-
-The default VM stack size is 64 kilo-words, up from 16 kilo-words. This
-allows more programs to execute in the default stack space. In the
-future we will probably implement extensible stacks via overflow
-handlers.
-
-Some lingering cases in which the VM could perform unaligned accesses
-have been fixed.
-
-The address range for relative jumps has been expanded from 16-bit
-addresses to 19-bit addresses via 8-byte alignment of jump targets. This
-will probably change to a 24-bit byte-addressable strategy before Guile
-2.0.
-
-** Compiler optimizations
-
-Procedures bound by `letrec' are no longer allocated on the heap,
-subject to a few constraints. In many cases, procedures bound by
-`letrec' and `let' can be rendered inline to their parent function, with
-loop detection for mutually tail-recursive procedures.
-
-Unreferenced variables are now optimized away.
-
-** Compiler robustness
-
-Guile may now warn about unused lexically-bound variables. Pass
-`-Wunused-variable' to `guile-tools compile', or `#:warnings
-(unused-variable)' within the #:opts argument to the `compile' procedure
-from `(system base compile)'.
-
-** Incomplete support for Unicode characters and strings
-
-Preliminary support for Unicode has landed. Characters may be entered in
-octal format via e.g. `#\454', or created via (integer->char 300). A hex
-external representation will probably be introduced at some point.
-
-Internally, strings are now represented either in the `latin-1'
-encoding, one byte per character, or in UTF-32, with four bytes per
-character. Strings manage their own allocation, switching if needed.
-
-Currently no locale conversion is performed. Extended characters may be
-written in a string using the hexadecimal escapes `\xXX', `\uXXXX', or
-`\UXXXXXX', for 8-bit, 16-bit, or 24-bit codepoints, respectively.
-
-This support is obviously incomplete. Many C functions have not yet been
-updated to deal with the new representations. Users are advised to wait
-for the next release for more serious use of Unicode strings.
-
-** `defined?' may accept a module as its second argument
-
-Previously it only accepted internal structures from the evaluator.
-
-** `let-values' is now implemented with a hygienic macro
-
-This could have implications discussed below in the NEWS entry titled,
-"Lexical bindings introduced by hygienic macros may not be referenced by
-nonhygienic macros".
-
-** Global variables `scm_charnames' and `scm_charnums' are removed
-
-These variables contained the names of control characters and were
-used when writing characters.  While these were global, they were
-never intended to be public API.  They have been replaced with private
-functions.
-
-** EBCDIC support is removed
-
-There was an EBCDIC compile flag that altered some of the character
-processing.  It appeared that full EBCDIC support was never completed
-and was unmaintained.
-
-** Packaging changes
-
-Guile now provides `guile-2.0.pc' (used by pkg-config) instead of
-`guile-1.8.pc'.
 
 ** And of course, the usual collection of bugfixes
  
@@ -555,6 +480,35 @@ This decision may be revisited before the 2.0 release. Feedback welcome
 to guile-devel@gnu.org (subscription required) or bug-guile@gnu.org (no
 subscription required).
 
+** Unicode characters
+
+Unicode characters may be entered in octal format via e.g. `#\454', or
+created via (integer->char 300). A hex external representation will
+probably be introduced at some point.
+
+** Unicode strings
+
+Internally, strings are now represented either in the `latin-1'
+encoding, one byte per character, or in UTF-32, with four bytes per
+character. Strings manage their own allocation, switching if needed.
+
+Currently no locale conversion is performed. Extended characters may be
+written in a string using the hexadecimal escapes `\xXX', `\uXXXX', or
+`\UXXXXXX', for 8-bit, 16-bit, or 24-bit codepoints, respectively.
+
+** Global variables `scm_charnames' and `scm_charnums' are removed
+
+These variables contained the names of control characters and were
+used when writing characters.  While these were global, they were
+never intended to be public API.  They have been replaced with private
+functions.
+
+** EBCDIC support is removed
+
+There was an EBCDIC compile flag that altered some of the character
+processing.  It appeared that full EBCDIC support was never completed
+and was unmaintained.
+
 ** New macro type: syncase-macro
 
 XXX Need to decide whether to document this for 2.0, probably should:
@@ -588,6 +542,10 @@ These are analogous to %load-path and %load-extensions.
 
 `(make-promise (lambda () foo))' is equivalent to `(delay foo)'.
 
+** `defined?' may accept a module as its second argument
+
+Previously it only accepted internal structures from the evaluator.
+
 ** New entry into %guile-build-info: `ccachedir'
 
 ** Fix bug in `module-bound?'.
@@ -601,6 +559,12 @@ the variable. This was an error, and was fixed.
 As syntax-case is available by default, importing `(ice-9 syncase)' has
 no effect, and will trigger a deprecation warning.
 
+** Removed deprecated uniform array procedures:
+   dimensions->uniform-array, list->uniform-array, array-prototype
+
+Instead, use make-typed-array, list->typed-array, or array-type,
+respectively.
+
 * Changes to the C interface
 
 ** The GH interface (deprecated in version 1.6, 2001) was removed.
@@ -629,6 +593,18 @@ definition depends on the application's value for `_FILE_OFFSET_BITS'.
 
 ** The `long_long' C type, deprecated in 1.8, has been removed
 
+** Removed deprecated uniform array procedures: scm_make_uve,
+   scm_array_prototype, scm_list_to_uniform_array,
+   scm_dimensions_to_uniform_array, scm_make_ra, scm_shap2ra, scm_cvref,
+   scm_ra_set_contp, scm_aind, scm_raprin1
+
+These functions have been deprecated since early 2005.
+
+** scm_array_p has one argument, not two
+
+Use of the second argument produced a deprecation warning, so it is
+unlikely that any code out there actually used this functionality.
+
 * Changes to the distribution
 
 ** Guile's license is now LGPLv3+
@@ -656,8 +632,8 @@ to /usr/lib/guile/1.9/ccache. These files are architecture-specific.
 
 ** New dependency: GNU libunistring.
 
-See http://www.gnu.org/software/libunistring/. We hope to merge in
+See http://www.gnu.org/software/libunistring/, for more information. Our
-Unicode support in the next prerelease.
+unicode support uses routines from libunistring.
 
 
 
@@ -666,6 +642,7 @@ Changes in 1.8.8 (since 1.8.7)
 * Bugs fixed
 
 ** Fix possible buffer overruns when parsing numbers
+** Avoid clash with system setjmp/longjmp on IA64
 
 
 Changes in 1.8.7 (since 1.8.6)

README

@@ -299,9 +299,8 @@ Guile Documentation ==================================================
 
 If you've never used Scheme before, then the Guile Tutorial
 (guile-tut.info) is a good starting point.  The Guile Reference Manual
-(guile.info) is the primary documentation for Guile.  The Goops object
+(guile.info) is the primary documentation for Guile.  A copy of the
-system is documented separately (goops.info).  A copy of the R5RS
+R5RS Scheme specification is included too (r5rs.info).
-Scheme specification is included too (r5rs.info).
 
 Info format versions of this documentation are installed as part of
 the normal build process.  The texinfo sources are under the doc

THANKS

@@ -30,6 +30,7 @@ For fixes or providing information which led to a fix:
             Rob Browning
          Adrian Bunk
         Michael Carmack
+              R Clayton
         Stephen Compall
           Brian Crowder
     Christopher Cramer
@@ -52,6 +53,7 @@ For fixes or providing information which led to a fix:
          Roland Haeder
 	   Sven Hartrumpf
 	   Eric Hanchrow
+	   Judy Hawkins
             Sam Hocevar
 	Patrick Horgan
            Ales Hvezda
@@ -94,6 +96,7 @@ For fixes or providing information which led to a fix:
          Werner Scheinast
 	   Bill Schottstaedt
 	  Frank Schwidom
+    John Steele Scott
          Thiemo Seufer
           Scott Shedden
            Alex Shinn
@@ -114,6 +117,7 @@ For fixes or providing information which led to a fix:
 	Andreas Vögele
         Michael Talbot-Wilson
         Michael Tuexen
+         Thomas Wawrzinek
         Mark H. Weaver
             Jon Wilson
            Andy Wingo

acinclude.m4

@@ -1,3 +1,5 @@
+dnl -*- Autoconf -*-
+
 dnl  On the NeXT, #including <utime.h> doesn't give you a definition for
 dnl  struct utime, unless you #define _POSIX_SOURCE.
 
@@ -308,3 +310,70 @@ else
 fi
 AC_LANG_RESTORE
 ])dnl ACX_PTHREAD
+
+dnl GUILE_READLINE
+dnl
+dnl Check all the things needed by `guile-readline', the Readline
+dnl bindings.
+AC_DEFUN([GUILE_READLINE], [
+  for termlib in ncurses curses termcap terminfo termlib ; do
+     AC_CHECK_LIB(${termlib}, [tgoto],
+       [READLINE_LIBS="-l${termlib} $READLINE_LIBS"; break])
+  done
+
+  AC_LIB_LINKFLAGS([readline])
+
+  if test "x$LTLIBREADLINE" = "x"; then
+    AC_MSG_WARN([GNU Readline was not found on your system.])
+  else
+    rl_save_LIBS="$LIBS"
+    LIBS="$LIBREADLINE $READLINE_LIBS $LIBS"
+
+    AC_CHECK_FUNCS([siginterrupt rl_clear_signals rl_cleanup_after_signal])
+
+    dnl Check for modern readline naming
+    AC_CHECK_FUNCS([rl_filename_completion_function])
+
+    dnl Check for rl_get_keymap.  We only use this for deciding whether to
+    dnl install paren matching on the Guile command line (when using
+    dnl readline for input), so it's completely optional.
+    AC_CHECK_FUNCS([rl_get_keymap])
+
+    AC_CACHE_CHECK([for rl_getc_function pointer in readline],
+		     ac_cv_var_rl_getc_function,
+		     [AC_TRY_LINK([
+    #include <stdio.h>
+    #include <readline/readline.h>],
+				  [printf ("%ld", (long) rl_getc_function)],
+				  [ac_cv_var_rl_getc_function=yes],
+				  [ac_cv_var_rl_getc_function=no])])
+    if test "${ac_cv_var_rl_getc_function}" = "yes"; then
+      AC_DEFINE([HAVE_RL_GETC_FUNCTION], 1,
+	[Define if your readline library has the rl_getc_function variable.])
+    fi
+
+    if test $ac_cv_var_rl_getc_function = no; then
+      AC_MSG_WARN([*** GNU Readline is too old on your system.])
+      AC_MSG_WARN([*** You need readline version 2.1 or later.])
+      LTLIBREADLINE=""
+      LIBREADLINE=""
+    fi
+
+    LIBS="$rl_save_LIBS"
+
+    READLINE_LIBS="$LTLIBREADLINE $READLINE_LIBS"
+  fi
+
+  AM_CONDITIONAL([HAVE_READLINE], [test "x$LTLIBREADLINE" != "x"])
+
+  AC_CHECK_FUNCS([strdup])
+
+  AC_SUBST([READLINE_LIBS])
+
+  . $srcdir/guile-readline/LIBGUILEREADLINE-VERSION
+  AC_SUBST(LIBGUILEREADLINE_MAJOR)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_CURRENT)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_REVISION)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE_AGE)
+  AC_SUBST(LIBGUILEREADLINE_INTERFACE)
+])

benchmark-suite/benchmarks/chars.bm

@@ -0,0 +1,57 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; chars.bm
+;;;
+;;; Copyright (C) 2009  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, 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 software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks chars)
+  :use-module (benchmark-suite lib))
+
+
+(with-benchmark-prefix "chars"
+                       
+  (benchmark "char" 1000000
+     #\a)
+
+  (benchmark "octal" 1000000
+     #\123)
+
+  (benchmark "char? eq" 1000000
+    (char? #\a))
+
+  (benchmark "char=?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char<?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char-ci=?" 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char-ci<? " 1000000
+    (char=? #\a #\a))
+
+  (benchmark "char->integer" 1000000
+    (char->integer #\a))
+
+  (benchmark "char-alphabetic?" 1000000
+    (char-upcase #\a))
+
+  (benchmark "char-numeric?" 1000000
+    (char-upcase #\a)))
+

benchmark-suite/benchmarks/srfi-13.bm

@@ -0,0 +1,310 @@
+;;; -*- mode: scheme; coding: latin-1; -*-
+;;; srfi-13.bm
+;;;
+;;; Copyright (C) 2009  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, 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 software; see the file COPYING.LESSER.  If
+;;; not, write to the Free Software Foundation, Inc., 51 Franklin
+;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (benchmarks strings)
+  :use-module (benchmark-suite lib))
+
+(seed->random-state 1)
+
+(define short-string "Hi")
+(define medium-string 
+"ARMA virumque cano, Troiae qui primus ab oris
+Italiam, fato profugus, Laviniaque venit")
+(define long-string
+  (string-tabulate 
+   (lambda (n) (integer->char (+ 32 (random 90)))) 
+   1000))
+
+(define short-chlist (string->list short-string))
+(define medium-chlist (string->list medium-string))
+(define long-chlist (string->list long-string))
+
+(define str1 (string-copy short-string))
+(define str2 (string-copy medium-string))
+(define str3 (string-copy long-string))
+
+
+(with-benchmark-prefix "strings"
+
+  (with-benchmark-prefix "predicates"
+
+    (benchmark "string?" 1190000
+      (string? short-string)
+      (string? medium-string)
+      (string? long-string))
+
+    (benchmark "null?" 969000
+      (string-null? short-string)
+      (string-null? medium-string)
+      (string-null? long-string))
+    
+    (benchmark "any" 94000
+      (string-any #\a short-string)
+      (string-any #\a medium-string)
+      (string-any #\a long-string))
+
+    (benchmark "every" 94000
+      (string-every #\a short-string)
+      (string-every #\a medium-string)
+      (string-every #\a long-string)))
+
+  (with-benchmark-prefix "constructors"
+
+    (benchmark "string" 5000
+      (apply string short-chlist)         
+      (apply string medium-chlist)
+      (apply string long-chlist))
+
+    (benchmark "list->" 4500
+      (list->string short-chlist)
+      (list->string medium-chlist)
+      (list->string long-chlist))
+
+    (benchmark "reverse-list->" 5000
+      (reverse-list->string short-chlist)
+      (reverse-list->string medium-chlist)
+      (reverse-list->string long-chlist))
+
+    (benchmark "make" 22000
+      (make-string 250 #\x))
+
+    (benchmark "tabulate" 17000
+      (string-tabulate integer->char 250))
+
+    (benchmark "join" 5500
+      (string-join (list short-string medium-string long-string) "|" 'suffix)))
+
+  (with-benchmark-prefix "list/string"
+    (benchmark "->list" 7300
+      (string->list short-string)
+      (string->list medium-string)
+      (string->list long-string))
+
+    (benchmark "split" 60000
+      (string-split short-string #\a)
+      (string-split medium-string #\a)
+      (string-split long-string #\a)))
+
+  (with-benchmark-prefix "selection"
+
+    (benchmark "ref" 660
+      (let loop ((k 0))
+        (if (< k (string-length short-string))
+            (begin
+              (string-ref short-string k)
+              (loop (+ k 1)))))
+      (let loop ((k 0))
+        (if (< k (string-length medium-string))
+            (begin
+              (string-ref medium-string k)
+              (loop (+ k 1)))))
+      (let loop ((k 0))
+        (if (< k (string-length long-string))
+            (begin
+              (string-ref long-string k)
+              (loop (+ k 1))))))
+
+    (benchmark "copy" 1100
+      (string-copy short-string)
+      (string-copy medium-string)
+      (string-copy long-string)
+      (substring/copy short-string 0 1)
+      (substring/copy medium-string 10 20)
+      (substring/copy long-string 100 200))
+
+    (benchmark "pad" 6800
+      (string-pad short-string 100)
+      (string-pad medium-string 100)
+      (string-pad long-string 100))
+
+    (benchmark "trim trim-right trim-both" 60000
+      (string-trim short-string char-alphabetic?)
+      (string-trim medium-string char-alphabetic?)
+      (string-trim long-string char-alphabetic?)
+      (string-trim-right short-string char-alphabetic?)
+      (string-trim-right medium-string char-alphabetic?)
+      (string-trim-right long-string char-alphabetic?)
+      (string-trim-both short-string char-alphabetic?)
+      (string-trim-both medium-string char-alphabetic?)
+      (string-trim-both long-string char-alphabetic?)))
+
+  (with-benchmark-prefix "modification"
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "set!" 3000
+      (let loop ((k 1))
+        (if (< k (string-length short-string))
+            (begin
+              (string-set! str1 k #\x)
+              (loop (+ k 1)))))
+      (let loop ((k 20))
+        (if (< k (string-length medium-string))
+            (begin
+              (string-set! str2 k #\x)
+              (loop (+ k 1)))))
+      (let loop ((k 900))
+        (if (< k (string-length long-string))
+            (begin
+              (string-set! str3 k #\x)
+              (loop (+ k 1))))))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "sub-move!" 230000
+      (substring-move! short-string 0 2 str2 10)
+      (substring-move! medium-string 10 20 str3 20))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "fill!" 230000
+      (string-fill! str1 #\y 0 1)
+      (string-fill! str2 #\y 10 20)
+      (string-fill! str3 #\y 20 30))
+
+  (with-benchmark-prefix "comparison"
+
+    (benchmark "compare compare-ci" 140000
+      (string-compare short-string medium-string string<? string=? string>?)  
+      (string-compare long-string medium-string string<? string=? string>?)
+      (string-compare-ci short-string medium-string string<? string=? string>?)  
+      (string-compare-ci long-string medium-string string<? string=? string>?))
+  
+    (benchmark "hash hash-ci" 1000
+      (string-hash short-string)
+      (string-hash medium-string)
+      (string-hash long-string)
+      (string-hash-ci short-string)
+      (string-hash-ci medium-string)
+      (string-hash-ci long-string))))
+  
+  (with-benchmark-prefix "searching" 20000
+
+    (benchmark "prefix-length suffix-length" 270
+      (string-prefix-length short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-length long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-length short-string
+                            (string-append medium-string short-string))
+      (string-suffix-length long-string
+                            (string-append medium-string long-string))
+      (string-prefix-length-ci short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-length-ci long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-length-ci short-string
+                            (string-append medium-string short-string))
+      (string-suffix-length-ci long-string
+                            (string-append medium-string long-string)))
+
+    (benchmark "prefix? suffix?" 270
+      (string-prefix? short-string 
+                            (string-append short-string medium-string))
+      (string-prefix? long-string 
+                            (string-append long-string medium-string))
+      (string-suffix? short-string
+                            (string-append medium-string short-string))
+      (string-suffix? long-string
+                            (string-append medium-string long-string))
+      (string-prefix-ci? short-string 
+                            (string-append short-string medium-string))
+      (string-prefix-ci? long-string 
+                            (string-append long-string medium-string))
+      (string-suffix-ci? short-string
+                            (string-append medium-string short-string))
+      (string-suffix-ci? long-string
+                            (string-append medium-string long-string)))
+
+    (benchmark "index index-right rindex" 100000
+      (string-index short-string #\T)
+      (string-index medium-string #\T)
+      (string-index long-string #\T)
+      (string-index-right short-string #\T)
+      (string-index-right medium-string #\T)
+      (string-index-right long-string #\T)
+      (string-rindex short-string #\T)
+      (string-rindex medium-string #\T)
+      (string-rindex long-string #\T))
+
+    (benchmark "skip skip-right?" 100000
+      (string-skip short-string char-alphabetic?)
+      (string-skip medium-string char-alphabetic?)
+      (string-skip long-string char-alphabetic?)
+      (string-skip-right short-string char-alphabetic?)
+      (string-skip-right medium-string char-alphabetic?)
+      (string-skip-right long-string char-alphabetic?))
+
+    (benchmark "count" 10000
+      (string-count short-string char-alphabetic?)
+      (string-count medium-string char-alphabetic?)
+      (string-count long-string char-alphabetic?))
+    
+    (benchmark "contains contains-ci" 34000
+      (string-contains short-string short-string)
+      (string-contains medium-string (substring medium-string 10 15))
+      (string-contains long-string (substring long-string 100 130))
+      (string-contains-ci short-string short-string)
+      (string-contains-ci medium-string (substring medium-string 10 15))
+      (string-contains-ci long-string (substring long-string 100 130)))
+
+    (set! str1 (string-copy short-string))                         
+    (set! str2 (string-copy medium-string))   
+    (set! str3 (string-copy long-string))
+
+    (benchmark "upcase downcase upcase! downcase!" 600
+      (string-upcase short-string)
+      (string-upcase medium-string)
+      (string-upcase long-string)
+      (string-downcase short-string)
+      (string-downcase medium-string)
+      (string-downcase long-string)
+      (string-upcase! str1 0 1)
+      (string-upcase! str2 10 20)
+      (string-upcase! str3 100 130)
+      (string-downcase! str1 0 1)
+      (string-downcase! str2 10 20)
+      (string-downcase! str3 100 130)))
+
+  (with-benchmark-prefix "readers"
+
+    (benchmark "read token, method 1" 1200
+      (let ((buf (make-string 512)))
+        (let loop ((i 0))
+          (if (< i 512)
+              (begin 
+                (string-set! buf i #\x)
+                (loop (+ i 1)))
+              buf))))
+
+    (benchmark "read token, method 2" 1200
+      (let ((lst '()))   
+        (let loop ((i 0))
+          (set! lst (append! lst (list #\x)))
+          (if (< i 512)
+              (loop (+ i 1))
+              (list->string lst)))))))

check-guile.in

@@ -41,7 +41,7 @@ if [ ! -f guile-procedures.txt ] ; then
 fi
 
 exec $guile \
-    -e main -s "$TEST_SUITE_DIR/guile-test" \
+    --no-autocompile -e main -s "$TEST_SUITE_DIR/guile-test" \
     --test-suite "$TEST_SUITE_DIR/tests" \
     --log-file check-guile.log "$@"
 

configure.ac

@@ -51,14 +51,6 @@ AC_CONFIG_SRCDIR([GUILE-VERSION])
 AC_CONFIG_HEADERS([config.h])
 AH_TOP(/*GUILE_CONFIGURE_COPYRIGHT*/)
 
-#--------------------------------------------------------------------
-#
-# Independent Subdirectories
-#
-#--------------------------------------------------------------------
-
-AC_CONFIG_SUBDIRS(guile-readline)
-
 #--------------------------------------------------------------------
 
 AC_LANG([C])
@@ -1456,6 +1448,9 @@ LIBLOBJS="`echo ${LIB@&t@OBJS} | sed 's,\.[[^.]]* ,.lo ,g;s,\.[[^.]]*$,.lo,'`"
 EXTRA_DOT_DOC_FILES="`echo ${LIB@&t@OBJS} | sed 's,\.[[^.]]* ,.doc ,g;s,\.[[^.]]*$,.doc,'`"
 EXTRA_DOT_X_FILES="`echo ${LIB@&t@OBJS} | sed 's,\.[[^.]]* ,.x ,g;s,\.[[^.]]*$,.x,'`"
 
+# GNU Readline bindings.
+GUILE_READLINE
+
 AC_SUBST(GUILE_MAJOR_VERSION)
 AC_SUBST(GUILE_MINOR_VERSION)
 AC_SUBST(GUILE_MICRO_VERSION)
@@ -1542,7 +1537,6 @@ AC_CONFIG_FILES([
   lib/Makefile
   benchmark-suite/Makefile
   doc/Makefile
-  doc/goops/Makefile
   doc/r5rs/Makefile
   doc/ref/Makefile
   doc/tutorial/Makefile
@@ -1551,6 +1545,7 @@ AC_CONFIG_FILES([
   lang/Makefile
   libguile/Makefile
   srfi/Makefile
+  guile-readline/Makefile
   test-suite/Makefile
   test-suite/standalone/Makefile
   meta/Makefile
@@ -1578,6 +1573,7 @@ AC_CONFIG_FILES([test-suite/standalone/test-use-srfi],
                 [chmod +x test-suite/standalone/test-use-srfi])
 AC_CONFIG_FILES([test-suite/standalone/test-fast-slot-ref],
                 [chmod +x test-suite/standalone/test-fast-slot-ref])
+AC_CONFIG_FILES([doc/ref/effective-version.texi])
 
 AC_OUTPUT
 

doc/Makefile.am

@@ -21,7 +21,7 @@
 
 AUTOMAKE_OPTIONS = gnu
 
-SUBDIRS = ref tutorial goops r5rs
+SUBDIRS = ref tutorial r5rs
 
 dist_man1_MANS = guile.1
 

doc/README

@@ -8,10 +8,6 @@ The documentation consists of the following manuals.
 - The Guile Reference Manual (guile.texi) contains (or is intended to
   contain) reference documentation on all aspects of Guile.
 
-- The GOOPS Manual (goops.texi) contains both tutorial-style and
-  reference documentation for using GOOPS, Guile's Object Oriented
-  Programming System.
-
 - The Revised^5 Report on the Algorithmic Language Scheme (r5rs.texi).
 
 Please be aware that this is all very much work in progress (apart

doc/goops/Makefile.am

@@ -1,29 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##  	Copyright (C) 1998, 2004, 2006, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of GUILE.
-##   
-##   GUILE 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, or
-##   (at your option) any later version.
-##
-##   GUILE 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 GUILE; see the file COPYING.LESSER.  If not,
-##   write to the Free Software Foundation, Inc., 51 Franklin Street,
-##   Fifth Floor, Boston, MA 02110-1301 USA
-
-AUTOMAKE_OPTIONS = gnu
-
-info_TEXINFOS = goops.texi
-
-goops_TEXINFOS = goops-tutorial.texi \
-  hierarchy.eps hierarchy.png hierarchy.txt hierarchy.pdf
-
-EXTRA_DIST = ChangeLog-2008

doc/ref/.gitignore

@@ -1,2 +1,3 @@
 autoconf-macros.texi
 lib-version.texi
+effective-version.texi

doc/ref/Makefile.am

@@ -78,11 +78,20 @@ guile_TEXINFOS = preface.texi			\
 		 libguile-linking.texi		\
 	 	 libguile-extensions.texi	\
 		 api-init.texi			\
-		 mod-getopt-long.texi
+		 mod-getopt-long.texi		\
+		 goops.texi			\
+		 goops-tutorial.texi		\
+		 effective-version.texi
 
 ETAGS_ARGS = $(info_TEXINFOS) $(guile_TEXINFOS)
 
-EXTRA_DIST = ChangeLog-2008
+PICTURES = hierarchy.eps \
+	   hierarchy.pdf \
+	   hierarchy.png \
+	   hierarchy.txt \
+	   mop.text
+
+EXTRA_DIST = ChangeLog-2008 $(PICTURES)
 
 include $(top_srcdir)/am/pre-inst-guile
 

doc/ref/api-compound.texi

@@ -1344,9 +1344,9 @@ otherwise.
 @deftypefn  {C Function} SCM scm_take_u8vector (const scm_t_uint8 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_s8vector (const scm_t_int8 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_u16vector (const scm_t_uint16 *data, size_t len)
-@deftypefnx {C Function} SCM scm_take_s168vector (const scm_t_int16 *data, size_t len)
+@deftypefnx {C Function} SCM scm_take_s16vector (const scm_t_int16 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_u32vector (const scm_t_uint32 *data, size_t len)
-@deftypefnx {C Function} SCM scm_take_s328vector (const scm_t_int32 *data, size_t len)
+@deftypefnx {C Function} SCM scm_take_s32vector (const scm_t_int32 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_u64vector (const scm_t_uint64 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_s64vector (const scm_t_int64 *data, size_t len)
 @deftypefnx {C Function} SCM scm_take_f32vector (const float *data, size_t len)
@@ -2001,13 +2001,24 @@ enclosed array is unspecified.
 For example,
 
 @lisp
-(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1)
+(enclose-array '#3(((a b c)
+                    (d e f))
+                   ((1 2 3)
+                    (4 5 6)))
+               1)
 @result{}
-#<enclosed-array (#1(a d) #1(b e) #1(c f)) (#1(1 4) #1(2 5) #1(3 6))>
+#<enclosed-array (#1(a d) #1(b e) #1(c f))
+                 (#1(1 4) #1(2 5) #1(3 6))>
 
-(enclose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 0)
+(enclose-array '#3(((a b c)
+                    (d e f))
+                   ((1 2 3)
+                    (4 5 6)))
+               1 0)
 @result{}
-#<enclosed-array #2((a 1) (d 4)) #2((b 2) (e 5)) #2((c 3) (f 6))>
+#<enclosed-array #2((a 1) (d 4))
+                 #2((b 2) (e 5))
+                 #2((c 3) (f 6))>
 @end lisp
 @end deffn
 
@@ -3083,8 +3094,10 @@ which can be changed.
                          (color ball)
                          (owner ball)))
                ball-color))
-(define (color ball) (struct-ref (struct-vtable ball) vtable-offset-user))
+(define (color ball)
-(define (owner ball) (struct-ref ball 0))
+  (struct-ref (struct-vtable ball) vtable-offset-user))
+(define (owner ball)
+  (struct-ref ball 0))
 
 (define red (make-ball-type 'red))
 (define green (make-ball-type 'green))
@@ -3460,7 +3473,8 @@ whole is not a proper list:
 (assoc "mary" '((1 . 2) ("key" . "door") . "open sesame"))
 @result{}
 ERROR: In procedure assoc in expression (assoc "mary" (quote #)):
-ERROR: Wrong type argument in position 2 (expecting association list): ((1 . 2) ("key" . "door") . "open sesame")
+ERROR: Wrong type argument in position 2 (expecting
+   association list): ((1 . 2) ("key" . "door") . "open sesame")
 
 (sloppy-assoc "mary" '((1 . 2) ("key" . "door") . "open sesame"))
 @result{}
@@ -3474,7 +3488,8 @@ Secondly, if one of the entries in the specified alist is not a pair:
 (assoc 2 '((1 . 1) 2 (3 . 9)))
 @result{}
 ERROR: In procedure assoc in expression (assoc 2 (quote #)):
-ERROR: Wrong type argument in position 2 (expecting association list): ((1 . 1) 2 (3 . 9))
+ERROR: Wrong type argument in position 2 (expecting
+   association list): ((1 . 1) 2 (3 . 9))
 
 (sloppy-assoc 2 '((1 . 1) 2 (3 . 9)))
 @result{}

doc/ref/api-control.texi

@@ -22,6 +22,7 @@ flow of Scheme affects C code.
 * Error Reporting::             Procedures for signaling errors.
 * Dynamic Wind::                Dealing with non-local entrance/exit.
 * Handling Errors::             How to handle errors in C code.
+* Continuation Barriers::       Protection from non-local control flow.
 @end menu
 
 @node begin
@@ -1501,6 +1502,33 @@ which is the name of the procedure incorrectly invoked.
 @end deftypefn
 
 
+@node Continuation Barriers
+@subsection Continuation Barriers
+
+The non-local flow of control caused by continuations might sometimes
+not be wanted.  You can use @code{with-continuation-barrier} etc to
+errect fences that continuations can not pass.
+
+@deffn {Scheme Procedure} with-continuation-barrier proc
+@deffnx {C Function} scm_with_continuation_barrier (proc)
+Call @var{proc} and return its result.  Do not allow the invocation of
+continuations that would leave or enter the dynamic extent of the call
+to @code{with-continuation-barrier}.  Such an attempt causes an error
+to be signaled.
+
+Throws (such as errors) that are not caught from within @var{proc} are
+caught by @code{with-continuation-barrier}.  In that case, a short
+message is printed to the current error port and @code{#f} is returned.
+
+Thus, @code{with-continuation-barrier} returns exactly once.
+@end deffn
+
+@deftypefn {C Function} {void *} scm_c_with_continuation_barrier (void *(*func) (void *), void *data)
+Like @code{scm_with_continuation_barrier} but call @var{func} on
+@var{data}.  When an error is caught, @code{NULL} is returned.
+@end deftypefn
+
+
 @c Local Variables:
 @c TeX-master: "guile.texi"
 @c End:

doc/ref/api-data.texi

@@ -3477,9 +3477,9 @@ allocated string.
 @deffnx {C Function} scm_string_concatenate_reverse (ls, final_string, end)
 Without optional arguments, this procedure is equivalent to
 
-@smalllisp
+@lisp
 (string-concatenate (reverse ls))
-@end smalllisp
+@end lisp
 
 If the optional argument @var{final_string} is specified, it is
 consed onto the beginning to @var{ls} before performing the
@@ -3535,7 +3535,8 @@ For example, to change characters to alternately upper and lower case,
 
 @example
 (define str (string-copy "studly"))
-(string-for-each-index (lambda (i)
+(string-for-each-index
+    (lambda (i)
       (string-set! str i
         ((if (even? i) char-upcase char-downcase)
          (string-ref str i))))
@@ -4447,7 +4448,8 @@ Or matching a @sc{yyyymmdd} format date such as @samp{20020828} and
 re-ordering and hyphenating the fields.
 
 @lisp
-(define date-regex "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
+(define date-regex
+   "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
 (define s "Date 20020429 12am.")
 (regexp-substitute #f (string-match date-regex s)
                    'pre 2 "-" 3 "-" 1 'post " (" 0 ")")
@@ -4507,7 +4509,8 @@ example the following is the date example from
 @code{string-match} call.
 
 @lisp
-(define date-regex "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
+(define date-regex 
+   "([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9])")
 (define s "Date 20020429 12am.")
 (regexp-substitute/global #f date-regex s
                           'pre 2 "-" 3 "-" 1 'post " (" 0 ")")
@@ -5502,7 +5505,7 @@ the @code{read-set!} procedure documented in @ref{User level options
 interfaces} and @ref{Reader options}.  Note that the @code{prefix} and
 @code{postfix} syntax are mutually exclusive.
 
-@smalllisp
+@lisp
 (read-set! keywords 'prefix)
 
 #:type
@@ -5534,7 +5537,7 @@ type:
 ERROR: In expression :type:
 ERROR: Unbound variable: :type
 ABORT: (unbound-variable)
-@end smalllisp
+@end lisp
 
 @node Keyword Procedures
 @subsubsection Keyword Procedures

doc/ref/api-debug.texi

@@ -283,9 +283,9 @@ runs a script non-interactively.
 The following procedures can be used to access and set the source
 properties of read expressions.
 
-@deffn {Scheme Procedure} set-source-properties! obj plist
+@deffn {Scheme Procedure} set-source-properties! obj alist
-@deffnx {C Function} scm_set_source_properties_x (obj, plist)
+@deffnx {C Function} scm_set_source_properties_x (obj, alist)
-Install the association list @var{plist} as the source property
+Install the association list @var{alist} as the source property
 list for @var{obj}.
 @end deffn
 
@@ -302,12 +302,12 @@ Return the source property association list of @var{obj}.
 
 @deffn {Scheme Procedure} source-property obj key
 @deffnx {C Function} scm_source_property (obj, key)
-Return the source property specified by @var{key} from
+Return the property specified by @var{key} from @var{obj}'s source
-@var{obj}'s source property list.
+properties.
 @end deffn
 
 In practice there are only two ways that you should use the ability to
-set an expression's source breakpoints.
+set an expression's source properties.
 
 @itemize
 @item
@@ -330,9 +330,9 @@ involved in a backtrace or error report.
 
 If you are looking for a way to attach arbitrary information to an
 expression other than these properties, you should use
-@code{make-object-property} instead (@pxref{Object Properties}), because
+@code{make-object-property} instead (@pxref{Object Properties}).  That
-that will avoid bloating the source property hash table, which is really
+will avoid bloating the source property hash table, which is really
-only intended for the specific purposes described in this section.
+only intended for the debugging purposes just described.
 
 
 @node Decoding Memoized Source Expressions
@@ -1708,7 +1708,7 @@ facilities just described.
 A good way to explore in detail what a Scheme procedure does is to set
 a trap on it and then single step through what it does.  To do this,
 make and install a @code{<procedure-trap>} with the @code{debug-trap}
-behaviour from @code{(ice-9 debugging ice-9-debugger-extensions)}.
+behaviour from @code{(ice-9 debugger)}.
 
 The following sample session illustrates this.  It assumes that the
 file @file{matrix.scm} defines a procedure @code{mkmatrix}, which is
@@ -1718,7 +1718,6 @@ calls @code{mkmatrix}.
 @lisp
 $ /usr/bin/guile -q
 guile> (use-modules (ice-9 debugger)
-                    (ice-9 debugging ice-9-debugger-extensions)
                     (ice-9 debugging traps))
 guile> (load "matrix.scm")
 guile> (install-trap (make <procedure-trap>
@@ -1732,16 +1731,16 @@ Frame 2 at matrix.scm:8:3
         [mkmatrix]
 debug> next
 Frame 3 at matrix.scm:4:3
-        (let ((x 1)) (quote this-is-a-matric))
+        (let ((x 1)) (quote hi!))
 debug> info frame
 Stack frame: 3
 This frame is an evaluation.
 The expression being evaluated is:
 matrix.scm:4:3:
-  (let ((x 1)) (quote this-is-a-matric))
+  (let ((x 1)) (quote hi!))
 debug> next
 Frame 3 at matrix.scm:5:21
-        (quote this-is-a-matric)
+        (quote hi!)
 debug> bt
 In unknown file:
    ?: 0* [primitive-eval (do-main 4)]
@@ -1750,18 +1749,17 @@ In standard input:
 In matrix.scm:
    8: 2  [mkmatrix]
    ...
-   5: 3  (quote this-is-a-matric)
+   5: 3  (quote hi!)
 debug> quit
-this-is-a-matric
+hi!
 guile> 
 @end lisp
 
 Or you can use Guile's Emacs interface (GDS), by using the module
 @code{(ice-9 gds-client)} instead of @code{(ice-9 debugger)} and
-@code{(ice-9 debugging ice-9-debugger-extensions)}, and changing
+changing @code{debug-trap} to @code{gds-debug-trap}.  Then the stack and
-@code{debug-trap} to @code{gds-debug-trap}.  Then the stack and
+corresponding source locations are displayed in Emacs instead of on the
-corresponding source locations are displayed in Emacs instead of on
+Guile command line.
-the Guile command line.
 
 
 @node Profiling or Tracing a Procedure's Code
@@ -1813,7 +1811,7 @@ guile> (do-main 4)
 |  5: (memq sym bindings)
 |  5: [memq let (debug)]
 |  5: =>#f
-|  2: (letrec ((yy 23)) (let ((x 1)) (quote this-is-a-matric)))
+|  2: (letrec ((yy 23)) (let ((x 1)) (quote hi!)))
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  4: (and (memq sym bindings) (let ...))
@@ -1832,7 +1830,7 @@ guile> (do-main 4)
 |  5: (memq sym bindings)
 |  5: [memq let (debug)]
 |  5: =>#f
-|  2: (let ((x 1)) (quote this-is-a-matric))
+|  2: (let ((x 1)) (quote hi!))
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  3: [#<procedure #f (a sym definep)> #<autoload # b7c93870> let #f]
 |  4: (and (memq sym bindings) (let ...))
@@ -1841,15 +1839,15 @@ guile> (do-main 4)
 |  5: =>#f
 |  2: [let (let # #) (# # #)]
 |  2: [let (let # #) (# # #)]
-|  2: =>(#@@let* (x 1) #@@let (quote this-is-a-matric))
+|  2: =>(#@@let* (x 1) #@@let (quote hi!))
-this-is-a-matric
+hi!
 guile> (do-main 4)
 |  2: [mkmatrix]
-|  2: (letrec ((yy 23)) (let* ((x 1)) (quote this-is-a-matric)))
+|  2: (letrec ((yy 23)) (let* ((x 1)) (quote hi!)))
-|  2: (let* ((x 1)) (quote this-is-a-matric))
+|  2: (let* ((x 1)) (quote hi!))
-|  2: (quote this-is-a-matric)
+|  2: (quote hi!)
-|  2: =>this-is-a-matric
+|  2: =>hi!
-this-is-a-matric
+hi!
 guile> 
 @end lisp
 
@@ -1881,11 +1879,11 @@ each trace line instead of the stack depth.
 guile> (set-trace-layout "|~16@@a: ~a\n" trace/source trace/info)
 guile> (do-main 4)
 |  matrix.scm:7:2: [mkmatrix]
-|                : (letrec ((yy 23)) (let* ((x 1)) (quote this-is-a-matric)))
+|                : (letrec ((yy 23)) (let* ((x 1)) (quote hi!)))
-|  matrix.scm:3:2: (let* ((x 1)) (quote this-is-a-matric))
+|  matrix.scm:3:2: (let* ((x 1)) (quote hi!))
-|  matrix.scm:4:4: (quote this-is-a-matric)
+|  matrix.scm:4:4: (quote hi!)
-|  matrix.scm:4:4: =>this-is-a-matric
+|  matrix.scm:4:4: =>hi!
-this-is-a-matric
+hi!
 guile> 
 @end lisp
 

doc/ref/api-io.texi

@@ -424,9 +424,9 @@ the current size, but this is not mandatory in the POSIX standard.
 
 The delimited-I/O module can be accessed with:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 rdelim))
-@end smalllisp
+@end lisp
 
 It can be used to read or write lines of text, or read text delimited by
 a specified set of characters.  It's similar to the @code{(scsh rdelim)}
@@ -536,9 +536,9 @@ delimiter may be either a newline or the @var{eof-object}; if
 
 The Block-string-I/O module can be accessed with:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 rw))
-@end smalllisp
+@end lisp
 
 It currently contains procedures that help to implement the
 @code{(scsh rw)} module in guile-scsh.
@@ -795,17 +795,17 @@ current interfaces.
 @rnindex open-input-file
 @deffn {Scheme Procedure} open-input-file filename
 Open @var{filename} for input.  Equivalent to
-@smalllisp
+@lisp
 (open-file @var{filename} "r")
-@end smalllisp
+@end lisp
 @end deffn
 
 @rnindex open-output-file
 @deffn {Scheme Procedure} open-output-file filename
 Open @var{filename} for output.  Equivalent to
-@smalllisp
+@lisp
 (open-file @var{filename} "w")
-@end smalllisp
+@end lisp
 @end deffn
 
 @deffn {Scheme Procedure} call-with-input-file filename proc

doc/ref/api-modules.texi

@@ -60,15 +60,15 @@ Library files in SLIB @emph{provide} a feature, and when user programs
 For example, the file @file{random.scm} in the SLIB package contains the
 line
 
-@smalllisp
+@lisp
 (provide 'random)
-@end smalllisp
+@end lisp
 
 so to use its procedures, a user would type
 
-@smalllisp
+@lisp
 (require 'random)
-@end smalllisp
+@end lisp
 
 and they would magically become available, @emph{but still have the same
 names!}  So this method is nice, but not as good as a full-featured
@@ -99,9 +99,9 @@ i.e., passed as the second argument to @code{eval}.
 Note: the following two procedures are available only when the 
 @code{(ice-9 r5rs)} module is loaded:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 r5rs))
-@end smalllisp
+@end lisp
 
 @deffn {Scheme Procedure} scheme-report-environment version
 @deffnx {Scheme Procedure} null-environment version
@@ -224,9 +224,9 @@ An @dfn{interface specification} has one of two forms.  The first
 variation is simply to name the module, in which case its public
 interface is the one accessed.  For example:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 popen))
-@end smalllisp
+@end lisp
 
 Here, the interface specification is @code{(ice-9 popen)}, and the
 result is that the current module now has access to @code{open-pipe},
@@ -241,11 +241,11 @@ module to be accessed, but also selects bindings from it and renames
 them to suit the current module's needs.  For example:
 
 @cindex binding renamer
-@smalllisp
+@lisp
 (use-modules ((ice-9 popen)
-              :select ((open-pipe . pipe-open) close-pipe)
+              #:select ((open-pipe . pipe-open) close-pipe)
-              :renamer (symbol-prefix-proc 'unixy:)))
+              #:renamer (symbol-prefix-proc 'unixy:)))
-@end smalllisp
+@end lisp
 
 Here, the interface specification is more complex than before, and the
 result is that a custom interface with only two bindings is created and
@@ -270,10 +270,10 @@ You can also directly refer to bindings in a module by using the
 open-pipe)}.  Thus an alternative to the complete @code{use-modules}
 statement would be
 
-@smalllisp
+@lisp
 (define unixy:pipe-open (@@ (ice-9 popen) open-pipe))
 (define unixy:close-pipe (@@ (ice-9 popen) close-pipe))
-@end smalllisp
+@end lisp
 
 There is also @code{@@@@}, which can be used like @code{@@}, but does
 not check whether the variable that is being accessed is actually
@@ -307,9 +307,9 @@ whose public interface is found and used.
 @var{spec} can also be of the form:
 
 @cindex binding renamer
-@smalllisp
+@lisp
  (MODULE-NAME [:select SELECTION] [:renamer RENAMER])
-@end smalllisp
+@end lisp
 
 in which case a custom interface is newly created and used.
 @var{module-name} is a list of symbols, as above; @var{selection} is a
@@ -373,9 +373,9 @@ by using @code{define-public} or @code{export} (both documented below).
 @var{module-name} is of the form @code{(hierarchy file)}.  One
 example of this is
 
-@smalllisp
+@lisp
 (define-module (ice-9 popen))
-@end smalllisp
+@end lisp
 
 @code{define-module} makes this module available to Guile programs under
 the given @var{module-name}.
@@ -541,9 +541,9 @@ duplication to the next handler in @var{list}.
 The default duplicate binding resolution policy is given by the
 @code{default-duplicate-binding-handler} procedure, and is
 
-@smalllisp
+@lisp
 (replace warn-override-core warn last)
-@end smalllisp
+@end lisp
 
 @item #:no-backtrace
 @cindex no backtrace
@@ -758,7 +758,7 @@ Record definition with @code{define-record-type} (@pxref{SRFI-9}).
 Read hash extension @code{#,()} (@pxref{SRFI-10}).
 
 @item (srfi srfi-11)
-Multiple-value handling with @code{let-values} and @code{let-values*}
+Multiple-value handling with @code{let-values} and @code{let*-values}
 (@pxref{SRFI-11}).
 
 @item (srfi srfi-13)
@@ -1138,12 +1138,12 @@ gcc -shared -o libbessel.so -fPIC bessel.c
 
 Now fire up Guile:
 
-@smalllisp
+@lisp
 (define bessel-lib (dynamic-link "./libbessel.so"))
 (dynamic-call "init_math_bessel" bessel-lib)
 (j0 2)
 @result{} 0.223890779141236
-@end smalllisp
+@end lisp
 
 The filename @file{./libbessel.so} should be pointing to the shared
 library produced with the @code{gcc} command above, of course.  The

doc/ref/api-options.texi

@@ -82,10 +82,11 @@ general are stored.  On Unix-like systems, this is usually
 @deffnx {C Function} scm_sys_library_dir ()
 Return the name of the directory where the Guile Scheme files that
 belong to the core Guile installation (as opposed to files from a 3rd
-party package) are installed.  On Unix-like systems, this is usually
+party package) are installed.  On Unix-like systems this is usually
 @file{/usr/local/share/guile/<GUILE_EFFECTIVE_VERSION>} or
-@file{/usr/share/guile/<GUILE_EFFECTIVE_VERSION>}, for example:
+@file{/usr/share/guile/<GUILE_EFFECTIVE_VERSION>};
-@file{/usr/local/share/guile/1.6}.
+
+@noindent for example @file{/usr/local/share/guile/1.6}.
 @end deffn
 
 @deffn {Scheme Procedure} %site-dir
@@ -503,9 +504,9 @@ Guile is case-sensitive by default.
 
 To make Guile case insensitive, you can type
 
-@smalllisp
+@lisp
 (read-enable 'case-insensitive)
-@end smalllisp
+@end lisp
 
 @node Printing options
 @subsubsection Printing options
@@ -680,7 +681,8 @@ the maximum stack size, use @code{debug-set!}, for example:
 @lisp
 (debug-set! stack 200000)
 @result{}
-(show-file-name #t stack 200000 debug backtrace depth 20 maxdepth 1000 frames 3 indent 10 width 79 procnames cheap)
+(show-file-name #t stack 200000 debug backtrace depth 20
+   maxdepth 1000 frames 3 indent 10 width 79 procnames cheap)
 
 (non-tail-recursive-factorial 500)
 @result{}
@@ -717,7 +719,6 @@ backtrace.  Need to give a better example, possibly putting debugging
 option examples in a separate session.]
 @end enumerate
 
-
 @smalllisp
 guile> (define abc "hello")
 guile> abc

doc/ref/api-scheduling.texi

@@ -8,14 +8,9 @@
 @node Scheduling
 @section Threads, Mutexes, Asyncs and Dynamic Roots
 
-[FIXME: This is pasted in from Tom Lord's original guile.texi chapter
-plus the Cygnus programmer's manual; it should be *very* carefully
-reviewed and largely reorganized.]
-
 @menu
 * Arbiters::                    Synchronization primitives.
 * Asyncs::                      Asynchronous procedure invocation.
-* Continuation Barriers::       Protection from non-local control flow.
 * Threads::                     Multiple threads of execution.
 * Mutexes and Condition Variables:: Synchronization primitives.
 * Blocking::                    How to block properly in guile mode.
@@ -47,7 +42,6 @@ process synchronization.
 
 @deffn {Scheme Procedure} try-arbiter arb
 @deffnx {C Function} scm_try_arbiter (arb)
-@deffnx {C Function} scm_try_arbiter (arb)
 If @var{arb} is unlocked, then lock it and return @code{#t}.
 If @var{arb} is already locked, then do nothing and return
 @code{#f}.
@@ -70,7 +64,7 @@ release it, but that's not required, any thread can release it.
 @cindex user asyncs
 @cindex system asyncs
 
-Asyncs are a means of deferring the excution of Scheme code until it is
+Asyncs are a means of deferring the execution of Scheme code until it is
 safe to do so.
 
 Guile provides two kinds of asyncs that share the basic concept but are
@@ -132,43 +126,42 @@ This procedure is not safe to be called from signal handlers.  Use
 signal handlers.
 @end deffn
 
-@c  FIXME: The use of @deffnx for scm_c_call_with_blocked_asyncs and
-@c  scm_c_call_with_unblocked_asyncs puts "void" into the function
-@c  index.  Would prefer to use @deftypefnx if makeinfo allowed that,
-@c  or a @deftypefn with an empty return type argument if it didn't
-@c  introduce an extra space.
-
 @deffn {Scheme Procedure} call-with-blocked-asyncs proc
 @deffnx {C Function} scm_call_with_blocked_asyncs (proc)
-@deffnx {C Function} {void *} scm_c_call_with_blocked_asyncs (void * (*proc) (void *data), void *data)
-@findex scm_c_call_with_blocked_asyncs
 Call @var{proc} and block the execution of system asyncs by one level
 for the current thread while it is running.  Return the value returned
 by @var{proc}.  For the first two variants, call @var{proc} with no
 arguments; for the third, call it with @var{data}.
 @end deffn
 
+@deftypefn {C Function} {void *} scm_c_call_with_blocked_asyncs (void * (*proc) (void *data), void *data)
+The same but with a C function @var{proc} instead of a Scheme thunk.
+@end deftypefn
+
 @deffn {Scheme Procedure} call-with-unblocked-asyncs proc
 @deffnx {C Function} scm_call_with_unblocked_asyncs (proc)
-@deffnx {C Function} {void *} scm_c_call_with_unblocked_asyncs (void *(*p) (void *d), void *d)
-@findex scm_c_call_with_unblocked_asyncs
 Call @var{proc} and unblock the execution of system asyncs by one
 level for the current thread while it is running.  Return the value
 returned by @var{proc}.  For the first two variants, call @var{proc}
 with no arguments; for the third, call it with @var{data}.
 @end deffn
 
+@deftypefn {C Function} {void *} scm_c_call_with_unblocked_asyncs (void *(*proc) (void *data), void *data)
+The same but with a C function @var{proc} instead of a Scheme thunk.
+@end deftypefn
+
 @deftypefn {C Function} void scm_dynwind_block_asyncs ()
-This function must be used inside a pair of calls to
+During the current dynwind context, increase the blocking of asyncs by
+one level.  This function must be used inside a pair of calls to
 @code{scm_dynwind_begin} and @code{scm_dynwind_end} (@pxref{Dynamic
-Wind}).  During the dynwind context, asyncs are blocked by one level.
+Wind}).
 @end deftypefn
 
 @deftypefn {C Function} void scm_dynwind_unblock_asyncs ()
-This function must be used inside a pair of calls to
+During the current dynwind context, decrease the blocking of asyncs by
+one level.  This function must be used inside a pair of calls to
 @code{scm_dynwind_begin} and @code{scm_dynwind_end} (@pxref{Dynamic
-Wind}).  During the dynwind context, asyncs are unblocked by one
+Wind}).
-level.
 @end deftypefn
 
 @node User asyncs
@@ -197,32 +190,6 @@ Mark the user async @var{a} for future execution.
 Execute all thunks from the marked asyncs of the list @var{list_of_a}.
 @end deffn
 
-@node Continuation Barriers
-@subsection Continuation Barriers
-
-The non-local flow of control caused by continuations might sometimes
-not be wanted.  You can use @code{with-continuation-barrier} etc to
-errect fences that continuations can not pass.
-
-@deffn {Scheme Procedure} with-continuation-barrier proc
-@deffnx {C Function} scm_with_continuation_barrier (proc)
-Call @var{proc} and return its result.  Do not allow the invocation of
-continuations that would leave or enter the dynamic extent of the call
-to @code{with-continuation-barrier}.  Such an attempt causes an error
-to be signaled.
-
-Throws (such as errors) that are not caught from within @var{proc} are
-caught by @code{with-continuation-barrier}.  In that case, a short
-message is printed to the current error port and @code{#f} is returned.
-
-Thus, @code{with-continuation-barrier} returns exactly once.
-@end deffn
-
-@deftypefn {C Function} {void *} scm_c_with_continuation_barrier (void *(*func) (void *), void *data)
-Like @code{scm_with_continuation_barrier} but call @var{func} on
-@var{data}.  When an error is caught, @code{NULL} is returned.
-@end deftypefn
-
 @node Threads
 @subsection Threads
 @cindex threads

doc/ref/autoconf.texi

@@ -48,19 +48,18 @@ checks.
 @cindex pkg-config
 @cindex autoconf
 
-GNU Guile provides a @dfn{pkg-config} description file, installed as
+GNU Guile provides a @dfn{pkg-config} description file, which contains
-@file{@var{prefix}/lib/pkgconfig/guile-2.0.pc}, which contains all the
+all the information necessary to compile and link C applications that
-information necessary to compile and link C applications that use Guile.
+use Guile.  The @code{pkg-config} program is able to read this file
-The @code{pkg-config} program is able to read this file and provide this
+and provide this information to application programmers; it can be
-information to application programmers; it can be obtained at
+obtained at @url{http://pkg-config.freedesktop.org/}.
-@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-2.0 --cflags
+pkg-config guile-@value{EFFECTIVE-VERSION} --cflags
-pkg-config guile-2.0 --libs
+pkg-config guile-@value{EFFECTIVE-VERSION} --libs
 @end example
 
 To ease use of pkg-config with Autoconf, pkg-config comes with a
@@ -71,7 +70,7 @@ accordingly, or prints an error and exits if Guile was not found:
 @findex PKG_CHECK_MODULES
 
 @example
-PKG_CHECK_MODULES([GUILE], [guile-2.0])
+PKG_CHECK_MODULES([GUILE], [guile-@value{EFFECTIVE-VERSION}])
 @end example
 
 Guile comes with additional Autoconf macros providing more information,

doc/ref/compiler.texi

@@ -536,7 +536,8 @@ be wrapped in a thunk that declares the arity of the expression:
 
 @example
 scheme@@(guile-user)> ,language glil
-Guile Lowlevel Intermediate Language (GLIL) interpreter 0.3 on Guile 1.9.0
+Guile Lowlevel Intermediate Language (GLIL) interpreter 0.3 on
+   Guile 1.9.0
 Copyright (C) 2001-2008 Free Software Foundation, Inc.
 
 Enter `,help' for help.

doc/ref/effective-version.texi.in

@@ -0,0 +1 @@
+@set EFFECTIVE-VERSION @GUILE_EFFECTIVE_VERSION@

doc/ref/expect.texi

@@ -10,9 +10,9 @@
 
 The macros in this section are made available with:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 expect))
-@end smalllisp
+@end lisp
 
 @code{expect} is a macro for selecting actions based on the output from
 a port.  The name comes from a tool of similar functionality by Don Libes.
@@ -30,14 +30,14 @@ which is matched against each of the patterns.  When a
 pattern matches, the remaining expression(s) in
 the clause are evaluated and the value of the last is returned.  For example:
 
-@smalllisp
+@lisp
 (with-input-from-file "/etc/passwd"
   (lambda ()
     (expect-strings
       ("^nobody" (display "Got a nobody user.\n")
                  (display "That's no problem.\n"))
       ("^daemon" (display "Got a daemon user.\n")))))
-@end smalllisp
+@end lisp
 
 The regular expression is compiled with the @code{REG_NEWLINE} flag, so
 that the ^ and $ anchors will match at any newline, not just at the start
@@ -54,13 +54,13 @@ The symbol @code{=>} can be used to indicate that the expression is a
 procedure which will accept the result of a successful regular expression
 match.  E.g.,
 
-@smalllisp
+@lisp
 ("^daemon" => write)
 ("^d(aemon)" => (lambda args (for-each write args)))
 ("^da(em)on" => (lambda (all sub)
                   (write all) (newline)
                   (write sub) (newline)))
-@end smalllisp
+@end lisp
 
 The order of the substrings corresponds to the order in which the
 opening brackets occur.
@@ -135,12 +135,12 @@ expression.
 In the following example, a string will only be matched at the beginning
 of the file:
 
-@smalllisp
+@lisp
 (let ((expect-port (open-input-file "/etc/passwd")))
   (expect
      ((lambda (s eof?) (string=? s "fnord!"))
         (display "Got a nobody user!\n"))))
-@end smalllisp
+@end lisp
 
 The control variables described for @code{expect-strings} also
 influence the behaviour of @code{expect}, with the exception of 

doc/ref/goops-tutorial.texi

@@ -1,3 +1,9 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C)  2008, 2009
+@c   Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+
 @c Original attribution:
 
 @c
@@ -24,19 +30,33 @@
 @c Guile
 @c @end macro
 
-This is chapter was originally written by Erick Gallesio as an appendix
+This section introduces the @goops{} package in more detail.  It was
-for the STk reference manual, and subsequently adapted to @goops{}.
+originally written by Erick Gallesio as an appendix for the STk
+reference manual, and subsequently adapted to @goops{}.
+
+The procedures and syntax described in this tutorial are provided by
+Guile modules that may need to be imported before being available.
+The main @goops{} module is imported by evaluating:
+
+@lisp
+(use-modules (oop goops))
+@end lisp
+@findex (oop goops)
+@cindex main module
+@cindex loading
+@cindex preparing
 
 @menu
 * Copyright::
-* Intro::                
+* Class definition::  
-* Class definition and instantiation::  
+* Instance creation and slot access::  
+* Slot description::            
 * Inheritance::                 
 * Generic functions::           
 @end menu
 
-@node Copyright, Intro, Tutorial, Tutorial
+@node Copyright
-@section Copyright
+@subsection Copyright
 
 Original attribution:
 
@@ -52,52 +72,13 @@ required for any of the authorized uses.
 This software is provided ``AS IS'' without express or implied
 warranty.
 
-Adapted for use in Guile with the authors permission
+Adapted for use in Guile with the author's permission
 
-@node Intro, Class definition and instantiation, Copyright, Tutorial
+@node Class definition
-@section Introduction
-
-@goops{} is the object oriented extension to @guile{}. Its
-implementation is derived from @w{STk-3.99.3} by Erick Gallesio and
-version 1.3 of the Gregor Kiczales @cite{Tiny-Clos}.  It is very close
-to CLOS, the Common Lisp Object System (@cite{CLtL2}) but is adapted for
-the Scheme language.
-
-Briefly stated, the @goops{} extension gives the user a full object
-oriented system with multiple inheritance and generic functions with
-multi-method dispatch.  Furthermore, the implementation relies on a true
-meta object protocol, in the spirit of the one defined for CLOS
-(@cite{Gregor Kiczales: A Metaobject Protocol}).
-
-The purpose of this tutorial is to introduce briefly the @goops{}
-package and in no case will it replace the @goops{} reference manual
-(which needs to be urgently written now@ @dots{}).
-
-Note that the operations described in this tutorial resides in modules
-that may need to be imported before being available.  The main module is
-imported by evaluating:
-
-@lisp
-(use-modules (oop goops))
-@end lisp
-@findex (oop goops)
-@cindex main module
-@cindex loading
-@cindex preparing
-
-@node Class definition and instantiation, Inheritance, Intro, Tutorial
-@section Class definition and instantiation
-
-@menu
-* Class definition::            
-@end menu
-
-@node Class definition,  , Class definition and instantiation, Class definition and instantiation
 @subsection Class definition
 
-A new class is defined with the @code{define-class}@footnote{Don't
+A new class is defined with the @code{define-class} macro. The syntax
-forget to import the @code{(oop goops)} module} macro. The syntax of
+of @code{define-class} is close to CLOS @code{defclass}:
-@code{define-class} is close to CLOS @code{defclass}:
 
 @findex define-class
 @cindex class
@@ -107,105 +88,36 @@ forget to import the @code{(oop goops)} module} macro. The syntax of
    @var{class-option} @dots{})
 @end lisp
 
-Class options will not be discussed in this tutorial.  The list of
+@var{class} is the class being defined.  The list of
-@var{superclass}es specifies which classes to inherit properties from
+@var{superclass}es specifies which existing classes, if any, to
-@var{class} (see @ref{Inheritance} for more details).  A
+inherit slots and properties from.  Each @var{slot-description} gives
-@var{slot-description} gives the name of a slot and, eventually, some
+the name of a slot and optionally some ``properties'' of this slot;
-``properties'' of this slot (such as its initial value, the function
+for example its initial value, the name of a function which will
-which permit to access its value, @dots{}). Slot descriptions will be
+access its value, and so on.  Slot descriptions and inheritance are
-discussed in @ref{Slot description}.
+discussed more below.  For class options, see @ref{Class Options}.
 @cindex slot
 
-As an example, let us define a type for representation of complex
+As an example, let us define a type for representing a complex number
-numbers in terms of real numbers. This can be done with the following
+in terms of two real numbers.@footnote{Of course Guile already
-class definition:
+provides complex numbers, and @code{<complex>} is in fact a predefined
+class in GOOPS; but the definition here is still useful as an
+example.}  This can be done with the following class definition:
 
 @lisp
-(define-class  <complex> (<number>)
+(define-class <my-complex> (<number>)
    r i)
 @end lisp
 
-This binds the variable @code{<complex>}@footnote{@code{<complex>} is in
+This binds the variable @code{<my-complex>} to a new class whose
-fact a builtin class in GOOPS.  Because of this, GOOPS will create a new
+instances will contain two slots.  These slots are called @code{r} and
-class.  The old class will still serve as the type for Guile's native
+@code{i} and will hold the real and imaginary parts of a complex
-complex numbers.} to a new class whose instances contain two
+number. Note that this class inherits from @code{<number>}, which is a
-slots. These slots are called @code{r} an @code{i} and we suppose here
+predefined class.@footnote{@code{<number>} is the direct superclass of
-that they contain respectively the real part and the imaginary part of a
+the predefined class @code{<complex>}; @code{<complex>} is the
-complex number. Note that this class inherits from @code{<number>} which
+superclass of @code{<real>}, and @code{<real>} is the superclass of
-is a pre-defined class.  (@code{<number>} is the direct super class of
+@code{<integer>}.}
-the pre-defined class @code{<complex>} which, in turn, is the super
-class of @code{<real>} which is the super of
-@code{<integer>}.)@footnote{With the new definition of @code{<complex>},
-a @code{<real>} is not a @code{<complex>} since @code{<real>} inherits
-from @code{ <number>} rather than @code{<complex>}. In practice,
-inheritance could be modified @emph{a posteriori}, if needed. However,
-this necessitates some knowledge of the meta object protocol and it will
-not be shown in this document}.
 
-@node Inheritance, Generic functions, Class definition and instantiation, Tutorial
+@node Instance creation and slot access
-@section Inheritance
-@c \label{inheritance}
-
-@menu
-* Class hierarchy and inheritance of slots::  
-* Instance creation and slot access::  
-* Slot description::            
-* Class precedence list::       
-@end menu
-
-@node Class hierarchy and inheritance of slots, Instance creation and slot access, Inheritance, Inheritance
-@subsection Class hierarchy and inheritance of slots
-Inheritance is specified upon class definition. As said in the
-introduction, @goops{} supports multiple inheritance.  Here are some
-class definitions:
-
-@lisp
-(define-class A () a)
-(define-class B () b)
-(define-class C () c)
-(define-class D (A B) d a)
-(define-class E (A C) e c)
-(define-class F (D E) f)
-@end lisp
-
-@code{A}, @code{B}, @code{C} have a null list of super classes. In this
-case, the system will replace it by the list which only contains
-@code{<object>}, the root of all the classes defined by
-@code{define-class}. @code{D}, @code{E}, @code{F} use multiple
-inheritance: each class inherits from two previously defined classes.
-Those class definitions define a hierarchy which is shown in Figure@ 1.
-In this figure, the class @code{<top>} is also shown; this class is the
-super class of all Scheme objects. In particular, @code{<top>} is the
-super class of all standard Scheme types.
-
-@example
-@group
-@image{hierarchy}
-@center @emph{Fig 1: A class hierarchy}
-@iftex
-@emph{(@code{<complex>} which is the direct subclass of @code{<number>}
-and the direct superclass of @code{<real>} has been omitted in this
-figure.)}
-@end iftex
-@end group
-@end example
-
-The set of slots of a given class is calculated by taking the union of the
-slots of all its super class. For instance, each instance of the class
-D, defined before will have three slots (@code{a}, @code{b} and
-@code{d}). The slots of a class can be obtained by the @code{class-slots}
-primitive.  For instance,
-
-@lisp
-(class-slots A) @result{} ((a))
-(class-slots E) @result{} ((a) (e) (c))
-(class-slots F) @result{} ((e) (c) (b) (d) (a) (f))
-@c used to be ((d) (a) (b) (c) (f))
-@end lisp
-
-@emph{Note: } The order of slots is not significant.
-
-@node Instance creation and slot access, Slot description, Class hierarchy and inheritance of slots, Inheritance
 @subsection Instance creation and slot access
 
 Creation of an instance of a previously defined
@@ -218,16 +130,16 @@ slots of the newly created instance. For instance, the following form
 @findex make
 @cindex instance
 @lisp
-(define c (make <complex>))
+(define c (make <my-complex>))
 @end lisp
 
-will create a new @code{<complex>} object and will bind it to the @code{c}
+@noindent
+will create a new @code{<my-complex>} object and will bind it to the @code{c}
 Scheme variable.
 
 Accessing the slots of the new complex number can be done with the
-@code{slot-ref} and the @code{slot-set!}  primitives. @code{Slot-set!}
+@code{slot-ref} and the @code{slot-set!}  primitives. @code{slot-set!}
-primitive permits to set the value of an object slot and @code{slot-ref}
+sets the value of an object slot and @code{slot-ref} retrieves it.
-permits to get its value.
 
 @findex slot-set!
 @findex slot-ref
@@ -250,50 +162,58 @@ First load the module @code{(oop goops describe)}:
 @code{(use-modules (oop goops describe))}
 @end example
 
-The expression
+@noindent
-
+Then the expression
-@smalllisp
-(describe c)
-@end smalllisp
-
-will now print the following information on the standard output:
 
 @lisp
-#<<complex> 401d8638> is an instance of class <complex>
+(describe c)
+@end lisp
+
+@noindent
+will print the following information on the standard output:
+
+@smalllisp
+#<<my-complex> 401d8638> is an instance of class <my-complex>
 Slots are: 
      r = 10
      i = 3
-@end lisp
+@end smalllisp
 
-@node Slot description, Class precedence list, Instance creation and slot access, Inheritance
+@node Slot description
 @subsection Slot description
 @c \label{slot-description}
 
-When specifying a slot, a set of options can be given to the
+When specifying a slot (in a @code{(define-class @dots{})} form),
-system. Each option is specified with a keyword. The list of authorized
+various options can be specified in addition to the slot's name.  Each
-keywords is given below:
+option is specified by a keyword.  The list of authorized keywords is
+given below:
 
 @cindex keyword
 @itemize @bullet
 @item
-@code{#:init-value} permits to supply a default value for the slot. This
+@code{#:init-value} permits to supply a constant default value for the
-default value is obtained by evaluating the form given after the
+slot.  The value is obtained by evaluating the form given after the
-@code{#:init-form} in the global environment, at class definition time.
+@code{#:init-value} at class definition time.
 @cindex default slot value
 @findex #:init-value
-@cindex top level environment
+
+@item
+@code{#:init-form} specifies a form that, when evaluated, will return
+an initial value for the slot.  The form is evaluated each time that
+an instance of the class is created, in the lexical environment of the
+containing @code{define-class} expression.
+@cindex default slot value
+@findex #:init-form
 
 @item
 @code{#:init-thunk} permits to supply a thunk that will provide a
-default value for the slot. The value is obtained by evaluating the
+default value for the slot.  The value is obtained by invoking the
-thunk a instance creation time.
+thunk at instance creation time.
-@c CHECKME: in the global environment?
 @findex default slot value
 @findex #:init-thunk
-@cindex top level environment
 
 @item
-@code{#:init-keyword} permits to specify the keyword for initializing a
+@code{#:init-keyword} permits to specify a keyword for initializing the
 slot.  The init-keyword may be provided during instance creation (i.e. in
 the @code{make} optional parameter list).  Specifying such a keyword
 during instance initialization will supersede the default slot
@@ -361,11 +281,11 @@ and @code{#:slot-set!} options. See the example below.
 @end itemize
 @end itemize
 
-To illustrate slot description, we shall redefine the @code{<complex>} class 
+To illustrate slot description, we shall redefine the @code{<my-complex>} class 
 seen before. A definition could be:
 
 @lisp
-(define-class <complex> (<number>) 
+(define-class <my-complex> (<number>) 
    (r #:init-value 0 #:getter get-r #:setter set-r! #:init-keyword #:r)
    (i #:init-value 0 #:getter get-i #:setter set-i! #:init-keyword #:i))
 @end lisp
@@ -378,11 +298,11 @@ functions @code{get-r} and @code{set-r!} (resp. @code{get-i} and
 the @code{r} (resp. @code{i}) slot.
 
 @lisp
-(define c1 (make <complex> #:r 1 #:i 2))
+(define c1 (make <my-complex> #:r 1 #:i 2))
 (get-r c1) @result{} 1
 (set-r! c1 12)
 (get-r c1) @result{} 12
-(define c2 (make <complex> #:r 2))
+(define c2 (make <my-complex> #:r 2))
 (get-r c2) @result{} 2
 (get-i c2) @result{} 0
 @end lisp
@@ -390,12 +310,12 @@ the @code{r} (resp. @code{i}) slot.
 Accessors provide an uniform access for reading and writing an object
 slot.  Writing a slot is done with an extended form of @code{set!}
 which is close to the Common Lisp @code{setf} macro. So, another
-definition of the previous @code{<complex>} class, using the
+definition of the previous @code{<my-complex>} class, using the
 @code{#:accessor} option, could be:
 
 @findex set!
 @lisp
-(define-class <complex> (<number>) 
+(define-class <my-complex> (<number>) 
    (r #:init-value 0 #:accessor real-part #:init-keyword #:r)
    (i #:init-value 0 #:accessor imag-part #:init-keyword #:i))
 @end lisp
@@ -416,13 +336,13 @@ coordinates as well as with polar coordinates. One solution could be to
 have a definition of complex numbers which uses one particular
 representation and some conversion functions to pass from one
 representation to the other.  A better solution uses virtual slots. A
-complete definition of the @code{<complex>} class using virtual slots is
+complete definition of the @code{<my-complex>} class using virtual slots is
 given in Figure@ 2.
 
 @example
 @group
 @lisp
-(define-class <complex> (<number>)
+(define-class <my-complex> (<number>)
    ;; True slots use rectangular coordinates
    (r #:init-value 0 #:accessor real-part #:init-keyword #:r)
    (i #:init-value 0 #:accessor imag-part #:init-keyword #:i)
@@ -446,7 +366,7 @@ given in Figure@ 2.
                       (slot-set! o 'i (* m (sin a)))))))
 
 @end lisp
-@center @emph{Fig 2: A @code{<complex>} number class definition using virtual slots}
+@center @emph{Fig 2: A @code{<my-complex>} number class definition using virtual slots}
 @end group
 @end example
 
@@ -480,20 +400,21 @@ A more complete example is given below:
 
 @example
 @group
-@lisp
+@smalllisp
-(define c (make <complex> #:r 12 #:i 20))
+(define c (make <my-complex> #:r 12 #:i 20))
 (real-part c) @result{} 12
 (angle c) @result{} 1.03037682652431
 (slot-set! c 'i 10)
 (set! (real-part c) 1)
-(describe c) @result{}
+(describe c)
-          #<<complex> 401e9b58> is an instance of class <complex>
+@print{}
-          Slots are: 
+#<<my-complex> 401e9b58> is an instance of class <my-complex>
+Slots are: 
      r = 1
      i = 10
      m = 10.0498756211209
      a = 1.47112767430373
-@end lisp
+@end smalllisp
 @end group
 @end example
 
@@ -503,14 +424,75 @@ Scheme primitives.
 
 @lisp
 (define make-rectangular 
-   (lambda (x y) (make <complex> #:r x #:i y)))
+   (lambda (x y) (make <my-complex> #:r x #:i y)))
 
 (define make-polar
-   (lambda (x y) (make <complex> #:magn x #:angle y)))
+   (lambda (x y) (make <my-complex> #:magn x #:angle y)))
 @end lisp
 
-@node Class precedence list,  , Slot description, Inheritance
+@node Inheritance
-@subsection Class precedence list
+@subsection Inheritance
+@c \label{inheritance}
+
+@menu
+* Class hierarchy and inheritance of slots::  
+* Class precedence list::       
+@end menu
+
+@node Class hierarchy and inheritance of slots
+@subsubsection Class hierarchy and inheritance of slots
+Inheritance is specified upon class definition. As said in the
+introduction, @goops{} supports multiple inheritance.  Here are some
+class definitions:
+
+@lisp
+(define-class A () a)
+(define-class B () b)
+(define-class C () c)
+(define-class D (A B) d a)
+(define-class E (A C) e c)
+(define-class F (D E) f)
+@end lisp
+
+@code{A}, @code{B}, @code{C} have a null list of super classes. In this
+case, the system will replace it by the list which only contains
+@code{<object>}, the root of all the classes defined by
+@code{define-class}. @code{D}, @code{E}, @code{F} use multiple
+inheritance: each class inherits from two previously defined classes.
+Those class definitions define a hierarchy which is shown in Figure@ 1.
+In this figure, the class @code{<top>} is also shown; this class is the
+super class of all Scheme objects. In particular, @code{<top>} is the
+super class of all standard Scheme types.
+
+@example
+@group
+@image{hierarchy}
+@center @emph{Fig 1: A class hierarchy}
+@iftex
+@emph{(@code{<complex>} which is the direct subclass of @code{<number>}
+and the direct superclass of @code{<real>} has been omitted in this
+figure.)}
+@end iftex
+@end group
+@end example
+
+The set of slots of a given class is calculated by taking the union of the
+slots of all its super class. For instance, each instance of the class
+D, defined before will have three slots (@code{a}, @code{b} and
+@code{d}). The slots of a class can be obtained by the @code{class-slots}
+primitive.  For instance,
+
+@lisp
+(class-slots A) @result{} ((a))
+(class-slots E) @result{} ((a) (e) (c))
+(class-slots F) @result{} ((e) (c) (b) (d) (a) (f))
+@c used to be ((d) (a) (b) (c) (f))
+@end lisp
+
+@emph{Note: } The order of slots is not significant.
+
+@node Class precedence list
+@subsubsection Class precedence list
 
 A class may have more than one superclass.  @footnote{This section is an
 adaptation of Jeff Dalton's (J.Dalton@@ed.ac.uk) @cite{Brief
@@ -587,8 +569,8 @@ However, this result is not too much readable; using the function
 (map class-name (class-precedence-list B)) @result{} (B <object> <top>) 
 @end lisp
 
-@node Generic functions,  , Inheritance, Tutorial
+@node Generic functions
-@section Generic functions
+@subsection Generic functions
 
 @menu
 * Generic functions and methods::  
@@ -596,8 +578,8 @@ However, this result is not too much readable; using the function
 * Example::                     
 @end menu
 
-@node Generic functions and methods, Next-method, Generic functions, Generic functions
+@node Generic functions and methods
-@subsection Generic functions and methods
+@subsubsection Generic functions and methods
 
 @c \label{gf-n-methods}
 Neither @goops{} nor CLOS use the message mechanism for methods as most
@@ -687,8 +669,8 @@ In this case,
 (G 'a 1)  @result{} top-number
 @end lisp
 
-@node Next-method, Example, Generic functions and methods, Generic functions
+@node Next-method
-@subsection Next-method
+@subsubsection Next-method
 
 When you call a generic function, with a particular set of arguments,
 GOOPS builds a list of all the methods that are applicable to those
@@ -737,16 +719,16 @@ Number is in range
 lead to an infinite recursion, but this consideration is just the same
 as in Scheme code in general.)
 
-@node Example,  , Next-method, Generic functions
+@node Example
-@subsection Example
+@subsubsection Example
 
-In this section we shall continue to define operations on the @code{<complex>}
+In this section we shall continue to define operations on the @code{<my-complex>}
 class defined in Figure@ 2. Suppose that we want to use it to implement 
 complex numbers completely. For instance a definition for the addition of 
 two complexes could be
 
 @lisp
-(define-method (new-+ (a <complex>) (b <complex>))
+(define-method (new-+ (a <my-complex>) (b <my-complex>))
   (make-rectangular (+ (real-part a) (real-part b))
                     (+ (imag-part a) (imag-part b))))
 @end lisp
@@ -758,7 +740,7 @@ addition we can do:
 (define-generic new-+)
 
 (let ((+ +))
-  (define-method (new-+ (a <complex>) (b <complex>))
+  (define-method (new-+ (a <my-complex>) (b <my-complex>))
     (make-rectangular (+ (real-part a) (real-part b))
                       (+ (imag-part a) (imag-part b)))))
 @end lisp
@@ -778,13 +760,13 @@ Figure@ 3.
 
   (define-method (new-+ (a <real>) (b <real>)) (+ a b))
 
-  (define-method (new-+ (a <real>) (b <complex>)) 
+  (define-method (new-+ (a <real>) (b <my-complex>)) 
     (make-rectangular (+ a (real-part b)) (imag-part b)))
 
-  (define-method (new-+ (a <complex>) (b <real>))
+  (define-method (new-+ (a <my-complex>) (b <real>))
     (make-rectangular (+ (real-part a) b) (imag-part a)))
 
-  (define-method (new-+ (a <complex>) (b <complex>))
+  (define-method (new-+ (a <my-complex>) (b <my-complex>))
     (make-rectangular (+ (real-part a) (real-part b))
                       (+ (imag-part a) (imag-part b))))
 
@@ -823,7 +805,7 @@ To terminate our implementation (integration?) of  complex numbers, we can
 redefine standard Scheme predicates in the following manner:
 
 @lisp
-(define-method (complex? c <complex>) #t)
+(define-method (complex? c <my-complex>) #t)
 (define-method (complex? c)           #f)
 
 (define-method (number? n <number>) #t)

doc/ref/goops.texi

@@ -1,19 +1,8 @@
-\input texinfo
 @c -*-texinfo-*-
-@c %**start of header
+@c This is part of the GNU Guile Reference Manual.
-@setfilename goops.info
+@c Copyright (C)  2008, 2009
-@settitle Goops Manual
+@c   Free Software Foundation, Inc.
-@set goops
+@c See the file guile.texi for copying conditions.
-@setchapternewpage odd
-@paragraphindent 0
-@c %**end of header
-
-@set VERSION 0.3
-
-@dircategory The Algorithmic Language Scheme
-@direntry
-* GOOPS: (goops).               The GOOPS reference manual.
-@end direntry
 
 @macro goops
 GOOPS
@@ -23,77 +12,8 @@ GOOPS
 Guile
 @end macro
 
-@ifinfo
+@node GOOPS
-This file documents GOOPS, an object oriented extension for Guile.
+@chapter GOOPS
-
-Copyright (C) 1999, 2000, 2001, 2003, 2006 Free Software Foundation
-
-Permission is granted to make and distribute verbatim copies of
-this manual provided the copyright notice and this permission notice
-are preserved on all copies.
-
-@end ifinfo
-
-@c  This title page illustrates only one of the
-@c  two methods of forming a title page.
-
-@titlepage
-@title Goops Manual
-@subtitle For use with GOOPS @value{VERSION}
-
-@c AUTHORS
-
-@c The GOOPS tutorial was written by Christian Lynbech and Mikael
-@c Djurfeldt, who also wrote GOOPS itself.  The GOOPS reference manual
-@c and MOP documentation were written by Neil Jerram and reviewed by
-@c Mikael Djurfeldt.
-
-@author Christian Lynbech
-@author @email{chl@@tbit.dk}
-@author
-@author Mikael Djurfeldt
-@author @email{djurfeldt@@nada.kth.se}
-@author
-@author Neil Jerram
-@author @email{neil@@ossau.uklinux.net}
-
-@c  The following two commands
-@c  start the copyright page.
-@page
-@vskip 0pt plus 1filll
-Copyright @copyright{} 1999, 2006 Free Software Foundation
-
-Permission is granted to make and distribute verbatim copies of
-this manual provided the copyright notice and this permission notice
-are preserved on all copies.
-
-@end titlepage
-
-@node Top, Introduction, (dir), (dir)
-
-@menu
-* Introduction::
-* Getting Started::
-* Reference Manual::
-* MOP Specification::
-
-* Tutorial::
-
-* Concept Index::
-* Function and Variable Index::
-@end menu
-
-@iftex
-@chapter Preliminaries
-@end iftex
-
-@node Introduction, Getting Started, Top, Top
-@iftex
-@section Introduction
-@end iftex
-@ifnottex
-@chapter Introduction
-@end ifnottex
 
 @goops{} is the object oriented extension to @guile{}. Its
 implementation is derived from @w{STk-3.99.3} by Erick Gallesio and
@@ -109,71 +29,58 @@ multi-method dispatch.  Furthermore, the implementation relies on a true
 meta object protocol, in the spirit of the one defined for CLOS
 (@cite{Gregor Kiczales: A Metaobject Protocol}).
 
-@node Getting Started, Reference Manual, Introduction, Top
-@iftex
-@section Getting Started
-@end iftex
-@ifnottex
-@chapter Getting Started
-@end ifnottex
-
 @menu
-* Running GOOPS::
+* Quick Start::
-
+* Tutorial::
-Examples of some basic GOOPS functionality.
+* Reference Manual::
-
+* MOP Specification::
-* Methods::
-* User-defined types::
-* Asking for the type of an object::
-
-See further in the GOOPS tutorial available in this distribution in
-info (goops.info) and texinfo format.
 @end menu
 
-@node Running GOOPS, Methods, Getting Started, Getting Started
+@node Quick Start
-@subsection Running GOOPS
+@section Quick Start
 
-@enumerate
+To give an immediate flavour of what GOOPS can do, here is a very
-@item
+brief introduction to its main operations.
-Type
 
-@smalllisp
+To start using GOOPS, load the @code{(oop goops)} module:
-guile-oops
-@end smalllisp
 
-You should now be at the Guile prompt ("guile> ").
+@lisp
-
-@item
-Type
-
-@smalllisp
 (use-modules (oop goops))
-@end smalllisp
+@end lisp
-
-to load GOOPS.  (If your system supports dynamic loading, you
-should be able to do this not only from `guile-oops' but from an
-arbitrary Guile interpreter.)
-@end enumerate
 
 We're now ready to try some basic GOOPS functionality.
 
-@node Methods, User-defined types, Running GOOPS, Getting Started
+@menu
+* Methods::
+* User-defined types::
+* Asking for the type of an object::
+@end menu
+
+@node Methods
 @subsection Methods
 
-@smalllisp
+A GOOPS method is like a Scheme procedure except that it is
-@group
+specialized for a particular set of argument types.
+
+@lisp
 (define-method (+ (x <string>) (y <string>))
   (string-append x y))
 
-(+ 1 2) --> 3
+(+ "abc" "de") @result{} "abcde"
-(+ "abc" "de") --> "abcde"
+@end lisp
-@end group
-@end smalllisp
 
-@node User-defined types, Asking for the type of an object, Methods, Getting Started
+If @code{+} is used with arguments that do not match the method's
+types, Guile falls back to using the normal Scheme @code{+} procedure.
+
+@lisp
+(+ 1 2) @result{} 3
+@end lisp
+
+
+@node User-defined types
 @subsection User-defined types
 
-@smalllisp
+@lisp
 (define-class <2D-vector> ()
   (x #:init-value 0 #:accessor x-component #:init-keyword #:x)
   (y #:init-value 0 #:accessor y-component #:init-keyword #:y))
@@ -182,12 +89,11 @@ We're now ready to try some basic GOOPS functionality.
 (use-modules (ice-9 format))
 
 (define-method (write (obj <2D-vector>) port)
-  (display (format #f "<~S, ~S>" (x-component obj) (y-component obj))
+  (format port "<~S, ~S>" (x-component obj) (y-component obj)))
-           port))
 
 (define v (make <2D-vector> #:x 3 #:y 4))
 
-v --> <3, 4>
+v @result{} <3, 4>
 @end group
 
 @group
@@ -196,24 +102,28 @@ v --> <3, 4>
         #:x (+ (x-component x) (x-component y))
         #:y (+ (y-component x) (y-component y))))
 
-(+ v v) --> <6, 8>
+(+ v v) @result{} <6, 8>
 @end group
-@end smalllisp
+@end lisp
 
-@node Asking for the type of an object, , User-defined types, Getting Started
+@node Asking for the type of an object
 @subsection Types
 
 @example
-(class-of v) --> #<<class> <2D-vector> 40241ac0>
+(class-of v) @result{} #<<class> <2D-vector> 40241ac0>
-<2D-vector>  --> #<<class> <2D-vector> 40241ac0>
+<2D-vector>  @result{} #<<class> <2D-vector> 40241ac0>
-(class-of 1) --> #<<class> <integer> 401b2a98>
+(class-of 1) @result{} #<<class> <integer> 401b2a98>
-<integer>    --> #<<class> <integer> 401b2a98>
+<integer>    @result{} #<<class> <integer> 401b2a98>
 
-(is-a? v <2D-vector>) --> #t
+(is-a? v <2D-vector>) @result{} #t
 @end example
 
-@node Reference Manual, MOP Specification, Getting Started, Top
+@node Tutorial
-@chapter Reference Manual
+@section Tutorial
+@include goops-tutorial.texi
+
+@node Reference Manual
+@section Reference Manual
 
 This chapter is the GOOPS reference manual.  It aims to describe all the
 syntax, procedures, options and associated concepts that a typical
@@ -241,7 +151,7 @@ For a detailed specification of the GOOPS metaobject protocol, see
 @end menu
 
 @node Introductory Remarks
-@section Introductory Remarks
+@subsection Introductory Remarks
 
 GOOPS is an object-oriented programming system based on a ``metaobject
 protocol'' derived from the ones used in CLOS (the Common Lisp Object
@@ -261,19 +171,19 @@ GOOPS' power, by customizing the behaviour of GOOPS itself.
 
 Each of the following sections of the reference manual is arranged
 such that the most basic usage is introduced first, and then subsequent
-subsections discuss the related internal functions and metaobject
+subsubsections discuss the related internal functions and metaobject
 protocols, finishing with a description of how to customize that area of
 functionality.
 
 These introductory remarks continue with a few words about metaobjects
 and the MOP.  Readers who do not want to be bothered yet with the MOP
-and customization could safely skip this subsection on a first reading,
+and customization could safely skip this subsubsection on a first reading,
-and should correspondingly skip subsequent subsections that are
+and should correspondingly skip subsequent subsubsections that are
 concerned with internals and customization.
 
 In general, this reference manual assumes familiarity with standard
 object oriented concepts and terminology.  However, some of the terms
-used in GOOPS are less well known, so the Terminology subsection
+used in GOOPS are less well known, so the Terminology subsubsection
 provides definitions for these terms.
 
 @menu
@@ -282,7 +192,7 @@ provides definitions for these terms.
 @end menu
 
 @node Metaobjects and the Metaobject Protocol
-@subsection Metaobjects and the Metaobject Protocol
+@subsubsection Metaobjects and the Metaobject Protocol
 
 The conceptual building blocks of GOOPS are classes, slot definitions,
 instances, generic functions and methods.  A class is a grouping of
@@ -377,7 +287,7 @@ Each subsequent section of the reference manual covers a particular area
 of GOOPS functionality, and describes the generic functions that are
 relevant for customization of that area.
 
-We conclude this subsection by emphasizing a point that may seem
+We conclude this subsubsection by emphasizing a point that may seem
 obvious, but contrasts with the corresponding situation in some other
 MOP implementations, such as CLOS.  The point is simply that an
 identifier which represents a GOOPS class or generic function is a
@@ -392,7 +302,7 @@ class names), but it is worth noting that GOOPS conforms fully to this
 Schemely principle.
 
 @node Terminology
-@subsection Terminology
+@subsubsection Terminology
 
 It is assumed that the reader is already familiar with standard object
 orientation concepts such as classes, objects/instances,
@@ -403,14 +313,7 @@ This section explains some of the less well known concepts and
 terminology that GOOPS uses, which are assumed by the following sections
 of the reference manual.
 
-@menu
+@subsubheading Metaclass
-* Metaclass::
-* Class Precedence List::
-* Accessor::
-@end menu
-
-@node Metaclass
-@subsubsection Metaclass
 
 A @dfn{metaclass} is the class of an object which represents a GOOPS
 class.  Put more succinctly, a metaclass is a class's class.
@@ -517,8 +420,7 @@ The metaclass of @code{<my-metaclass>} is @code{<class>}.
 @code{<class>}.
 @end itemize
 
-@node Class Precedence List
+@subsubheading Class Precedence List
-@subsubsection Class Precedence List
 
 The @dfn{class precedence list} of a class is the list of all direct and
 indirect superclasses of that class, including the class itself.
@@ -548,8 +450,7 @@ precedence list}.
 ``Class precedence list'' is often abbreviated, in documentation and
 Scheme variable names, to @dfn{cpl}.
 
-@node Accessor
+@subsubheading Accessor
-@subsubsection Accessor
 
 An @dfn{accessor} is a generic function with both reference and setter
 methods.
@@ -583,7 +484,7 @@ be invoked using the generalized @code{set!} syntax, as in:
 @end example
 
 @node Defining New Classes
-@section Defining New Classes
+@subsection Defining New Classes
 
 [ *fixme* Somewhere in this manual there needs to be an introductory
 discussion about GOOPS classes, generic functions and methods, covering
@@ -622,7 +523,7 @@ the discussion there. ]
 @end menu
 
 @node Basic Class Definition
-@subsection Basic Class Definition
+@subsubsection Basic Class Definition
 
 New classes are defined using the @code{define-class} syntax, with
 arguments that specify the classes that the new class should inherit
@@ -651,7 +552,7 @@ keywords and corresponding values.
 @end deffn
 
 The standard GOOPS class and slot options are described in the following
-subsections: see @ref{Class Options} and @ref{Slot Options}.
+subsubsections: see @ref{Class Options} and @ref{Slot Options}.
 
 Example 1.  Define a class that combines two pre-existing classes by
 inheritance but adds no new slots.
@@ -681,13 +582,13 @@ customized via an application-defined metaclass.
 @end example
 
 @node Class Options
-@subsection Class Options
+@subsubsection Class Options
 
 @deffn {class option} #:metaclass metaclass
 The @code{#:metaclass} class option specifies the metaclass of the class
 being defined.  @var{metaclass} must be a class that inherits from
 @code{<class>}.  For an introduction to the use of metaclasses, see
-@ref{Metaobjects and the Metaobject Protocol} and @ref{Metaclass}.
+@ref{Metaobjects and the Metaobject Protocol} and @ref{Terminology}.
 
 If the @code{#:metaclass} option is absent, GOOPS reuses or constructs a
 metaclass for the new class by calling @code{ensure-metaclass}
@@ -714,7 +615,7 @@ environment defaults to the top-level environment in which the
 @end deffn
 
 @node Slot Options
-@subsection Slot Options
+@subsubsection Slot Options
 
 @deffn {slot option} #:allocation allocation
 The @code{#:allocation} option tells GOOPS how to allocate storage for
@@ -917,7 +818,7 @@ classes.
 @end deffn
 
 @node Class Definition Internals
-@subsection Class Definition Internals
+@subsubsection Class Definition Internals
 
 Implementation notes: @code{define-class} expands to an expression which
 
@@ -1030,7 +931,7 @@ class object, are described in @ref{Customizing Instance Creation},
 which covers the creation and initialization of instances in general.
 
 @node Customizing Class Definition
-@subsection Customizing Class Definition
+@subsubsection Customizing Class Definition
 
 During the initialization of a new class, GOOPS calls a number of generic
 functions with the newly allocated class instance as the first
@@ -1124,7 +1025,8 @@ allocation to do this.
 
 (let ((batch-allocation-count 0)
       (batch-get-n-set #f))
-  (define-method (compute-get-n-set (class <batched-allocation-metaclass>) s)
+  (define-method (compute-get-n-set
+                     (class <batched-allocation-metaclass>) s)
     (case (slot-definition-allocation s)
       ((#:batched)
        ;; If we've already used the same slot storage for 10 instances,
@@ -1165,7 +1067,7 @@ typically it would perform additional class initialization steps before
 and/or after calling @code{(next-method)} for the standard behaviour.
 
 @node STKlos Compatibility
-@subsection STKlos Compatibility
+@subsubsection STKlos Compatibility
 
 If the STKlos compatibility module is loaded, @code{define-class} is
 overwritten by a STKlos-specific definition; the standard GOOPS
@@ -1178,7 +1080,7 @@ definition of @code{define-class} remains available in
 @end deffn
 
 @node Creating Instances
-@section Creating Instances
+@subsection Creating Instances
 
 @menu
 * Basic Instance Creation::
@@ -1186,7 +1088,7 @@ definition of @code{define-class} remains available in
 @end menu
 
 @node Basic Instance Creation
-@subsection Basic Instance Creation
+@subsubsection Basic Instance Creation
 
 To create a new instance of any GOOPS class, use the generic function
 @code{make} or @code{make-instance}, passing the required class and any
@@ -1223,7 +1125,7 @@ instance's class.  Any unprocessed keyword value pairs are ignored.
 @end deffn
 
 @node Customizing Instance Creation
-@subsection Customizing Instance Creation
+@subsubsection Customizing Instance Creation
 
 @code{make} itself is a generic function.  Hence the @code{make}
 invocation itself can be customized in the case where the new instance's
@@ -1290,7 +1192,7 @@ and closures in the slot definitions, it is neater to write an
 and initializes all the dependent slot values according to the results.
 
 @node Accessing Slots
-@section Accessing Slots
+@subsection Accessing Slots
 
 The definition of a slot contains at the very least a slot name, and may
 also contain various slot options, including getter, setter and/or
@@ -1298,7 +1200,7 @@ accessor functions for the slot.
 
 It is always possible to access slots by name, using the various
 ``slot-ref'' and ``slot-set!'' procedures described in the following
-subsections.  For example,
+subsubsections.  For example,
 
 @example
 (define-class <my-class> ()      ;; Define a class with slots
@@ -1354,7 +1256,7 @@ closures, see @ref{Customizing Class Definition,, compute-get-n-set}.)
 @end menu
 
 @node Instance Slots
-@subsection Instance Slots
+@subsubsection Instance Slots
 
 Any slot, regardless of its allocation, can be queried, referenced and
 set using the following four primitive procedures.
@@ -1451,7 +1353,7 @@ slot-missing}).
 @end deffn
 
 @node Class Slots
-@subsection Class Slots
+@subsubsection Class Slots
 
 Slots whose allocation is per-class rather than per-instance can be
 referenced and set without needing to specify any particular instance.
@@ -1479,7 +1381,7 @@ function with arguments @var{class} and @var{slot-name}.
 @end deffn
 
 @node Handling Slot Access Errors
-@subsection Handling Slot Access Errors
+@subsubsection Handling Slot Access Errors
 
 GOOPS calls one of the following generic functions when a ``slot-ref''
 or ``slot-set!'' call specifies a non-existent slot name, or tries to
@@ -1510,7 +1412,7 @@ message.
 @end deffn
 
 @node Creating Generic Functions
-@section Creating Generic Functions
+@subsection Creating Generic Functions
 
 A generic function is a collection of methods, with rules for
 determining which of the methods should be applied for any given
@@ -1526,7 +1428,7 @@ GOOPS represents generic functions as metaobjects of the class
 @end menu
 
 @node Basic Generic Function Creation
-@subsection Basic Generic Function Creation
+@subsubsection Basic Generic Function Creation
 
 The following forms may be used to bind a variable to a generic
 function.  Depending on that variable's pre-existing value, the generic
@@ -1586,20 +1488,20 @@ This can be resolved automagically with the duplicates handler
 @code{merge-generics} which gives the module system license to merge
 all generic functions sharing a common name:
 
-@smalllisp
+@lisp
 (define-module (math 2D-vectors)
-  :use-module (oop goops)
+  #:use-module (oop goops)
-  :export (x y ...))
+  #:export (x y ...))
 		  
 (define-module (math 3D-vectors)
-  :use-module (oop goops)
+  #:use-module (oop goops)
-  :export (x y z ...))
+  #:export (x y z ...))
 
 (define-module (my-module)
-  :use-module (math 2D-vectors)
+  #:use-module (math 2D-vectors)
-  :use-module (math 3D-vectors)
+  #:use-module (math 3D-vectors)
-  :duplicates merge-generics)
+  #:duplicates merge-generics)
-@end smalllisp
+@end lisp
 
 The generic function @code{x} in @code{(my-module)} will now share
 methods with @code{x} in both imported modules.
@@ -1629,14 +1531,14 @@ Sharing is dynamic, so that adding new methods to a descendant implies
 adding it to the ancestor.
 
 If duplicates checking is desired in the above example, the following
-form of the @code{:duplicates} option can be used instead:
+form of the @code{#:duplicates} option can be used instead:
 
-@smalllisp
+@lisp
-  :duplicates (merge-generics check)
+  #:duplicates (merge-generics check)
-@end smalllisp
+@end lisp
 
 @node Generic Function Internals
-@subsection Generic Function Internals
+@subsubsection Generic Function Internals
 
 @code{define-generic} calls @code{ensure-generic} to upgrade a
 pre-existing procedure value, or @code{make} with metaclass
@@ -1705,7 +1607,7 @@ accessor, passing the setter generic function as the value of the
 @code{#:setter} keyword.
 
 @node Extending Guiles Primitives
-@subsection Extending Guile's Primitives
+@subsubsection Extending Guile's Primitives
 
 When GOOPS is loaded, many of Guile's primitive procedures can be
 extended by giving them a generic function definition that operates
@@ -1752,7 +1654,7 @@ integrated into the core of Guile.  Consequently, the
 procedures described in this section may disappear as well.
 
 @node Adding Methods to Generic Functions
-@section Adding Methods to Generic Functions
+@subsection Adding Methods to Generic Functions
 
 @menu
 * Basic Method Definition::
@@ -1760,7 +1662,7 @@ procedures described in this section may disappear as well.
 @end menu
 
 @node Basic Method Definition
-@subsection Basic Method Definition
+@subsubsection Basic Method Definition
 
 To add a method to a generic function, use the @code{define-method} form.
 
@@ -1819,7 +1721,7 @@ invocation error handling, and generic function invocation in general,
 see @ref{Invoking Generic Functions}.
 
 @node Method Definition Internals
-@subsection Method Definition Internals
+@subsubsection Method Definition Internals
 
 @code{define-method}
 
@@ -1906,7 +1808,7 @@ function.
 @end deffn
 
 @node Invoking Generic Functions
-@section Invoking Generic Functions
+@subsection Invoking Generic Functions
 
 When a variable with a generic function definition appears as the first
 element of a list that is being evaluated, the Guile evaluator tries
@@ -1928,7 +1830,7 @@ may be applied subsequently if a method that is being applied calls
 @end menu
 
 @node Determining Which Methods to Apply
-@subsection Determining Which Methods to Apply
+@subsubsection Determining Which Methods to Apply
 
 [ *fixme*  Sorry - this is the area of GOOPS that I understand least of
 all, so I'm afraid I have to pass on this section.  Would some other
@@ -1959,7 +1861,7 @@ kind person consider filling it in? ]
 @end deffn
 
 @node Handling Invocation Errors
-@subsection Handling Invocation Errors
+@subsubsection Handling Invocation Errors
 
 @deffn generic no-method
 @deffnx method no-method (gf <generic>) args
@@ -1987,7 +1889,7 @@ default method calls @code{goops-error} with an appropriate message.
 @end deffn
 
 @node Redefining a Class
-@section Redefining a Class
+@subsection Redefining a Class
 
 Suppose that a class @code{<my-class>} is defined using @code{define-class}
 (@pxref{Basic Class Definition,, define-class}), with slots that have
@@ -2002,7 +1904,7 @@ make}).  What then happens if @code{<my-class>} is redefined by calling
 @end menu
 
 @node Default Class Redefinition Behaviour
-@subsection Default Class Redefinition Behaviour
+@subsubsection Default Class Redefinition Behaviour
 
 GOOPS' default answer to this question is as follows.
 
@@ -2055,7 +1957,7 @@ Also bear in mind that, like most of GOOPS' default behaviour, it can
 be customized@dots{}
 
 @node Customizing Class Redefinition
-@subsection Customizing Class Redefinition
+@subsubsection Customizing Class Redefinition
 
 When @code{define-class} notices that a class is being redefined,
 it constructs the new class metaobject as usual, and then invokes the
@@ -2092,7 +1994,8 @@ is specialized for this metaclass:
 @example
 (define-class <can-be-nameless> (<class>))
 
-(define-method (class-redefinition (old <can-be-nameless>) (new <class>))
+(define-method (class-redefinition (old <can-be-nameless>)
+                                   (new <class>))
   new)
 @end example
 
@@ -2119,7 +2022,7 @@ generic functions, and so on@dots{}  The detailed protocol for all of these
 is described in @ref{MOP Specification}.
 
 @node Changing the Class of an Instance
-@section Changing the Class of an Instance
+@subsection Changing the Class of an Instance
 
 You can change the class of an existing instance by invoking the
 generic function @code{change-class} with two arguments: the instance
@@ -2158,7 +2061,7 @@ invokes the @code{change-class} generic function for each existing
 instance of the redefined class.
 
 @node Introspection
-@section Introspection
+@subsection Introspection
 
 @dfn{Introspection}, also known as @dfn{reflection}, is the name given
 to the ability to obtain information dynamically about GOOPS metaobjects.
@@ -2197,7 +2100,7 @@ GOOPS equivalents --- to be obtained dynamically, at run time.
 @end menu
 
 @node Classes
-@subsection Classes
+@subsubsection Classes
 
 @deffn {primitive procedure} class-name class
 Return the name of class @var{class}.
@@ -2257,7 +2160,7 @@ Return a list of all methods that use @var{class} or a subclass of
 @end deffn
 
 @node Slots
-@subsection Slots
+@subsubsection Slots
 
 @deffn procedure class-slot-definition class slot-name
 Return the slot definition for the slot named @var{slot-name} in class
@@ -2338,7 +2241,7 @@ see @ref{Slot Options,, init-value}.
 @end deffn
 
 @node Instances
-@subsection Instances
+@subsubsection Instances
 
 @deffn {primitive procedure} class-of value
 Return the GOOPS class of any Scheme @var{value}.
@@ -2359,7 +2262,7 @@ Implementation notes: @code{is-a?} uses @code{class-of} and
 @var{object}.
 
 @node Generic Functions
-@subsection Generic Functions
+@subsubsection Generic Functions
 
 @deffn {primitive procedure} generic-function-name gf
 Return the name of generic function @var{gf}.
@@ -2371,7 +2274,7 @@ This is the value of the @var{gf} metaobject's @code{methods} slot.
 @end deffn
 
 @node Generic Function Methods
-@subsection Generic Function Methods
+@subsubsection Generic Function Methods
 
 @deffn {primitive procedure} method-generic-function method
 Return the generic function that @var{method} belongs to.
@@ -2409,18 +2312,18 @@ Return an expression that prints to show the definition of method
 @end deffn
 
 @node Miscellaneous Functions
-@section Miscellaneous Functions
+@subsection Miscellaneous Functions
 
 @menu
 * Administrative Functions::
-* Error Handling::
+* GOOPS Error Handling::
 * Object Comparisons::
 * Cloning Objects::
 * Write and Display::
 @end menu
 
 @node Administrative Functions
-@subsection Administration Functions
+@subsubsection Administration Functions
 
 This section describes administrative, non-technical GOOPS functions.
 
@@ -2428,8 +2331,8 @@ This section describes administrative, non-technical GOOPS functions.
 Return the current GOOPS version as a string, for example ``0.2''.
 @end deffn
 
-@node Error Handling
+@node GOOPS Error Handling
-@subsection Error Handling
+@subsubsection Error Handling
 
 The procedure @code{goops-error} is called to raise an appropriate error
 by the default methods of the following generic functions:
@@ -2464,7 +2367,7 @@ as done by @code{scm-error}.
 @end deffn
 
 @node Object Comparisons
-@subsection Object Comparisons
+@subsubsection Object Comparisons
 
 @deffn generic eqv?
 @deffnx method eqv? ((x <top>) (y <top>))
@@ -2493,7 +2396,7 @@ and the Guile reference manual.
 @end deffn
 
 @node Cloning Objects
-@subsection Cloning Objects
+@subsubsection Cloning Objects
 
 @deffn generic shallow-clone
 @deffnx method shallow-clone (self <object>)
@@ -2514,7 +2417,7 @@ or by reference.
 @end deffn
 
 @node Write and Display
-@subsection Write and Display
+@subsubsection Write and Display
 
 @deffn {primitive generic} write object port
 @deffnx {primitive generic} display object port
@@ -2542,8 +2445,8 @@ methods - instances of the class @code{<method>}.
 as the Guile primitive @code{write} and @code{display} functions.
 @end deffn
 
-@node MOP Specification, Tutorial, Reference Manual, Top
+@node MOP Specification
-@chapter MOP Specification
+@section MOP Specification
 
 For an introduction to metaobjects and the metaobject protocol,
 see @ref{Metaobjects and the Metaobject Protocol}.
@@ -2598,7 +2501,7 @@ what the caller expects to get as the applied method's return value.
 @end menu
 
 @node Class Definition
-@section Class Definition
+@subsection Class Definition
 
 @code{define-class} (syntax)
 
@@ -2731,7 +2634,7 @@ or @code{#:accessor} option.
 @end itemize
 
 @node Instance Creation
-@section Instance Creation
+@subsection Instance Creation
 
 @code{make <class> . @var{initargs}} (method)
 
@@ -2752,13 +2655,13 @@ return value is ignored.
 @end itemize
 
 @node Class Redefinition
-@section Class Redefinition
+@subsection Class Redefinition
 
 The default @code{class-redefinition} method, specialized for classes
 with the default metaclass @code{<class>}, has the following internal
 protocol.
 
-@code{class-redefinition @var{(old <class>)} @var{(new <class>)}}
+@code{class-redefinition (@var{old <class>}) (@var{new <class>})}
 (method)
 
 @itemize @bullet
@@ -2797,7 +2700,7 @@ to the modified instance, and initializes new slots, as described in
 generic function invocation that can be used to customize the instance
 update algorithm.
 
-@code{change-class @var{(old-instance <object>)} @var{(new <class>)}} (method)
+@code{change-class (@var{old-instance <object>}) (@var{new <class>})} (method)
 
 @itemize @bullet
 @item
@@ -2814,7 +2717,7 @@ nothing.
 @end itemize
 
 @node Method Definition
-@section Method Definition
+@subsection Method Definition
 
 @code{define-method} (syntax)
 
@@ -2842,7 +2745,7 @@ theoretically handle adding methods to further types of target.
 @end itemize
 
 @node Generic Function Invocation
-@section Generic Function Invocation
+@subsection Generic Function Invocation
 
 [ *fixme* Description required here. ]
 
@@ -2885,21 +2788,3 @@ theoretically handle adding methods to further types of target.
 @item
 @code{no-next-method}
 @end itemize
-
-@node Tutorial, Concept Index, MOP Specification, Top
-@chapter Tutorial
-@include goops-tutorial.texi
-
-@node     Concept Index, Function and Variable Index, Tutorial, Top
-@unnumberedsec Concept Index
-
-@printindex cp
-
-@node Function and Variable Index,  , Concept Index, Top
-@unnumberedsec Function and Variable Index
-
-@printindex fn
-
-@summarycontents
-@contents
-@bye

doc/ref/guile.texi

@@ -4,22 +4,21 @@
 @setfilename guile.info
 @settitle Guile Reference Manual
 @set guile
-@set MANUAL-EDITION 1.1
+@set MANUAL-REVISION 1
 @c %**end of header
 @include version.texi
 @include lib-version.texi
+@include effective-version.texi
 
 @copying
-This reference manual documents Guile, GNU's Ubiquitous Intelligent
+This manual documents Guile version @value{VERSION}.
-Language for Extensions.  This is edition @value{MANUAL-EDITION}
-corresponding to Guile @value{VERSION}.
 
-Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005 Free
+Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2009 Free
 Software Foundation.
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with the
+any later version published by the Free Software Foundation; with
 no Invariant Sections, with the Front-Cover Texts being ``A GNU
 Manual,'' and with the Back-Cover Text ``You are free to copy and
 modify this GNU Manual.''.  A copy of the license is included in the
@@ -137,7 +136,7 @@ x
 @sp 10
 @comment The title is printed in a large font.
 @title Guile Reference Manual
-@subtitle Edition @value{MANUAL-EDITION}, for use with Guile @value{VERSION}
+@subtitle Edition @value{EDITION}, revision @value{MANUAL-REVISION}, for use with Guile @value{VERSION}
 @c @subtitle $Id: guile.texi,v 1.49 2008-03-19 22:51:23 ossau Exp $
 
 @c See preface.texi for the list of authors
@@ -177,6 +176,8 @@ x
 
 * Guile Modules::
 
+* GOOPS::
+
 * Guile Implementation::
 
 * Autoconf Support::
@@ -365,6 +366,8 @@ available through both Scheme and C interfaces.
 @include scsh.texi
 @include scheme-debugging.texi
 
+@include goops.texi
+
 @node Guile Implementation
 @chapter Guile Implementation
 

doc/ref/intro.texi

@@ -80,6 +80,7 @@ To unbundle Guile use the instruction
 zcat guile-@value{VERSION}.tar.gz | tar xvf -
 @end example
 
+@noindent
 which will create a directory called @file{guile-@value{VERSION}} with
 all the sources.  You can look at the file @file{INSTALL} for detailed
 instructions on how to build and install Guile, but you should be able
@@ -93,7 +94,7 @@ make install
 @end example
 
 This will install the Guile executable @file{guile}, the Guile library
-@file{-lguile} and various associated header files and support
+@file{libguile} and various associated header files and support
 libraries. It will also install the Guile tutorial and reference
 manual.
 
@@ -101,14 +102,14 @@ manual.
 
 Since this manual frequently refers to the Scheme ``standard'', also
 known as R5RS, or the
-@iftex
+@tex
 ``Revised$^5$ Report on the Algorithmic Language Scheme'',
-@end iftex
+@end tex
 @ifnottex
 ``Revised^5 Report on the Algorithmic Language Scheme'',
 @end ifnottex
-we have included the report in the Guile distribution;
+we have included the report in the Guile distribution; see
-@xref{Top, , Introduction, r5rs, Revised(5) Report on the Algorithmic
+@ref{Top, , Introduction, r5rs, Revised(5) Report on the Algorithmic
 Language Scheme}.
 This will also be installed in your info directory.
 
@@ -471,11 +472,12 @@ You can get the version number by invoking the command
 @example
 $ guile --version
 Guile 1.9.0
-Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation
+Copyright (c) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004,
+2005, 2006, 2007, 2008, 2009 Free Software Foundation
 Guile may be distributed under the terms of the GNU Lesser General
 Public Licence.  For details, see the files `COPYING.LESSER' and
-`COPYING', which are included in the Guile distribution.  There is no
+`COPYING', which are included in the Guile distribution.  There is
-warranty, to the extent permitted by law.
+no warranty, to the extent permitted by law.
 @end example
 
 @item

doc/ref/libguile-extensions.texi

@@ -94,11 +94,11 @@ we are going to call the function @code{init_bessel} which will make
 @file{.so} when invoking @code{load-extension}.  The right extension for
 the host platform will be provided automatically.
 
-@smalllisp
+@lisp
 (load-extension "libguile-bessel" "init_bessel")
 (j0 2)
 @result{} 0.223890779141236
-@end smalllisp
+@end lisp
 
 For this to work, @code{load-extension} must be able to find
 @file{libguile-bessel}, of course.  It will look in the places that

doc/ref/libguile-linking.texi

@@ -173,7 +173,8 @@ creating ./config.status
 creating Makefile
 $ make
 gcc -c -I/usr/local/include simple-guile.c
-gcc simple-guile.o -L/usr/local/lib -lguile -lqthreads -lpthread -lm -o simple-guile
+gcc simple-guile.o -L/usr/local/lib -lguile -lqthreads -lpthread -lm
+  -o simple-guile
 $ ./simple-guile
 guile> (+ 1 2 3)
 6

doc/ref/libguile-smobs.texi

@@ -28,7 +28,7 @@ datatypes described here.)
 
 @menu
 * Describing a New Type::       
-* Creating Instances::          
+* Creating Smob Instances::          
 * Type checking::                
 * Garbage Collecting Smobs::    
 * Garbage Collecting Simple Smobs::  
@@ -132,8 +132,8 @@ init_image_type (void)
 @end example
 
 
-@node Creating Instances
+@node Creating Smob Instances
-@subsection Creating Instances
+@subsection Creating Smob Instances
 
 Normally, smobs can have one @emph{immediate} word of data.  This word
 stores either a pointer to an additional memory block that holds the
@@ -211,7 +211,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
 
   /* Step 1: Allocate the memory block.
    */
-  image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
+  image = (struct image *)
+     scm_gc_malloc (sizeof (struct image), "image");
 
   /* Step 2: Initialize it with straight code.
    */
@@ -228,7 +229,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
   /* Step 4: Finish the initialization.
    */
   image->name = name;
-  image->pixels = scm_gc_malloc (width * height, "image pixels");
+  image->pixels =
+     scm_gc_malloc (width * height, "image pixels");
 
   return smob;
 @}
@@ -404,7 +406,9 @@ free_image (SCM image_smob)
 @{
   struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
 
-  scm_gc_free (image->pixels, image->width * image->height, "image pixels");
+  scm_gc_free (image->pixels,
+               image->width * image->height,
+               "image pixels");
   scm_gc_free (image, sizeof (struct image), "image");
 
   return 0;
@@ -583,7 +587,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
 
   /* Step 1: Allocate the memory block.
    */
-  image = (struct image *) scm_gc_malloc (sizeof (struct image), "image");
+  image = (struct image *)
+     scm_gc_malloc (sizeof (struct image), "image");
 
   /* Step 2: Initialize it with straight code.
    */
@@ -600,7 +605,8 @@ make_image (SCM name, SCM s_width, SCM s_height)
   /* Step 4: Finish the initialization.
    */
   image->name = name;
-  image->pixels = scm_gc_malloc (width * height, "image pixels");
+  image->pixels =
+     scm_gc_malloc (width * height, "image pixels");
 
   return smob;
 @}
@@ -642,7 +648,9 @@ free_image (SCM image_smob)
 @{
   struct image *image = (struct image *) SCM_SMOB_DATA (image_smob);
 
-  scm_gc_free (image->pixels, image->width * image->height, "image pixels");
+  scm_gc_free (image->pixels,
+               image->width * image->height,
+               "image pixels");
   scm_gc_free (image, sizeof (struct image), "image");
 
   return 0;

doc/ref/posix.texi

@@ -2072,9 +2072,9 @@ The following procedures are similar to the @code{popen} and
 @code{pclose} system routines.  The code is in a separate ``popen''
 module:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 popen))
-@end smalllisp
+@end lisp
 
 @findex popen
 @deffn {Scheme Procedure} open-pipe command mode

doc/ref/preface.texi

@@ -7,12 +7,9 @@
 @node Preface
 @chapter Preface
 
-This reference manual documents Guile, GNU's Ubiquitous Intelligent
+This manual documents version @value{VERSION} of Guile, GNU's
-Language for Extensions.  It describes how to use Guile in many useful
+Ubiquitous Intelligent Language for Extensions.  It describes how to
-and interesting ways.
+use Guile in many useful and interesting ways.
-
-This is edition @value{MANUAL-EDITION} of the reference manual, and
-corresponds to Guile version @value{VERSION}.
 
 @menu
 * Manual Layout::               
@@ -25,7 +22,7 @@ corresponds to Guile version @value{VERSION}.
 @node Manual Layout
 @section Layout of this Manual
 
-The manual is divided into five chapters.
+The manual is divided into the following chapters.
 
 @table @strong
 @item Chapter 1: Introduction to Guile
@@ -38,7 +35,7 @@ the later parts of the manual.  This part also explains how to obtain
 and install new versions of Guile, and how to report bugs effectively.
 
 @item Chapter 2: Programming in Scheme
-This part provides an overview over programming in Scheme with Guile.
+This part provides an overview of programming in Scheme with Guile.
 It covers how to invoke the @code{guile} program from the command-line
 and how to write scripts in Scheme.  It also gives an introduction
 into the basic ideas of Scheme itself and to the various extensions
@@ -61,6 +58,10 @@ Describes some important modules, distributed as part of the Guile
 distribution, that extend the functionality provided by the Guile
 Scheme core.
 
+@item Chapter 6: GOOPS
+Describes GOOPS, an object oriented extension to Guile that provides
+classes, multiple inheritance and generic functions.
+
 @end table
 
 
@@ -72,7 +73,7 @@ We use some conventions in this manual.
 @itemize @bullet
 
 @item
-For some procedures, notably type predicates, we use @dfn{iff} to mean
+For some procedures, notably type predicates, we use ``iff'' to mean
 ``if and only if''.  The construct is usually something like: `Return
 @var{val} iff @var{condition}', where @var{val} is usually
 ``@nicode{#t}'' or ``non-@nicode{#f}''.  This typically means that
@@ -144,6 +145,9 @@ filling out a lot of the documentation of Scheme data types, control
 mechanisms and procedures.  In addition, he wrote the documentation
 for Guile's SRFI modules and modules associated with the Guile REPL.
 
+The chapter on GOOPS was written by Christian Lynbech, Mikael
+Djurfeldt and Neil Jerram.
+
 @node Guile License
 @section The Guile License
 @cindex copying
@@ -179,7 +183,7 @@ C code linking to the Guile readline module is subject to the terms of
 that module.  Basically such code must be published on Free terms.
 
 Scheme level code written to be run by Guile (but not derived from
-Guile itself) is not resticted in any way, and may be published on any
+Guile itself) is not restricted in any way, and may be published on any
 terms.  We encourage authors to publish on Free terms.
 
 You must be aware there is no warranty whatsoever for Guile.  This is

doc/ref/scheme-debugging.texi

@@ -14,9 +14,9 @@ call to that procedure is reported to the user during a program run.
 The idea is that you can mark a collection of procedures for tracing,
 and Guile will subsequently print out a line of the form
 
-@smalllisp
+@lisp
 |  |  [@var{procedure} @var{args} @dots{}]
-@end smalllisp
+@end lisp
 
 whenever a marked procedure is about to be applied to its arguments.
 This can help a programmer determine whether a function is being called
@@ -27,7 +27,7 @@ how the traced applications are or are not tail recursive with respect
 to each other.  Thus, a trace of a non-tail recursive factorial
 implementation looks like this:
 
-@smalllisp
+@lisp
 [fact1 4]
 |  [fact1 3]
 |  |  [fact1 2]
@@ -38,11 +38,11 @@ implementation looks like this:
 |  |  2
 |  6
 24
-@end smalllisp
+@end lisp
 
 While a typical tail recursive implementation would look more like this:
 
-@smalllisp
+@lisp
 [fact2 4]
 [facti 1 4]
 [facti 4 3]
@@ -50,7 +50,7 @@ While a typical tail recursive implementation would look more like this:
 [facti 24 1]
 [facti 24 0]
 24
-@end smalllisp
+@end lisp
 
 @deffn {Scheme Procedure} trace procedure
 Enable tracing for @code{procedure}.  While a program is being run,

doc/ref/scheme-ideas.texi

@@ -390,7 +390,11 @@ this:
 
 @noindent
 This is a valid procedure invocation expression, and its result is the
-string @code{"Name=FSF:Address=Cambridge"}.
+string:
+
+@lisp
+"Name=FSF:Address=Cambridge"
+@end lisp
 
 It is more common, though, to store the procedure value in a variable ---
 

doc/ref/scsh.texi

@@ -19,8 +19,8 @@ For information about scsh see
 
 The closest emulation of scsh can be obtained by running:
 
-@smalllisp
+@lisp
 (load-from-path "scsh/init")
-@end smalllisp
+@end lisp
 
 See the USAGE file supplied with guile-scsh for more details.

doc/ref/slib.texi

@@ -4,7 +4,6 @@
 @c   Free Software Foundation, Inc.
 @c See the file guile.texi for copying conditions.
 
-@page
 @node SLIB
 @section SLIB
 @cindex SLIB
@@ -12,9 +11,9 @@
 Before the SLIB facilities can be used, the following Scheme expression
 must be executed:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 slib))
-@end smalllisp
+@end lisp
 
 @findex require
 @code{require} can then be used in the usual way (@pxref{Require,,,
@@ -64,7 +63,7 @@ Alternatively, you can create a symlink in the Guile directory to SLIB,
 e.g.:
 
 @example
-ln -s /usr/local/lib/slib /usr/local/share/guile/1.8/slib
+ln -s /usr/local/lib/slib /usr/local/share/guile/@value{EFFECTIVE-VERSION}/slib
 @end example
 
 @item
@@ -78,7 +77,7 @@ guile> (quit)
 @end example
 
 The catalog data should now be in
-@file{/usr/local/share/guile/1.8/slibcat}.
+@file{/usr/local/share/guile/@value{EFFECTIVE-VERSION}/slibcat}.
 
 If instead you get an error such as:
 
@@ -104,11 +103,11 @@ It is usually installed as an extra package in SLIB.
 
 You can use Guile's interface to SLIB to invoke Jacal:
 
-@smalllisp
+@lisp
 (use-modules (ice-9 slib))
 (slib:load "math")
 (math)
-@end smalllisp
+@end lisp
 
 @noindent
 For complete documentation on Jacal, please read the Jacal manual.  If

doc/ref/tools.texi

@@ -232,8 +232,8 @@ is a expression suitable for initializing a new variable.
 For procedures, you can use @code{SCM_DEFINE} for most purposes.  Use
 @code{SCM_PROC} along with @code{SCM_REGISTER_PROC} when you don't
 want to be bothered with docstrings.  Use @code{SCM_GPROC} for generic
-functions (@pxref{Creating Generic Functions,,, goops, GOOPS}).  All
+functions (@pxref{Creating Generic Functions}).  All procedures are
-procedures are declared with return type @code{SCM}.
+declared with return type @code{SCM}.
 
 For everything else, use the appropriate macro (@code{SCM_SYMBOL} for
 symbols, and so on).  Without "_GLOBAL_", the declarations are
@@ -364,7 +364,7 @@ of the form:
 
 @example
 (define-module (scripts PROGRAM)
-  :export (PROGRAM))
+  #:export (PROGRAM))
 @end example
 
 Feel free to export other definitions useful in the module context.

doc/ref/vm.texi

@@ -159,17 +159,19 @@ The structure of the fixed part of an application frame is as follows:
 
 @example
              Stack
-   |                  | <- fp + bp->nargs + bp->nlocs + 3
+   | ...              |
-   +------------------+    = SCM_FRAME_UPPER_ADDRESS (fp)
+   | Intermed. val. 0 | <- fp + bp->nargs + bp->nlocs = SCM_FRAME_UPPER_ADDRESS (fp)
-   | Return address   |
+   +==================+
-   | MV return address|
+   | Local variable 1 |
-   | Dynamic link     | <- fp + bp->nargs + bp->nlocs
-   | Local variable 1 |    = SCM_FRAME_DATA_ADDRESS (fp)
    | Local variable 0 | <- fp + bp->nargs
    | Argument 1       |
    | Argument 0       | <- fp
    | Program          | <- fp - 1
-   +------------------+    = SCM_FRAME_LOWER_ADDRESS (fp)
+   +------------------+    
+   | Return address   |
+   | MV return address|
+   | Dynamic link     | <- fp - 4 = SCM_FRAME_DATA_ADDRESS (fp) = SCM_FRAME_LOWER_ADDRESS (fp)
+   +==================+
    |                  |
 @end example
 
@@ -649,32 +651,30 @@ closures.
 @node Procedural Instructions
 @subsubsection Procedural Instructions
 
-@deffn Instruction return
+@deffn Instructions new-frame
-Free the program's frame, returning the top value from the stack to
+Push a new frame on the stack, reserving space for the dynamic link,
-the current continuation. (The stack should have exactly one value on
+return address, and the multiple-values return address. The frame
-it.)
+pointer is not yet updated, because the frame is not yet active -- it
-
+has to be patched by a @code{call} instruction to get the return
-Specifically, the @code{sp} is decremented to one below the current
+address.
-@code{fp}, the @code{ip} is reset to the current return address, the
-@code{fp} is reset to the value of the current dynamic link, and then
-the top item on the stack (formerly the procedure being applied) is
-set to the returned value.
 @end deffn
 
 @deffn Instruction call nargs
 Call the procedure located at @code{sp[-nargs]} with the @var{nargs}
 arguments located from @code{sp[-nargs + 1]} to @code{sp[0]}.
 
-For compiled procedures, this instruction sets up a new stack frame,
+This instruction requires that a new frame be pushed on the stack
-as described in @ref{Stack Layout}, and then dispatches to the first
+before the procedure, via @code{new-frame}. @xref{Stack Layout}, for
-instruction in the called procedure, relying on the called procedure
+more information. It patches up that frame with the current @code{ip}
-to return one value to the newly-created continuation. Because the new
+as the return address, then dispatches to the first instruction in the
-frame pointer will point to sp[-nargs + 1], the arguments don't have
+called procedure, relying on the called procedure to return one value
-to be shuffled around -- they are already in place.
+to the newly-created continuation. Because the new frame pointer will
+point to sp[-nargs + 1], the arguments don't have to be shuffled
+around -- they are already in place.
 
 For non-compiled procedures (continuations, primitives, and
-interpreted procedures), @code{call} will pop the procedure and
+interpreted procedures), @code{call} will pop the frame, procedure,
-arguments off the stack, and push the result of calling
+and arguments off the stack, and push the result of calling
 @code{scm_apply}.
 @end deffn
 
@@ -682,10 +682,10 @@ arguments off the stack, and push the result of calling
 Like @code{call}, but reusing the current continuation. This
 instruction implements tail calls as required by RnRS.
 
-For compiled procedures, that means that @code{goto/args} reuses the
+For compiled procedures, that means that @code{goto/args} simply
-current frame instead of building a new one. The @code{goto/*}
+shuffles down the procedure and arguments to the current stack frame.
-instruction family is named as it is because tail calls are equivalent
+The @code{goto/*} instruction family is named as it is because tail
-to @code{goto}, along with relabeled variables.
+calls are equivalent to @code{goto}, along with relabeled variables.
 
 For non-VM procedures, the result is the same, but the current VM
 invocation remains on the C stack. True tail calls are not currently
@@ -708,15 +708,6 @@ These instructions are used in the implementation of multiple value
 returns, where the actual number of values is pushed on the stack.
 @end deffn
 
-@deffn Instruction call/cc
-@deffnx Instruction goto/cc
-Capture the current continuation, and then call (or tail-call) the
-procedure on the top of the stack, with the continuation as the
-argument.
-
-Both the VM continuation and the C continuation are captured.
-@end deffn
-
 @deffn Instruction mv-call nargs offset
 Like @code{call}, except that a multiple-value continuation is created
 in addition to a single-value continuation.
@@ -729,6 +720,18 @@ the stack to be the number of values, and below that values
 themselves, pushed separately.
 @end deffn
 
+@deffn Instruction return
+Free the program's frame, returning the top value from the stack to
+the current continuation. (The stack should have exactly one value on
+it.)
+
+Specifically, the @code{sp} is decremented to one below the current
+@code{fp}, the @code{ip} is reset to the current return address, the
+@code{fp} is reset to the value of the current dynamic link, and then
+the top item on the stack (formerly the procedure being applied) is
+set to the returned value.
+@end deffn
+
 @deffn Instruction return/values nvalues
 Return the top @var{nvalues} to the current continuation.
 
@@ -763,6 +766,19 @@ be 1 (to indicate that one of the bindings was a rest argument).
 Signals an error if there is an insufficient number of values.
 @end deffn
 
+@deffn Instruction call/cc
+@deffnx Instruction goto/cc
+Capture the current continuation, and then call (or tail-call) the
+procedure on the top of the stack, with the continuation as the
+argument.
+
+@code{call/cc} does not require a @code{new-frame} to be pushed on the
+stack, as @code{call} does, because it needs to capture the stack
+before the frame is pushed.
+
+Both the VM continuation and the C continuation are captured.
+@end deffn
+
 @node Data Control Instructions
 @subsubsection Data Control Instructions
 
@@ -838,32 +854,6 @@ popping off those values and pushing on the resulting vector. @var{n}
 is a two-byte value, like in @code{vector}.
 @end deffn
 
-@deffn Instruction mark
-Pushes a special value onto the stack that other stack instructions
-like @code{list-mark} can use.
-@end deffn
-
-@deffn Instruction list-mark
-Create a list from values from the stack, as in @code{list}, but
-instead of knowing beforehand how many there will be, keep going until
-we see a @code{mark} value.
-@end deffn
-
-@deffn Instruction cons-mark
-As the scheme procedure @code{cons*} is to the scheme procedure
-@code{list}, so the instruction @code{cons-mark} is to the instruction
-@code{list-mark}.
-@end deffn
-
-@deffn Instruction vector-mark
-Like @code{list-mark}, but makes a vector instead of a list.
-@end deffn
-
-@deffn Instruction list-break
-The opposite of @code{list}: pops a value, which should be a list, and
-pushes its elements on the stack.
-@end deffn
-
 @node Miscellaneous Instructions
 @subsubsection Miscellaneous Instructions
 

emacs/gds-faq.txt

@@ -0,0 +1,225 @@
+
+* Installation
+
+** How do I install guile-debugging?
+
+After unpacking the .tar.gz file, run the usual sequence of commands:
+
+$ ./configure
+$ make
+$ sudo make install
+
+Then you need to make sure that the directory where guile-debugging's
+Scheme files were installed is included in your Guile's load path.
+(The sequence above will usually install guile-debugging under
+/usr/local, and /usr/local is not in Guile's load path by default,
+unless Guile itself was installed under /usr/local.)  You can discover
+your Guile's default load path by typing
+
+$ guile -q -c '(begin (write %load-path) (newline))'
+
+There are two ways to add guile-debugging's installation directory to
+Guile's load path, if it isn't already there.
+
+1. Edit or create the `init.scm' file, which Guile reads on startup,
+   so that it includes a line like this:
+
+   (set! %load-path (cons "/usr/local/share/guile" %load-path))
+
+   but with "/usr/local" replaced by the prefix that you installed
+   guile-debugging under, if not /usr/local.
+
+   The init.scm file must be installed (if it does not already exist
+   there) in one of the directories in Guile's default load-path.
+
+2. Add this line to your .emacs file:
+
+   (setq gds-scheme-directory "/usr/local/share/guile")
+
+   before the `require' or `load' line that loads GDS, but with
+   "/usr/local" replaced by the prefix that you installed
+   guile-debugging under, if not /usr/local.
+
+Finally, if you want guile-debugging's GDS interface to be loaded
+automatically whenever you run Emacs, add this line to your .emacs:
+
+(require 'gds)
+
+* Troubleshooting
+
+** "error in process filter" when starting Emacs (or loading GDS)
+
+This is caused by an internal error in GDS's Scheme code, for which a
+backtrace will have appeared in the gds-debug buffer, so please switch
+to the gds-debug buffer and see what it says there.
+
+The most common cause is a load path problem: Guile cannot find GDS's
+Scheme code because it is not in the known load path.  In this case
+you should see the error message "no code for module" somewhere in the
+backtrace.  If you see this, please try the remedies described in `How
+do I install guile-debugging?' above, then restart Emacs and see if
+the problem has been cured.
+
+If you don't see "no code for module", or if the described remedies
+don't fix the problem, please send the contents of the gds-debug
+buffer to me at <neil@ossau.uklinux.net>, so I can debug the problem.
+
+If you don't see a backtrace at all in the gds-debug buffer, try the
+next item ...
+
+** "error in process filter" at some other time
+
+This is caused by an internal error somewhere in GDS's Emacs Lisp
+code.  If possible, please
+
+- switch on the `debug-on-error' option (M-x set-variable RET
+  debug-on-error RET t RET)
+
+- do whatever you were doing so that the same error happens again
+
+- send the Emacs Lisp stack trace which pops up to me at
+  <neil@ossau.uklinux.net>.
+
+If that doesn't work, please just mail me with as much detail as
+possible of what you were doing when the error occurred.
+
+* GDS Features
+
+** How do I inspect variable values?
+
+Type `e' followed by the name of the variable, then <RET>.  This
+works whenever GDS is displaying a stack for an error at at a
+breakpoint.  (You can actually `e' to evaluate any expression in the
+local environment of the selected stack frame; inspecting variables is
+the special case of this where the expression is only a variable name.)
+
+If GDS is displaying the associated source code in the window above or
+below the stack, you can see the values of any variables in the
+highlighted code just by hovering your mouse over them.
+
+** How do I change a variable's value?
+
+Type `e' and then `(set! VARNAME NEWVAL)', where VARNAME is the name
+of the variable you want to set and NEWVAL is an expression which
+Guile can evaluate to get the new value.  This works whenever GDS is
+displaying a stack for an error at at a breakpoint.  The setting will
+take effect in the local environment of the selected stack frame.
+
+** How do I change the expression that Guile is about to evaluate?
+
+Type `t' followed by the expression that you want Guile to evaluate
+instead, then <RET>.
+
+Then type one of the commands that tells Guile to continue execution.
+
+(Tweaking expressions, as described here, is only supported by the
+latest CVS version of Guile.  The GDS stack display tells you when
+tweaking is possible by adding "(tweakable)" to the first line of the
+stack window.)
+
+** How do I return a value from the current stack frame different to what the evaluator has calculated?
+
+You have to be at the normal exit of the relevant frame first, so if
+GDS is not already showing you the normally calculated return value,
+type `o' to finish the evaluation of the selected frame.
+
+Then type `t' followed by the value you want to return, and <RET>.
+The value that you type can be any expression, but note that it will
+not be evaluated before being returned; for example if you type `(+ 2
+3)', the return value will be a three-element list, not 5.
+
+Finally type one of the commands that tells Guile to continue
+execution.
+
+(Tweaking return values, as described here, is only supported by the
+latest CVS version of Guile.  The GDS stack display tells you when
+tweaking is possible by adding "(tweakable)" to the first line of the
+stack window.)
+
+** How do I step over a line of code?
+
+Scheme isn't organized by lines, so it doesn't really make sense to
+think of stepping over lines.  Instead please see the next entry on
+stepping over expressions.
+
+** How do I step over an expression?
+
+It depends what you mean by "step over".  If you mean that you want
+Guile to evaluate that expression normally, but then show you its
+return value, type `o', which does exactly that.
+
+If you mean that you want to skip the evaluation of that expression
+(for example because it has side effects that you don't want to
+happen), use `t' to change the expression to something else which
+Guile will evaluate instead.
+
+There has to be a substitute expression so Guile can calculate a value
+to return to the calling frame.  If you know at a particular point
+that the return value is not important, you can type `t #f <RET>' or
+`t 0 <RET>'.
+
+See `How do I change the expression that Guile is about to evaluate?'
+above for more on using `t'.
+
+** How do I move up and down the call stack?
+
+Type `u' to move up and `d' to move down.  "Up" in GDS means to a more
+"inner" frame, and "down" means to a more "outer" frame.
+
+** How do I run until the next breakpoint?
+
+Type `g' (for "go").
+
+** How do I run until the end of the selected stack frame?
+
+Type `o'.
+
+** How do I set a breakpoint?
+
+First identify the code that you want to set the breakpoint in, and
+what kind of breakpoint you want.  To set a breakpoint on entry to a
+top level procedure, move the cursor to anywhere in the procedure
+definition, and make sure that the region/mark is inactive.  To set a
+breakpoint on a particular expression (or sequence of expressions) set
+point and mark so that the region covers the opening parentheses of
+all the target expressions.
+
+Then type ...
+
+  `C-c C-b d' for a `debug' breakpoint, which means that GDS will
+  display the stack when the breakpoint is hit
+
+  `C-c C-b t' for a `trace' breakpoint, which means that the start and
+  end of the relevant procedure or expression(s) will be traced to the
+  *GDS Trace* buffer
+
+  `C-c C-b T' for a `trace-subtree' breakpoint, which means that every
+  evaluation step involved in the evaluation of the relevant procedure
+  or expression(s) will be traced to the *GDS Trace* buffer.
+
+You can also type `C-x <SPC>', which does the same as one of the
+above, depending on the value of `gds-default-breakpoint-type'.
+
+** How do I clear a breakpoint?
+
+Select a region containing the breakpoints that you want to clear, and
+type `C-c C-b <DEL>'.
+
+** How do I trace calls to a particular procedure or evaluations of a particular expression?
+
+In GDS this means setting a breakpoint whose type is `trace' or
+`trace-subtree'.  See `How do I set a breakpoint?' above.
+
+* Development
+
+** How can I follow or contribute to guile-debugging's development?
+
+guile-debugging is hosted at http://gna.org, so please see the project
+page there.  Feel free to raise bugs, tasks containing patches or
+feature requests, and so on.  You can also write directly to me by
+email: <neil@ossau.uklinux.net>.
+
+
+Local Variables:
+mode: outline
+End:

emacs/gds-scheme.el

@@ -206,23 +206,28 @@ Emacs to display an error or trap so that the user can debug it."
                               "-q"
                               "--debug"
                               "-c"
-                              code))
+                              code)))
-         (client nil))
     ;; Note that this process can be killed automatically on Emacs
     ;; exit.
     (process-kill-without-query proc)
     ;; Set up a process filter to catch the new client's number.
     (set-process-filter proc
                         (lambda (proc string)
-                          (setq client (string-to-number string))
                           (if (process-buffer proc)
                               (with-current-buffer (process-buffer proc)
-                                (insert string)))))
+                                (insert string)
+				(or gds-client
+				    (save-excursion
+				      (goto-char (point-min))
+				      (setq gds-client
+					    (condition-case nil
+						(read (current-buffer))
+					      (error nil)))))))))
     ;; Accept output from the new process until we have its number.
-    (while (not client)
+    (while (not (with-current-buffer (process-buffer proc) gds-client))
       (accept-process-output proc))
     ;; Return the new process's client number.
-    client))
+    (with-current-buffer (process-buffer proc) gds-client)))
 
 ;;;; Evaluating code.
 

emacs/gds-server.el

@@ -43,25 +43,24 @@
   :group 'gds
   :type '(choice (const :tag "nil" nil) directory))
 
-(defun gds-start-server (procname port-or-path protocol-handler &optional bufname)
+(defun gds-start-server (procname unix-socket-name tcp-port protocol-handler)
-  "Start a GDS server process called PROCNAME, listening on TCP port
+  "Start a GDS server process called PROCNAME, listening on Unix
-or Unix domain socket PORT-OR-PATH.  PROTOCOL-HANDLER should be a
+domain socket UNIX-SOCKET-NAME and TCP port number TCP-PORT.
-function that accepts and processes one protocol form.  Optional arg
+PROTOCOL-HANDLER should be a function that accepts and processes
-BUFNAME specifies the name of the buffer that is used for process
+one protocol form."
-output; if not specified the buffer name is the same as the process
+  (with-current-buffer (get-buffer-create procname)
-name."
-  (with-current-buffer (get-buffer-create (or bufname procname))
     (erase-buffer)
     (let* ((code (format "(begin
                             %s
                             (use-modules (ice-9 gds-server))
-                            (run-server %S))"
+                            (run-server %S %S))"
 			 (if gds-scheme-directory
 			     (concat "(set! %load-path (cons "
 				     (format "%S" gds-scheme-directory)
 				     " %load-path))")
 			   "")
-                         port-or-path))
+                         unix-socket-name
+			 tcp-port))
            (process-connection-type nil) ; use a pipe
            (proc (start-process procname
                                 (current-buffer)

emacs/gds-test.el

@@ -0,0 +1,166 @@
+
+;; Test utility code.
+(defun gds-test-execute-keys (keys &optional keys2)
+  (execute-kbd-macro (apply 'vector (listify-key-sequence keys))))
+
+(defvar gds-test-expecting nil)
+
+(defun gds-test-protocol-hook (form)
+  (message "[protocol: %s]" (car form))
+  (if (eq (car form) gds-test-expecting)
+      (setq gds-test-expecting nil)))
+
+(defun gds-test-expect-protocol (proc &optional timeout)
+  (message "[expect: %s]" proc)
+  (setq gds-test-expecting proc)
+  (while gds-test-expecting
+    (or (accept-process-output gds-debug-server (or timeout 5))
+	(error "Timed out after %ds waiting for %s" (or timeout 5) proc))))
+
+(defun gds-test-check-buffer (name &rest strings)
+  (let ((buf (or (get-buffer name) (error "No %s buffer" name))))
+    (save-excursion
+      (set-buffer buf)
+      (goto-char (point-min))
+      (while strings
+	(search-forward (car strings))
+	(setq strings (cdr strings))))))
+
+(defun TEST (desc)
+  (message "TEST: %s" desc))
+
+;; Make sure we take GDS elisp code from this code tree.
+(setq load-path (cons (concat default-directory "emacs/") load-path))
+
+;; Protect the tests so we can do some cleanups in case of error.
+(unwind-protect
+    (progn
+
+      ;; Visit the tutorial.
+      (find-file "gds-tutorial.txt")
+
+      (TEST "Load up GDS.")
+      (search-forward "(require 'gds)")
+      (setq load-path (cons (concat default-directory "emacs/") load-path))
+      (gds-test-execute-keys "\C-x\C-e")
+
+      ;; Install our testing hook.
+      (add-hook 'gds-protocol-hook 'gds-test-protocol-hook)
+
+      (TEST "Help.")
+      (search-forward "(list-ref")
+      (backward-char 2)
+      (gds-test-execute-keys "\C-hg\C-m")
+      (gds-test-expect-protocol 'eval-results 10)
+      (gds-test-check-buffer "*Guile Help*"
+			     "help list-ref"
+			     "is a primitive procedure in the (guile) module")
+
+      (TEST "Completion.")
+      (re-search-forward "^with-output-to-s")
+      (gds-test-execute-keys "\e\C-i")
+      (beginning-of-line)
+      (or (looking-at "with-output-to-string")
+	  (error "Expected completion `with-output-to-string' failed"))
+
+      (TEST "Eval defun.")
+      (search-forward "(display z)")
+      (gds-test-execute-keys "\e\C-x")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(let ((x 1) (y 2))"
+			     "Arctangent is: 0.46"
+			     "=> 0.46")
+
+      (TEST "Multiple values.")
+      (search-forward "(values 'a ")
+      (gds-test-execute-keys "\e\C-x")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(values 'a"
+			     "hello world"
+			     "=> a"
+			     "=> b"
+			     "=> c")
+
+      (TEST "Eval region with multiple expressions.")
+      (search-forward "(display \"Arctangent is: \")")
+      (beginning-of-line)
+      (push-mark nil nil t)
+      (forward-line 3)
+      (gds-test-execute-keys "\C-c\C-r")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(display \"Arctangent is"
+			     "Arctangent is:"
+			     "=> no (or unspecified) value"
+			     "ERROR: Unbound variable: z"
+			     "=> error-in-evaluation"
+			     "Evaluating expression 3"
+			     "=> no (or unspecified) value")
+
+      (TEST "Eval syntactically unbalanced region.")
+      (search-forward "(let ((z (atan x y)))")
+      (beginning-of-line)
+      (push-mark nil nil t)
+      (forward-line 4)
+      (gds-test-execute-keys "\C-c\C-r")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(let ((z (atan"
+			     "Reading expressions to evaluate"
+			     "ERROR"
+			     "end of file"
+			     "=> error-in-read")
+
+      (TEST "Stepping through an evaluation.")
+      (search-forward "(for-each (lambda (x)")
+      (forward-line 1)
+      (push-mark nil nil t)
+      (forward-line 1)
+      (gds-test-execute-keys "\C-u\e\C-x")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys " ")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "o")
+      (gds-test-expect-protocol 'stack)
+      (gds-test-execute-keys "g")
+      (gds-test-expect-protocol 'eval-results)
+      (gds-test-check-buffer "*Guile Evaluation*"
+			     "(for-each (lambda"
+			     "Evaluating in current module"
+			     "3 cubed is 27"
+			     "=> no (or unspecified) value")
+
+      ;; Done.
+      (message "====================================")
+      (message "gds-test.el completed without errors")
+      (message "====================================")
+      
+      )
+
+  (switch-to-buffer "gds-debug")
+  (write-region (point-min) (point-max) "gds-test.debug")
+
+  (switch-to-buffer "*GDS Transcript*")
+  (write-region (point-min) (point-max) "gds-test.transcript")
+
+  )

emacs/gds-test.sh

@@ -0,0 +1,2 @@
+#!/bin/sh
+GUILE_LOAD_PATH=$(pwd) emacs --batch --no-site-file -q -l gds-test.el < gds-test.stdin

emacs/gds-test.stdin

@@ -0,0 +1 @@
+

emacs/gds-tutorial.txt

@@ -0,0 +1,223 @@
+
+;; Welcome to the GDS tutorial!
+
+;; This tutorial teaches the use of GDS by leading you through a set
+;; of examples where you actually use GDS, in Emacs, along the way.
+;; To get maximum benefit, therefore, you should be reading this
+;; tutorial in Emacs.
+
+;; ** GDS setup
+
+;; The first thing to do, if you haven't already, is to load the GDS
+;; library into Emacs.  The Emacs Lisp expression for this is:
+
+(require 'gds)
+
+;; So, if you don't already have this in your .emacs, either add it
+;; and then restart Emacs, or evaluate it just for this Emacs session
+;; by moving the cursor to just after the closing parenthesis and
+;; typing `C-x C-e'.
+
+;; (Note that if you _have_ already loaded GDS, and you type `C-x C-e'
+;; after this expression, you will see a *Guile Evaluation* window
+;; telling you that the evaluation failed because `require' is
+;; unbound.  Don't worry; this is not a problem, and the rest of the
+;; tutorial should still work just fine.)
+
+;; ** Help
+
+;; GDS makes it easy to access the Guile help system when working on a
+;; Scheme program in Emacs.  For example, suppose that you are writing
+;; code that uses list-ref, and need to remind yourself about
+;; list-ref's arguments ...
+
+(define (penultimate l)
+  (list-ref
+
+;; Just place the cursor on the word "list-ref" and type `C-h g RET'.
+;; Try it now!
+
+;; If GDS is working correctly, a window should have popped up above
+;; or below showing the Guile help for list-ref.
+
+;; You can also do an "apropos" search through Guile's help.  If you
+;; couldn't remember the name list-ref, for example, you could search
+;; for anything matching "list" by typing `C-h C-g' and entering
+;; "list" at the minibuffer prompt.  Try doing this now: you should
+;; see a longish list of Guile definitions whose names include "list".
+;; As usual in Emacs, you can use `M-PageUp' and `M-PageDown' to
+;; conveniently scroll the other window without having to select it.
+
+;; The functions called by `C-h g' and `C-h C-g' are gds-help-symbol
+;; and gds-apropos.  They both look up the symbol or word at point by
+;; default, but that default can be overidden by typing something else
+;; at the minibuffer prompt.
+
+;; ** Completion
+
+;; As you are typing Scheme code, you can ask GDS to complete the
+;; symbol before point for you, by typing `ESC TAB'.  GDS selects
+;; possible completions by matching the text so far against all
+;; definitions in the Guile environment.  (This may be contrasted with
+;; the "dabbrev" completion performed by `M-/', which selects possible
+;; completions from the contents of Emacs buffers.  So, if you are
+;; trying to complete "with-ou", to get "with-output-to-string", for
+;; example, `ESC TAB' will always work, because with-output-to-string
+;; is always defined in Guile's default environment, whereas `M-/'
+;; will only work if one of Emacs's buffers happens to contain the
+;; full name "with-output-to-string".)
+
+;; To illustrate the idea, here are some partial names that you can
+;; try completing.  For each one, move the cursor to the end of the
+;; line and type `ESC TAB' to try to complete it.
+
+list-
+with-ou
+with-output-to-s
+mkst
+
+;; (If you are not familiar with any of the completed definitions,
+;; feel free to use `C-h g' to find out about them!)
+
+;; ** Evaluation
+
+;; GDS provides several ways for you to evaluate Scheme code from
+;; within Emacs.
+
+;; Just like in Emacs Lisp, a single expression in a buffer can be
+;; evaluated using `C-x C-e' or `C-M-x'.  For `C-x C-e', the
+;; expression is that which ends immediately before point (so that it
+;; is useful for evaluating something just after you have typed it).
+;; For `C-M-x', the expression is the "top level defun" around point;
+;; this means the balanced chunk of code around point whose opening
+;; parenthesis is in column 0.
+
+;; Take this code fragment as an example:
+
+(let ((x 1) (y 2))
+  (let ((z (atan x y)))
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+    z))
+
+;; If you move the cursor to the end of the (display z) line and type
+;; `C-x C-e', the code evaluated is just "(display z)", which normally
+;; produces an error, because z is not defined in the usual Guile
+;; environment.  If, however, you type `C-M-x' with the cursor in the
+;; same place, the code evaluated is the whole "(let ((x 1) (y 2))
+;; ...)" kaboodle, because that is the most recent expression before
+;; point that starts in column 0.
+
+;; Try these now.  The Guile Evaluation window should pop up again,
+;; and show you:
+;; - the expression that was evaluated (probably abbreviated)
+;; - the module that it was evaluated in
+;; - anything that the code wrote to its standard output
+;; - the return value(s) of the evaluation.
+;; Following the convention of the Emacs Lisp and Guile manuals,
+;; return values are indicated by the symbol "=>".
+
+;; To see what happens when an expression has multiple return values,
+;; try evaluating this one:
+
+(values 'a (begin (display "hello world\n") 'b) 'c)
+
+;; You can also evaluate a region of a buffer using `C-c C-r'.  If the
+;; code in the region consists of multiple expressions, GDS evaluates
+;; them sequentially.  For example, try selecting the following three
+;; lines and typing `C-c C-r'.
+
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+
+;; If the code in the region evaluated isn't syntactically balanced,
+;; GDS will indicate a read error, for example for this code:
+
+  (let ((z (atan x y)))
+    (display "Arctangent is: ")
+    (display z)
+    (newline)
+
+;; Finally, if you want to evaluate something quickly that is not in a
+;; buffer, you can use `C-c C-e' and type the code to evaluate at the
+;; minibuffer prompt.  The results are popped up in the same way as
+;; for code from a buffer.
+
+;; ** Breakpoints
+
+;; Before evaluating Scheme code from an Emacs buffer, you may want to
+;; set some breakpoints in it.  With GDS you can set breakpoints in
+;; Scheme code by typing `C-x SPC'.
+;;
+;; To see how this works, select the second line of the following code
+;; (the `(format ...)' line) and type `C-x SPC'.
+
+(for-each (lambda (x)
+	    (format #t "~A cubed is ~A\n" x (* x x x)))
+	  (iota 6))
+
+;; The two opening parentheses in that line should now be highlighted
+;; in red, to show that breakpoints have been set at the start of the
+;; `(format ...)' and `(* x x x)' expressions.  Then evaluate the
+;; whole for-each expression by typing `C-M-x' ...
+;;
+;; In the upper half of your Emacs, a buffer appears showing you the
+;; Scheme stack.
+;;
+;; In the lower half, the `(format ...)' expression is highlighted.
+;;
+;; What has happened is that Guile started evaluating the for-each
+;; code, but then hit the breakpoint that you set on the start of the
+;; format expression.  Guile therefore pauses the evaluation at that
+;; point and passes the stack (which encapsulates everything that is
+;; interesting about the state of Guile at that point) to GDS.  You
+;; can then explore the stack and decide how to tell Guile to
+;; continue.
+;;
+;; - If you move your mouse over any of the identifiers in the
+;;   highlighted code, a help echo (or tooltip) will appear to tell
+;;   you that identifier's current value.  (Note though that this only
+;;   works when the stack buffer is selected.  So if you have switched
+;;   to this buffer in order to scroll down and read these lines, you
+;;   will need to switch back to the stack buffer before trying this
+;;   out.)
+;;
+;; - In the stack buffer, the "=>" on the left shows you that the top
+;;   frame is currently selected.  You can move up and down the stack
+;;   by pressing the up and down arrows (or `u' and `d').  As you do
+;;   this, GDS will change the highlight in the lower window to show
+;;   the code that corresponds to the selected stack frame.
+;;
+;; - You can evaluate an arbitrary expression in the local environment
+;;   of the selected stack frame by typing `e' followed by the
+;;   expression.
+;;
+;; - You can show various bits of information about the selected frame
+;;   by typing `I', `A' and `S'.  Feel free to try these now, to see
+;;   what they do.
+;;
+;; You also have control over the continuing evaluation of this code.
+;; Here are some of the things you can do - please try them as you
+;; read.
+;;
+;; - `g' tells Guile to continue execution normally.  In this case
+;;   that means that evaluation will continue until it hits the next
+;;   breakpoint, which is on the `(* x x x)' expression.
+;;
+;; - `SPC' tells Guile to continue until the next significant event in
+;;   the same source file as the selected frame.  A "significant
+;;   event" means either beginning to evaluate an expression in the
+;;   relevant file, or completing such an evaluation, in which case
+;;   GDS tells you the value that it is returning.  Pressing `SPC'
+;;   repeatedly is a nice way to step through all the details of the
+;;   code in a given file, but stepping over calls that involve code
+;;   from other files.
+;;
+;; - `o' tells Guile to continue execution until the selected stack
+;;   frame completes, and then to show its return value.
+
+;; Local Variables:
+;; mode: scheme
+;; End:

emacs/gds.el

@@ -36,10 +36,11 @@
 ;; The subprocess object for the debug server.
 (defvar gds-debug-server nil)
 
-(defvar gds-socket-type-alist '((tcp . 8333)
+(defvar gds-unix-socket-name (format "/tmp/.gds-socket-%d" (emacs-pid))
-				(unix . "/tmp/.gds_socket"))
+  "Name of the Unix domain socket that GDS will listen on.")
-  "Maps each of the possible socket types that the GDS server can
+
-listen on to the path that it should bind to for each one.")
+(defvar gds-tcp-port 8333
+  "The TCP port number that GDS will listen on.")
 
 (defun gds-run-debug-server ()
   "Start (or restart, if already running) the GDS debug server process."
@@ -47,10 +48,14 @@ listen on to the path that it should bind to for each one.")
   (if gds-debug-server (gds-kill-debug-server))
   (setq gds-debug-server
         (gds-start-server "gds-debug"
-			  (cdr (assq gds-server-socket-type
+			  gds-unix-socket-name
-				     gds-socket-type-alist))
+			  gds-tcp-port
 			  'gds-debug-protocol))
-  (process-kill-without-query gds-debug-server))
+  (process-kill-without-query gds-debug-server)
+  ;; Add the Unix socket name to the environment, so that Guile
+  ;; clients started from within this Emacs will be able to use it,
+  ;; and thereby ensure that they connect to the GDS in this Emacs.
+  (setenv "GDS_UNIX_SOCKET_NAME" gds-unix-socket-name))
 
 (defun gds-kill-debug-server ()
   "Kill the GDS debug server process."
@@ -137,7 +142,13 @@ listen on to the path that it should bind to for each one.")
 
 ;;;; Debugger protocol
 
+(defcustom gds-protocol-hook nil
+  "Hook called on receipt of a protocol form from the GDS client."
+  :type 'hook
+  :group 'gds)
+
 (defun gds-debug-protocol (client form)
+  (run-hook-with-args 'gds-protocol-hook form)
   (or (eq client '*)
       (let ((proc (car form)))
         (cond ((eq proc 'name)
@@ -610,7 +621,7 @@ you would add an element to this alist to transform
   :group 'gds)
 
 (defcustom gds-server-socket-type 'tcp
-  "What kind of socket the GDS server should listen on."
+  "This option is now obsolete and has no effect."
   :group 'gds
   :type '(choice (const :tag "TCP" tcp)
 		 (const :tag "Unix" unix)))

guile-readline/Makefile.am

@@ -1,6 +1,6 @@
 ## Process this file with Automake to create Makefile.in
 ##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006, 2007, 2008 Free Software Foundation, Inc.
+##  	Copyright (C) 1998, 1999, 2000, 2001, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
 ##
 ##   This file is part of guile-readline.
 ##
@@ -19,41 +19,58 @@
 ##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
 ##   Floor, Boston, MA 02110-1301 USA
 
-SUBDIRS = ice-9
-
 ## Prevent automake from adding extra -I options
 DEFS = @DEFS@ @EXTRA_DEFS@
+
+if HAVE_READLINE
+
+# `ice-9' subdirectory.
+ice9dir = $(pkgdatadir)/$(GUILE_EFFECTIVE_VERSION)
+nobase_ice9_DATA = ice-9/readline.scm
+EXTRA_DIST = $(nobase_ice9_DATA)
+
+
 ## Check for headers in $(srcdir)/.., so that #include
 ## <libguile/MUMBLE.h> will find MUMBLE.h in this dir when we're
 ## building.  Also look for Gnulib headers in `lib'.
-INCLUDES = -I. -I.. -I$(srcdir)/..			\
+AM_CPPFLAGS = -I. -I.. -I$(srcdir)/..			\
 	      -I$(top_srcdir)/lib -I$(top_builddir)/lib
 
+AM_CFLAGS = $(GCC_CFLAGS)
+
 GUILE_SNARF = ../libguile/guile-snarf
 
 lib_LTLIBRARIES = libguilereadline-v-@LIBGUILEREADLINE_MAJOR@.la
 
 libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_SOURCES = readline.c
 libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_LIBADD =	\
+  $(READLINE_LIBS)					\
   ../libguile/libguile.la ../lib/libgnu.la
-libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_LDFLAGS = -version-info @LIBGUILEREADLINE_INTERFACE@ -export-dynamic -no-undefined
+
+libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_LDFLAGS =	\
+  -version-info @LIBGUILEREADLINE_INTERFACE@ -export-dynamic	\
+  -no-undefined
 
 
 BUILT_SOURCES = readline.x
 
 pkginclude_HEADERS = readline.h
 
-snarfcppopts = $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+snarfcppopts = $(DEFS) $(AM_CPPFLAGS) $(CPPFLAGS) $(CFLAGS)
 SUFFIXES = .x
 .c.x:
 	$(GUILE_SNARF) -o $@ $< $(snarfcppopts)
 
-EXTRA_DIST = LIBGUILEREADLINE-VERSION ChangeLog-2008
+EXTRA_DIST += LIBGUILEREADLINE-VERSION ChangeLog-2008
 
-MKDEP = gcc -M -MG $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS)
+ETAGS_ARGS =							\
+  $(nobase_ice9_DATA)						\
+  $(libguilereadline_v_@LIBGUILEREADLINE_MAJOR@_la_SOURCES)
 
 CLEANFILES = *.x
 
+endif HAVE_READLINE
+
 dist-hook:
 	(temp="/tmp/mangle-deps.$$$$"; \
 	 trap "rm -f $$temp" 0 1 2 15; \

guile-readline/autogen.sh

@@ -1,8 +0,0 @@
-#!/bin/sh
-
-[ -f readline-activator.scm ] || {
-  echo "autogen.sh: run this command only in the guile-readline directory."
-  exit 1
-}
-
-autoreconf -i --force

guile-readline/configure.ac

@@ -1,88 +0,0 @@
-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,
-        patsubst(m4_esyscmd(. ../GUILE-VERSION && echo ${GUILE_VERSION}), [
-]),
-	[bug-guile@gnu.org])
-
-AC_CONFIG_AUX_DIR([../build-aux])
-AC_CONFIG_SRCDIR(readline.c)
-AM_CONFIG_HEADER([guile-readline-config.h])
-AM_INIT_AUTOMAKE([foreign no-define])
-
-. $srcdir/../GUILE-VERSION
-
-AC_PROG_INSTALL
-AC_PROG_CC
-AM_PROG_CC_STDC
-AC_LIBTOOL_WIN32_DLL
-AC_PROG_LIBTOOL
-
-dnl
-dnl Check for Winsock and other functionality on Win32 (*not* CygWin)
-dnl
-AC_CYGWIN
-AC_MINGW32
-EXTRA_DEFS=""
-if test "$MINGW32" = "yes" ; then
-    if test $enable_shared = yes ; then
-      EXTRA_DEFS="-DSCM_IMPORT"
-    fi
-fi
-AC_SUBST(EXTRA_DEFS)
-
-for termlib in ncurses curses termcap terminfo termlib ; do
-   AC_CHECK_LIB(${termlib}, tgoto,
-                [LIBS="-l${termlib} $LIBS"; break])
-done
-
-AC_LIB_LINKFLAGS(readline)
-AC_CHECK_LIB(readline, readline)
-if test $ac_cv_lib_readline_readline = no; then
-  AC_MSG_WARN([libreadline was not found on your system.])
-fi
-
-AC_CHECK_FUNCS(siginterrupt rl_clear_signals rl_cleanup_after_signal)
-
-dnl Check for modern readline naming
-AC_CHECK_FUNCS(rl_filename_completion_function)
-
-dnl Check for rl_get_keymap.  We only use this for deciding whether to
-dnl install paren matching on the Guile command line (when using
-dnl readline for input), so it's completely optional.
-AC_CHECK_FUNCS(rl_get_keymap)
-
-AC_CACHE_CHECK([for rl_getc_function pointer in readline],
-		 ac_cv_var_rl_getc_function,
-		 [AC_TRY_LINK([
-#include <stdio.h>
-#include <readline/readline.h>],
-			      [printf ("%ld", (long) rl_getc_function)],
-			      [ac_cv_var_rl_getc_function=yes],
-			      [ac_cv_var_rl_getc_function=no])])
-if test "${ac_cv_var_rl_getc_function}" = "yes"; then
-  AC_DEFINE(HAVE_RL_GETC_FUNCTION, 1,
-    [Define if your readline library has the rl_getc_function variable.])
-fi
-
-if test $ac_cv_lib_readline_readline = yes \
-        -a $ac_cv_var_rl_getc_function = no; then
-  AC_MSG_WARN([*** libreadline is too old on your system.])
-  AC_MSG_WARN([*** You need readline version 2.1 or later.])
-fi
-
-AC_CHECK_FUNCS(strdup)
-
-. $srcdir/LIBGUILEREADLINE-VERSION
-AC_SUBST(LIBGUILEREADLINE_MAJOR)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_CURRENT)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_REVISION)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE_AGE)
-AC_SUBST(LIBGUILEREADLINE_INTERFACE)
-
-AC_SUBST(GUILE_EFFECTIVE_VERSION)
-
-AC_CONFIG_FILES(Makefile ice-9/Makefile)
-AC_OUTPUT

guile-readline/ice-9/Makefile.am

@@ -1,28 +0,0 @@
-## Process this file with Automake to create Makefile.in
-##
-##  	Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
-##
-##   This file is part of guile-readline.
-##
-##   guile-readline 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 3, or
-##   (at your option) any later version.
-##
-##   guile-readline 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 guile-readline; see the file COPYING.  If not, write
-##   to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
-##   Floor, Boston, MA 02110-1301 USA
-
-# Guile's `pkgdatadir'.
-guile_pdd = $(datadir)/guile
-
-ice9dir = $(guile_pdd)/$(GUILE_EFFECTIVE_VERSION)/ice-9
-ice9_DATA = readline.scm
-ETAGS_ARGS = $(ice9_DATA)
-EXTRA_DIST = $(ice9_DATA)

guile-readline/readline.c

@@ -1,6 +1,6 @@
 /* readline.c --- line editing support for Guile */
 
-/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008, 2009 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
@@ -21,9 +21,9 @@
 
 
 
-
+#ifdef HAVE_CONFIG_H
-/* Include private, configure generated header (i.e. config.h). */
+# include <config.h>
-#include "guile-readline-config.h"
+#endif
 
 #ifdef HAVE_RL_GETC_FUNCTION
 #include "libguile.h"

lang/elisp/interface.scm

@@ -20,7 +20,10 @@
 
 (define (eval-elisp x)
   "Evaluate the Elisp expression @var{x}."
-  (eval x the-elisp-module))
+  (save-module-excursion 
+   (lambda ()
+     (set-current-module the-elisp-module)
+     (primitive-eval x))))
 
 (define (translate-elisp x)
   "Translate the Elisp expression @var{x} to equivalent Scheme code."

libguile.h

@@ -31,8 +31,12 @@ extern "C" {
 #include "libguile/__scm.h"
 #include "libguile/alist.h"
 #include "libguile/arbiters.h"
+#include "libguile/array-handle.h"
+#include "libguile/array-map.h"
+#include "libguile/arrays.h"
 #include "libguile/async.h"
 #include "libguile/boolean.h"
+#include "libguile/bitvectors.h"
 #include "libguile/bytevectors.h"
 #include "libguile/chars.h"
 #include "libguile/continuations.h"
@@ -50,6 +54,8 @@ extern "C" {
 #include "libguile/futures.h"
 #include "libguile/gc.h"
 #include "libguile/gdbint.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 #include "libguile/goops.h"
 #include "libguile/gsubr.h"
 #include "libguile/guardians.h"
@@ -78,7 +84,6 @@ extern "C" {
 #include "libguile/properties.h"
 #include "libguile/procs.h"
 #include "libguile/r6rs-ports.h"
-#include "libguile/ramap.h"
 #include "libguile/random.h"
 #include "libguile/read.h"
 #include "libguile/root.h"
@@ -101,7 +106,7 @@ extern "C" {
 #include "libguile/symbols.h"
 #include "libguile/tags.h"
 #include "libguile/throw.h"
-#include "libguile/unif.h"
+#include "libguile/uniform.h"
 #include "libguile/validate.h"
 #include "libguile/values.h"
 #include "libguile/variable.h"

libguile/Makefile.am

@@ -105,26 +105,103 @@ guile_LDFLAGS = $(GUILE_CFLAGS)
 
 libguile_la_CFLAGS = $(GUILE_CFLAGS) $(AM_CFLAGS)
 
-libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	\
+libguile_la_SOURCES =				\
-    bytevectors.c chars.c continuations.c				\
+	alist.c					\
-    convert.c debug.c deprecation.c					\
+	arbiters.c				\
-    deprecated.c discouraged.c dynwind.c eq.c error.c	\
+	array-handle.c				\
-    eval.c evalext.c extensions.c feature.c fluids.c fports.c		\
+	array-map.c				\
-    futures.c gc.c gc-malloc.c						\
+	arrays.c				\
-    gdbint.c gettext.c goops.c gsubr.c					\
+	async.c					\
-    guardians.c hash.c hashtab.c hooks.c init.c inline.c		\
+	backtrace.c				\
-    ioext.c keywords.c lang.c list.c load.c macros.c mallocs.c		\
+	boolean.c				\
-    modules.c numbers.c objects.c objprop.c options.c pairs.c ports.c	\
+	bitvectors.c				\
-    print.c procprop.c procs.c properties.c				\
+	bytevectors.c				\
-    r6rs-ports.c random.c rdelim.c read.c				\
+	chars.c					\
-    root.c rw.c scmsigs.c script.c simpos.c smob.c sort.c srcprop.c	\
+	continuations.c				\
-    stackchk.c stacks.c stime.c strings.c srfi-4.c srfi-13.c srfi-14.c	\
+	debug.c					\
-    strorder.c strports.c struct.c symbols.c threads.c null-threads.c	\
+	deprecated.c				\
-    throw.c values.c variable.c vectors.c version.c vports.c weaks.c	\
+	deprecation.c				\
-    ramap.c unif.c
+	discouraged.c				\
-
+	dynwind.c				\
-# vm-related sources
+	eq.c					\
-libguile_la_SOURCES += frames.c instructions.c objcodes.c programs.c vm.c
+	error.c					\
+	eval.c					\
+	evalext.c				\
+	extensions.c				\
+	feature.c				\
+	fluids.c				\
+	fports.c				\
+	frames.c				\
+	futures.c				\
+	gc-malloc.c				\
+	gc.c					\
+	gdbint.c				\
+	gettext.c				\
+	generalized-arrays.c			\
+	generalized-vectors.c			\
+	goops.c					\
+	gsubr.c					\
+	guardians.c				\
+	hash.c					\
+	hashtab.c				\
+	hooks.c					\
+	init.c					\
+	inline.c				\
+	instructions.c				\
+	ioext.c					\
+	keywords.c				\
+	lang.c					\
+	list.c					\
+	load.c					\
+	macros.c				\
+	mallocs.c				\
+	modules.c				\
+	null-threads.c				\
+	numbers.c				\
+	objcodes.c				\
+	objects.c				\
+	objprop.c				\
+	options.c				\
+	pairs.c					\
+	ports.c					\
+	print.c					\
+	procprop.c				\
+	procs.c					\
+	programs.c				\
+	properties.c				\
+	r6rs-ports.c				\
+	random.c				\
+	rdelim.c				\
+	read.c					\
+	root.c					\
+	rw.c					\
+	scmsigs.c				\
+	script.c				\
+	simpos.c				\
+	smob.c					\
+	sort.c					\
+	srcprop.c				\
+	srfi-13.c				\
+	srfi-14.c				\
+	srfi-4.c				\
+	stackchk.c				\
+	stacks.c				\
+	stime.c					\
+	strings.c				\
+	strorder.c				\
+	strports.c				\
+	struct.c				\
+	symbols.c				\
+	threads.c				\
+	throw.c					\
+	uniform.c				\
+	values.c				\
+	variable.c				\
+	vectors.c				\
+	version.c				\
+	vm.c					\
+	vports.c				\
+	weaks.c
 
 libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_SOURCES = i18n.c
 libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_CFLAGS =	\
@@ -135,46 +212,194 @@ libguile_i18n_v_@LIBGUILE_I18N_MAJOR@_la_LDFLAGS =	\
    -module -L$(builddir) -lguile				\
    -version-info @LIBGUILE_I18N_INTERFACE@
 
-DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x		\
+DOT_X_FILES =					\
-    bytevectors.x chars.x						\
+	alist.x					\
-    continuations.x debug.x deprecation.x deprecated.x discouraged.x	\
+	arbiters.x				\
-    dynl.x dynwind.x environments.x eq.x error.x eval.x evalext.x	\
+	array-handle.x				\
-    extensions.x feature.x fluids.x fports.x futures.x gc.x		\
+	array-map.x				\
-    gettext.x goops.x gsubr.x guardians.x				\
+	arrays.x				\
-    hash.x hashtab.x hooks.x i18n.x init.x ioext.x keywords.x lang.x	\
+	async.x					\
-    list.x load.x macros.x mallocs.x modules.x numbers.x objects.x	\
+	backtrace.x				\
-    objprop.x options.x pairs.x ports.x print.x procprop.x procs.x	\
+	boolean.x				\
-    properties.x r6rs-ports.x random.x rdelim.x				\
+	bitvectors.x				\
-    read.x root.x rw.x scmsigs.x					\
+	bytevectors.x				\
-    script.x simpos.x smob.x sort.x srcprop.x stackchk.x stacks.x	\
+	chars.x					\
-    stime.x strings.x srfi-4.x srfi-13.x srfi-14.x strorder.x		\
+	continuations.x				\
-    strports.x struct.x symbols.x threads.x throw.x values.x		\
+	debug.x					\
-    variable.x vectors.x version.x vports.x weaks.x ramap.x unif.x
+	deprecated.x				\
+	deprecation.x				\
+	discouraged.x				\
+	dynl.x					\
+	dynwind.x				\
+	eq.x					\
+	error.x					\
+	eval.x					\
+	evalext.x				\
+	extensions.x				\
+	feature.x				\
+	fluids.x				\
+	fports.x				\
+	futures.x				\
+	gc-malloc.x				\
+	gc.x					\
+	gettext.x				\
+	generalized-arrays.x			\
+	generalized-vectors.x			\
+	goops.x					\
+	gsubr.x					\
+	guardians.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					\
+	properties.x				\
+	r6rs-ports.x				\
+	random.x				\
+	rdelim.x				\
+	read.x					\
+	root.x					\
+	rw.x					\
+	scmsigs.x				\
+	script.x				\
+	simpos.x				\
+	smob.x					\
+	sort.x					\
+	srcprop.x				\
+	srfi-13.x				\
+	srfi-14.x				\
+	srfi-4.x				\
+	stackchk.x				\
+	stacks.x				\
+	stime.x					\
+	strings.x				\
+	strorder.x				\
+	strports.x				\
+	struct.x				\
+	symbols.x				\
+	threads.x				\
+	throw.x					\
+	uniform.x				\
+	values.x				\
+	variable.x				\
+	vectors.x				\
+	version.x				\
+	vports.x				\
+	weaks.x
 
 # vm-related snarfs
 DOT_X_FILES += frames.x instructions.x objcodes.x programs.x vm.x
 
 EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
 
-DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc		\
+DOT_DOC_FILES = 				\
-    boolean.doc bytevectors.doc chars.doc				\
+	alist.doc				\
-    continuations.doc debug.doc deprecation.doc				\
+	arbiters.doc				\
-    deprecated.doc discouraged.doc dynl.doc dynwind.doc			\
+	array-handle.doc			\
-    eq.doc error.doc eval.doc evalext.doc		\
+	array-map.doc				\
-    extensions.doc feature.doc fluids.doc fports.doc futures.doc	\
+	arrays.doc				\
-    gc.doc goops.doc gsubr.doc						\
+	async.doc				\
-    gc-malloc.doc gettext.doc guardians.doc hash.doc hashtab.doc	\
+	backtrace.doc				\
-    hooks.doc i18n.doc init.doc ioext.doc keywords.doc lang.doc		\
+	boolean.doc				\
-    list.doc load.doc macros.doc mallocs.doc modules.doc numbers.doc	\
+	bitvectors.doc				\
-    objects.doc objprop.doc options.doc pairs.doc ports.doc print.doc	\
+	bytevectors.doc				\
-    procprop.doc procs.doc properties.doc r6rs-ports.doc		\
+	chars.doc				\
-    random.doc rdelim.doc						\
+	continuations.doc			\
-    read.doc root.doc rw.doc scmsigs.doc script.doc simpos.doc		\
+	debug.doc				\
-    smob.doc sort.doc srcprop.doc stackchk.doc stacks.doc stime.doc	\
+	deprecated.doc				\
-    strings.doc srfi-4.doc srfi-13.doc srfi-14.doc strorder.doc		\
+	deprecation.doc				\
-    strports.doc struct.doc symbols.doc threads.doc throw.doc		\
+	discouraged.doc				\
-    values.doc variable.doc vectors.doc version.doc vports.doc		\
+	dynl.doc				\
-    weaks.doc ramap.doc unif.doc
+	dynwind.doc				\
+	eq.doc					\
+	error.doc				\
+	eval.doc				\
+	evalext.doc				\
+	extensions.doc				\
+	feature.doc				\
+	fluids.doc				\
+	fports.doc				\
+	futures.doc				\
+	gc-malloc.doc				\
+	gc.doc					\
+	gettext.doc				\
+	generalized-arrays.doc			\
+	generalized-vectors.doc			\
+	goops.doc				\
+	gsubr.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				\
+	objects.doc				\
+	objprop.doc				\
+	options.doc				\
+	pairs.doc				\
+	ports.doc				\
+	print.doc				\
+	procprop.doc				\
+	procs.doc				\
+	properties.doc				\
+	r6rs-ports.doc				\
+	random.doc				\
+	rdelim.doc				\
+	read.doc				\
+	root.doc				\
+	rw.doc					\
+	scmsigs.doc				\
+	script.doc				\
+	simpos.doc				\
+	smob.doc				\
+	sort.doc				\
+	srcprop.doc				\
+	srfi-13.doc				\
+	srfi-14.doc				\
+	srfi-4.doc				\
+	stackchk.doc				\
+	stacks.doc				\
+	stime.doc				\
+	strings.doc				\
+	strorder.doc				\
+	strports.doc				\
+	struct.doc				\
+	symbols.doc				\
+	threads.doc				\
+	throw.doc				\
+	uniform.doc				\
+	values.doc				\
+	variable.doc				\
+	vectors.doc				\
+	version.doc				\
+	vports.doc				\
+	weaks.doc
 
 EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
 
@@ -205,10 +430,9 @@ install-exec-hook:
 ## compile, since they are #included.  So instead we list them here.
 ## Perhaps we can deal with them normally once the merge seems to be
 ## working.
-noinst_HEADERS = convert.i.c					\
+noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c		\
-                 conv-integer.i.c conv-uinteger.i.c		\
                  eval.i.c ieee-754.h				\
-                 srfi-4.i.c					\
+                 srfi-4.i.c srfi-14.i.c				\
                  quicksort.i.c                                  \
                  win32-uname.h win32-dirent.h win32-socket.h	\
 	         private-gc.h private-options.h
@@ -232,28 +456,119 @@ pkginclude_HEADERS =
 
 # These are headers visible as <libguile/mumble.h>.
 modincludedir = $(includedir)/libguile
-modinclude_HEADERS = __scm.h alist.h arbiters.h async.h backtrace.h	\
+modinclude_HEADERS =				\
-    boehm-gc.h bytevectors.h						\
+	__scm.h					\
-    boolean.h chars.h continuations.h convert.h debug.h debug-malloc.h	\
+	alist.h					\
-    deprecation.h deprecated.h discouraged.h dynl.h dynwind.h		\
+	arbiters.h				\
-    eq.h error.h eval.h evalext.h extensions.h		\
+	array-handle.h				\
-    feature.h filesys.h fluids.h fports.h futures.h gc.h		\
+	array-map.h				\
-    gdb_interface.h gdbint.h gettext.h goops.h				\
+	arrays.h				\
-    gsubr.h guardians.h hash.h						\
+	async.h					\
-    hashtab.h hooks.h i18n.h init.h inline.h ioext.h iselect.h		\
+	backtrace.h				\
-    keywords.h lang.h list.h load.h macros.h mallocs.h modules.h	\
+	boolean.h				\
-    net_db.h numbers.h objects.h objprop.h options.h pairs.h ports.h	\
+	bitvectors.h				\
-    posix.h r6rs-ports.h regex-posix.h print.h				\
+	bytevectors.h				\
-    procprop.h procs.h properties.h					\
+	chars.h					\
-    random.h ramap.h rdelim.h read.h root.h rw.h scmsigs.h validate.h	\
+	continuations.h				\
-    script.h simpos.h smob.h snarf.h socket.h sort.h srcprop.h		\
+	debug-malloc.h				\
-    stackchk.h stacks.h stime.h strings.h srfi-4.h srfi-13.h srfi-14.h	\
+	debug.h					\
-    strorder.h strports.h struct.h symbols.h tags.h threads.h		\
+	deprecated.h				\
-    pthread-threads.h null-threads.h throw.h unif.h values.h		\
+	deprecation.h				\
-    variable.h vectors.h vports.h weaks.h
+	discouraged.h				\
-
+	dynl.h					\
-modinclude_HEADERS += vm-bootstrap.h frames.h instructions.h objcodes.h	\
+	dynwind.h				\
-    programs.h vm.h vm-engine.h vm-expand.h
+	eq.h					\
+	error.h					\
+	eval.h					\
+	evalext.h				\
+	extensions.h				\
+	feature.h				\
+	filesys.h				\
+	fluids.h				\
+	fports.h				\
+	frames.h				\
+	futures.h				\
+	gc.h					\
+	gdb_interface.h				\
+	gdbint.h				\
+	gettext.h				\
+	generalized-arrays.h			\
+	generalized-vectors.h			\
+	goops.h					\
+	gsubr.h					\
+	guardians.h				\
+	hash.h					\
+	hashtab.h				\
+	hooks.h					\
+	i18n.h					\
+	init.h					\
+	inline.h				\
+	instructions.h				\
+	ioext.h					\
+	iselect.h				\
+	keywords.h				\
+	lang.h					\
+	list.h					\
+	load.h					\
+	macros.h				\
+	mallocs.h				\
+	modules.h				\
+	net_db.h				\
+	null-threads.h				\
+	numbers.h				\
+	objcodes.h				\
+	objects.h				\
+	objprop.h				\
+	options.h				\
+	pairs.h					\
+	ports.h					\
+	posix.h					\
+	print.h					\
+	procprop.h				\
+	procs.h					\
+	programs.h				\
+	properties.h				\
+	pthread-threads.h			\
+	r6rs-ports.h				\
+	random.h				\
+	rdelim.h				\
+	read.h					\
+	regex-posix.h				\
+	root.h					\
+	rw.h					\
+	scmsigs.h				\
+	script.h				\
+	simpos.h				\
+	smob.h					\
+	snarf.h					\
+	socket.h				\
+	sort.h					\
+	srcprop.h				\
+	srfi-13.h				\
+	srfi-14.h				\
+	srfi-4.h				\
+	stackchk.h				\
+	stacks.h				\
+	stime.h					\
+	strings.h				\
+	strorder.h				\
+	strports.h				\
+	struct.h				\
+	symbols.h				\
+	tags.h					\
+	threads.h				\
+	throw.h					\
+	validate.h				\
+	uniform.h				\
+	values.h				\
+	variable.h				\
+	vectors.h				\
+	vm-bootstrap.h				\
+	vm-engine.h				\
+	vm-expand.h				\
+	vm.h					\
+	vports.h				\
+	weaks.h
 
 nodist_modinclude_HEADERS = version.h scmconfig.h
 
@@ -268,7 +583,7 @@ EXTRA_DIST = ChangeLog-scm ChangeLog-threads		\
     cpp_errno.c cpp_err_symbols.in cpp_err_symbols.c			\
     cpp_sig_symbols.c cpp_sig_symbols.in cpp_cnvt.awk			\
     c-tokenize.lex version.h.in						\
-    scmconfig.h.top libgettext.h libguile.map
+    scmconfig.h.top libgettext.h unidata_to_charset.pl libguile.map
 #    $(DOT_DOC_FILES) $(EXTRA_DOT_DOC_FILES) \
 #    guile-procedures.txt guile.texi
 

libguile/__scm.h

@@ -423,19 +423,28 @@
     typedef struct {
       ucontext_t ctx;
       int fresh;
-    } jmp_buf;
+    } scm_i_jmp_buf;
-#   define setjmp(JB)				        \
+#   define SCM_I_SETJMP(JB)			        \
       ( (JB).fresh = 1,				        \
         getcontext (&((JB).ctx)),			\
         ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
-#   define longjmp(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
+#   define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
-    void scm_ia64_longjmp (jmp_buf *, int);
+    void scm_ia64_longjmp (scm_i_jmp_buf *, int);
 #  else                 	/* ndef __ia64__ */
 #   include <setjmp.h>
 #  endif			/* ndef __ia64__ */
 # endif				/* ndef _CRAY1 */
 #endif				/* ndef vms */
 
+/* For any platform where SCM_I_SETJMP hasn't been defined in some
+   special way above, map SCM_I_SETJMP, SCM_I_LONGJMP and
+   scm_i_jmp_buf to setjmp, longjmp and jmp_buf. */
+#ifndef SCM_I_SETJMP
+#define scm_i_jmp_buf jmp_buf
+#define SCM_I_SETJMP setjmp
+#define SCM_I_LONGJMP longjmp
+#endif
+
 /* James Clark came up with this neat one instruction fix for
  * continuations on the SPARC.  It flushes the register windows so
  * that all the state of the process is contained in the stack.
@@ -556,6 +565,13 @@ SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
   return (SCM_UNPACK (gf)					\
 	  ? scm_call_generic_1 ((gf), (a1))			\
 	  : (scm_wrong_type_arg ((subr), (pos), (a1)), SCM_UNSPECIFIED))
+
+/* This form is for dispatching a subroutine.  */
+#define SCM_WTA_DISPATCH_1_SUBR(subr, a1, pos)				\
+  return (SCM_UNPACK ((*SCM_SUBR_GENERIC (subr)))			\
+	  ? scm_call_generic_1 ((*SCM_SUBR_GENERIC (subr)), (a1))	\
+	  : (scm_i_wrong_type_arg_symbol (SCM_SUBR_NAME (subr), (pos), (a1)), SCM_UNSPECIFIED))
+
 #define SCM_GASSERT1(cond, gf, a1, pos, subr)		\
   if (SCM_UNLIKELY (!(cond)))			\
     SCM_WTA_DISPATCH_1((gf), (a1), (pos), (subr))

libguile/_scm.h

@@ -172,7 +172,7 @@
 
 /* Major and minor versions must be single characters. */
 #define SCM_OBJCODE_MAJOR_VERSION 0
-#define SCM_OBJCODE_MINOR_VERSION B
+#define SCM_OBJCODE_MINOR_VERSION D
 #define SCM_OBJCODE_MAJOR_VERSION_STRING        \
   SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
 #define SCM_OBJCODE_MINOR_VERSION_STRING        \

libguile/array-handle.c

@@ -0,0 +1,162 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 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 3 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
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+
+#include "libguile/array-handle.h"
+
+
+SCM scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_LAST + 1];
+
+
+#define ARRAY_IMPLS_N_STATIC_ALLOC 7
+static scm_t_array_implementation array_impls[ARRAY_IMPLS_N_STATIC_ALLOC];
+static int num_array_impls_registered = 0;
+
+
+void
+scm_i_register_array_implementation (scm_t_array_implementation *impl)
+{
+  if (num_array_impls_registered >= ARRAY_IMPLS_N_STATIC_ALLOC)
+    /* need to increase ARRAY_IMPLS_N_STATIC_ALLOC, buster */
+    abort ();
+  else
+    array_impls[num_array_impls_registered++] = *impl;
+}
+
+scm_t_array_implementation*
+scm_i_array_implementation_for_obj (SCM obj)
+{
+  int i;
+  for (i = 0; i < num_array_impls_registered; i++)
+    if (SCM_NIMP (obj)
+        && (SCM_CELL_TYPE (obj) & array_impls[i].mask) == array_impls[i].tag)
+      return &array_impls[i];
+  return NULL;
+}
+
+void
+scm_array_get_handle (SCM array, scm_t_array_handle *h)
+{
+  scm_t_array_implementation *impl = scm_i_array_implementation_for_obj (array);
+  if (!impl)
+    scm_wrong_type_arg_msg (NULL, 0, array, "array");
+  h->array = array;
+  h->impl = impl;
+  h->base = 0;
+  h->ndims = 0;
+  h->dims = NULL;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_SCM; /* have to default to
+                                                   something... */
+  h->elements = NULL;
+  h->writable_elements = NULL;
+  h->impl->get_handle (array, h);
+}
+
+ssize_t
+scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
+{
+  scm_t_array_dim *s = scm_array_handle_dims (h);
+  ssize_t pos = 0, i;
+  size_t k = scm_array_handle_rank (h);
+  
+  while (k > 0 && scm_is_pair (indices))
+    {
+      i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
+      pos += (i - s->lbnd) * s->inc;
+      k--;
+      s++;
+      indices = SCM_CDR (indices);
+    }
+  if (k > 0 || !scm_is_null (indices))
+    scm_misc_error (NULL, "wrong number of indices, expecting ~a",
+		    scm_list_1 (scm_from_size_t (scm_array_handle_rank (h))));
+  return pos;
+}
+
+SCM
+scm_array_handle_element_type (scm_t_array_handle *h)
+{
+  if (h->element_type < 0 || h->element_type > SCM_ARRAY_ELEMENT_TYPE_LAST)
+    abort (); /* guile programming error */
+  return scm_i_array_element_types[h->element_type];
+}
+
+void
+scm_array_handle_release (scm_t_array_handle *h)
+{
+  /* Nothing to do here until arrays need to be reserved for real.
+   */
+}
+
+const SCM *
+scm_array_handle_elements (scm_t_array_handle *h)
+{
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+  return ((const SCM*)h->elements) + h->base;
+}
+
+SCM *
+scm_array_handle_writable_elements (scm_t_array_handle *h)
+{
+  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
+    scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
+  return ((SCM*)h->elements) + h->base;
+}
+
+void
+scm_init_array_handle (void)
+{
+#define DEFINE_ARRAY_TYPE(tag, TAG)                             \
+  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG]   \
+    = (scm_permanent_object (scm_from_locale_symbol (#tag)))
+  
+  scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_SCM] = SCM_BOOL_T;
+  DEFINE_ARRAY_TYPE (a, CHAR);
+  DEFINE_ARRAY_TYPE (b, BIT);
+  DEFINE_ARRAY_TYPE (vu8, VU8);
+  DEFINE_ARRAY_TYPE (u8, U8);
+  DEFINE_ARRAY_TYPE (s8, S8);
+  DEFINE_ARRAY_TYPE (u16, U16);
+  DEFINE_ARRAY_TYPE (s16, S16);
+  DEFINE_ARRAY_TYPE (u32, U32);
+  DEFINE_ARRAY_TYPE (s32, S32);
+  DEFINE_ARRAY_TYPE (u64, U64);
+  DEFINE_ARRAY_TYPE (s64, S64);
+  DEFINE_ARRAY_TYPE (f32, F32);
+  DEFINE_ARRAY_TYPE (f64, F64);
+  DEFINE_ARRAY_TYPE (c32, C32);
+  DEFINE_ARRAY_TYPE (c64, C64);
+
+#include "libguile/array-handle.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/

libguile/array-handle.h

@@ -0,0 +1,129 @@
+/* classes: h_files */
+
+#ifndef SCM_ARRAY_HANDLE_H
+#define SCM_ARRAY_HANDLE_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 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 3 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 "libguile/__scm.h"
+
+
+
+struct scm_t_array_handle;
+
+typedef SCM (*scm_i_t_array_ref) (struct scm_t_array_handle *, size_t);
+typedef void (*scm_i_t_array_set) (struct scm_t_array_handle *, size_t, SCM);
+
+typedef struct
+{
+  scm_t_bits tag;
+  scm_t_bits mask;
+  scm_i_t_array_ref vref;
+  scm_i_t_array_set vset;
+  void (*get_handle)(SCM, struct scm_t_array_handle*);
+} scm_t_array_implementation;
+  
+#define SCM_ARRAY_IMPLEMENTATION(tag_,mask_,vref_,vset_,handle_) \
+  SCM_SNARF_INIT ({                                                     \
+      scm_t_array_implementation impl;                                  \
+      impl.tag = tag_; impl.mask = mask_;                               \
+      impl.vref = vref_; impl.vset = vset_;                             \
+      impl.get_handle = handle_;                                        \
+      scm_i_register_array_implementation (&impl);                      \
+  })
+  
+
+SCM_INTERNAL void scm_i_register_array_implementation (scm_t_array_implementation *impl);
+SCM_INTERNAL scm_t_array_implementation* scm_i_array_implementation_for_obj (SCM obj);
+
+
+
+
+typedef struct scm_t_array_dim
+{
+  ssize_t lbnd;
+  ssize_t ubnd;
+  ssize_t inc;
+} scm_t_array_dim;
+
+typedef enum {    
+  SCM_ARRAY_ELEMENT_TYPE_SCM = 0, /* SCM values */
+  SCM_ARRAY_ELEMENT_TYPE_CHAR = 1, /* characters */
+  SCM_ARRAY_ELEMENT_TYPE_BIT = 2, /* packed numeric values */
+  SCM_ARRAY_ELEMENT_TYPE_VU8 = 3,
+  SCM_ARRAY_ELEMENT_TYPE_U8 = 4,
+  SCM_ARRAY_ELEMENT_TYPE_S8 = 5,
+  SCM_ARRAY_ELEMENT_TYPE_U16 = 6,
+  SCM_ARRAY_ELEMENT_TYPE_S16 = 7,
+  SCM_ARRAY_ELEMENT_TYPE_U32 = 8,
+  SCM_ARRAY_ELEMENT_TYPE_S32 = 9,
+  SCM_ARRAY_ELEMENT_TYPE_U64 = 10,
+  SCM_ARRAY_ELEMENT_TYPE_S64 = 11,
+  SCM_ARRAY_ELEMENT_TYPE_F32 = 12,
+  SCM_ARRAY_ELEMENT_TYPE_F64 = 13,
+  SCM_ARRAY_ELEMENT_TYPE_C32 = 14,
+  SCM_ARRAY_ELEMENT_TYPE_C64 = 15,
+  SCM_ARRAY_ELEMENT_TYPE_LAST = 15,
+} scm_t_array_element_type;
+
+SCM_INTERNAL SCM scm_i_array_element_types[];
+
+
+typedef struct scm_t_array_handle {
+  SCM array;
+  scm_t_array_implementation *impl;
+  /* `Base' is an offset into elements or writable_elements, corresponding to
+     the first element in the array. It would be nicer just to adjust the
+     elements/writable_elements pointer, but we can't because that element might
+     not even be byte-addressable, as is the case with bitvectors. A nicer
+     solution would be, well, nice.
+   */
+  size_t base;
+  size_t ndims; /* ndims == the rank of the array */
+  scm_t_array_dim *dims;
+  scm_t_array_dim dim0;
+  scm_t_array_element_type element_type;
+  const void *elements;
+  void *writable_elements;
+} scm_t_array_handle;
+
+#define scm_array_handle_rank(h) ((h)->ndims)
+#define scm_array_handle_dims(h) ((h)->dims)
+
+SCM_API void scm_array_get_handle (SCM array, scm_t_array_handle *h);
+SCM_API ssize_t scm_array_handle_pos (scm_t_array_handle *h, SCM indices);
+SCM_API SCM scm_array_handle_element_type (scm_t_array_handle *h);
+SCM_API void scm_array_handle_release (scm_t_array_handle *h);
+SCM_API const SCM* scm_array_handle_elements (scm_t_array_handle *h);
+SCM_API SCM* scm_array_handle_writable_elements (scm_t_array_handle *h);
+
+/* See inline.h for scm_array_handle_ref and scm_array_handle_set */
+
+SCM_INTERNAL void scm_init_array_handle (void);
+
+
+#endif  /* SCM_ARRAY_HANDLE_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/

libguile/array-map.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1998,2000,2001,2004,2005, 2006, 2008, 2009 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
@@ -17,10 +17,6 @@
  */
 
 
-/*
-  HWN:FIXME::
-  Someone should rename this to arraymap.c; that would reflect the
-  contents better.  */
 
 
 
@@ -31,7 +27,7 @@
 
 #include "libguile/_scm.h"
 #include "libguile/strings.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/smob.h"
 #include "libguile/chars.h"
 #include "libguile/eq.h"
@@ -39,11 +35,14 @@
 #include "libguile/feature.h"
 #include "libguile/root.h"
 #include "libguile/vectors.h"
+#include "libguile/bitvectors.h"
 #include "libguile/srfi-4.h"
 #include "libguile/dynwind.h"
+#include "libguile/generalized-arrays.h"
+#include "libguile/generalized-vectors.h"
 
 #include "libguile/validate.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 
 
 typedef struct
@@ -223,7 +222,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
       if (!SCM_I_ARRAYP (vra0))
 	{
 	  size_t length = scm_c_generalized_vector_length (vra0);
-	  vra1 = scm_i_make_ra (1, 0);
+	  vra1 = scm_i_make_array (1);
 	  SCM_I_ARRAY_BASE (vra1) = 0;
 	  SCM_I_ARRAY_DIMS (vra1)->lbnd = 0;
 	  SCM_I_ARRAY_DIMS (vra1)->ubnd = length - 1;
@@ -236,7 +235,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
       for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
 	{
 	  ra1 = SCM_CAR (z);
-	  vra1 = scm_i_make_ra (1, 0);
+	  vra1 = scm_i_make_array (1);
 	  SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
 	  SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
 	  if (!SCM_I_ARRAYP (ra1))
@@ -259,7 +258,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
       return (SCM_UNBNDP (data) ? cproc(vra0, lvra) : cproc(vra0, data, lvra));
     case 1:
     gencase:			/* Have to loop over all dimensions. */
-    vra0 = scm_i_make_ra (1, 0);
+      vra0 = scm_i_make_array (1);
     if (SCM_I_ARRAYP (ra0))
       {
 	kmax = SCM_I_ARRAY_NDIM (ra0) - 1;
@@ -294,7 +293,7 @@ scm_ramapc (int (*cproc)(), SCM data, SCM ra0, SCM lra, const char *what)
     for (z = lra; SCM_NIMP (z); z = SCM_CDR (z))
       {
 	ra1 = SCM_CAR (z);
-	vra1 = scm_i_make_ra (1, 0);
+	vra1 = scm_i_make_array (1);
 	SCM_I_ARRAY_DIMS (vra1)->lbnd = SCM_I_ARRAY_DIMS (vra0)->lbnd;
 	SCM_I_ARRAY_DIMS (vra1)->ubnd = SCM_I_ARRAY_DIMS (vra0)->ubnd;
 	if (SCM_I_ARRAYP (ra1))
@@ -1222,13 +1221,13 @@ init_raprocs (ra_iproc *subra)
 
 
 void
-scm_init_ramap ()
+scm_init_array_map (void)
 {
   init_raprocs (ra_rpsubrs);
   init_raprocs (ra_asubrs);
   scm_c_define_subr (s_array_equal_p, scm_tc7_rpsubr, scm_array_equal_p);
   scm_smobs[SCM_TC2SMOBNUM (scm_i_tc16_array)].equalp = scm_raequal;
-#include "libguile/ramap.x"
+#include "libguile/array-map.x"
   scm_add_feature (s_scm_array_for_each);
 }
 

libguile/array-map.h

@@ -1,9 +1,9 @@
 /* classes: h_files */
 
-#ifndef SCM_RAMAP_H
+#ifndef SCM_ARRAY_MAP_H
-#define SCM_RAMAP_H
+#define SCM_ARRAY_MAP_H
 
-/* Copyright (C) 1995,1996,1997,2000, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000, 2006, 2008, 2009 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
@@ -48,9 +48,9 @@ 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_INTERNAL void scm_init_ramap (void);
+SCM_INTERNAL void scm_init_array_map (void);
 
-#endif  /* SCM_RAMAP_H */
+#endif  /* SCM_ARRAY_MAP_H */
 
 /*
   Local Variables:

libguile/arrays.h

@@ -0,0 +1,91 @@
+/* classes: h_files */
+
+#ifndef SCM_ARRAY_H
+#define SCM_ARRAY_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 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 3 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 "libguile/__scm.h"
+#include "libguile/print.h"
+
+
+
+/* Multidimensional arrays. Woo hoo!
+   Also see ....
+ */
+
+
+/** Arrays */
+
+SCM_API SCM scm_make_array (SCM fill, SCM bounds);
+SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
+SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
+                                             const void *bytes,
+                                             size_t byte_len);
+SCM_API SCM scm_shared_array_root (SCM ra);
+SCM_API SCM scm_shared_array_offset (SCM ra);
+SCM_API SCM scm_shared_array_increments (SCM ra);
+SCM_API SCM scm_make_shared_array (SCM oldra, SCM mapfunc, SCM dims);
+SCM_API SCM scm_transpose_array (SCM ra, SCM args);
+SCM_API SCM scm_array_contents (SCM ra, SCM strict);
+SCM_API SCM scm_uniform_array_read_x (SCM ra, SCM port_or_fd,
+				      SCM start, SCM end);
+SCM_API SCM scm_uniform_array_write (SCM v, SCM port_or_fd,
+				     SCM start, SCM end);
+SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
+SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
+
+SCM_API SCM scm_ra2contig (SCM ra, int copy);
+
+/* internal. */
+
+typedef struct scm_i_t_array
+{
+  SCM v;  /* the contents of the array, e.g., a vector or uniform vector.  */
+  unsigned long base;
+} scm_i_t_array;
+
+SCM_API scm_t_bits scm_i_tc16_array;
+
+#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 16)
+
+#define SCM_I_ARRAYP(a)	    SCM_TYP16_PREDICATE (scm_i_tc16_array, a)
+#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x) >> 17))
+#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0(x) & SCM_I_ARRAY_FLAG_CONTIGUOUS)
+
+#define SCM_I_ARRAY_MEM(a)  ((scm_i_t_array *) SCM_CELL_WORD_1 (a))
+#define SCM_I_ARRAY_V(a)    (SCM_I_ARRAY_MEM (a)->v)
+#define SCM_I_ARRAY_BASE(a) (SCM_I_ARRAY_MEM (a)->base)
+#define SCM_I_ARRAY_DIMS(a) \
+  ((scm_t_array_dim *)((char *) SCM_I_ARRAY_MEM (a) + sizeof (scm_i_t_array)))
+
+SCM_INTERNAL SCM scm_i_make_array (int ndim);
+SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
+
+SCM_INTERNAL void scm_init_arrays (void);
+
+#endif  /* SCM_ARRAYS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/

libguile/bitvectors.c

@@ -0,0 +1,910 @@
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009 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 3 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
+ */
+
+
+
+
+#ifdef HAVE_CONFIG_H
+#  include <config.h>
+#endif
+
+#include <string.h>
+
+#include "libguile/_scm.h"
+#include "libguile/__scm.h"
+#include "libguile/smob.h"
+#include "libguile/strings.h"
+#include "libguile/array-handle.h"
+#include "libguile/bitvectors.h"
+#include "libguile/arrays.h"
+#include "libguile/generalized-vectors.h"
+#include "libguile/srfi-4.h"
+
+/* Bit vectors. Would be nice if they were implemented on top of bytevectors,
+ * but alack, all we have is this crufty C.
+ */
+
+static scm_t_bits scm_tc16_bitvector;
+
+#define IS_BITVECTOR(obj)       SCM_SMOB_PREDICATE(scm_tc16_bitvector,(obj))
+#define BITVECTOR_BITS(obj)     ((scm_t_uint32 *)SCM_SMOB_DATA(obj))
+#define BITVECTOR_LENGTH(obj)   ((size_t)SCM_SMOB_DATA_2(obj))
+
+static size_t
+bitvector_free (SCM vec)
+{
+  scm_gc_free (BITVECTOR_BITS (vec),
+	       sizeof (scm_t_uint32) * ((BITVECTOR_LENGTH (vec)+31)/32),
+	       "bitvector");
+  return 0;
+}
+
+static int
+bitvector_print (SCM vec, SCM port, scm_print_state *pstate)
+{
+  size_t bit_len = BITVECTOR_LENGTH (vec);
+  size_t word_len = (bit_len+31)/32;
+  scm_t_uint32 *bits = BITVECTOR_BITS (vec);
+  size_t i, j;
+
+  scm_puts ("#*", port);
+  for (i = 0; i < word_len; i++, bit_len -= 32)
+    {
+      scm_t_uint32 mask = 1;
+      for (j = 0; j < 32 && j < bit_len; j++, mask <<= 1)
+	scm_putc ((bits[i] & mask)? '1' : '0', port);
+    }
+    
+  return 1;
+}
+
+static SCM
+bitvector_equalp (SCM vec1, SCM vec2)
+{
+  size_t bit_len = BITVECTOR_LENGTH (vec1);
+  size_t word_len = (bit_len + 31) / 32;
+  scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - bit_len);
+  scm_t_uint32 *bits1 = BITVECTOR_BITS (vec1);
+  scm_t_uint32 *bits2 = BITVECTOR_BITS (vec2);
+
+  /* compare lengths */
+  if (BITVECTOR_LENGTH (vec2) != bit_len)
+    return SCM_BOOL_F;
+  /* avoid underflow in word_len-1 below. */
+  if (bit_len == 0)
+    return SCM_BOOL_T;
+  /* compare full words */
+  if (memcmp (bits1, bits2, sizeof (scm_t_uint32) * (word_len-1)))
+    return SCM_BOOL_F;
+  /* compare partial last words */
+  if ((bits1[word_len-1] & last_mask) != (bits2[word_len-1] & last_mask))
+    return SCM_BOOL_F;
+  return SCM_BOOL_T;
+}
+
+int
+scm_is_bitvector (SCM vec)
+{
+  return IS_BITVECTOR (vec);
+}
+
+SCM_DEFINE (scm_bitvector_p, "bitvector?", 1, 0, 0,
+	    (SCM obj),
+	    "Return @code{#t} when @var{obj} is a bitvector, else\n"
+	    "return @code{#f}.")
+#define FUNC_NAME s_scm_bitvector_p
+{
+  return scm_from_bool (scm_is_bitvector (obj));
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_make_bitvector (size_t len, SCM fill)
+{
+  size_t word_len = (len + 31) / 32;
+  scm_t_uint32 *bits;
+  SCM res;
+
+  bits = scm_gc_malloc (sizeof (scm_t_uint32) * word_len,
+			"bitvector");
+  SCM_NEWSMOB2 (res, scm_tc16_bitvector, bits, len);
+
+  if (!SCM_UNBNDP (fill))
+    scm_bitvector_fill_x (res, fill);
+      
+  return res;
+}
+
+SCM_DEFINE (scm_make_bitvector, "make-bitvector", 1, 1, 0,
+	    (SCM len, SCM fill),
+	    "Create a new bitvector of length @var{len} and\n"
+	    "optionally initialize all elements to @var{fill}.")
+#define FUNC_NAME s_scm_make_bitvector
+{
+  return scm_c_make_bitvector (scm_to_size_t (len), fill);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector, "bitvector", 0, 0, 1,
+	    (SCM bits),
+	    "Create a new bitvector with the arguments as elements.")
+#define FUNC_NAME s_scm_bitvector
+{
+  return scm_list_to_bitvector (bits);
+}
+#undef FUNC_NAME
+
+size_t
+scm_c_bitvector_length (SCM vec)
+{
+  scm_assert_smob_type (scm_tc16_bitvector, vec);
+  return BITVECTOR_LENGTH (vec);
+}
+
+SCM_DEFINE (scm_bitvector_length, "bitvector-length", 1, 0, 0,
+	    (SCM vec),
+	    "Return the length of the bitvector @var{vec}.")
+#define FUNC_NAME s_scm_bitvector_length
+{
+  return scm_from_size_t (scm_c_bitvector_length (vec));
+}
+#undef FUNC_NAME
+
+const scm_t_uint32 *
+scm_array_handle_bit_elements (scm_t_array_handle *h)
+{
+  return scm_array_handle_bit_writable_elements (h);
+}
+
+scm_t_uint32 *
+scm_array_handle_bit_writable_elements (scm_t_array_handle *h)
+{
+  SCM vec = h->array;
+  if (SCM_I_ARRAYP (vec))
+    vec = SCM_I_ARRAY_V (vec);
+  if (IS_BITVECTOR (vec))
+    return BITVECTOR_BITS (vec) + h->base/32;
+  scm_wrong_type_arg_msg (NULL, 0, h->array, "bit array");
+}
+
+size_t
+scm_array_handle_bit_elements_offset (scm_t_array_handle *h)
+{
+  return h->base % 32;
+}
+
+const scm_t_uint32 *
+scm_bitvector_elements (SCM vec,
+			scm_t_array_handle *h,
+			size_t *offp,
+			size_t *lenp,
+			ssize_t *incp)
+{
+  return scm_bitvector_writable_elements (vec, h, offp, lenp, incp);
+}
+
+
+scm_t_uint32 *
+scm_bitvector_writable_elements (SCM vec,
+				 scm_t_array_handle *h,
+				 size_t *offp,
+				 size_t *lenp,
+				 ssize_t *incp)
+{
+  scm_generalized_vector_get_handle (vec, h);
+  if (offp)
+    {
+      scm_t_array_dim *dim = scm_array_handle_dims (h);
+      *offp = scm_array_handle_bit_elements_offset (h);
+      *lenp = dim->ubnd - dim->lbnd + 1;
+      *incp = dim->inc;
+    }
+  return scm_array_handle_bit_writable_elements (h);
+}
+
+SCM
+scm_c_bitvector_ref (SCM vec, size_t idx)
+{
+  scm_t_array_handle handle;
+  const scm_t_uint32 *bits;
+
+  if (IS_BITVECTOR (vec))
+    {
+      if (idx >= BITVECTOR_LENGTH (vec))
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      bits = BITVECTOR_BITS(vec);
+      return scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+    }
+  else
+    {
+      SCM res;
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+      res = scm_from_bool (bits[idx/32] & (1L << (idx%32)));
+      scm_array_handle_release (&handle);
+      return res;
+    }
+}
+
+SCM_DEFINE (scm_bitvector_ref, "bitvector-ref", 2, 0, 0,
+	    (SCM vec, SCM idx),
+	    "Return the element at index @var{idx} of the bitvector\n"
+	    "@var{vec}.")
+#define FUNC_NAME s_scm_bitvector_ref
+{
+  return scm_c_bitvector_ref (vec, scm_to_size_t (idx));
+}
+#undef FUNC_NAME
+
+void
+scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val)
+{
+  scm_t_array_handle handle;
+  scm_t_uint32 *bits, mask;
+
+  if (IS_BITVECTOR (vec))
+    {
+      if (idx >= BITVECTOR_LENGTH (vec))
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      bits = BITVECTOR_BITS(vec);
+    }
+  else
+    {
+      size_t len, off;
+      ssize_t inc;
+  
+      bits = scm_bitvector_writable_elements (vec, &handle, &off, &len, &inc);
+      if (idx >= len)
+	scm_out_of_range (NULL, scm_from_size_t (idx));
+      idx = idx*inc + off;
+    }
+
+  mask = 1L << (idx%32);
+  if (scm_is_true (val))
+    bits[idx/32] |= mask;
+  else
+    bits[idx/32] &= ~mask;
+
+  if (!IS_BITVECTOR (vec))
+      scm_array_handle_release (&handle);
+}
+
+SCM_DEFINE (scm_bitvector_set_x, "bitvector-set!", 3, 0, 0,
+	    (SCM vec, SCM idx, SCM val),
+	    "Set the element at index @var{idx} of the bitvector\n"
+	    "@var{vec} when @var{val} is true, else clear it.")
+#define FUNC_NAME s_scm_bitvector_set_x
+{
+  scm_c_bitvector_set_x (vec, scm_to_size_t (idx), val);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_fill_x, "bitvector-fill!", 2, 0, 0,
+	    (SCM vec, SCM val),
+	    "Set all elements of the bitvector\n"
+	    "@var{vec} when @var{val} is true, else clear them.")
+#define FUNC_NAME s_scm_bitvector_fill_x
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+
+  bits = scm_bitvector_writable_elements (vec, &handle,
+					  &off, &len, &inc);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+
+      if (scm_is_true (val))
+	{
+	  memset (bits, 0xFF, sizeof(scm_t_uint32)*(word_len-1));
+	  bits[word_len-1] |= last_mask;
+	}
+      else
+	{
+	  memset (bits, 0x00, sizeof(scm_t_uint32)*(word_len-1));
+	  bits[word_len-1] &= ~last_mask;
+	}
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+	scm_array_handle_set (&handle, i*inc, val);
+    }
+
+  scm_array_handle_release (&handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_list_to_bitvector, "list->bitvector", 1, 0, 0,
+	    (SCM list),
+	    "Return a new bitvector initialized with the elements\n"
+	    "of @var{list}.")
+#define FUNC_NAME s_scm_list_to_bitvector
+{
+  size_t bit_len = scm_to_size_t (scm_length (list));
+  SCM vec = scm_c_make_bitvector (bit_len, SCM_UNDEFINED);
+  size_t word_len = (bit_len+31)/32;
+  scm_t_array_handle handle;
+  scm_t_uint32 *bits = scm_bitvector_writable_elements (vec, &handle,
+							NULL, NULL, NULL);
+  size_t i, j;
+
+  for (i = 0; i < word_len && scm_is_pair (list); i++, bit_len -= 32)
+    {
+      scm_t_uint32 mask = 1;
+      bits[i] = 0;
+      for (j = 0; j < 32 && j < bit_len;
+	   j++, mask <<= 1, list = SCM_CDR (list))
+	if (scm_is_true (SCM_CAR (list)))
+	  bits[i] |= mask;
+    }
+
+  scm_array_handle_release (&handle);
+
+  return vec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bitvector_to_list, "bitvector->list", 1, 0, 0,
+	    (SCM vec),
+	    "Return a new list initialized with the elements\n"
+	    "of the bitvector @var{vec}.")
+#define FUNC_NAME s_scm_bitvector_to_list
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+  SCM res = SCM_EOL;
+
+  bits = scm_bitvector_writable_elements (vec, &handle,
+					  &off, &len, &inc);
+
+  if (off == 0 && inc == 1)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      size_t i, j;
+
+      for (i = 0; i < word_len; i++, len -= 32)
+	{
+	  scm_t_uint32 mask = 1;
+	  for (j = 0; j < 32 && j < len; j++, mask <<= 1)
+	    res = scm_cons ((bits[i] & mask)? SCM_BOOL_T : SCM_BOOL_F, res);
+	}
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+	res = scm_cons (scm_array_handle_ref (&handle, i*inc), res);
+    }
+
+  scm_array_handle_release (&handle);
+  
+  return scm_reverse_x (res, SCM_EOL);
+}
+#undef FUNC_NAME
+
+/* From mmix-arith.w by Knuth.
+
+  Here's a fun way to count the number of bits in a tetrabyte.
+
+  [This classical trick is called the ``Gillies--Miller method for
+  sideways addition'' in {\sl The Preparation of Programs for an
+  Electronic Digital Computer\/} by Wilkes, Wheeler, and Gill, second
+  edition (Reading, Mass.:\ Addison--Wesley, 1957), 191--193. Some of
+  the tricks used here were suggested by Balbir Singh, Peter
+  Rossmanith, and Stefan Schwoon.]
+*/
+
+static size_t
+count_ones (scm_t_uint32 x)
+{
+  x=x-((x>>1)&0x55555555);
+  x=(x&0x33333333)+((x>>2)&0x33333333);
+  x=(x+(x>>4))&0x0f0f0f0f;
+  x=x+(x>>8);
+  return (x+(x>>16)) & 0xff;
+}
+
+SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0,
+	    (SCM b, SCM bitvector),
+	    "Return the number of occurrences of the boolean @var{b} in\n"
+	    "@var{bitvector}.")
+#define FUNC_NAME s_scm_bit_count
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+  int bit = scm_to_bool (b);
+  size_t count = 0;
+
+  bits = scm_bitvector_writable_elements (bitvector, &handle,
+					  &off, &len, &inc);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      /* the usual case
+       */
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t i;
+
+      for (i = 0; i < word_len-1; i++)
+	count += count_ones (bits[i]);
+      count += count_ones (bits[i] & last_mask);
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+	if (scm_is_true (scm_array_handle_ref (&handle, i*inc)))
+	  count++;
+    }
+  
+  scm_array_handle_release (&handle);
+
+  return scm_from_size_t (bit? count : len-count);
+}
+#undef FUNC_NAME
+
+/* returns 32 for x == 0. 
+*/
+static size_t
+find_first_one (scm_t_uint32 x)
+{
+  size_t pos = 0;
+  /* do a binary search in x. */
+  if ((x & 0xFFFF) == 0)
+    x >>= 16, pos += 16;
+  if ((x & 0xFF) == 0)
+    x >>= 8, pos += 8;
+  if ((x & 0xF) == 0)
+    x >>= 4, pos += 4;
+  if ((x & 0x3) == 0)
+    x >>= 2, pos += 2;
+  if ((x & 0x1) == 0)
+    pos += 1;
+  return pos;
+}
+
+SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0,
+           (SCM item, SCM v, SCM k),
+	    "Return the index of the first occurrance of @var{item} in bit\n"
+	    "vector @var{v}, starting from @var{k}.  If there is no\n"
+	    "@var{item} entry between @var{k} and the end of\n"
+	    "@var{bitvector}, then return @code{#f}.  For example,\n"
+	    "\n"
+	    "@example\n"
+	    "(bit-position #t #*000101 0)  @result{} 3\n"
+	    "(bit-position #f #*0001111 3) @result{} #f\n"
+	    "@end example")
+#define FUNC_NAME s_scm_bit_position
+{
+  scm_t_array_handle handle;
+  size_t off, len, first_bit;
+  ssize_t inc;
+  const scm_t_uint32 *bits;
+  int bit = scm_to_bool (item);
+  SCM res = SCM_BOOL_F;
+  
+  bits = scm_bitvector_elements (v, &handle, &off, &len, &inc);
+  first_bit = scm_to_unsigned_integer (k, 0, len);
+
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      size_t i, word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask =  ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t first_word = first_bit / 32;
+      scm_t_uint32 first_mask =
+	((scm_t_uint32)-1) << (first_bit - 32*first_word);
+      scm_t_uint32 w;
+      
+      for (i = first_word; i < word_len; i++)
+	{
+	  w = (bit? bits[i] : ~bits[i]);
+	  if (i == first_word)
+	    w &= first_mask;
+	  if (i == word_len-1)
+	    w &= last_mask;
+	  if (w)
+	    {
+	      res = scm_from_size_t (32*i + find_first_one (w));
+	      break;
+	    }
+	}
+    }
+  else
+    {
+      size_t i;
+      for (i = first_bit; i < len; i++)
+	{
+	  SCM elt = scm_array_handle_ref (&handle, i*inc);
+	  if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+	    {
+	      res = scm_from_size_t (i);
+	      break;
+	    }
+	}
+    }
+
+  scm_array_handle_release (&handle);
+
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bit_set_star_x, "bit-set*!", 3, 0, 0,
+	    (SCM v, SCM kv, SCM obj),
+	    "Set entries of bit vector @var{v} to @var{obj}, with @var{kv}\n"
+	    "selecting the entries to change.  The return value is\n"
+	    "unspecified.\n"
+	    "\n"
+	    "If @var{kv} is a bit vector, then those entries where it has\n"
+	    "@code{#t} are the ones in @var{v} which are set to @var{obj}.\n"
+	    "@var{kv} and @var{v} must be the same length.  When @var{obj}\n"
+	    "is @code{#t} it's like @var{kv} is OR'ed into @var{v}.  Or when\n"
+	    "@var{obj} is @code{#f} it can be seen as an ANDNOT.\n"
+	    "\n"
+	    "@example\n"
+	    "(define bv #*01000010)\n"
+	    "(bit-set*! bv #*10010001 #t)\n"
+	    "bv\n"
+	    "@result{} #*11010011\n"
+	    "@end example\n"
+	    "\n"
+	    "If @var{kv} is a u32vector, then its elements are\n"
+	    "indices into @var{v} which are set to @var{obj}.\n"
+	    "\n"
+	    "@example\n"
+	    "(define bv #*01000010)\n"
+	    "(bit-set*! bv #u32(5 2 7) #t)\n"
+	    "bv\n"
+	    "@result{} #*01100111\n"
+	    "@end example")
+#define FUNC_NAME s_scm_bit_set_star_x
+{
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  scm_t_uint32 *v_bits;
+  int bit;
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  bit = scm_to_bool (obj);
+
+  v_bits = scm_bitvector_writable_elements (v, &v_handle,
+					    &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_off, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_bits;
+      
+      kv_bits = scm_bitvector_elements (v, &kv_handle,
+					&kv_off, &kv_len, &kv_inc);
+
+      if (v_len != kv_len)
+	scm_misc_error (NULL,
+			"bit vectors must have equal length",
+			SCM_EOL);
+
+      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
+	{
+	  size_t word_len = (kv_len + 31) / 32;
+	  scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+	  size_t i;
+ 
+	  if (bit == 0)
+	    {
+	      for (i = 0; i < word_len-1; i++)
+		v_bits[i] &= ~kv_bits[i];
+	      v_bits[i] &= ~(kv_bits[i] & last_mask);
+	    }
+	  else
+	    {
+	      for (i = 0; i < word_len-1; i++)
+		v_bits[i] |= kv_bits[i];
+	      v_bits[i] |= kv_bits[i] & last_mask;
+	    }
+	}
+      else
+	{
+	  size_t i;
+	  for (i = 0; i < kv_len; i++)
+	    if (scm_is_true (scm_array_handle_ref (&kv_handle, i*kv_inc)))
+	      scm_array_handle_set (&v_handle, i*v_inc, obj);
+	}
+      
+      scm_array_handle_release (&kv_handle);
+
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t i, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+	scm_array_handle_set (&v_handle, (*kv_elts)*v_inc, obj);
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else 
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
+           (SCM v, SCM kv, SCM obj),
+	    "Return a count of how many entries in bit vector @var{v} are\n"
+	    "equal to @var{obj}, with @var{kv} selecting the entries to\n"
+	    "consider.\n"
+	    "\n"
+	    "If @var{kv} is a bit vector, then those entries where it has\n"
+	    "@code{#t} are the ones in @var{v} which are considered.\n"
+	    "@var{kv} and @var{v} must be the same length.\n"
+	    "\n"
+	    "If @var{kv} is a u32vector, then it contains\n"
+	    "the indexes in @var{v} to consider.\n"
+	    "\n"
+	    "For example,\n"
+	    "\n"
+	    "@example\n"
+	    "(bit-count* #*01110111 #*11001101 #t) @result{} 3\n"
+	    "(bit-count* #*01110111 #u32(7 0 4) #f)  @result{} 2\n"
+	    "@end example")
+#define FUNC_NAME s_scm_bit_count_star
+{
+  scm_t_array_handle v_handle;
+  size_t v_off, v_len;
+  ssize_t v_inc;
+  const scm_t_uint32 *v_bits;
+  size_t count = 0;
+  int bit;
+
+  /* Validate that OBJ is a boolean so this is done even if we don't
+     need BIT.
+  */
+  bit = scm_to_bool (obj);
+
+  v_bits = scm_bitvector_elements (v, &v_handle,
+				   &v_off, &v_len, &v_inc);
+
+  if (scm_is_bitvector (kv))
+    {
+      scm_t_array_handle kv_handle;
+      size_t kv_off, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_bits;
+      
+      kv_bits = scm_bitvector_elements (v, &kv_handle,
+					&kv_off, &kv_len, &kv_inc);
+
+      if (v_len != kv_len)
+	scm_misc_error (NULL,
+			"bit vectors must have equal length",
+			SCM_EOL);
+
+      if (v_off == 0 && v_inc == 1 && kv_off == 0 && kv_inc == 1 && kv_len > 0)
+	{
+	  size_t i, word_len = (kv_len + 31) / 32;
+	  scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - kv_len);
+	  scm_t_uint32 xor_mask = bit? 0 : ((scm_t_uint32)-1);
+
+	  for (i = 0; i < word_len-1; i++)
+	    count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i]);
+	  count += count_ones ((v_bits[i]^xor_mask) & kv_bits[i] & last_mask);
+ 	}
+      else
+	{
+	  size_t i;
+	  for (i = 0; i < kv_len; i++)
+	    if (scm_is_true (scm_array_handle_ref (&kv_handle, i)))
+	      {
+		SCM elt = scm_array_handle_ref (&v_handle, i*v_inc);
+		if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+		  count++;
+	      }
+	}
+      
+      scm_array_handle_release (&kv_handle);
+
+    }
+  else if (scm_is_true (scm_u32vector_p (kv)))
+    {
+      scm_t_array_handle kv_handle;
+      size_t i, kv_len;
+      ssize_t kv_inc;
+      const scm_t_uint32 *kv_elts;
+
+      kv_elts = scm_u32vector_elements (kv, &kv_handle, &kv_len, &kv_inc);
+      for (i = 0; i < kv_len; i++, kv_elts += kv_inc)
+	{
+	  SCM elt = scm_array_handle_ref (&v_handle, (*kv_elts)*v_inc);
+	  if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt)))
+	    count++;
+	}
+
+      scm_array_handle_release (&kv_handle);
+    }
+  else 
+    scm_wrong_type_arg_msg (NULL, 0, kv, "bitvector or u32vector");
+
+  scm_array_handle_release (&v_handle);
+
+  return scm_from_size_t (count);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_bit_invert_x, "bit-invert!", 1, 0, 0, 
+           (SCM v),
+	    "Modify the bit vector @var{v} by replacing each element with\n"
+	    "its negation.")
+#define FUNC_NAME s_scm_bit_invert_x
+{
+  scm_t_array_handle handle;
+  size_t off, len;
+  ssize_t inc;
+  scm_t_uint32 *bits;
+
+  bits = scm_bitvector_writable_elements (v, &handle, &off, &len, &inc);
+  
+  if (off == 0 && inc == 1 && len > 0)
+    {
+      size_t word_len = (len + 31) / 32;
+      scm_t_uint32 last_mask = ((scm_t_uint32)-1) >> (32*word_len - len);
+      size_t i;
+
+      for (i = 0; i < word_len-1; i++)
+	bits[i] = ~bits[i];
+      bits[i] = bits[i] ^ last_mask;
+    }
+  else
+    {
+      size_t i;
+      for (i = 0; i < len; i++)
+	scm_array_handle_set (&handle, i*inc,
+			      scm_not (scm_array_handle_ref (&handle, i*inc)));
+    }
+
+  scm_array_handle_release (&handle);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+SCM
+scm_istr2bve (SCM str)
+{
+  scm_t_array_handle handle;
+  size_t len = scm_i_string_length (str);
+  SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED);
+  SCM res = vec;
+
+  scm_t_uint32 mask;
+  size_t k, j;
+  const char *c_str;
+  scm_t_uint32 *data;
+
+  data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL);
+  c_str = scm_i_string_chars (str);
+
+  for (k = 0; k < (len + 31) / 32; k++)
+    {
+      data[k] = 0L;
+      j = len - k * 32;
+      if (j > 32)
+	j = 32;
+      for (mask = 1L; j--; mask <<= 1)
+	switch (*c_str++)
+	  {
+	  case '0':
+	    break;
+	  case '1':
+	    data[k] |= mask;
+	    break;
+	  default:
+	    res = SCM_BOOL_F;
+	    goto exit;
+	  }
+    }
+  
+ exit:
+  scm_array_handle_release (&handle);
+  scm_remember_upto_here_1 (str);
+  return res;
+}
+
+/* FIXME: h->array should be h->vector */
+static SCM
+bitvector_handle_ref (scm_t_array_handle *h, size_t pos)
+{
+  return scm_c_bitvector_ref (h->array, pos);
+}
+
+static void
+bitvector_handle_set (scm_t_array_handle *h, size_t pos, SCM val)
+{
+  scm_c_bitvector_set_x (h->array, pos, val);
+}
+
+static void
+bitvector_get_handle (SCM bv, scm_t_array_handle *h)
+{
+  h->array = bv;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = BITVECTOR_LENGTH (bv) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_ARRAY_ELEMENT_TYPE_BIT;
+  h->elements = h->writable_elements = BITVECTOR_BITS (bv);
+}
+
+SCM_ARRAY_IMPLEMENTATION (scm_tc16_bitvector, 0xffff,
+                          bitvector_handle_ref, bitvector_handle_set,
+                          bitvector_get_handle);
+SCM_VECTOR_IMPLEMENTATION (SCM_ARRAY_ELEMENT_TYPE_BIT, scm_make_bitvector);
+
+void
+scm_init_bitvectors ()
+{
+  scm_tc16_bitvector = scm_make_smob_type ("bitvector", 0);
+  scm_set_smob_free (scm_tc16_bitvector, bitvector_free);
+  scm_set_smob_print (scm_tc16_bitvector, bitvector_print);
+  scm_set_smob_equalp (scm_tc16_bitvector, bitvector_equalp);
+
+#include "libguile/bitvectors.x"
+}
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/

libguile/bitvectors.h

@@ -0,0 +1,81 @@
+/* classes: h_files */
+
+#ifndef SCM_BITVECTORS_H
+#define SCM_BITVECTORS_H
+
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009 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 3 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 "libguile/__scm.h"
+#include "libguile/array-handle.h"
+
+
+
+/* Bitvectors. Exciting stuff, maybe!
+ */
+
+
+/** Bit vectors */
+
+SCM_API SCM scm_bitvector_p (SCM vec);
+SCM_API SCM scm_bitvector (SCM bits);
+SCM_API SCM scm_make_bitvector (SCM len, SCM fill);
+SCM_API SCM scm_bitvector_length (SCM vec);
+SCM_API SCM scm_bitvector_ref (SCM vec, SCM idx);
+SCM_API SCM scm_bitvector_set_x (SCM vec, SCM idx, SCM val);
+SCM_API SCM scm_list_to_bitvector (SCM list);
+SCM_API SCM scm_bitvector_to_list (SCM vec);
+SCM_API SCM scm_bitvector_fill_x (SCM vec, SCM val);
+
+SCM_API SCM scm_bit_count (SCM item, SCM seq);
+SCM_API SCM scm_bit_position (SCM item, SCM v, SCM k);
+SCM_API SCM scm_bit_set_star_x (SCM v, SCM kv, SCM obj);
+SCM_API SCM scm_bit_count_star (SCM v, SCM kv, SCM obj);
+SCM_API SCM scm_bit_invert_x (SCM v);
+SCM_API SCM scm_istr2bve (SCM str);
+
+SCM_API int scm_is_bitvector (SCM obj);
+SCM_API SCM scm_c_make_bitvector (size_t len, SCM fill);
+SCM_API size_t scm_c_bitvector_length (SCM vec);
+SCM_API SCM scm_c_bitvector_ref (SCM vec, size_t idx);
+SCM_API void scm_c_bitvector_set_x (SCM vec, size_t idx, SCM val);
+SCM_API const scm_t_uint32 *scm_array_handle_bit_elements (scm_t_array_handle *h);
+SCM_API scm_t_uint32 *scm_array_handle_bit_writable_elements (scm_t_array_handle *h);
+SCM_API size_t scm_array_handle_bit_elements_offset (scm_t_array_handle *h);
+SCM_API const scm_t_uint32 *scm_bitvector_elements (SCM vec,
+						    scm_t_array_handle *h,
+						    size_t *offp,
+						    size_t *lenp,
+						    ssize_t *incp);
+SCM_API scm_t_uint32 *scm_bitvector_writable_elements (SCM vec, 
+						       scm_t_array_handle *h,
+						       size_t *offp,
+						       size_t *lenp,
+						       ssize_t *incp);
+
+SCM_INTERNAL void scm_init_bitvectors (void);
+
+#endif  /* SCM_BITVECTORS_H */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/

libguile/bytevectors.c

@@ -31,7 +31,9 @@
 #include "libguile/strings.h"
 #include "libguile/validate.h"
 #include "libguile/ieee-754.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
+#include "libguile/array-handle.h"
+#include "libguile/uniform.h"
 #include "libguile/srfi-4.h"
 
 #include <byteswap.h>
@@ -175,48 +177,99 @@
 
 scm_t_bits scm_tc16_bytevector;
 
+#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
+#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)	\
+  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
 #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len)            \
   SCM_SET_SMOB_DATA ((_bv), (scm_t_bits) (_len))
 #define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _buf)          \
   SCM_SET_SMOB_DATA_2 ((_bv), (scm_t_bits) (_buf))
+#define SCM_BYTEVECTOR_SET_INLINE(bv)                                   \
+  SCM_SET_SMOB_FLAGS (bv, SCM_SMOB_FLAGS (bv) | SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_SET_ELEMENT_TYPE(bv, hint)                          \
+  SCM_SET_SMOB_FLAGS (bv, (SCM_SMOB_FLAGS (bv) & 0xFF) | (hint << 8))
+#define SCM_BYTEVECTOR_TYPE_SIZE(var)                           \
+  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
+#define SCM_BYTEVECTOR_TYPED_LENGTH(var)                        \
+  SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var)
 
 /* The empty bytevector.  */
 SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
 
 static inline SCM
-make_bytevector_from_buffer (size_t len, signed char *contents)
+make_bytevector_from_buffer (size_t len, void *contents,
+                             scm_t_array_element_type element_type)
 {
-  /* Assuming LEN > SCM_BYTEVECTOR_INLINE_THRESHOLD.  */
+  SCM ret;
-  SCM_RETURN_NEWSMOB2 (scm_tc16_bytevector, len, contents);
+  size_t c_len;
+  
+  if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+                    || scm_i_array_element_type_sizes[element_type] < 8
+                    || len >= (SCM_I_SIZE_MAX
+                               / (scm_i_array_element_type_sizes[element_type]/8))))
+    /* This would be an internal Guile programming error */
+    abort ();
+  
+  c_len = len * (scm_i_array_element_type_sizes[element_type] / 8);
+  if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+    SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, contents);
+  else
+    {
+      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
+      SCM_BYTEVECTOR_SET_INLINE (ret);
+      if (contents)
+        {
+          memcpy (SCM_BYTEVECTOR_CONTENTS (ret), contents, c_len);
+          scm_gc_free (contents, c_len, SCM_GC_BYTEVECTOR);
+        }
+    }
+  SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+  return ret;
 }
 
 static inline SCM
-make_bytevector (size_t len)
+make_bytevector (size_t len, scm_t_array_element_type element_type)
 {
-  SCM bv;
+  size_t c_len;
 
-  if (SCM_UNLIKELY (len == 0))
+  if (SCM_UNLIKELY (len == 0 && element_type == 0))
-    bv = scm_null_bytevector;
+    return scm_null_bytevector;
+  else if (SCM_UNLIKELY (element_type > SCM_ARRAY_ELEMENT_TYPE_LAST
+                         || scm_i_array_element_type_sizes[element_type] < 8
+                         || len >= (SCM_I_SIZE_MAX
+                                    / (scm_i_array_element_type_sizes[element_type]/8))))
+    /* This would be an internal Guile programming error */
+    abort ();
+
+  c_len = len * (scm_i_array_element_type_sizes[element_type]/8);
+  if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_len))
+    {
+      SCM ret;
+      SCM_NEWSMOB2 (ret, scm_tc16_bytevector, c_len, NULL);
+      SCM_BYTEVECTOR_SET_INLINE (ret);
+      SCM_BYTEVECTOR_SET_ELEMENT_TYPE (ret, element_type);
+      return ret;
+    }
   else
     {
-      signed char *contents = NULL;
+      void *buf = scm_gc_malloc_pointerless (c_len, SCM_GC_BYTEVECTOR);
-
+      return make_bytevector_from_buffer (len, buf, element_type);
-      if (!SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len))
-	contents = (signed char *)
-	  scm_gc_malloc_pointerless (len, SCM_GC_BYTEVECTOR);
-
-      bv = make_bytevector_from_buffer (len, contents);
     }
-
-  return bv;
 }
 
 /* Return a new bytevector of size LEN octets.  */
 SCM
 scm_c_make_bytevector (size_t len)
 {
-  return (make_bytevector (len));
+  return make_bytevector (len, SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
+
+/* Return a new bytevector of size LEN elements.  */
+SCM
+scm_i_make_typed_bytevector (size_t len, scm_t_array_element_type element_type)
+{
+  return make_bytevector (len, element_type);
 }
 
 /* Return a bytevector of size LEN made up of CONTENTS.  The area pointed to
@@ -224,22 +277,14 @@ scm_c_make_bytevector (size_t len)
 SCM
 scm_c_take_bytevector (signed char *contents, size_t len)
 {
-  SCM bv;
+  return make_bytevector_from_buffer (len, contents, SCM_ARRAY_ELEMENT_TYPE_VU8);
+}
 
-  if (SCM_UNLIKELY (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (len)))
+SCM
-    {
+scm_c_take_typed_bytevector (signed char *contents, size_t len,
-      /* Copy CONTENTS into an "in-line" buffer, then free CONTENTS.  */
+                             scm_t_array_element_type element_type)
-      signed char *c_bv;
+{
-
+  return make_bytevector_from_buffer (len, contents, element_type);
-      bv = make_bytevector (len);
-      c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
-      memcpy (c_bv, contents, len);
-      scm_gc_free (contents, len, SCM_GC_BYTEVECTOR);
-    }
-  else
-    bv = make_bytevector_from_buffer (len, contents);
-
-  return bv;
 }
 
 /* Shrink BV to C_NEW_LEN (which is assumed to be smaller than its current
@@ -247,6 +292,10 @@ scm_c_take_bytevector (signed char *contents, size_t len)
 SCM
 scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
 {
+  if (SCM_UNLIKELY (c_new_len % SCM_BYTEVECTOR_TYPE_SIZE (bv)))
+    /* This would be an internal Guile programming error */
+    abort ();
+
   if (!SCM_BYTEVECTOR_INLINE_P (bv))
     {
       size_t c_len;
@@ -260,6 +309,7 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
       if (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (c_new_len))
 	{
 	  /* Copy to the in-line buffer and free the current buffer.  */
+          SCM_BYTEVECTOR_SET_INLINE (bv);
 	  c_new_bv = SCM_BYTEVECTOR_CONTENTS (bv);
 	  memcpy (c_new_bv, c_bv, c_new_len);
 	  scm_gc_free (c_bv, c_len, SCM_GC_BYTEVECTOR);
@@ -272,6 +322,8 @@ scm_i_shrink_bytevector (SCM bv, size_t c_new_len)
 	  SCM_BYTEVECTOR_SET_CONTENTS (bv, c_new_bv);
 	}
     }
+  else
+    SCM_BYTEVECTOR_SET_LENGTH (bv, c_new_len);
 
   return bv;
 }
@@ -330,38 +382,30 @@ scm_c_bytevector_set_x (SCM bv, size_t index, scm_t_uint8 value)
 }
 #undef FUNC_NAME
 
-/* This procedure is used by `scm_c_generalized_vector_set_x ()'.  */
+
-void
+
-scm_i_bytevector_generalized_set_x (SCM bv, size_t index, SCM value)
+
-#define FUNC_NAME "scm_i_bytevector_generalized_set_x"
-{
-  scm_c_bytevector_set_x (bv, index, scm_to_uint8 (value));
-}
-#undef FUNC_NAME
 
 static int
-print_bytevector (SCM bv, SCM port, scm_print_state *pstate)
+print_bytevector (SCM bv, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
-  unsigned c_len, i;
+  ssize_t ubnd, inc, i;
-  unsigned char *c_bv;
+  scm_t_array_handle h;
   
-  c_len = SCM_BYTEVECTOR_LENGTH (bv);
+  scm_array_get_handle (bv, &h);
-  c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
 
-  scm_puts ("#vu8(", port);
+  scm_putc ('#', port);
-  for (i = 0; i < c_len; i++)
+  scm_write (scm_array_handle_element_type (&h), port);
+  scm_putc ('(', port);
+  for (i = h.dims[0].lbnd, ubnd = h.dims[0].ubnd, inc = h.dims[0].inc;
+       i <= ubnd; i += inc)
     {
       if (i > 0)
 	scm_putc (' ', port);
-
+      scm_write (scm_array_handle_ref (&h, i), port);
-      scm_uintprint (c_bv[i], 10, port);
     }
-
   scm_putc (')', port);
 
-  /* Make GCC think we use it.  */
-  scm_remember_upto_here ((SCM) pstate);
-
   return 1;
 }
 
@@ -430,7 +474,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
       c_fill = (signed char) value;
     }
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   if (fill != SCM_UNDEFINED)
     {
       unsigned i;
@@ -556,7 +600,7 @@ SCM_DEFINE (scm_bytevector_copy, "bytevector-copy", 1, 0, 0,
   c_len = SCM_BYTEVECTOR_LENGTH (bv);
   c_bv = SCM_BYTEVECTOR_CONTENTS (bv);
 
-  copy = make_bytevector (c_len);
+  copy = make_bytevector (c_len, SCM_BYTEVECTOR_ELEMENT_TYPE (bv));
   c_copy = SCM_BYTEVECTOR_CONTENTS (copy);
   memcpy (c_copy, c_bv, c_len);
 
@@ -586,7 +630,7 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, "uniform-array->bytevector",
   len = h.dims->inc * (h.dims->ubnd - h.dims->lbnd + 1);
   sz = scm_array_handle_uniform_element_size (&h);
 
-  ret = make_bytevector (len * sz);
+  ret = make_bytevector (len * sz, SCM_ARRAY_ELEMENT_TYPE_VU8);
   memcpy (SCM_BYTEVECTOR_CONTENTS (ret), base, len * sz);
 
   scm_array_handle_release (&h);
@@ -675,7 +719,7 @@ SCM_DEFINE (scm_u8_list_to_bytevector, "u8-list->bytevector", 1, 0, 0,
 
   SCM_VALIDATE_LIST_COPYLEN (1, lst, c_len);
 
-  bv = make_bytevector (c_len);
+  bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   c_bv = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv);
 
   for (i = 0; i < c_len; lst = SCM_CDR (lst), i++)
@@ -1112,7 +1156,7 @@ SCM_DEFINE (scm_bytevector_to_uint_list, "bytevector->uint-list",
   if (SCM_UNLIKELY ((c_size == 0) || (c_size >= (ULONG_MAX >> 3L))))	\
     scm_out_of_range (FUNC_NAME, size);					\
 									\
-  bv = make_bytevector (c_len * c_size);				\
+  bv = make_bytevector (c_len * c_size, SCM_ARRAY_ELEMENT_TYPE_VU8);     \
   c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);				\
 									\
   for (c_bv_ptr = c_bv;							\
@@ -1611,6 +1655,12 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
    _c_type ## _to_foreign_endianness
 
 
+/* FIXME: SCM_VALIDATE_REAL rejects integers, etc. grrr */
+#define VALIDATE_REAL(pos, v) \
+  do { \
+    SCM_ASSERT_TYPE (scm_is_true (scm_rational_p (v)), v, pos, FUNC_NAME, "real"); \
+  } while (0)
+
 /* Templace getters and setters.  */
 
 #define IEEE754_ACCESSOR_PROLOGUE(_type)			\
@@ -1647,7 +1697,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
   _type c_value;						\
 								\
   IEEE754_ACCESSOR_PROLOGUE (_type);				\
-  SCM_VALIDATE_REAL (3, value);					\
+  VALIDATE_REAL (3, value);					\
   SCM_VALIDATE_SYMBOL (4, endianness);				\
   c_value = IEEE754_FROM_SCM (_type) (value);			\
 								\
@@ -1667,7 +1717,7 @@ double_from_foreign_endianness (const union scm_ieee754_double *source)
   _type c_value;					\
 							\
   IEEE754_ACCESSOR_PROLOGUE (_type);			\
-  SCM_VALIDATE_REAL (3, value);				\
+  VALIDATE_REAL (3, value);				\
   c_value = IEEE754_FROM_SCM (_type) (value);		\
 							\
   memcpy (&c_bv[c_index], &c_value, sizeof (c_value));	\
@@ -1883,7 +1933,8 @@ utf_encoding_name (char *name, size_t utf_width, SCM endianness)
       scm_dynwind_begin (0);						\
       scm_dynwind_free (c_utf);						\
 									\
-      utf = make_bytevector (c_utf_len);				\
+      utf = make_bytevector (c_utf_len,					\
+                             SCM_ARRAY_ELEMENT_TYPE_VU8);		\
       memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf,			\
 	      c_utf_len);						\
 									\
@@ -1928,7 +1979,8 @@ SCM_DEFINE (scm_string_to_utf8, "string->utf8",
       scm_dynwind_begin (0);
       scm_dynwind_free (c_utf);
 
-      utf = make_bytevector (UTF_STRLEN (8, c_utf));
+      utf = make_bytevector (UTF_STRLEN (8, c_utf),
+			     SCM_ARRAY_ELEMENT_TYPE_VU8);
       memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf,
 	      UTF_STRLEN (8, c_utf));
 
@@ -2058,6 +2110,127 @@ SCM_DEFINE (scm_utf32_to_string, "utf32->string",
 #undef FUNC_NAME
 
 
+
+/* Bytevectors as generalized vectors & arrays.  */
+
+
+static SCM
+bytevector_ref_c32 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+  const float *contents = (const float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/8], contents[i/8 + 1]);
+}
+
+static SCM
+bytevector_ref_c64 (SCM bv, SCM idx)
+{ /* FIXME add some checks */
+  const double *contents = (const double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  return scm_c_make_rectangular (contents[i/16], contents[i/16 + 1]);
+}
+
+typedef SCM (*scm_t_bytevector_ref_fn)(SCM, SCM);
+
+const scm_t_bytevector_ref_fn bytevector_ref_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = 
+{
+  NULL, /* SCM */
+  NULL, /* CHAR */
+  NULL, /* BIT */
+  scm_bytevector_u8_ref, /* VU8 */
+  scm_bytevector_u8_ref, /* U8 */
+  scm_bytevector_s8_ref,
+  scm_bytevector_u16_native_ref,
+  scm_bytevector_s16_native_ref,
+  scm_bytevector_u32_native_ref,
+  scm_bytevector_s32_native_ref,
+  scm_bytevector_u64_native_ref,
+  scm_bytevector_s64_native_ref,
+  scm_bytevector_ieee_single_native_ref,
+  scm_bytevector_ieee_double_native_ref,
+  bytevector_ref_c32,
+  bytevector_ref_c64
+};
+
+static SCM
+bv_handle_ref (scm_t_array_handle *h, size_t index)
+{
+  SCM byte_index;
+  scm_t_bytevector_ref_fn ref_fn;
+  
+  ref_fn = bytevector_ref_fns[h->element_type];
+  byte_index =
+    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
+  return ref_fn (h->array, byte_index);
+}
+
+static SCM
+bytevector_set_c32 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  float *contents = (float*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  contents[i/8] = scm_c_real_part (val);
+  contents[i/8 + 1] = scm_c_imag_part (val);
+  return SCM_UNSPECIFIED;
+}
+
+static SCM
+bytevector_set_c64 (SCM bv, SCM idx, SCM val)
+{ /* checks are unnecessary here */
+  double *contents = (double*)SCM_BYTEVECTOR_CONTENTS (bv);
+  size_t i = scm_to_size_t (idx);
+  contents[i/16] = scm_c_real_part (val);
+  contents[i/16 + 1] = scm_c_imag_part (val);
+  return SCM_UNSPECIFIED;
+}
+
+typedef SCM (*scm_t_bytevector_set_fn)(SCM, SCM, SCM);
+
+const scm_t_bytevector_set_fn bytevector_set_fns[SCM_ARRAY_ELEMENT_TYPE_LAST + 1] = 
+{
+  NULL, /* SCM */
+  NULL, /* CHAR */
+  NULL, /* BIT */
+  scm_bytevector_u8_set_x, /* VU8 */
+  scm_bytevector_u8_set_x, /* U8 */
+  scm_bytevector_s8_set_x,
+  scm_bytevector_u16_native_set_x,
+  scm_bytevector_s16_native_set_x,
+  scm_bytevector_u32_native_set_x,
+  scm_bytevector_s32_native_set_x,
+  scm_bytevector_u64_native_set_x,
+  scm_bytevector_s64_native_set_x,
+  scm_bytevector_ieee_single_native_set_x,
+  scm_bytevector_ieee_double_native_set_x,
+  bytevector_set_c32,
+  bytevector_set_c64
+};
+
+static void
+bv_handle_set_x (scm_t_array_handle *h, size_t index, SCM val)
+{
+  SCM byte_index;
+  scm_t_bytevector_set_fn set_fn;
+  
+  set_fn = bytevector_set_fns[h->element_type];
+  byte_index =
+    scm_from_size_t (index * scm_array_handle_uniform_element_size (h));
+  set_fn (h->array, byte_index, val);
+}
+
+static void
+bytevector_get_handle (SCM v, scm_t_array_handle *h)
+{
+  h->array = v;
+  h->ndims = 1;
+  h->dims = &h->dim0;
+  h->dim0.lbnd = 0;
+  h->dim0.ubnd = SCM_BYTEVECTOR_TYPED_LENGTH (v) - 1;
+  h->dim0.inc = 1;
+  h->element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (v);
+  h->elements = h->writable_elements = SCM_BYTEVECTOR_CONTENTS (v);
+}
+
 
 /* Initialization.  */
 
@@ -2072,7 +2245,8 @@ scm_bootstrap_bytevectors (void)
   scm_set_smob_equalp (scm_tc16_bytevector, bytevector_equal_p);
 
   scm_null_bytevector =
-    scm_gc_protect_object (make_bytevector_from_buffer (0, NULL));
+    scm_gc_protect_object
+    (make_bytevector_from_buffer (0, NULL, SCM_ARRAY_ELEMENT_TYPE_VU8));
 
 #ifdef WORDS_BIGENDIAN
   scm_i_native_endianness = scm_permanent_object (scm_from_locale_symbol ("big"));
@@ -2083,6 +2257,20 @@ scm_bootstrap_bytevectors (void)
   scm_c_register_extension ("libguile", "scm_init_bytevectors",
 			    (scm_t_extension_init_func) scm_init_bytevectors,
 			    NULL);
+
+  {
+    scm_t_array_implementation impl;
+    
+    impl.tag = scm_tc16_bytevector;
+    impl.mask = 0xffff;
+    impl.vref = bv_handle_ref;
+    impl.vset = bv_handle_set_x;
+    impl.get_handle = bytevector_get_handle;
+    scm_i_register_array_implementation (&impl);
+    scm_i_register_vector_constructor
+      (scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_VU8],
+       scm_make_bytevector);
+  }
 }
 
 void

libguile/bytevectors.h

@@ -118,15 +118,19 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
    common.  */
 #define SCM_BYTEVECTOR_P(_bv)                   \
   SCM_SMOB_PREDICATE (scm_tc16_bytevector, _bv)
-#define SCM_BYTEVECTOR_INLINE_THRESHOLD  (2 * sizeof (SCM))
+#define SCM_F_BYTEVECTOR_INLINE 0x1
-#define SCM_BYTEVECTOR_INLINEABLE_SIZE_P(_size)	\
-  ((_size) <= SCM_BYTEVECTOR_INLINE_THRESHOLD)
 #define SCM_BYTEVECTOR_INLINE_P(_bv)            \
-  (SCM_BYTEVECTOR_INLINEABLE_SIZE_P (SCM_BYTEVECTOR_LENGTH (_bv)))
+  (SCM_SMOB_FLAGS (_bv) & SCM_F_BYTEVECTOR_INLINE)
+#define SCM_BYTEVECTOR_ELEMENT_TYPE(_bv)	\
+  (SCM_SMOB_FLAGS (_bv) >> 8)
 
 /* Hint that is passed to `scm_gc_malloc ()' and friends.  */
 #define SCM_GC_BYTEVECTOR "bytevector"
 
+SCM_INTERNAL SCM scm_i_make_typed_bytevector (size_t, scm_t_array_element_type);
+SCM_INTERNAL SCM scm_c_take_typed_bytevector (signed char *, size_t,
+                                              scm_t_array_element_type);
+
 SCM_INTERNAL void scm_bootstrap_bytevectors (void);
 SCM_INTERNAL void scm_init_bytevectors (void);
 

libguile/chars.c

@@ -296,20 +296,14 @@ TODO: change name  to scm_i_.. ? --hwn
 scm_t_wchar
 scm_c_upcase (scm_t_wchar c)
 {
-  if (c > 255)
+  return uc_toupper ((int) c);
-    return c;
-
-  return toupper ((int) c);
 }
 
 
 scm_t_wchar
 scm_c_downcase (scm_t_wchar c)
 {
-  if (c > 255)
+  return uc_tolower ((int) c);
-    return c;
-
-  return tolower ((int) c);
 }
 
 

libguile/chars.h

@@ -24,7 +24,11 @@
 
 
 #include "libguile/__scm.h"
-#include "libguile/numbers.h"
+
+#ifndef SCM_T_WCHAR_DEFINED
+typedef scm_t_int32 scm_t_wchar;
+#define SCM_T_WCHAR_DEFINED
+#endif /* SCM_T_WCHAR_DEFINED */
 
 
 /* Immediate Characters
@@ -32,8 +36,14 @@
 #define SCM_CHARP(x) (SCM_ITAG8(x) == scm_tc8_char)
 #define SCM_CHAR(x) ((scm_t_wchar)SCM_ITAG8_DATA(x))
 
+/* SCM_MAKE_CHAR maps signed chars (-128 to 127) and unsigned chars (0
+   to 255) to Latin-1 codepoints (0 to 255) while allowing higher
+   codepoints (256 to 1114111) to pass through unchanged.
+
+   This macro evaluates x twice, which may lead to side effects if not
+   used properly. */
 #define SCM_MAKE_CHAR(x)                                                \
-  ((scm_t_int32) (x) < 0                                               \
+  ((x) <= 1                                                             \
    ? SCM_MAKE_ITAG8 ((scm_t_bits) (unsigned char) (x), scm_tc8_char)    \
    : SCM_MAKE_ITAG8 ((scm_t_bits) (x), scm_tc8_char))
 

libguile/continuations.c

@@ -95,7 +95,7 @@ scm_make_continuation (int *first)
 
   SCM_NEWSMOB (cont, scm_tc16_continuation, continuation);
 
-  *first = !setjmp (continuation->jmpbuf);
+  *first = !SCM_I_SETJMP (continuation->jmpbuf);
   if (*first)
     {
 #ifdef __ia64__
@@ -193,12 +193,12 @@ copy_stack_and_call (scm_t_contregs *continuation, SCM val,
   scm_i_set_last_debug_frame (continuation->dframe);
 
   continuation->throw_value = val;
-  longjmp (continuation->jmpbuf, 1);
+  SCM_I_LONGJMP (continuation->jmpbuf, 1);
 }
 
 #ifdef __ia64__
 void
-scm_ia64_longjmp (jmp_buf *JB, int VAL)
+scm_ia64_longjmp (scm_i_jmp_buf *JB, int VAL)
 {
   scm_i_thread *t = SCM_I_CURRENT_THREAD;
 

libguile/continuations.h

@@ -44,7 +44,7 @@ SCM_API scm_t_bits scm_tc16_continuation;
 typedef struct 
 {
   SCM throw_value;
-  jmp_buf jmpbuf;
+  scm_i_jmp_buf jmpbuf;
   SCM dynenv;
 #ifdef __ia64__
   void *backing_store;

libguile/conv-uinteger.i.c

@@ -53,10 +53,17 @@ SCM_TO_TYPE_PROTO (SCM val)
 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
 	      return n;
 #else
+
+#if TYPE_MIN == 0 
+              if (n <= TYPE_MAX)
+                return n;
+#else /* TYPE_MIN != 0 */
               if (n >= TYPE_MIN && n <= TYPE_MAX)
                 return n;
+#endif /* TYPE_MIN != 0 */
               else
                 goto out_of_range;
+
 #endif
 	    }
 	  else
@@ -76,10 +83,16 @@ SCM_TO_TYPE_PROTO (SCM val)
 	  
 	  mpz_export (&n, &count, 1, sizeof (TYPE), 0, 0, SCM_I_BIG_MPZ (val));
 
+#if TYPE_MIN == 0
+	  if (n <= TYPE_MAX)
+	    return n;
+#else /* TYPE_MIN != 0 */
 	  if (n >= TYPE_MIN && n <= TYPE_MAX)
 	    return n;
+#endif /* TYPE_MIN != 0 */
           else
             goto out_of_range;
+
 	}
     }
   else

libguile/convert.c

@@ -1,147 +0,0 @@
-/* Copyright (C) 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 3 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
- */
-
-
-#ifdef HAVE_CONFIG_H
-#  include <config.h>
-#endif
-
-#include "libguile/_scm.h"
-#include "libguile/validate.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/pairs.h"
-#include "libguile/unif.h"
-#include "libguile/srfi-4.h"
-
-#include "libguile/convert.h"
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-
-/* char *scm_c_scm2chars (SCM obj, char *dst);
-   SCM   scm_c_chars2scm (const char *src, long n);
-   SCM   scm_c_chars2byvect (const char *src, long n);
-*/
-
-#define CTYPE            char
-#define FROM_CTYPE       scm_from_char
-#define SCM2CTYPES       scm_c_scm2chars
-#define CTYPES2SCM       scm_c_chars2scm
-#define CTYPES2UVECT     scm_c_chars2byvect
-#if CHAR_MIN == 0
-/* 'char' is unsigned. */
-#define UVEC_TAG         u8
-#define UVEC_CTYPE       scm_t_uint8
-#else
-/* 'char' is signed. */
-#define UVEC_TAG         s8
-#define UVEC_CTYPE       scm_t_int8
-#endif
-#include "libguile/convert.i.c"
-
-/* short *scm_c_scm2shorts (SCM obj, short *dst);
-   SCM scm_c_shorts2scm (const short *src, long n);
-   SCM scm_c_shorts2svect (const short *src, long n);
-*/
-
-#define CTYPE            short
-#define FROM_CTYPE       scm_from_short
-#define SCM2CTYPES       scm_c_scm2shorts
-#define CTYPES2SCM       scm_c_shorts2scm
-#define CTYPES2UVECT     scm_c_shorts2svect
-#define UVEC_TAG         s16
-#define UVEC_CTYPE       scm_t_int16
-#include "libguile/convert.i.c"
-
-/* int *scm_c_scm2ints (SCM obj, int *dst);
-   SCM scm_c_ints2scm (const int *src, long n);
-   SCM scm_c_ints2ivect (const int *src, long n);
-   SCM scm_c_uints2uvect (const unsigned int *src, long n);
-*/
-
-#define CTYPE            int
-#define FROM_CTYPE       scm_from_int
-#define SCM2CTYPES       scm_c_scm2ints
-#define CTYPES2SCM       scm_c_ints2scm
-#define CTYPES2UVECT     scm_c_ints2ivect
-#define UVEC_TAG         s32
-#define UVEC_CTYPE       scm_t_int32
-
-#define CTYPES2UVECT_2   scm_c_uints2uvect
-#define CTYPE_2          unsigned int
-#define UVEC_TAG_2       u32
-#define UVEC_CTYPE_2     scm_t_uint32
-
-#include "libguile/convert.i.c"
-
-/* long *scm_c_scm2longs (SCM obj, long *dst);
-   SCM scm_c_longs2scm (const long *src, long n);
-   SCM scm_c_longs2ivect (const long *src, long n);
-   SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
-*/
-
-#define CTYPE            long
-#define FROM_CTYPE       scm_from_long
-#define SCM2CTYPES       scm_c_scm2longs
-#define CTYPES2SCM       scm_c_longs2scm
-#define CTYPES2UVECT     scm_c_longs2ivect
-#define UVEC_TAG         s32
-#define UVEC_CTYPE       scm_t_int32
-
-#define CTYPES2UVECT_2   scm_c_ulongs2uvect
-#define CTYPE_2          unsigned int
-#define UVEC_TAG_2       u32
-#define UVEC_CTYPE_2     scm_t_uint32
-
-#include "libguile/convert.i.c"
-
-/* float *scm_c_scm2floats (SCM obj, float *dst);
-   SCM scm_c_floats2scm (const float *src, long n);
-   SCM scm_c_floats2fvect (const float *src, long n);
-*/
-
-#define CTYPE            float
-#define FROM_CTYPE       scm_from_double
-#define SCM2CTYPES       scm_c_scm2floats
-#define CTYPES2SCM       scm_c_floats2scm
-#define CTYPES2UVECT     scm_c_floats2fvect
-#define UVEC_TAG         f32
-#define UVEC_CTYPE       float
-#include "libguile/convert.i.c"
-
-/* double *scm_c_scm2doubles (SCM obj, double *dst);
-   SCM scm_c_doubles2scm (const double *src, long n);
-   SCM scm_c_doubles2dvect (const double *src, long n);
-*/
-
-#define CTYPE            double
-#define FROM_CTYPE       scm_from_double
-#define SCM2CTYPES       scm_c_scm2doubles
-#define CTYPES2SCM       scm_c_doubles2scm
-#define CTYPES2UVECT     scm_c_doubles2dvect
-#define UVEC_TAG         f64
-#define UVEC_CTYPE       double
-#include "libguile/convert.i.c"
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/

libguile/convert.h

@@ -1,51 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_CONVERT_H
-#define SCM_CONVERT_H
-
-/* Copyright (C) 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 3 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 "libguile/__scm.h"
-
-SCM_API char *scm_c_scm2chars (SCM obj, char *dst);
-SCM_API short *scm_c_scm2shorts (SCM obj, short *dst);
-SCM_API int *scm_c_scm2ints (SCM obj, int *dst);
-SCM_API long *scm_c_scm2longs (SCM obj, long *dst);
-SCM_API float *scm_c_scm2floats (SCM obj, float *dst);
-SCM_API double *scm_c_scm2doubles (SCM obj, double *dst);
-
-SCM_API SCM scm_c_chars2scm (const char *src, long n);
-SCM_API SCM scm_c_shorts2scm (const short *src, long n);
-SCM_API SCM scm_c_ints2scm (const int *src, long n);
-SCM_API SCM scm_c_longs2scm (const long *src, long n);
-SCM_API SCM scm_c_floats2scm (const float *src, long n);
-SCM_API SCM scm_c_doubles2scm (const double *src, long n);
-
-SCM_API SCM scm_c_chars2byvect (const char *src, long n);
-SCM_API SCM scm_c_shorts2svect (const short *src, long n);
-SCM_API SCM scm_c_ints2ivect (const int *src, long n);
-SCM_API SCM scm_c_uints2uvect (const unsigned int *src, long n);
-SCM_API SCM scm_c_longs2ivect (const long *src, long n);
-SCM_API SCM scm_c_ulongs2uvect (const unsigned long *src, long n);
-SCM_API SCM scm_c_floats2fvect (const float *src, long n);
-SCM_API SCM scm_c_doubles2dvect (const double *src, long n);
-
-#endif /* SCM_CONVERT_H */

libguile/convert.i.c

@@ -1,171 +0,0 @@
-/* this file is #include'd (x times) by convert.c */
-
-/* You need to define the following macros before including this
-   template.  They are undefined at the end of this file to give a
-   clean slate for the next inclusion.
-
-   - CTYPE
-
-   The type of an element of the C array, for example 'char'.
-
-   - FROM_CTYPE
-
-   The function that converts a CTYPE to a SCM, for example
-   scm_from_char.
-
-   - UVEC_TAG
-
-   The tag of a suitable uniform vector that can hold the CTYPE, for
-   example 's8'.
-
-   - UVEC_CTYPE
-
-   The C type of an element of the uniform vector, for example
-   scm_t_int8.
-
-   - SCM2CTYPES
-
-   The name of the 'SCM-to-C' function, for example scm_c_scm2chars.
-
-   - CTYPES2SCM
-
-   The name of the 'C-to-SCM' function, for example, scm_c_chars2scm.
-
-   - CTYPES2UVECT
-
-   The name of the 'C-to-uniform-vector' function, for example
-   scm_c_chars2byvect.  It will create a uniform vector of kind
-   UVEC_TAG.
-
-   - CTYPES2UVECT_2
-
-   The name of a second 'C-to-uniform-vector' function.  Leave
-   undefined if you want only one such function.
-
-   - CTYPE_2
-   - UVEC_TAG_2
-   - UVEC_CTYPE_2
-
-   The tag and C type of the second kind of uniform vector, for use
-   with the function described above.
-
-*/
-
-/* The first level does not expand macros in the arguments. */
-#define paste(a1,a2,a3)   a1##a2##a3
-#define stringify(a)      #a
-
-/* But the second level does. */
-#define F(pre,T,suf)   paste(pre,T,suf)
-#define S(T)           stringify(T)
-
-/* Convert a vector, list or uniform vector into a C array.  If the
-   result array in argument 2 is NULL, malloc() a new one.
-*/
-
-CTYPE *
-SCM2CTYPES (SCM obj, CTYPE *data)
-{
-  scm_t_array_handle handle;
-  size_t i, len;
-  ssize_t inc;
-  const UVEC_CTYPE *uvec_elements;
-
-  obj = F(scm_any_to_,UVEC_TAG,vector) (obj);
-  uvec_elements = F(scm_,UVEC_TAG,vector_elements) (obj, &handle, &len, &inc);
-
-  if (data == NULL)
-    data = scm_malloc (len * sizeof (CTYPE));
-  for (i = 0; i < len; i++, uvec_elements += inc)
-    data[i] = uvec_elements[i];
-
-  scm_array_handle_release (&handle);
-
-  return data;
-}
-
-/* Converts a C array into a vector. */
-
-SCM
-CTYPES2SCM (const CTYPE *data, long n)
-{
-  long i;
-  SCM v;
-  
-  v = scm_c_make_vector (n, SCM_UNSPECIFIED);
-
-  for (i = 0; i < n; i++)
-    SCM_SIMPLE_VECTOR_SET (v, i, FROM_CTYPE (data[i]));
-
-  return v;
-}
-
-/* Converts a C array into a uniform vector. */
-
-SCM
-CTYPES2UVECT (const CTYPE *data, long n)
-{
-  scm_t_array_handle handle;
-  long i;
-  SCM uvec;
-  UVEC_CTYPE *uvec_elements;
-  
-  uvec = F(scm_make_,UVEC_TAG,vector) (scm_from_long (n), SCM_UNDEFINED);
-  uvec_elements = F(scm_,UVEC_TAG,vector_writable_elements) (uvec, &handle,
-							     NULL, NULL);
-  for (i = 0; i < n; i++)
-    uvec_elements[i] = data[i];
-
-  scm_array_handle_release (&handle);
-
-  return uvec;
-}
-
-#ifdef CTYPE2UVECT_2
-
-SCM
-CTYPES2UVECT_2 (const CTYPE_2 *data, long n)
-{
-  scm_t_array_handle handle;
-  long i;
-  SCM uvec;
-  UVEC_CTYPE_2 *uvec_elements;
-  
-  uvec = F(scm_make_,UVEC_TAG_2,vector) (scm_from_long (n), SCM_UNDEFINED);
-  uvec_elements = F(scm_,UVEC_TAG_2,vector_writable_elements) (uvec, &handle,
-							       NULL, NULL);
-
-  for (i = 0; i < n; i++)
-    uvec_elements[i] = data[i];
-
-  scm_array_handle_release (&handle);
-
-  return uvec;
-}
-
-#endif
-
-#undef paste
-#undef stringify
-#undef F
-#undef S
-
-#undef CTYPE
-#undef FROM_CTYPE
-#undef UVEC_TAG
-#undef UVEC_CTYPE
-#undef SCM2CTYPES
-#undef CTYPES2SCM
-#undef CTYPES2UVECT
-#ifdef CTYPES2UVECT_2
-#undef CTYPES2UVECT_2
-#undef CTYPE_2
-#undef UVEC_TAG_2
-#undef UVEC_CTYPE_2
-#endif
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/

libguile/debug.c

@@ -363,6 +363,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
     if (!SCM_SMOB_DESCRIPTOR (proc).apply)
       break;
   case scm_tcs_subrs:
+  case scm_tc7_program:
   procprop:
     /* It would indeed be a nice thing if we supplied source even for
        built in procedures! */

libguile/deprecated.c

@@ -34,6 +34,7 @@
 #include "libguile/strings.h"
 #include "libguile/srfi-13.h"
 #include "libguile/modules.h"
+#include "libguile/generalized-arrays.h"
 #include "libguile/eval.h"
 #include "libguile/smob.h"
 #include "libguile/procprop.h"
@@ -749,17 +750,13 @@ scm_sym2ovcell (SCM sym, SCM obarray)
    return (SYMBOL . SCM_UNDEFINED).  */
 
 
-SCM 
+static SCM 
-scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int softness)
+intern_obarray_soft (SCM symbol, SCM obarray, unsigned int softness)
 {
-  SCM symbol = scm_from_locale_symboln (name, len);
   size_t raw_hash = scm_i_symbol_hash (symbol);
   size_t hash;
   SCM lsym;
 
-  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
-				   "Use hashtables instead.");
-
   if (scm_is_false (obarray))
     {
       if (softness)
@@ -795,6 +792,18 @@ scm_intern_obarray_soft (const char *name,size_t len,SCM obarray,unsigned int so
 }
 
 
+SCM 
+scm_intern_obarray_soft (const char *name, size_t len, SCM obarray,
+                         unsigned int softness)
+{
+  SCM symbol = scm_from_locale_symboln (name, len);
+
+  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
+				   "Use hashtables instead.");
+
+  return intern_obarray_soft (symbol, obarray, softness);
+}
+  
 SCM
 scm_intern_obarray (const char *name,size_t len,SCM obarray)
 {
@@ -850,10 +859,7 @@ SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
   else if (scm_is_eq (o, SCM_BOOL_T))
     o = SCM_BOOL_F;
     
-  vcell = scm_intern_obarray_soft (scm_i_string_chars (s),
+  vcell = intern_obarray_soft (scm_string_to_symbol (s), o, softness);
-				   scm_i_string_length (s),
-				   o,
-				   softness);
   if (scm_is_false (vcell))
     return vcell;
   answer = SCM_CAR (vcell);
@@ -1070,7 +1076,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
 {
   char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
   char *name = buf;
-  int len, n_digits;
+  int n_digits;
+  size_t len;
 
   scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
 				   "Use `gensym' instead.");
@@ -1084,9 +1091,8 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
     {
       SCM_VALIDATE_STRING (1, prefix);
       len = scm_i_string_length (prefix);
-      if (len > MAX_PREFIX_LENGTH)
+      name = scm_to_locale_stringn (prefix, &len);
-	name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
+      name = scm_realloc (name, len + SCM_INTBUFLEN);
-      strncpy (name, scm_i_string_chars (prefix), len);
     }
 
   if (SCM_UNBNDP (obarray))
@@ -1108,7 +1114,7 @@ SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
 					 obarray,
 					 0);
     if (name != buf)
-      scm_must_free (name);
+      free (name);
     return SCM_CAR (vcell);
   }
 }
@@ -1309,7 +1315,7 @@ scm_i_arrayp (SCM a)
 {
   scm_c_issue_deprecation_warning
     ("SCM_ARRAYP is deprecated.  Use scm_is_array instead.");
-  return SCM_I_ARRAYP(a) || SCM_I_ENCLOSED_ARRAYP(a);
+  return SCM_I_ARRAYP(a);
 }
 
 size_t

libguile/deprecated.h

@@ -24,6 +24,7 @@
  */
 
 #include "libguile/__scm.h"
+#include "libguile/arrays.h"
 #include "libguile/strings.h"
 
 #if (SCM_ENABLE_DEPRECATED == 1)

libguile/discouraged.c

@@ -265,7 +265,7 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
   SCM dash_string, non_dash_symbol;
 
   SCM_ASSERT (scm_is_symbol (symbol)
-	      && ('-' == scm_i_symbol_chars(symbol)[0]),
+	      && (scm_i_symbol_ref (symbol, 0) == '-'),
 	      symbol, SCM_ARG1, FUNC_NAME);
 
   dash_string = scm_symbol_to_string (symbol);

libguile/eq.c

@@ -1,4 +1,4 @@
-/* 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, 2009 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
@@ -22,13 +22,13 @@
 #endif
 
 #include "libguile/_scm.h"
-#include "libguile/ramap.h"
+#include "libguile/array-map.h"
 #include "libguile/stackchk.h"
 #include "libguile/strorder.h"
 #include "libguile/async.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
-#include "libguile/unif.h"
+#include "libguile/arrays.h"
 #include "libguile/vectors.h"
 
 #include "libguile/struct.h"

libguile/error.c

@@ -232,6 +232,19 @@ scm_wrong_type_arg (const char *subr, int pos, SCM bad_value)
 	     scm_list_1 (bad_value));
 }
 
+void
+scm_i_wrong_type_arg_symbol (SCM symbol, int pos, SCM bad_value)
+{
+  scm_error_scm (scm_arg_type_key,
+		 scm_symbol_to_string (symbol),
+		 (pos == 0) ? scm_from_locale_string ("Wrong type: ~S")
+		 : scm_from_locale_string ("Wrong type argument in position ~A: ~S"),
+		 (pos == 0) ? scm_list_1 (bad_value)
+		 : scm_list_2 (scm_from_int (pos), bad_value),
+		 scm_list_1 (bad_value));
+  scm_remember_upto_here_2 (symbol, bad_value);
+}
+
 void
 scm_wrong_type_arg_msg (const char *subr, int pos, SCM bad_value, const char *szMessage)
 {

libguile/error.h

@@ -53,6 +53,8 @@ SCM_API void scm_wrong_num_args (SCM proc) SCM_NORETURN;
 SCM_API void scm_error_num_args_subr (const char* subr) SCM_NORETURN;
 SCM_API void scm_wrong_type_arg (const char *subr, int pos,
 				 SCM bad_value) SCM_NORETURN;
+SCM_INTERNAL void scm_i_wrong_type_arg_symbol (SCM symbol, int pos,
+					       SCM bad_value) SCM_NORETURN;
 SCM_API void scm_wrong_type_arg_msg (const char *subr, int pos,
 				     SCM bad_value, const char *sz) SCM_NORETURN;
 SCM_API void scm_memory_error (const char *subr) SCM_NORETURN;

libguile/eval.c

@@ -3328,6 +3328,7 @@ scm_trampoline_0 (SCM proc)
     case scm_tc7_rpsubr:
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_0;
       break;
     default:
@@ -3380,8 +3381,7 @@ call_dsubr_1 (SCM proc, SCM arg1)
     {
       return (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
     }
-  SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
+  SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
-		      SCM_ARG1, scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
 }
 
 static SCM
@@ -3454,6 +3454,7 @@ scm_trampoline_1 (SCM proc)
     case scm_tc7_rpsubr:
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_1;
       break;
     default:
@@ -3548,6 +3549,7 @@ scm_trampoline_2 (SCM proc)
       break;
     case scm_tc7_gsubr:
     case scm_tc7_pws:
+    case scm_tc7_program:
       trampoline = scm_call_2;
       break;
     default:

libguile/eval.i.c

@@ -1132,6 +1132,8 @@ dispatch:
 	RETURN (SCM_BOOL_T);
       case scm_tc7_asubr:
 	RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED));
+      case scm_tc7_program:
+        RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0));
       case scm_tc7_smob:
 	if (!SCM_SMOB_APPLICABLE_P (proc))
 	  goto badfun;
@@ -1236,13 +1238,13 @@ dispatch:
 	      {
                 RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
 	      }
-	    SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
+	    SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
-                                SCM_ARG1,
-				scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
 	  case scm_tc7_cxr:
 	    RETURN (scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)));
 	  case scm_tc7_rpsubr:
 	    RETURN (SCM_BOOL_T);
+          case scm_tc7_program:
+            RETURN (scm_c_vm_run (scm_the_vm (), proc, &arg1, 1));
 	  case scm_tc7_asubr:
 	    RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED));
 	  case scm_tc7_lsubr:
@@ -1353,6 +1355,12 @@ dispatch:
 	  case scm_tc7_rpsubr:
 	  case scm_tc7_asubr:
 	    RETURN (SCM_SUBRF (proc) (arg1, arg2));
+          case scm_tc7_program:
+            { SCM args[2];
+              args[0] = arg1;
+              args[1] = arg2;
+              RETURN (scm_c_vm_run (scm_the_vm (), proc, args, 2));
+            }
 	  case scm_tc7_smob:
 	    if (!SCM_SMOB_APPLICABLE_P (proc))
 	      goto badfun;
@@ -1492,6 +1500,8 @@ dispatch:
 				    SCM_CDDR (debug.info->a.args)));
 	case scm_tc7_gsubr:
 	  RETURN (scm_i_gsubr_apply_list (proc, debug.info->a.args));
+        case scm_tc7_program:
+          RETURN (scm_vm_apply (scm_the_vm (), proc, debug.info->a.args));
 	case scm_tc7_pws:
 	  proc = SCM_PROCEDURE (proc);
 	  debug.info->a.proc = proc;
@@ -1563,6 +1573,11 @@ dispatch:
 					    scm_cons2 (arg1, arg2,
 						       scm_ceval_args (x, env,
 								       proc))));
+        case scm_tc7_program:
+          RETURN (scm_vm_apply
+                  (scm_the_vm (), proc,
+                   scm_cons (arg1, scm_cons (arg2,
+                                             scm_ceval_args (x, env, proc)))));
 	case scm_tc7_pws:
 	  proc = SCM_PROCEDURE (proc);
 	  if (!SCM_CLOSUREP (proc))
@@ -1764,8 +1779,7 @@ tail:
 	{
 	  RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
 	}
-      SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
+      SCM_WTA_DISPATCH_1_SUBR (proc, arg1, SCM_ARG1);
-                          SCM_ARG1, scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
     case scm_tc7_cxr:
       if (SCM_UNLIKELY (SCM_UNBNDP (arg1) || !scm_is_null (args)))
 	scm_wrong_num_args (proc);
@@ -1798,6 +1812,11 @@ tail:
 	  args = SCM_CDR (args);
 	}
       RETURN (arg1);
+    case scm_tc7_program:
+      if (SCM_UNBNDP (arg1))
+        RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0));
+      else
+        RETURN (scm_vm_apply (scm_the_vm (), proc, scm_cons (arg1, args)));
     case scm_tc7_rpsubr:
       if (scm_is_null (args))
 	RETURN (SCM_BOOL_T);

libguile/evalext.c

@@ -82,6 +82,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
 	case scm_tc7_string:
 	case scm_tc7_smob:
 	case scm_tc7_pws:
+	case scm_tc7_program:
 	case scm_tcs_subrs:
 	case scm_tcs_struct:
 	  return SCM_BOOL_T;

libguile/extensions.c

@@ -1,6 +1,6 @@
 /* extensions.c - registering and loading extensions.
  *
- * Copyright (C) 2001, 2006 Free Software Foundation, Inc.
+ * Copyright (C) 2001, 2006, 2009 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
@@ -41,7 +41,7 @@ typedef struct extension_t
   void *data;
 } extension_t;
 
-static extension_t *registered_extensions;
+static extension_t *registered_extensions = NULL;
 
 /* Register a LIB/INIT pair for use by `scm_load_extension'.  LIB is
    allowed to be NULL and then only INIT is used to identify the
@@ -157,7 +157,6 @@ SCM_DEFINE (scm_load_extension, "load-extension", 2, 0, 0,
 void
 scm_init_extensions ()
 {
-  registered_extensions = NULL;
 #include "libguile/extensions.x"
 }
 

libguile/filesys.c

@@ -1573,31 +1573,39 @@ SCM_DEFINE (scm_dirname, "dirname", 1, 0, 0,
 	    "component, @code{.} is returned.")
 #define FUNC_NAME s_scm_dirname
 {
-  const char *s;
   long int i;
   unsigned long int len;
 
   SCM_VALIDATE_STRING (1, filename);
 
-  s = scm_i_string_chars (filename);
   len = scm_i_string_length (filename);
 
   i = len - 1;
 #ifdef __MINGW32__
-  while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
-  while (i >= 0 && (s[i] != '/' && s[i] != '\\')) --i;
+		    || scm_i_string_ref (filename, i) == '\\')) 
-  while (i >= 0 && (s[i] == '/' || s[i] == '\\')) --i;
+    --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
+		    && scm_i_string_ref (filename, i) != '\\')) 
+    --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+		    || scm_i_string_ref (filename, i) == '\\')) 
+    --i;
 #else
-  while (i >= 0 && s[i] == '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/') 
-  while (i >= 0 && s[i] != '/') --i;
+    --i;
-  while (i >= 0 && s[i] == '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) != '/') 
+    --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/') 
+    --i;
 #endif /* ndef __MINGW32__ */
   if (i < 0)
     {
 #ifdef __MINGW32__
-      if (len > 0 && (s[0] == '/' || s[0] == '\\'))
+      if (len > 0 && (scm_i_string_ref (filename, 0) == '/'
+		      || scm_i_string_ref (filename, 0) == '\\'))
 #else
-      if (len > 0 && s[0] == '/')
+      if (len > 0 && scm_i_string_ref (filename, 0) == '/')
 #endif /* ndef __MINGW32__ */
 	return scm_c_substring (filename, 0, 1);
       else
@@ -1616,11 +1624,9 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
 	    "@var{basename}, it is removed also.")
 #define FUNC_NAME s_scm_basename
 {
-  const char *f, *s = 0;
   int i, j, len, end;
 
   SCM_VALIDATE_STRING (1, filename);
-  f = scm_i_string_chars (filename);
   len = scm_i_string_length (filename);
 
   if (SCM_UNBNDP (suffix))
@@ -1628,30 +1634,42 @@ SCM_DEFINE (scm_basename, "basename", 1, 1, 0,
   else
     {
       SCM_VALIDATE_STRING (2, suffix);
-      s = scm_i_string_chars (suffix);
       j = scm_i_string_length (suffix) - 1;
     }
   i = len - 1;
 #ifdef __MINGW32__
-  while (i >= 0 && (f[i] == '/' || f[i] == '\\')) --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) == '/'
+		    || scm_i_string_ref (filename, i) ==  '\\'))
+    --i;
 #else
-  while (i >= 0 && f[i] == '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) == '/')
+    --i;
 #endif /* ndef __MINGW32__ */
   end = i;
-  while (i >= 0 && j >= 0 && f[i] == s[j]) --i, --j;
+  while (i >= 0 && j >= 0 
+	 && (scm_i_string_ref (filename, i)
+	     == scm_i_string_ref (suffix, j)))
+    {
+      --i;
+      --j;
+    }
   if (j == -1)
     end = i;
 #ifdef __MINGW32__
-  while (i >= 0 && f[i] != '/' && f[i] != '\\') --i;
+  while (i >= 0 && (scm_i_string_ref (filename, i) != '/'
+		    && scm_i_string_ref (filename, i) != '\\'))
+    --i;
 #else
-  while (i >= 0 && f[i] != '/') --i;
+  while (i >= 0 && scm_i_string_ref (filename, i) != '/')
+    --i;
 #endif /* ndef __MINGW32__ */
   if (i == end)
     {
 #ifdef __MINGW32__
-      if (len > 0 && (f[0] == '/' || f[0] == '\\'))
+      if (len > 0 && (scm_i_string_ref (filename, 0) ==  '/'
+		      || scm_i_string_ref (filename, 0) ==  '\\'))
 #else
-      if (len > 0 && f[0] == '/')
+      if (len > 0 && scm_i_string_ref (filename, 0) == '/')
 #endif /* ndef __MINGW32__ */
         return scm_c_substring (filename, 0, 1);
       else

libguile/fports.c

@@ -594,7 +594,7 @@ static void fport_flush (SCM port);
 
 /* fill a port's read-buffer with a single read.  returns the first
    char or EOF if end of file.  */
-static int
+static scm_t_wchar
 fport_fill_input (SCM port)
 {
   long count;
@@ -608,7 +608,7 @@ fport_fill_input (SCM port)
   if (count == -1)
     scm_syserror ("fport_fill_input");
   if (count == 0)
-    return EOF;
+    return (scm_t_wchar) EOF;
   else
     {
       pt->read_pos = pt->read_buf;

libguile/frames.c

@@ -33,7 +33,7 @@ scm_t_bits scm_tc16_vm_frame;
 
 SCM
 scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
-                     scm_byte_t *ip, scm_t_ptrdiff offset)
+                     scm_t_uint8 *ip, scm_t_ptrdiff offset)
 {
   struct scm_vm_frame *p = scm_gc_malloc (sizeof (struct scm_vm_frame),
                                           "vmframe");
@@ -98,12 +98,12 @@ SCM_DEFINE (scm_vm_frame_arguments, "vm-frame-arguments", 1, 0, 0,
   if (!bp->nargs)
     return SCM_EOL;
   else if (bp->nrest)
-    ret = fp[bp->nargs - 1];
+    ret = SCM_FRAME_VARIABLE (fp, bp->nargs - 1);
   else
-    ret = scm_cons (fp[bp->nargs - 1], SCM_EOL);
+    ret = scm_cons (SCM_FRAME_VARIABLE (fp, bp->nargs - 1), SCM_EOL);
   
   for (i = bp->nargs - 2; i >= 0; i--)
-    ret = scm_cons (fp[i], ret);
+    ret = scm_cons (SCM_FRAME_VARIABLE (fp, i), ret);
   
   return ret;
 }

libguile/frames.h

@@ -30,36 +30,43 @@
 /* VM Frame Layout
    ---------------
 
-   |                  | <- fp + bp->nargs + bp->nlocs + 3
+   | ...              |
-   +------------------+    = SCM_FRAME_UPPER_ADDRESS (fp)
+   | Intermed. val. 0 | <- fp + bp->nargs + bp->nlocs = SCM_FRAME_UPPER_ADDRESS (fp)
-   | Return address   |
+   +==================+
-   | MV return address|
+   | Local variable 1 |
-   | Dynamic link     | <- fp + bp->nargs + bp->blocs
-   | Local variable 1 |    = SCM_FRAME_DATA_ADDRESS (fp)
    | Local variable 0 | <- fp + bp->nargs
    | Argument 1       |
    | Argument 0       | <- fp
    | Program          | <- fp - 1
-   +------------------+    = SCM_FRAME_LOWER_ADDRESS (fp)
+   +------------------+    
+   | Return address   |
+   | MV return address|
+   | Dynamic link     | <- fp - 4 = SCM_FRAME_DATA_ADDRESS (fp) = SCM_FRAME_LOWER_ADDRESS (fp)
+   +==================+
    |                  |
 
    As can be inferred from this drawing, it is assumed that
    `sizeof (SCM *) == sizeof (SCM)', since pointers (the `link' parts) are
    assumed to be as long as SCM objects.  */
 
-#define SCM_FRAME_DATA_ADDRESS(fp)				\
+#define SCM_FRAME_DATA_ADDRESS(fp)	(fp - 4)
-  (fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs	\
+#define SCM_FRAME_UPPER_ADDRESS(fp)                             \
+  (fp                                                           \
+   + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs           \
    + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs)
-#define SCM_FRAME_UPPER_ADDRESS(fp)	(SCM_FRAME_DATA_ADDRESS (fp) + 3)
+#define SCM_FRAME_LOWER_ADDRESS(fp)	(fp - 4)
-#define SCM_FRAME_LOWER_ADDRESS(fp)	(fp - 1)
 
-#define SCM_FRAME_BYTE_CAST(x)		((scm_byte_t *) SCM_UNPACK (x))
+#define SCM_FRAME_BYTE_CAST(x)		((scm_t_uint8 *) SCM_UNPACK (x))
 #define SCM_FRAME_STACK_CAST(x)		((SCM *) SCM_UNPACK (x))
 
 #define SCM_FRAME_RETURN_ADDRESS(fp)				\
   (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
+#define SCM_FRAME_SET_RETURN_ADDRESS(fp, ra)			\
+  ((SCM_FRAME_DATA_ADDRESS (fp)[2])) = (SCM)(ra);
 #define SCM_FRAME_MV_RETURN_ADDRESS(fp)				\
   (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
+#define SCM_FRAME_SET_MV_RETURN_ADDRESS(fp, mvra)		\
+  ((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(mvra);
 #define SCM_FRAME_DYNAMIC_LINK(fp)				\
   (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[0]))
 #define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl)			\
@@ -79,7 +86,7 @@ struct scm_vm_frame
   SCM stack_holder;
   SCM *fp;
   SCM *sp;
-  scm_byte_t *ip;
+  scm_t_uint8 *ip;
   scm_t_ptrdiff offset;
 };
 
@@ -92,9 +99,8 @@ struct scm_vm_frame
 #define SCM_VM_FRAME_OFFSET(f)	SCM_VM_FRAME_DATA(f)->offset
 #define SCM_VALIDATE_VM_FRAME(p,x)	SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
 
-/* FIXME rename scm_byte_t */
 SCM_API SCM scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp,
-                                scm_byte_t *ip, scm_t_ptrdiff offset);
+                                 scm_t_uint8 *ip, scm_t_ptrdiff offset);
 SCM_API SCM scm_vm_frame_p (SCM obj);
 SCM_API SCM scm_vm_frame_program (SCM frame);
 SCM_API SCM scm_vm_frame_arguments (SCM frame);