mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts: libguile/gc-mark.c libguile/procs.c libguile/procs.h libguile/threads.c libguile/threads.h
This commit is contained in:
commit
f7a1ab8b94
17 changed files with 143 additions and 387 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
@ -74,3 +74,4 @@ libguile/stack-limit-calibration.scm
|
|||
cscope.out
|
||||
cscope.files
|
||||
*.log
|
||||
INSTALL
|
||||
|
|
291
INSTALL
291
INSTALL
|
@ -1,291 +0,0 @@
|
|||
Installation Instructions
|
||||
*************************
|
||||
|
||||
Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2004, 2005,
|
||||
2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
|
||||
This file is free documentation; the Free Software Foundation gives
|
||||
unlimited permission to copy, distribute and modify it.
|
||||
|
||||
Basic Installation
|
||||
==================
|
||||
|
||||
Briefly, the shell commands `./configure; make; make install' should
|
||||
configure, build, and install this package. The following
|
||||
more-detailed instructions are generic; see the `README' file for
|
||||
instructions specific to this package.
|
||||
|
||||
The `configure' shell script attempts to guess correct values for
|
||||
various system-dependent variables used during compilation. It uses
|
||||
those values to create a `Makefile' in each directory of the package.
|
||||
It may also create one or more `.h' files containing system-dependent
|
||||
definitions. Finally, it creates a shell script `config.status' that
|
||||
you can run in the future to recreate the current configuration, and a
|
||||
file `config.log' containing compiler output (useful mainly for
|
||||
debugging `configure').
|
||||
|
||||
It can also use an optional file (typically called `config.cache'
|
||||
and enabled with `--cache-file=config.cache' or simply `-C') that saves
|
||||
the results of its tests to speed up reconfiguring. Caching is
|
||||
disabled by default to prevent problems with accidental use of stale
|
||||
cache files.
|
||||
|
||||
If you need to do unusual things to compile the package, please try
|
||||
to figure out how `configure' could check whether to do them, and mail
|
||||
diffs or instructions to the address given in the `README' so they can
|
||||
be considered for the next release. If you are using the cache, and at
|
||||
some point `config.cache' contains results you don't want to keep, you
|
||||
may remove or edit it.
|
||||
|
||||
The file `configure.ac' (or `configure.in') is used to create
|
||||
`configure' by a program called `autoconf'. You need `configure.ac' if
|
||||
you want to change it or regenerate `configure' using a newer version
|
||||
of `autoconf'.
|
||||
|
||||
The simplest way to compile this package is:
|
||||
|
||||
1. `cd' to the directory containing the package's source code and type
|
||||
`./configure' to configure the package for your system.
|
||||
|
||||
Running `configure' might take a while. While running, it prints
|
||||
some messages telling which features it is checking for.
|
||||
|
||||
2. Type `make' to compile the package.
|
||||
|
||||
3. Optionally, type `make check' to run any self-tests that come with
|
||||
the package.
|
||||
|
||||
4. Type `make install' to install the programs and any data files and
|
||||
documentation.
|
||||
|
||||
5. You can remove the program binaries and object files from the
|
||||
source code directory by typing `make clean'. To also remove the
|
||||
files that `configure' created (so you can compile the package for
|
||||
a different kind of computer), type `make distclean'. There is
|
||||
also a `make maintainer-clean' target, but that is intended mainly
|
||||
for the package's developers. If you use it, you may have to get
|
||||
all sorts of other programs in order to regenerate files that came
|
||||
with the distribution.
|
||||
|
||||
6. Often, you can also type `make uninstall' to remove the installed
|
||||
files again.
|
||||
|
||||
Compilers and Options
|
||||
=====================
|
||||
|
||||
Some systems require unusual options for compilation or linking that
|
||||
the `configure' script does not know about. Run `./configure --help'
|
||||
for details on some of the pertinent environment variables.
|
||||
|
||||
You can give `configure' initial values for configuration parameters
|
||||
by setting variables in the command line or in the environment. Here
|
||||
is an example:
|
||||
|
||||
./configure CC=c99 CFLAGS=-g LIBS=-lposix
|
||||
|
||||
*Note Defining Variables::, for more details.
|
||||
|
||||
Compiling For Multiple Architectures
|
||||
====================================
|
||||
|
||||
You can compile the package for more than one kind of computer at the
|
||||
same time, by placing the object files for each architecture in their
|
||||
own directory. To do this, you can use GNU `make'. `cd' to the
|
||||
directory where you want the object files and executables to go and run
|
||||
the `configure' script. `configure' automatically checks for the
|
||||
source code in the directory that `configure' is in and in `..'.
|
||||
|
||||
With a non-GNU `make', it is safer to compile the package for one
|
||||
architecture at a time in the source code directory. After you have
|
||||
installed the package for one architecture, use `make distclean' before
|
||||
reconfiguring for another architecture.
|
||||
|
||||
On MacOS X 10.5 and later systems, you can create libraries and
|
||||
executables that work on multiple system types--known as "fat" or
|
||||
"universal" binaries--by specifying multiple `-arch' options to the
|
||||
compiler but only a single `-arch' option to the preprocessor. Like
|
||||
this:
|
||||
|
||||
./configure CC="gcc -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
|
||||
CXX="g++ -arch i386 -arch x86_64 -arch ppc -arch ppc64" \
|
||||
CPP="gcc -E" CXXCPP="g++ -E"
|
||||
|
||||
This is not guaranteed to produce working output in all cases, you
|
||||
may have to build one architecture at a time and combine the results
|
||||
using the `lipo' tool if you have problems.
|
||||
|
||||
Installation Names
|
||||
==================
|
||||
|
||||
By default, `make install' installs the package's commands under
|
||||
`/usr/local/bin', include files under `/usr/local/include', etc. You
|
||||
can specify an installation prefix other than `/usr/local' by giving
|
||||
`configure' the option `--prefix=PREFIX'.
|
||||
|
||||
You can specify separate installation prefixes for
|
||||
architecture-specific files and architecture-independent files. If you
|
||||
pass the option `--exec-prefix=PREFIX' to `configure', the package uses
|
||||
PREFIX as the prefix for installing programs and libraries.
|
||||
Documentation and other data files still use the regular prefix.
|
||||
|
||||
In addition, if you use an unusual directory layout you can give
|
||||
options like `--bindir=DIR' to specify different values for particular
|
||||
kinds of files. Run `configure --help' for a list of the directories
|
||||
you can set and what kinds of files go in them.
|
||||
|
||||
If the package supports it, you can cause programs to be installed
|
||||
with an extra prefix or suffix on their names by giving `configure' the
|
||||
option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'.
|
||||
|
||||
Optional Features
|
||||
=================
|
||||
|
||||
Some packages pay attention to `--enable-FEATURE' options to
|
||||
`configure', where FEATURE indicates an optional part of the package.
|
||||
They may also pay attention to `--with-PACKAGE' options, where PACKAGE
|
||||
is something like `gnu-as' or `x' (for the X Window System). The
|
||||
`README' should mention any `--enable-' and `--with-' options that the
|
||||
package recognizes.
|
||||
|
||||
For packages that use the X Window System, `configure' can usually
|
||||
find the X include and library files automatically, but if it doesn't,
|
||||
you can use the `configure' options `--x-includes=DIR' and
|
||||
`--x-libraries=DIR' to specify their locations.
|
||||
|
||||
Particular systems
|
||||
==================
|
||||
|
||||
On HP-UX, the default C compiler is not ANSI C compatible. If GNU
|
||||
CC is not installed, it is recommended to use the following options in
|
||||
order to use an ANSI C compiler:
|
||||
|
||||
./configure CC="cc -Ae"
|
||||
|
||||
and if that doesn't work, install pre-built binaries of GCC for HP-UX.
|
||||
|
||||
On OSF/1 a.k.a. Tru64, some versions of the default C compiler cannot
|
||||
parse its `<wchar.h>' header file. The option `-nodtk' can be used as
|
||||
a workaround. If GNU CC is not installed, it is therefore recommended
|
||||
to try
|
||||
|
||||
./configure CC="cc"
|
||||
|
||||
and if that doesn't work, try
|
||||
|
||||
./configure CC="cc -nodtk"
|
||||
|
||||
Specifying the System Type
|
||||
==========================
|
||||
|
||||
There may be some features `configure' cannot figure out
|
||||
automatically, but needs to determine by the type of machine the package
|
||||
will run on. Usually, assuming the package is built to be run on the
|
||||
_same_ architectures, `configure' can figure that out, but if it prints
|
||||
a message saying it cannot guess the machine type, give it the
|
||||
`--build=TYPE' option. TYPE can either be a short name for the system
|
||||
type, such as `sun4', or a canonical name which has the form:
|
||||
|
||||
CPU-COMPANY-SYSTEM
|
||||
|
||||
where SYSTEM can have one of these forms:
|
||||
|
||||
OS KERNEL-OS
|
||||
|
||||
See the file `config.sub' for the possible values of each field. If
|
||||
`config.sub' isn't included in this package, then this package doesn't
|
||||
need to know the machine type.
|
||||
|
||||
If you are _building_ compiler tools for cross-compiling, you should
|
||||
use the option `--target=TYPE' to select the type of system they will
|
||||
produce code for.
|
||||
|
||||
If you want to _use_ a cross compiler, that generates code for a
|
||||
platform different from the build platform, you should specify the
|
||||
"host" platform (i.e., that on which the generated programs will
|
||||
eventually be run) with `--host=TYPE'.
|
||||
|
||||
Sharing Defaults
|
||||
================
|
||||
|
||||
If you want to set default values for `configure' scripts to share,
|
||||
you can create a site shell script called `config.site' that gives
|
||||
default values for variables like `CC', `cache_file', and `prefix'.
|
||||
`configure' looks for `PREFIX/share/config.site' if it exists, then
|
||||
`PREFIX/etc/config.site' if it exists. Or, you can set the
|
||||
`CONFIG_SITE' environment variable to the location of the site script.
|
||||
A warning: not all `configure' scripts look for a site script.
|
||||
|
||||
Defining Variables
|
||||
==================
|
||||
|
||||
Variables not defined in a site shell script can be set in the
|
||||
environment passed to `configure'. However, some packages may run
|
||||
configure again during the build, and the customized values of these
|
||||
variables may be lost. In order to avoid this problem, you should set
|
||||
them in the `configure' command line, using `VAR=value'. For example:
|
||||
|
||||
./configure CC=/usr/local2/bin/gcc
|
||||
|
||||
causes the specified `gcc' to be used as the C compiler (unless it is
|
||||
overridden in the site shell script).
|
||||
|
||||
Unfortunately, this technique does not work for `CONFIG_SHELL' due to
|
||||
an Autoconf bug. Until the bug is fixed you can use this workaround:
|
||||
|
||||
CONFIG_SHELL=/bin/bash /bin/bash ./configure CONFIG_SHELL=/bin/bash
|
||||
|
||||
`configure' Invocation
|
||||
======================
|
||||
|
||||
`configure' recognizes the following options to control how it
|
||||
operates.
|
||||
|
||||
`--help'
|
||||
`-h'
|
||||
Print a summary of all of the options to `configure', and exit.
|
||||
|
||||
`--help=short'
|
||||
`--help=recursive'
|
||||
Print a summary of the options unique to this package's
|
||||
`configure', and exit. The `short' variant lists options used
|
||||
only in the top level, while the `recursive' variant lists options
|
||||
also present in any nested packages.
|
||||
|
||||
`--version'
|
||||
`-V'
|
||||
Print the version of Autoconf used to generate the `configure'
|
||||
script, and exit.
|
||||
|
||||
`--cache-file=FILE'
|
||||
Enable the cache: use and save the results of the tests in FILE,
|
||||
traditionally `config.cache'. FILE defaults to `/dev/null' to
|
||||
disable caching.
|
||||
|
||||
`--config-cache'
|
||||
`-C'
|
||||
Alias for `--cache-file=config.cache'.
|
||||
|
||||
`--quiet'
|
||||
`--silent'
|
||||
`-q'
|
||||
Do not print messages saying which checks are being made. To
|
||||
suppress all normal output, redirect it to `/dev/null' (any error
|
||||
messages will still be shown).
|
||||
|
||||
`--srcdir=DIR'
|
||||
Look for the package's source code in directory DIR. Usually
|
||||
`configure' can determine that directory automatically.
|
||||
|
||||
`--prefix=DIR'
|
||||
Use DIR as the installation prefix. *Note Installation Names::
|
||||
for more details, including other options available for fine-tuning
|
||||
the installation locations.
|
||||
|
||||
`--no-create'
|
||||
`-n'
|
||||
Run the configure checks, but stop before creating any output
|
||||
files.
|
||||
|
||||
`configure' also accepts some other, not widely useful, options. Run
|
||||
`configure --help' for more details.
|
||||
|
15
NEWS
15
NEWS
|
@ -1,5 +1,5 @@
|
|||
Guile NEWS --- history of user-visible changes.
|
||||
Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
|
||||
Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
|
||||
See the end for copying conditions.
|
||||
|
||||
Please send Guile bug reports to bug-guile@gnu.org.
|
||||
|
@ -40,12 +40,25 @@ application code.
|
|||
** Functions for handling `scm_option' now no longer require an argument
|
||||
indicating length of the `scm_t_option' array.
|
||||
|
||||
** Primitive procedures (aka. "subrs") are now stored in double cells
|
||||
This removes the subr table and simplifies the code.
|
||||
|
||||
|
||||
Changes in 1.8.7 (since 1.8.6)
|
||||
|
||||
* Bugs fixed
|
||||
|
||||
** Fix %fast-slot-ref/set!, to avoid possible segmentation fault
|
||||
** Fix MinGW build problem caused by HAVE_STRUCT_TIMESPEC confusion
|
||||
** Fix build problem when scm_t_timespec is different from struct timespec
|
||||
** Fix build when compiled with -Wundef -Werror
|
||||
|
||||
** Allow @ macro to work with (ice-9 syncase)
|
||||
|
||||
Previously, use of the @ macro in a module whose code is being
|
||||
transformed by (ice-9 syncase) would cause an "Invalid syntax" error.
|
||||
Now it works as you would expect (giving the value of the specified
|
||||
module binding).
|
||||
|
||||
|
||||
Changes in 1.8.6 (since 1.8.5)
|
||||
|
|
4
THANKS
4
THANKS
|
@ -23,6 +23,7 @@ For fixes or providing information which led to a fix:
|
|||
David Allouche
|
||||
Martin Baulig
|
||||
Fabrice Bauzac
|
||||
Carlo Bramini
|
||||
Rob Browning
|
||||
Adrian Bunk
|
||||
Michael Carmack
|
||||
|
@ -35,13 +36,16 @@ For fixes or providing information which led to a fix:
|
|||
Nils Durner
|
||||
John W Eaton
|
||||
Clinton Ebadi
|
||||
David Fang
|
||||
Charles Gagnon
|
||||
Peter Gavin
|
||||
Eric Gillespie, Jr
|
||||
Didier Godefroy
|
||||
Panicz Maciej Godek
|
||||
John Goerzen
|
||||
Mike Gran
|
||||
Szavai Gyula
|
||||
Roland Haeder
|
||||
Sven Hartrumpf
|
||||
Eric Hanchrow
|
||||
Sam Hocevar
|
||||
|
|
|
@ -98,9 +98,12 @@ lib-version.texi: $(top_srcdir)/GUILE-VERSION
|
|||
MAINTAINERCLEANFILES = autoconf-macros.texi
|
||||
|
||||
# To allow "make distcheck" to succeed, lib-version.texi must either
|
||||
# be cleaned or be included in the distribution. There's no point
|
||||
# forcing a distribution build to regenerate lib-version.texi, because
|
||||
# it can't possibly be different on the build machine than where the
|
||||
# distribution was generated, so we might as well include it in the
|
||||
# distribution.
|
||||
# be cleaned or be included in the distribution. Or both - and in
|
||||
# fact both are good. There's no point forcing a distribution build
|
||||
# to regenerate lib-version.texi, because it can't possibly be
|
||||
# different on the build machine than where the distribution was
|
||||
# generated, so we might as well include it in the distribution.
|
||||
EXTRA_DIST += lib-version.texi
|
||||
# But when we want to get back to a clean tree, lib-version.texi
|
||||
# should be cleaned.
|
||||
CLEANFILES = lib-version.texi
|
||||
|
|
|
@ -29,7 +29,7 @@ get the relevant SRFI documents from the SRFI home page
|
|||
* SRFI-8:: receive.
|
||||
* SRFI-9:: define-record-type.
|
||||
* SRFI-10:: Hash-Comma Reader Extension.
|
||||
* SRFI-11:: let-values and let-values*.
|
||||
* SRFI-11:: let-values and let*-values.
|
||||
* SRFI-13:: String library.
|
||||
* SRFI-14:: Character-set library.
|
||||
* SRFI-16:: case-lambda
|
||||
|
@ -1514,9 +1514,9 @@ the anonymous and compact syntax of @nicode{#,()} is much better.
|
|||
@cindex SRFI-11
|
||||
|
||||
@findex let-values
|
||||
@findex let-values*
|
||||
@findex let*-values
|
||||
This module implements the binding forms for multiple values
|
||||
@code{let-values} and @code{let-values*}. These forms are similar to
|
||||
@code{let-values} and @code{let*-values}. These forms are similar to
|
||||
@code{let} and @code{let*} (@pxref{Local Bindings}), but they support
|
||||
binding of the values returned by multiple-valued expressions.
|
||||
|
||||
|
@ -1533,7 +1533,7 @@ available.
|
|||
|
||||
@code{let-values} performs all bindings simultaneously, which means that
|
||||
no expression in the binding clauses may refer to variables bound in the
|
||||
same clause list. @code{let-values*}, on the other hand, performs the
|
||||
same clause list. @code{let*-values}, on the other hand, performs the
|
||||
bindings sequentially, just like @code{let*} does for single-valued
|
||||
expressions.
|
||||
|
||||
|
|
|
@ -20,12 +20,58 @@
|
|||
:use-module (ice-9 documentation)
|
||||
:use-module (ice-9 regex)
|
||||
:use-module (ice-9 rdelim)
|
||||
:export (help apropos apropos-internal apropos-fold
|
||||
apropos-fold-accessible apropos-fold-exported apropos-fold-all
|
||||
source arity system-module))
|
||||
:export (help
|
||||
add-value-help-handler! remove-value-help-handler!
|
||||
add-name-help-handler! remove-name-help-handler!
|
||||
apropos apropos-internal apropos-fold apropos-fold-accessible
|
||||
apropos-fold-exported apropos-fold-all source arity
|
||||
system-module module-commentary))
|
||||
|
||||
|
||||
|
||||
(define *value-help-handlers*
|
||||
`(,(lambda (name value)
|
||||
(object-documentation value))))
|
||||
|
||||
(define (add-value-help-handler! proc)
|
||||
"Adds a handler for performing `help' on a value.
|
||||
|
||||
`proc' will be called as (PROC NAME VALUE). `proc' should return #t to
|
||||
indicate that it has performed help, a string to override the default
|
||||
object documentation, or #f to try the other handlers, potentially
|
||||
falling back on the normal behavior for `help'."
|
||||
(set! *value-help-handlers* (cons proc *value-help-handlers*)))
|
||||
|
||||
(define (remove-value-help-handler! proc)
|
||||
"Removes a handler for performing `help' on a value."
|
||||
(set! *value-help-handlers* (delete! proc *value-help-handlers*)))
|
||||
|
||||
(define (try-value-help name value)
|
||||
(or-map (lambda (proc) (proc name value)) *value-help-handlers*))
|
||||
|
||||
|
||||
(define *name-help-handlers* '())
|
||||
|
||||
(define (add-name-help-handler! proc)
|
||||
"Adds a handler for performing `help' on a name.
|
||||
|
||||
`proc' will be called with the unevaluated name as its argument. That is
|
||||
to say, when the user calls `(help FOO)', the name is FOO, exactly as
|
||||
the user types it.
|
||||
|
||||
`proc' should return #t to indicate that it has performed help, a string
|
||||
to override the default object documentation, or #f to try the other
|
||||
handlers, potentially falling back on the normal behavior for `help'."
|
||||
(set! *name-help-handlers* (cons proc *name-help-handlers*)))
|
||||
|
||||
(define (remove-name-help-handler! proc)
|
||||
"Removes a handler for performing `help' on a name."
|
||||
(set! *name-help-handlers* (delete! proc *name-help-handlers*)))
|
||||
|
||||
(define (try-name-help name)
|
||||
(or-map (lambda (proc) (proc name)) *name-help-handlers*))
|
||||
|
||||
|
||||
;;; Documentation
|
||||
;;;
|
||||
(define help
|
||||
|
@ -45,6 +91,10 @@ You don't seem to have regular expressions installed.\n"))
|
|||
type x))))
|
||||
(cond
|
||||
|
||||
;; User-specified
|
||||
((try-name-help name)
|
||||
=> (lambda (x) (if (not (eq? x #t)) (display x))))
|
||||
|
||||
;; SYMBOL
|
||||
((symbol? name)
|
||||
(help-doc name
|
||||
|
@ -60,10 +110,11 @@ You don't seem to have regular expressions installed.\n"))
|
|||
((and (list? name)
|
||||
(= (length name) 2)
|
||||
(eq? (car name) 'unquote))
|
||||
(cond ((object-documentation
|
||||
(local-eval (cadr name) env))
|
||||
=> write-line)
|
||||
(else (not-found 'documentation (cadr name)))))
|
||||
(let ((doc (try-value-help (cadr name)
|
||||
(local-eval (cadr name) env))))
|
||||
(cond ((not doc) (not-found 'documentation (cadr name)))
|
||||
((eq? doc #t)) ;; pass
|
||||
(else (write-line doc)))))
|
||||
|
||||
;; (quote SYMBOL)
|
||||
((and (list? name)
|
||||
|
@ -109,7 +160,7 @@ You don't seem to have regular expressions installed.\n"))
|
|||
(let ((entries (apropos-fold (lambda (module name object data)
|
||||
(cons (list module
|
||||
name
|
||||
(object-documentation object)
|
||||
(try-value-help name object)
|
||||
(cond ((closure? object)
|
||||
"a procedure")
|
||||
((procedure? object)
|
||||
|
|
|
@ -146,9 +146,11 @@
|
|||
(let ((e ((macro-transformer m)
|
||||
e
|
||||
(append r (list eval-closure)))))
|
||||
(if (null? r)
|
||||
(sc-expand e)
|
||||
(sc-chi e r w))))))))))
|
||||
(if (variable? e)
|
||||
e
|
||||
(if (null? r)
|
||||
(sc-expand e)
|
||||
(sc-chi e r w)))))))))))
|
||||
|
||||
(define generated-symbols (make-weak-key-hash-table 1019))
|
||||
|
||||
|
|
|
@ -38,6 +38,25 @@
|
|||
# include <config.h>
|
||||
#endif
|
||||
|
||||
/* Undefine HAVE_STRUCT_TIMESPEC, because the libguile C code doesn't
|
||||
need it anymore, and because on MinGW:
|
||||
|
||||
- the definition of struct timespec is provided (if at all) by
|
||||
pthread.h
|
||||
|
||||
- pthread.h will _not_ define struct timespec if
|
||||
HAVE_STRUCT_TIMESPEC is 1, because then it thinks that it doesn't
|
||||
need to.
|
||||
|
||||
The libguile C code doesn't need HAVE_STRUCT_TIMESPEC anymore,
|
||||
because the value of HAVE_STRUCT_TIMESPEC has already been
|
||||
incorporated in how scm_t_timespec is defined (in scmconfig.h), and
|
||||
the rest of the libguile C code now just uses scm_t_timespec.
|
||||
*/
|
||||
#ifdef HAVE_STRUCT_TIMESPEC
|
||||
#undef HAVE_STRUCT_TIMESPEC
|
||||
#endif
|
||||
|
||||
#include <errno.h>
|
||||
#include "libguile/__scm.h"
|
||||
|
||||
|
|
|
@ -1905,7 +1905,7 @@ scm_c_extend_primitive_generic (SCM extended, SCM extension)
|
|||
gext = scm_call_2 (SCM_VARIABLE_REF (scm_var_make_extended_generic),
|
||||
gf,
|
||||
SCM_SNAME (extension));
|
||||
*SCM_SUBR_GENERIC (extension) = gext;
|
||||
SCM_SET_SUBR_GENERIC (extension, gext);
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 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
|
||||
|
@ -75,13 +75,13 @@ create_gsubr (int define, const char *name,
|
|||
subr = scm_c_make_subr (name, scm_tc7_lsubr_2, fcn);
|
||||
create_subr:
|
||||
if (define)
|
||||
scm_define (SCM_SUBR_ENTRY(subr).name, subr);
|
||||
scm_define (SCM_SNAME (subr), subr);
|
||||
return subr;
|
||||
default:
|
||||
{
|
||||
SCM cclo = scm_makcclo (scm_f_gsubr_apply, 3L);
|
||||
SCM subr = scm_c_make_subr (name, scm_tc7_subr_0, fcn);
|
||||
SCM sym = SCM_SUBR_ENTRY(subr).name;
|
||||
SCM sym = SCM_SNAME (subr);
|
||||
if (SCM_GSUBR_MAX < req + opt + rst)
|
||||
{
|
||||
fprintf (stderr,
|
||||
|
@ -151,7 +151,7 @@ create_gsubr_with_generic (int define,
|
|||
subr = scm_c_make_subr_with_generic (name, scm_tc7_lsubr_2, fcn, gf);
|
||||
create_subr:
|
||||
if (define)
|
||||
scm_define (SCM_SUBR_ENTRY(subr).name, subr);
|
||||
scm_define (SCM_SNAME (subr), subr);
|
||||
return subr;
|
||||
default:
|
||||
;
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 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
|
||||
|
@ -446,7 +446,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
|
|||
|
||||
scm_struct_prehistory (); /* requires storage */
|
||||
scm_symbols_prehistory (); /* requires storage */
|
||||
scm_init_subr_table ();
|
||||
#if 0
|
||||
scm_environments_prehistory (); /* requires storage */
|
||||
#endif
|
||||
|
|
|
@ -54,7 +54,7 @@
|
|||
C99 mode and doesn't define `__GNUC_STDC_INLINE__'. Fall back to "static
|
||||
inline" in that case. */
|
||||
|
||||
# if (defined __GNUC__) && (!(__APPLE_CC__ > 5400 && __STDC_VERSION__ >= 199901L))
|
||||
# if (defined __GNUC__) && (!(((defined __APPLE_CC__) && (__APPLE_CC__ > 5400)) && __STDC_VERSION__ >= 199901L))
|
||||
# define SCM_C_USE_EXTERN_INLINE 1
|
||||
# if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2)
|
||||
# define SCM_C_EXTERN_INLINE \
|
||||
|
|
|
@ -37,45 +37,20 @@
|
|||
/* {Procedures}
|
||||
*/
|
||||
|
||||
scm_t_subr_entry *scm_subr_table;
|
||||
|
||||
/* libguile contained approx. 700 primitive procedures on 24 Aug 1999. */
|
||||
|
||||
/* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on
|
||||
startup, 786 with guile-readline. 'martin */
|
||||
|
||||
static unsigned long scm_subr_table_size = 0;
|
||||
static unsigned long scm_subr_table_room = 800;
|
||||
|
||||
/* Hint for `scm_gc_malloc ()' and friends. */
|
||||
static const char subr_table_gc_hint[] = "subr table";
|
||||
|
||||
SCM
|
||||
SCM
|
||||
scm_c_make_subr (const char *name, long type, SCM (*fcn) ())
|
||||
{
|
||||
register SCM z;
|
||||
unsigned long entry;
|
||||
SCM *meta_info;
|
||||
|
||||
if (scm_subr_table_size == scm_subr_table_room)
|
||||
{
|
||||
long new_size = scm_subr_table_room * 3 / 2;
|
||||
void *new_table
|
||||
= scm_gc_realloc (scm_subr_table,
|
||||
sizeof (* scm_subr_table) * scm_subr_table_room,
|
||||
sizeof (* scm_subr_table) * new_size,
|
||||
subr_table_gc_hint);
|
||||
scm_subr_table = new_table;
|
||||
scm_subr_table_room = new_size;
|
||||
}
|
||||
meta_info = scm_gc_malloc (2 * sizeof (*meta_info), "subr meta-info");
|
||||
meta_info[0] = scm_from_locale_symbol (name);
|
||||
meta_info[1] = SCM_EOL; /* properties */
|
||||
|
||||
z = scm_double_cell ((scm_t_bits) type, (scm_t_bits) fcn,
|
||||
0 /* generic */, (scm_t_bits) meta_info);
|
||||
|
||||
entry = scm_subr_table_size;
|
||||
z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn);
|
||||
scm_subr_table[entry].handle = z;
|
||||
scm_subr_table[entry].name = scm_from_locale_symbol (name);
|
||||
scm_subr_table[entry].generic = 0;
|
||||
scm_subr_table[entry].properties = SCM_EOL;
|
||||
scm_subr_table_size++;
|
||||
|
||||
return z;
|
||||
}
|
||||
|
||||
|
@ -83,7 +58,7 @@ SCM
|
|||
scm_c_define_subr (const char *name, long type, SCM (*fcn) ())
|
||||
{
|
||||
SCM subr = scm_c_make_subr (name, type, fcn);
|
||||
scm_define (SCM_SUBR_ENTRY(subr).name, subr);
|
||||
scm_define (SCM_SNAME (subr), subr);
|
||||
return subr;
|
||||
}
|
||||
|
||||
|
@ -92,7 +67,7 @@ scm_c_make_subr_with_generic (const char *name,
|
|||
long type, SCM (*fcn) (), SCM *gf)
|
||||
{
|
||||
SCM subr = scm_c_make_subr (name, type, fcn);
|
||||
SCM_SUBR_ENTRY(subr).generic = gf;
|
||||
SCM_SET_SUBR_GENERIC_LOC (subr, gf);
|
||||
return subr;
|
||||
}
|
||||
|
||||
|
@ -101,7 +76,7 @@ scm_c_define_subr_with_generic (const char *name,
|
|||
long type, SCM (*fcn) (), SCM *gf)
|
||||
{
|
||||
SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf);
|
||||
scm_define (SCM_SUBR_ENTRY(subr).name, subr);
|
||||
scm_define (SCM_SNAME (subr), subr);
|
||||
return subr;
|
||||
}
|
||||
|
||||
|
@ -327,16 +302,7 @@ scm_setter (SCM proc)
|
|||
return SCM_BOOL_F; /* not reached */
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
scm_init_subr_table ()
|
||||
{
|
||||
scm_subr_table
|
||||
= ((scm_t_subr_entry *)
|
||||
scm_gc_malloc (sizeof (* scm_subr_table) * scm_subr_table_room,
|
||||
subr_table_gc_hint));
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
scm_init_procs ()
|
||||
{
|
||||
|
|
|
@ -30,23 +30,14 @@
|
|||
/* Subrs
|
||||
*/
|
||||
|
||||
typedef struct
|
||||
{
|
||||
SCM handle; /* link back to procedure object */
|
||||
SCM name;
|
||||
SCM *generic; /* 0 if no generic support
|
||||
* *generic == 0 until first method
|
||||
*/
|
||||
SCM properties; /* procedure properties */
|
||||
} scm_t_subr_entry;
|
||||
|
||||
#define SCM_SUBRNUM(subr) (SCM_CELL_WORD_0 (subr) >> 8)
|
||||
#define SCM_SUBR_ENTRY(x) (scm_subr_table[SCM_SUBRNUM (x)])
|
||||
#define SCM_SNAME(x) (SCM_SUBR_ENTRY (x).name)
|
||||
#define SCM_SUBR_META_INFO(x) ((SCM *) SCM_CELL_WORD_3 (x))
|
||||
#define SCM_SNAME(x) (SCM_SUBR_META_INFO (x) [0])
|
||||
#define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x))
|
||||
#define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x))
|
||||
#define SCM_SUBR_PROPS(x) (SCM_SUBR_ENTRY (x).properties)
|
||||
#define SCM_SUBR_GENERIC(x) (SCM_SUBR_ENTRY (x).generic)
|
||||
#define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1])
|
||||
#define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x))
|
||||
#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))
|
||||
#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) g))
|
||||
|
||||
#define SCM_CCLO_LENGTH(x) (SCM_CELL_WORD_0 (x) >> 8)
|
||||
#define SCM_MAKE_CCLO_TAG(v) (((v) << 8) + scm_tc7_cclo)
|
||||
|
@ -124,10 +115,6 @@ typedef struct
|
|||
#define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj)
|
||||
#define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
|
||||
|
||||
SCM_API scm_t_subr_entry *scm_subr_table;
|
||||
|
||||
|
||||
|
||||
SCM_API SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)());
|
||||
SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type,
|
||||
SCM (*fcn)(), SCM *gf);
|
||||
|
@ -144,7 +131,6 @@ SCM_API SCM scm_procedure_with_setter_p (SCM obj);
|
|||
SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter);
|
||||
SCM_API SCM scm_procedure (SCM proc);
|
||||
SCM_API SCM scm_setter (SCM proc);
|
||||
SCM_INTERNAL void scm_init_subr_table (void);
|
||||
SCM_INTERNAL void scm_init_procs (void);
|
||||
|
||||
#ifdef GUILE_DEBUG
|
||||
|
|
|
@ -210,7 +210,7 @@ SCM_API int scm_pthread_cond_wait (pthread_cond_t *cond,
|
|||
pthread_mutex_t *mutex);
|
||||
SCM_API int scm_pthread_cond_timedwait (pthread_cond_t *cond,
|
||||
pthread_mutex_t *mutex,
|
||||
const struct timespec *abstime);
|
||||
const scm_t_timespec *abstime);
|
||||
#endif
|
||||
|
||||
/* More convenience functions.
|
||||
|
|
|
@ -34,3 +34,6 @@
|
|||
|
||||
(pass-if "basic syncase macro"
|
||||
(= (plus 1 2 3) (+ 1 2 3)))
|
||||
|
||||
(pass-if "@ works with syncase"
|
||||
(eq? run-test (@ (test-suite lib) run-test)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue