mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

maintainer changed: was lord, now jimb; first import

Browse source
This commit is contained in:
Jim Blandy 1996-07-25 22:56:11 +00:00
commit 0f2d19dd46
155 changed files with 53863 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

339
COPYING Normal file
View file

@ -0,0 +1,339 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991, 1992, 1993 Free Software Foundation, Inc.
675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

4
GUILE-VERSION Normal file
View file

@ -0,0 +1,4 @@
GUILE_MAJOR_VERSION=1
GUILE_MINOR_VERSION=0
GUILE_VERSION=$GUILE_MAJOR_VERSION.$GUILE_MINOR_VERSION

294
Makefile.in Normal file
View file

@ -0,0 +1,294 @@
# Copyright (C) 1994,1995 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this software; see the file COPYING. If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
SHELL = /bin/sh
subdirs=@existingdirs@
localfiles = ANNOUNCE \
COPYING \
Makefile.in \
configure \
configure.in \
config.sub \
config.guess \
install-sh
localtreats = ANN.BX
# `all'
# Compile the entire program. This should be the default target.
# This target need not rebuild any documentation files; info files
# should normally be included in the distribution, and DVI files
# should be made only when explicitly asked for.
all:
@for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} all; \
cd .. ;\
done
#`install'
# Compile the program and copy the executables, libraries, and so on
# to the file names where they should reside for actual use. If
# there is a simple test to verify that a program is properly
# installed then run that test.
#
# Use `-' before any command for installing a man page, so that
# `make' will ignore any errors. This is in case there are systems
# that don't have the Unix man page documentation system installed.
#
# In the future, when we have a standard way of installing info
# files, `install' targets will be the proper place to do so.
#
subdir-inst-target=install-nobuild
install: all
${MAKE} subdir-inst-target=install install-nobuild
install-nobuild:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} ${subdir-inst-target}; \
cd .. ;\
done
#`uninstall'
# Delete all the installed files that the `install' target would
# create (but not the noninstalled files such as `make all' would
# create).
uninstall:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} uninstall; \
cd .. ;\
done
#`clean'
# Delete all files from the current directory that are normally
# created by building the program. Don't delete the files that
# record the configuration. Also preserve files that could be made
# by building, but normally aren't because the distribution comes
# with them.
#
# Delete `.dvi' files here if they are not part of the distribution.
#
clean:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} clean; \
cd .. ;\
done
#`distclean'
# Delete all files from the current directory that are created by
# configuring or building the program. If you have unpacked the
# source and built the program without creating any other files,
# `make distclean' should leave only the files that were in the
# distribution.
distclean:
rm -f config.cache
rm -f config.log
rm -f config.status
rm -f Makefile
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} distclean; \
cd .. ;\
done
#`mostlyclean'
# Like `clean', but may refrain from deleting a few files that people
# normally don't want to recompile. For example, the `mostlyclean'
# target for GCC does not delete `libgcc.a', because recompiling it
# is rarely necessary and takes a lot of time.
mostlyclean:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} mostlyclean; \
cd .. ;\
done
#`realclean'
# Delete everything from the current directory that can be
# reconstructed with this Makefile. This typically includes
# everything deleted by distclean, plus more: C source files
# produced by Bison, tags tables, info files, and so on.
#
# One exception, however: `make realclean' should not delete
# `configure' even if `configure' can be remade using a rule in the
# Makefile. More generally, `make realclean' should not delete
# anything that needs to exist in order to run `configure' and then
# begin to build the program.
realclean:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} realclean; \
cd .. ;\
done
#`TAGS'
# Update a tags table for this program.
TAGS:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} TAGS; \
cd .. ;\
done
#`info'
# Generate any info files needed. The best way to write the rules
# is as follows:
#
# info: foo.info
#
# foo.info: $(srcdir)/foo.texi $(srcdir)/chap1.texi $(srcdir)/chap2.texi
# $(MAKEINFO) $(srcdir)/foo.texi
#
# You must define the variable `MAKEINFO' in the Makefile. It
# should run the Makeinfo program, which is part of the Texinfo2
# distribution.
info:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} info; \
cd .. ;\
done
#`dvi'
# Generate DVI files for all TeXinfo documentation. For example:
#
# dvi: foo.dvi
#
# foo.dvi: $(srcdir)/foo.texi $(srcdir)/chap1.texi $(srcdir)/chap2.texi
# $(TEXI2DVI) $(srcdir)/foo.texi
#
# You must define the variable `TEXI2DVI' in the Makefile. It should
# run the program `texi2dvi', which is part of the Texinfo2
# distribution. Alternatively, write just the dependencies, and
# allow GNU Make to provide the command.
dvi:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} dvi; \
cd .. ;\
done
#`dist'
# Create a distribution tar file for this program. The tar file
# should be set up so that the file names in the tar file start with
# a subdirectory name which is the name of the package it is a
# distribution for. This name can include the version number.
#
# For example, the distribution tar file of GCC version 1.40 unpacks
# into a subdirectory named `gcc-1.40'.
#
# The easiest way to do this is to create a subdirectory
# appropriately named, use `ln' or `cp' to install the proper files
# in it, and then `tar' that subdirectory.
#
# The `dist' target should explicitly depend on all non-source files
# that are in the distribution, to make sure they are up to date in
# the distribution. *Ref Making Releases: (standards)Releases.
distname = brand-x
distdir = $(distname)
treats = $(localtreats)
announcefile = ANN.BX
manifest-file:
rm -f MANIFEST
cp $(announcefile) ANNOUNCE
for treat in $(localfiles) $(treats) ; \
do echo $$treat >> MANIFEST ; \
done
for subdir in $(subdirs) ; do \
make -s -f $$subdir/Makefile.in SUBDIR=$$subdir manifest >> MANIFEST ; \
done
sed -e "s%^%$(distdir)/%" MANIFEST > M2
sed -e "/Entering dir/d" -e "/Leaving dir/d" M2 > MANIFEST
rm M2
dist: manifest-file
mkdir $(distdir)
- cd $(distdir); \
for file in $(localfiles) $(treats) $(subdirs); do ln -s ../$$file .; done; \
cd ..; \
gtar -zhcvf $(distname).tar.gz --files-from MANIFEST
rm -rf $(distdir)
-gtar ztvf $(distname).tar.gz | grep ".*~" > BACKUPS
test -s BACKUPS && (echo WARNING -- MANIFEST INCLUDES BACK FILES; cat BACKUPS)
#`check'
# Perform self-tests (if any). The user must build the program
# before running the tests, but need not install the program; you
# should write the self-tests so that they work when the program is
# built but not installed.
check:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} check; \
cd .. ;\
done
#`installcheck'
# Perform installation tests (if any). The user must build and
# install the program before running the tests. You should not
# assume that `$(bindir)' is in the search path.
installcheck:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} installcheck; \
cd .. ;\
done
#`installdirs'
# It's useful to add a target named `installdirs' to create the
# directories where files are installed, and their parent
# directories. There is a script called `mkinstalldirs' which is
# convenient for this; find it in the Texinfo package.You can use a
# rule like this:
#
# # Make sure all installation directories, e.g. $(bindir) actually exist by
# # making them if necessary.
# installdirs: mkinstalldirs
# $(srcdir)/mkinstalldirs $(bindir) $(datadir) $(libdir) \
# $(infodir) $(mandir)
installdirs:
for dir in ${subdirs}; do \
cd $$dir; \
${MAKE} installdirs; \
cd .. ;\
done
# Cygnus extention:
#
# `Makefile'
# Calls `./config.status' to rebuild the `Makefile' in this
# directory.
Makefile:
${SHELL-/bin/sh} config.status

497
config.guess vendored Executable file
View file

@ -0,0 +1,497 @@
#! /bin/sh
# Attempt to guess a canonical system name.
# Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
#
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
# Written by Per Bothner <bothner@cygnus.com>.
# The master version of this file is at the FSF in /home/gd/gnu/lib.
#
# This script attempts to guess a canonical system name similar to
# config.sub. If it succeeds, it prints the system name on stdout, and
# exits with 0. Otherwise, it exits with 1.
#
# The plan is that this can be called by configure scripts if you
# don't specify an explicit system type (host/target name).
#
# Only a few systems have been added to this list; please add others
# (but try to keep the structure clean).
#
# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
# (ghazi@noc.rutgers.edu 8/24/94.)
if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
PATH=$PATH:/.attbin ; export PATH
fi
UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15
# Note: order is significant - the case branches are not exclusive.
case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
alpha:OSF1:V*:*)
# After 1.2, OSF1 uses "V1.3" for uname -r.
echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^V//'`
exit 0 ;;
alpha:OSF1:*:*)
# 1.2 uses "1.2" for uname -r.
echo alpha-dec-osf${UNAME_RELEASE}
exit 0 ;;
amiga:NetBSD:*:*)
echo m68k-cbm-netbsd${UNAME_RELEASE}
exit 0 ;;
arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
echo arm-acorn-riscix${UNAME_RELEASE}
exit 0;;
Pyramid*:OSx*:*:*)
if test "`(/bin/universe) 2>/dev/null`" = att ; then
echo pyramid-pyramid-sysv3
else
echo pyramid-pyramid-bsd
fi
exit 0 ;;
sun4*:SunOS:5.*:*)
echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit 0 ;;
sun4*:SunOS:6*:*)
# According to config.sub, this is the proper way to canonicalize
# SunOS6. Hard to guess exactly what SunOS6 will be like, but
# it's likely to be more like Solaris than SunOS4.
echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit 0 ;;
sun4*:SunOS:*:*)
case "`/usr/bin/arch -k`" in
Series*|S4*)
UNAME_RELEASE=`uname -v`
;;
esac
# Japanese Language versions have a version number like `4.1.3-JL'.
echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
exit 0 ;;
sun3*:SunOS:*:*)
echo m68k-sun-sunos${UNAME_RELEASE}
exit 0 ;;
RISC*:ULTRIX:*:*)
echo mips-dec-ultrix${UNAME_RELEASE}
exit 0 ;;
VAX*:ULTRIX*:*:*)
echo vax-dec-ultrix${UNAME_RELEASE}
exit 0 ;;
mips:*:5*:RISCos)
echo mips-mips-riscos${UNAME_RELEASE}
exit 0 ;;
m88k:CX/UX:7*:*)
echo m88k-harris-cxux7
exit 0 ;;
m88k:*:4*:R4*)
echo m88k-motorola-sysv4
exit 0 ;;
m88k:*:3*:R3*)
echo m88k-motorola-sysv3
exit 0 ;;
AViiON:dgux:*:*)
if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \
-o ${TARGET_BINARY_INTERFACE}x = x ] ; then
echo m88k-dg-dgux${UNAME_RELEASE}
else
echo m88k-dg-dguxbcs${UNAME_RELEASE}
fi
exit 0 ;;
M88*:DolphinOS:*:*) # DolphinOS (SVR3)
echo m88k-dolphin-sysv3
exit 0 ;;
M88*:*:R3*:*)
# Delta 88k system running SVR3
echo m88k-motorola-sysv3
exit 0 ;;
XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
echo m88k-tektronix-sysv3
exit 0 ;;
Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
echo m68k-tektronix-bsd
exit 0 ;;
*:IRIX*:*:*)
echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'`
exit 0 ;;
????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX.
echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id
exit 0 ;; # Note that: echo "'`uname -s`'" gives 'AIX '
i[34]86:AIX:*:*)
echo i386-ibm-aix
exit 0 ;;
*:AIX:2:3)
if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
sed 's/^ //' << EOF >dummy.c
#include <sys/systemcfg.h>
main()
{
if (!__power_pc())
exit(1);
puts("powerpc-ibm-aix3.2.5");
exit(0);
}
EOF
${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0
rm -f dummy.c dummy
echo rs6000-ibm-aix3.2.5
elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
echo rs6000-ibm-aix3.2.4
else
echo rs6000-ibm-aix3.2
fi
exit 0 ;;
*:AIX:*:4)
if /usr/sbin/lsattr -EHl proc0 | grep POWER >/dev/null 2>&1; then
IBM_ARCH=rs6000
else
IBM_ARCH=powerpc
fi
if grep bos410 /usr/include/stdio.h >/dev/null 2>&1; then
IBM_REV=4.1
elif grep bos411 /usr/include/stdio.h >/dev/null 2>&1; then
IBM_REV=4.1.1
else
IBM_REV=4.${UNAME_RELEASE}
fi
echo ${IBM_ARCH}-ibm-aix${IBM_REV}
exit 0 ;;
*:AIX:*:*)
echo rs6000-ibm-aix
exit 0 ;;
ibmrt:4.4BSD:*|romp-ibm:BSD:*)
echo romp-ibm-bsd4.4
exit 0 ;;
ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and
echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to
exit 0 ;; # report: romp-ibm BSD 4.3
*:BOSX:*:*)
echo rs6000-bull-bosx
exit 0 ;;
DPX/2?00:B.O.S.:*:*)
echo m68k-bull-sysv3
exit 0 ;;
9000/[34]??:4.3bsd:1.*:*)
echo m68k-hp-bsd
exit 0 ;;
hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
echo m68k-hp-bsd4.4
exit 0 ;;
9000/[3478]??:HP-UX:*:*)
case "${UNAME_MACHINE}" in
9000/31? ) HP_ARCH=m68000 ;;
9000/[34]?? ) HP_ARCH=m68k ;;
9000/7?? | 9000/8?7 ) HP_ARCH=hppa1.1 ;;
9000/8?? ) HP_ARCH=hppa1.0 ;;
esac
HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
echo ${HP_ARCH}-hp-hpux${HPUX_REV}
exit 0 ;;
3050*:HI-UX:*:*)
sed 's/^ //' << EOF >dummy.c
#include <unistd.h>
int
main ()
{
long cpu = sysconf (_SC_CPU_VERSION);
/* The order matters, because CPU_IS_HP_MC68K erroneously returns
true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
results, however. */
if (CPU_IS_PA_RISC (cpu))
{
switch (cpu)
{
case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
default: puts ("hppa-hitachi-hiuxwe2"); break;
}
}
else if (CPU_IS_HP_MC68K (cpu))
puts ("m68k-hitachi-hiuxwe2");
else puts ("unknown-hitachi-hiuxwe2");
exit (0);
}
EOF
${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0
rm -f dummy.c dummy
echo unknown-hitachi-hiuxwe2
exit 0 ;;
9000/7??:4.3bsd:*:* | 9000/8?7:4.3bsd:*:* )
echo hppa1.1-hp-bsd
exit 0 ;;
9000/8??:4.3bsd:*:*)
echo hppa1.0-hp-bsd
exit 0 ;;
hp7??:OSF1:*:* | hp8?7:OSF1:*:* )
echo hppa1.1-hp-osf
exit 0 ;;
hp8??:OSF1:*:*)
echo hppa1.0-hp-osf
exit 0 ;;
C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
echo c1-convex-bsd
exit 0 ;;
C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
if getsysinfo -f scalar_acc
then echo c32-convex-bsd
else echo c2-convex-bsd
fi
exit 0 ;;
C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
echo c34-convex-bsd
exit 0 ;;
C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
echo c38-convex-bsd
exit 0 ;;
C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
echo c4-convex-bsd
exit 0 ;;
CRAY*X-MP:UNICOS:*:*)
echo xmp-cray-unicos
exit 0 ;;
CRAY*Y-MP:UNICOS:*:*)
echo ymp-cray-unicos
exit 0 ;;
CRAY-2:UNICOS:*:*)
echo cray2-cray-unicos
exit 0 ;;
hp3[0-9][05]:NetBSD:*:*)
echo m68k-hp-netbsd${UNAME_RELEASE}
exit 0 ;;
i[34]86:BSD/386:*:* | *:BSD/OS:*:*)
echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
exit 0 ;;
*:FreeBSD:*:*)
echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
exit 0 ;;
*:NetBSD:*:*)
echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
exit 0 ;;
*:GNU:*:*)
echo `echo ${UNAME_MACHINE}|sed -e 's,/.*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
exit 0 ;;
*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux
exit 0 ;;
# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions
# are messed up and put the nodename in both sysname and nodename.
i[34]86:DYNIX/ptx:4*:*)
echo i386-sequent-sysv4
exit 0 ;;
i[34]86:*:4.*:* | i[34]86:SYSTEM_V:4.*:*)
if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE}
else
echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}
fi
exit 0 ;;
i[34]86:*:3.2:*)
if test -f /usr/options/cb.name; then
UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
echo ${UNAME_MACHINE}-unknown-isc$UNAME_REL
elif /bin/uname -X 2>/dev/null >/dev/null ; then
UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
(/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
echo ${UNAME_MACHINE}-unknown-sco$UNAME_REL
else
echo ${UNAME_MACHINE}-unknown-sysv32
fi
exit 0 ;;
Intel:Mach:3*:*)
echo i386-unknown-mach3
exit 0 ;;
paragon:*:*:*)
echo i860-intel-osf1
exit 0 ;;
i860:*:4.*:*) # i860-SVR4
if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
else # Add other i860-SVR4 vendors below as they are discovered.
echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4
fi
exit 0 ;;
mini*:CTIX:SYS*5:*)
# "miniframe"
echo m68010-convergent-sysv
exit 0 ;;
M680[234]0:*:R3V[567]*:*)
test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0)
uname -p 2>/dev/null | grep 86 >/dev/null \
&& echo i486-ncr-sysv4.3 && exit 0 ;;
3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
uname -p 2>/dev/null | grep 86 >/dev/null \
&& echo i486-ncr-sysv4 && exit 0 ;;
m680[234]0:LynxOS:2.2*:*)
echo m68k-lynx-lynxos${UNAME_RELEASE}
exit 0 ;;
mc68030:UNIX_System_V:4.*:*)
echo m68k-atari-sysv4
exit 0 ;;
i[34]86:LynxOS:2.2*:*)
echo i386-lynx-lynxos${UNAME_RELEASE}
exit 0 ;;
TSUNAMI:LynxOS:2.2*:*)
echo sparc-lynx-lynxos${UNAME_RELEASE}
exit 0 ;;
rs6000:LynxOS:2.2*:*)
echo rs6000-lynx-lynxos${UNAME_RELEASE}
exit 0 ;;
RM*:SINIX-*:*:*)
echo mips-sni-sysv4
exit 0 ;;
*:SINIX-*:*:*)
if uname -p 2>/dev/null >/dev/null ; then
UNAME_MACHINE=`(uname -p) 2>/dev/null`
echo ${UNAME_MACHINE}-sni-sysv4
else
echo ns32k-sni-sysv
fi
exit 0 ;;
esac
#echo '(No uname command or uname output not recognized.)' 1>&2
#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
cat >dummy.c <<EOF
main ()
{
#if defined (sony)
#if defined (MIPSEB)
/* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
I don't know.... */
printf ("mips-sony-bsd\n"); exit (0);
#else
#include <sys/param.h>
printf ("m68k-sony-newsos%s\n",
#ifdef NEWSOS4
"4"
#else
""
#endif
); exit (0);
#endif
#endif
#if defined (__arm) && defined (__acorn) && defined (__unix)
printf ("arm-acorn-riscix"); exit (0);
#endif
#if defined (hp300) && !defined (hpux)
printf ("m68k-hp-bsd\n"); exit (0);
#endif
#if defined (NeXT)
#if !defined (__ARCHITECTURE__)
#define __ARCHITECTURE__ "m68k"
#endif
int version;
version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
printf ("%s-next-nextstep%s\n", __ARCHITECTURE__, version==2 ? "2" : "3");
exit (0);
#endif
#if defined (MULTIMAX) || defined (n16)
#if defined (UMAXV)
printf ("ns32k-encore-sysv\n"); exit (0);
#else
#if defined (CMU)
printf ("ns32k-encore-mach\n"); exit (0);
#else
printf ("ns32k-encore-bsd\n"); exit (0);
#endif
#endif
#endif
#if defined (__386BSD__)
printf ("i386-unknown-bsd\n"); exit (0);
#endif
#if defined (sequent)
#if defined (i386)
printf ("i386-sequent-dynix\n"); exit (0);
#endif
#if defined (ns32000)
printf ("ns32k-sequent-dynix\n"); exit (0);
#endif
#endif
#if defined (_SEQUENT_)
printf ("i386-sequent-ptx\n"); exit (0);
#endif
#if defined (vax)
#if !defined (ultrix)
printf ("vax-dec-bsd\n"); exit (0);
#else
printf ("vax-dec-ultrix\n"); exit (0);
#endif
#endif
#if defined (alliant) && defined (i860)
printf ("i860-alliant-bsd\n"); exit (0);
#endif
exit (1);
}
EOF
${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy && rm dummy.c dummy && exit 0
rm -f dummy.c dummy
# Apollos put the system type in the environment.
test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; }
# Convex versions that predate uname can use getsysinfo(1)
if [ -x /usr/convex/getsysinfo ]
then
case `getsysinfo -f cpu_type` in
c1*)
echo c1-convex-bsd
exit 0 ;;
c2*)
if getsysinfo -f scalar_acc
then echo c32-convex-bsd
else echo c2-convex-bsd
fi
exit 0 ;;
c34*)
echo c34-convex-bsd
exit 0 ;;
c38*)
echo c38-convex-bsd
exit 0 ;;
c4*)
echo c4-convex-bsd
exit 0 ;;
esac
fi
#echo '(Unable to guess system type)' 1>&2
exit 1

833
config.sub vendored Executable file
View file

@ -0,0 +1,833 @@
#! /bin/sh
# Configuration validation subroutine script, version 1.1.
# Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
# This file is (in principle) common to ALL GNU software.
# The presence of a machine in this file suggests that SOME GNU software
# can handle that machine. It does not imply ALL GNU software can.
#
# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
# Configuration subroutine to validate and canonicalize a configuration type.
# Supply the specified configuration type as an argument.
# If it is invalid, we print an error message on stderr and exit with code 1.
# Otherwise, we print the canonical config type on stdout and succeed.
# This file is supposed to be the same for all GNU packages
# and recognize all the CPU types, system types and aliases
# that are meaningful with *any* GNU software.
# Each package is responsible for reporting which valid configurations
# it does not support. The user should be able to distinguish
# a failure to support a valid configuration from a meaningless
# configuration.
# The goal of this file is to map all the various variations of a given
# machine specification into a single specification in the form:
# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
# It is wrong to echo any other type of specification.
if [ x$1 = x ]
then
echo Configuration name missing. 1>&2
echo "Usage: $0 CPU-MFR-OPSYS" 1>&2
echo "or $0 ALIAS" 1>&2
echo where ALIAS is a recognized configuration type. 1>&2
exit 1
fi
# First pass through any local machine types.
case $1 in
*local*)
echo $1
exit 0
;;
*)
;;
esac
# Separate what the user gave into CPU-COMPANY and OS (if any).
basic_machine=`echo $1 | sed 's/-[^-]*$//'`
if [ $basic_machine != $1 ]
then os=`echo $1 | sed 's/.*-/-/'`
else os=; fi
### Let's recognize common machines as not being operating systems so
### that things like config.sub decstation-3100 work. We also
### recognize some manufacturers as not being operating systems, so we
### can provide default operating systems below.
case $os in
-sun*os*)
# Prevent following clause from handling this invalid input.
;;
-dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
-att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
-unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp )
os=
basic_machine=$1
;;
-hiux*)
os=-hiuxwe2
;;
-sco4)
os=-sco3.2v4
basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
;;
-sco3.2.[4-9]*)
os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
;;
-sco3.2v[4-9]*)
# Don't forget version if it is 3.2v4 or newer.
basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
;;
-sco*)
os=-sco3.2v2
basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
;;
-isc)
os=-isc2.2
basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
;;
-clix*)
basic_machine=clipper-intergraph
;;
-isc*)
basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
;;
-lynx*)
os=-lynxos
;;
-ptx*)
basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
;;
-windowsnt*)
os=`echo $os | sed -e 's/windowsnt/winnt/'`
;;
esac
# Decode aliases for certain CPU-COMPANY combinations.
case $basic_machine in
# Recognize the basic CPU types without company name.
# Some are omitted here because they have special meanings below.
tahoe | i[345]86 | i860 | m68k | m68000 | m88k | ns32k | arm | pyramid \
| tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \
| alpha | we32k | ns16k | clipper | sparclite | i370 | sh \
| powerpc | sparc64 | 1750a | dsp16xx | mips64 | mipsel \
| pdp11 | mips64el | mips64orion | mips64orionel \
| sparc)
basic_machine=$basic_machine-unknown
;;
# Object if more than one company name word.
*-*-*)
echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
exit 1
;;
# Recognize the basic CPU types with company name.
vax-* | tahoe-* | i[345]86-* | i860-* | m68k-* | m68000-* | m88k-* \
| sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \
| mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \
| none-* | 580-* | cray2-* | h8300-* | i960-* | xmp-* | ymp-* \
| hppa1.0-* | hppa1.1-* | alpha-* | we32k-* | cydra-* | ns16k-* \
| pn-* | np1-* | xps100-* | clipper-* | orion-* | sparclite-* \
| pdp11-* | sh-* | powerpc-* | sparc64-* | mips64-* | mipsel-* \
| mips64el-* | mips64orion-* | mips64orionel-*)
;;
# Recognize the various machine names and aliases which stand
# for a CPU type and a company and sometimes even an OS.
3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
basic_machine=m68000-att
;;
3b*)
basic_machine=we32k-att
;;
alliant | fx80)
basic_machine=fx80-alliant
;;
altos | altos3068)
basic_machine=m68k-altos
;;
am29k)
basic_machine=a29k-none
os=-bsd
;;
amdahl)
basic_machine=580-amdahl
os=-sysv
;;
amiga | amiga-*)
basic_machine=m68k-cbm
;;
amigados)
basic_machine=m68k-cbm
os=-amigados
;;
amigaunix | amix)
basic_machine=m68k-cbm
os=-sysv4
;;
apollo68)
basic_machine=m68k-apollo
os=-sysv
;;
balance)
basic_machine=ns32k-sequent
os=-dynix
;;
convex-c1)
basic_machine=c1-convex
os=-bsd
;;
convex-c2)
basic_machine=c2-convex
os=-bsd
;;
convex-c32)
basic_machine=c32-convex
os=-bsd
;;
convex-c34)
basic_machine=c34-convex
os=-bsd
;;
convex-c38)
basic_machine=c38-convex
os=-bsd
;;
cray | ymp)
basic_machine=ymp-cray
os=-unicos
;;
cray2)
basic_machine=cray2-cray
os=-unicos
;;
crds | unos)
basic_machine=m68k-crds
;;
da30 | da30-*)
basic_machine=m68k-da30
;;
decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
basic_machine=mips-dec
;;
delta | 3300 | motorola-3300 | motorola-delta \
| 3300-motorola | delta-motorola)
basic_machine=m68k-motorola
;;
delta88)
basic_machine=m88k-motorola
os=-sysv3
;;
dpx20 | dpx20-*)
basic_machine=rs6000-bull
os=-bosx
;;
dpx2* | dpx2*-bull)
basic_machine=m68k-bull
os=-sysv3
;;
ebmon29k)
basic_machine=a29k-amd
os=-ebmon
;;
elxsi)
basic_machine=elxsi-elxsi
os=-bsd
;;
encore | umax | mmax)
basic_machine=ns32k-encore
;;
fx2800)
basic_machine=i860-alliant
;;
genix)
basic_machine=ns32k-ns
;;
gmicro)
basic_machine=tron-gmicro
os=-sysv
;;
h3050r* | hiux*)
basic_machine=hppa1.1-hitachi
os=-hiuxwe2
;;
h8300hms)
basic_machine=h8300-hitachi
os=-hms
;;
harris)
basic_machine=m88k-harris
os=-sysv3
;;
hp300-*)
basic_machine=m68k-hp
;;
hp300bsd)
basic_machine=m68k-hp
os=-bsd
;;
hp300hpux)
basic_machine=m68k-hp
os=-hpux
;;
hp9k2[0-9][0-9] | hp9k31[0-9])
basic_machine=m68000-hp
;;
hp9k3[2-9][0-9])
basic_machine=m68k-hp
;;
hp9k7[0-9][0-9] | hp7[0-9][0-9] | hp9k8[0-9]7 | hp8[0-9]7)
basic_machine=hppa1.1-hp
;;
hp9k8[0-9][0-9] | hp8[0-9][0-9])
basic_machine=hppa1.0-hp
;;
i370-ibm* | ibm*)
basic_machine=i370-ibm
os=-mvs
;;
# I'm not sure what "Sysv32" means. Should this be sysv3.2?
i[345]86v32)
basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
os=-sysv32
;;
i[345]86v4*)
basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
os=-sysv4
;;
i[345]86v)
basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
os=-sysv
;;
i[345]86sol2)
basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
os=-solaris2
;;
iris | iris4d)
basic_machine=mips-sgi
case $os in
-irix*)
;;
*)
os=-irix4
;;
esac
;;
isi68 | isi)
basic_machine=m68k-isi
os=-sysv
;;
m88k-omron*)
basic_machine=m88k-omron
;;
magnum | m3230)
basic_machine=mips-mips
os=-sysv
;;
merlin)
basic_machine=ns32k-utek
os=-sysv
;;
miniframe)
basic_machine=m68000-convergent
;;
mips3*-*)
basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
;;
mips3*)
basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
;;
ncr3000)
basic_machine=i486-ncr
os=-sysv4
;;
news | news700 | news800 | news900)
basic_machine=m68k-sony
os=-newsos
;;
news1000)
basic_machine=m68030-sony
os=-newsos
;;
news-3600 | risc-news)
basic_machine=mips-sony
os=-newsos
;;
next | m*-next )
basic_machine=m68k-next
case $os in
-nextstep* )
;;
-ns2*)
os=-nextstep2
;;
*)
os=-nextstep3
;;
esac
;;
nh3000)
basic_machine=m68k-harris
os=-cxux
;;
nh[45]000)
basic_machine=m88k-harris
os=-cxux
;;
nindy960)
basic_machine=i960-intel
os=-nindy
;;
np1)
basic_machine=np1-gould
;;
pa-hitachi)
basic_machine=hppa1.1-hitachi
os=-hiuxwe2
;;
paragon)
basic_machine=i860-intel
os=-osf
;;
pbd)
basic_machine=sparc-tti
;;
pbb)
basic_machine=m68k-tti
;;
pc532 | pc532-*)
basic_machine=ns32k-pc532
;;
pentium-*)
# We will change tis to say i586 once there has been
# time for various packages to start to recognize that.
basic_machine=i486-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pn)
basic_machine=pn-gould
;;
ps2)
basic_machine=i386-ibm
;;
rm[46]00)
basic_machine=mips-siemens
;;
rtpc | rtpc-*)
basic_machine=romp-ibm
;;
sequent)
basic_machine=i386-sequent
;;
sh)
basic_machine=sh-hitachi
os=-hms
;;
sps7)
basic_machine=m68k-bull
os=-sysv2
;;
spur)
basic_machine=spur-unknown
;;
sun2)
basic_machine=m68000-sun
;;
sun2os3)
basic_machine=m68000-sun
os=-sunos3
;;
sun2os4)
basic_machine=m68000-sun
os=-sunos4
;;
sun3os3)
basic_machine=m68k-sun
os=-sunos3
;;
sun3os4)
basic_machine=m68k-sun
os=-sunos4
;;
sun4os3)
basic_machine=sparc-sun
os=-sunos3
;;
sun4os4)
basic_machine=sparc-sun
os=-sunos4
;;
sun4sol2)
basic_machine=sparc-sun
os=-solaris2
;;
sun3 | sun3-*)
basic_machine=m68k-sun
;;
sun4)
basic_machine=sparc-sun
;;
sun386 | sun386i | roadrunner)
basic_machine=i386-sun
;;
symmetry)
basic_machine=i386-sequent
os=-dynix
;;
tower | tower-32)
basic_machine=m68k-ncr
;;
udi29k)
basic_machine=a29k-amd
os=-udi
;;
ultra3)
basic_machine=a29k-nyu
os=-sym1
;;
vaxv)
basic_machine=vax-dec
os=-sysv
;;
vms)
basic_machine=vax-dec
os=-vms
;;
vxworks960)
basic_machine=i960-wrs
os=-vxworks
;;
vxworks68)
basic_machine=m68k-wrs
os=-vxworks
;;
xmp)
basic_machine=xmp-cray
os=-unicos
;;
xps | xps100)
basic_machine=xps100-honeywell
;;
none)
basic_machine=none-none
os=-none
;;
# Here we handle the default manufacturer of certain CPU types. It is in
# some cases the only manufacturer, in others, it is the most popular.
mips)
basic_machine=mips-mips
;;
romp)
basic_machine=romp-ibm
;;
rs6000)
basic_machine=rs6000-ibm
;;
vax)
basic_machine=vax-dec
;;
pdp11)
basic_machine=pdp11-dec
;;
we32k)
basic_machine=we32k-att
;;
sparc)
basic_machine=sparc-sun
;;
cydra)
basic_machine=cydra-cydrome
;;
orion)
basic_machine=orion-highlevel
;;
orion105)
basic_machine=clipper-highlevel
;;
*)
echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
exit 1
;;
esac
# Here we canonicalize certain aliases for manufacturers.
case $basic_machine in
*-digital*)
basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
;;
*-commodore*)
basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
;;
*)
;;
esac
# Decode manufacturer-specific aliases for certain operating systems.
if [ x"$os" != x"" ]
then
case $os in
# -solaris* is a basic system type, with this one exception.
-solaris1 | -solaris1.*)
os=`echo $os | sed -e 's|solaris1|sunos4|'`
;;
-solaris)
os=-solaris2
;;
-unixware* | svr4*)
os=-sysv4
;;
-gnu/linux*)
os=`echo $os | sed -e 's|gnu/linux|linux|'`
;;
# First accept the basic system types.
# The portable systems comes first.
# Each alternative must end in a *, to match a version number.
# -sysv* is not here because it comes later, after sysvr4.
-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
| -vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[345]* \
| -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
| -amigados* | -msdos* | -newsos* | -unicos* | -aos* \
| -nindy* | -vxworks* | -ebmon* | -hms* | -mvs* | -clix* \
| -riscos* | -linux* | -uniplus* | -iris* | -rtu* | -xenix* \
| -hiux* | -386bsd* | -netbsd* | -freebsd* | -riscix* \
| -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \
| -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta | -udi | -eabi)
;;
-sunos5*)
os=`echo $os | sed -e 's|sunos5|solaris2|'`
;;
-sunos6*)
os=`echo $os | sed -e 's|sunos6|solaris3|'`
;;
-osfrose*)
os=-osfrose
;;
-osf*)
os=-osf
;;
-utek*)
os=-bsd
;;
-dynix*)
os=-bsd
;;
-acis*)
os=-aos
;;
-ctix* | -uts*)
os=-sysv
;;
# Preserve the version number of sinix5.
-sinix5.*)
os=`echo $os | sed -e 's|sinix|sysv|'`
;;
-sinix*)
os=-sysv4
;;
-triton*)
os=-sysv3
;;
-oss*)
os=-sysv3
;;
-svr4)
os=-sysv4
;;
-svr3)
os=-sysv3
;;
-sysvr4)
os=-sysv4
;;
# This must come after -sysvr4.
-sysv*)
;;
-xenix)
os=-xenix
;;
-none)
;;
*)
# Get rid of the `-' at the beginning of $os.
os=`echo $os | sed 's/[^-]*-//'`
echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
exit 1
;;
esac
else
# Here we handle the default operating systems that come with various machines.
# The value should be what the vendor currently ships out the door with their
# machine or put another way, the most popular os provided with the machine.
# Note that if you're going to try to match "-MANUFACTURER" here (say,
# "-sun"), then you have to tell the case statement up towards the top
# that MANUFACTURER isn't an operating system. Otherwise, code above
# will signal an error saying that MANUFACTURER isn't an operating
# system, and we'll never get to this point.
case $basic_machine in
*-acorn)
os=-riscix1.2
;;
pdp11-*)
os=-none
;;
*-dec | vax-*)
os=-ultrix4.2
;;
m68*-apollo)
os=-domain
;;
i386-sun)
os=-sunos4.0.2
;;
m68000-sun)
os=-sunos3
# This also exists in the configure program, but was not the
# default.
# os=-sunos4
;;
*-tti) # must be before sparc entry or we get the wrong os.
os=-sysv3
;;
sparc-* | *-sun)
os=-sunos4.1.1
;;
*-ibm)
os=-aix
;;
*-hp)
os=-hpux
;;
*-hitachi)
os=-hiux
;;
i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
os=-sysv
;;
*-cbm)
os=-amigados
;;
*-dg)
os=-dgux
;;
*-dolphin)
os=-sysv3
;;
m68k-ccur)
os=-rtu
;;
m88k-omron*)
os=-luna
;;
*-sequent)
os=-ptx
;;
*-crds)
os=-unos
;;
*-ns)
os=-genix
;;
i370-*)
os=-mvs
;;
*-next)
os=-nextstep3
;;
*-gould)
os=-sysv
;;
*-highlevel)
os=-bsd
;;
*-encore)
os=-bsd
;;
*-sgi)
os=-irix
;;
*-siemens)
os=-sysv4
;;
*-masscomp)
os=-rtu
;;
*)
os=-none
;;
esac
fi
# Here we handle the case where we know the os, and the CPU type, but not the
# manufacturer. We pick the logical manufacturer.
vendor=unknown
case $basic_machine in
*-unknown)
case $os in
-riscix*)
vendor=acorn
;;
-sunos*)
vendor=sun
;;
-lynxos*)
vendor=lynx
;;
-aix*)
vendor=ibm
;;
-hpux*)
vendor=hp
;;
-hiux*)
vendor=hitachi
;;
-unos*)
vendor=crds
;;
-dgux*)
vendor=dg
;;
-luna*)
vendor=omron
;;
-genix*)
vendor=ns
;;
-mvs*)
vendor=ibm
;;
-ptx*)
vendor=sequent
;;
-vxworks*)
vendor=wrs
;;
esac
basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
;;
esac
echo $basic_machine$os

868
configure vendored Executable file
View file

@ -0,0 +1,868 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated automatically using autoconf version 2.9
# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
# Defaults:
ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
# Initialize some variables set by options.
# The variables have the same names as the options, with
# dashes changed to underlines.
build=NONE
cache_file=./config.cache
exec_prefix=NONE
host=NONE
no_create=
nonopt=NONE
no_recursion=
prefix=NONE
program_prefix=NONE
program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
srcdir=
target=NONE
verbose=
x_includes=NONE
x_libraries=NONE
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datadir='${prefix}/share'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
infodir='${prefix}/info'
mandir='${prefix}/man'
# Initialize some other variables.
subdirs=
MFLAGS= MAKEFLAGS=
ac_prev=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
eval "$ac_prev=\$ac_option"
ac_prev=
continue
fi
case "$ac_option" in
-*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
*) ac_optarg= ;;
esac
# Accept the important Cygnus configure options, so we can diagnose typos.
case "$ac_option" in
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
-bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
bindir="$ac_optarg" ;;
-build | --build | --buil | --bui | --bu)
ac_prev=build ;;
-build=* | --build=* | --buil=* | --bui=* | --bu=*)
build="$ac_optarg" ;;
-cache-file | --cache-file | --cache-fil | --cache-fi \
| --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
ac_prev=cache_file ;;
-cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
| --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
cache_file="$ac_optarg" ;;
-datadir | --datadir | --datadi | --datad | --data | --dat | --da)
ac_prev=datadir ;;
-datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
| --da=*)
datadir="$ac_optarg" ;;
-disable-* | --disable-*)
ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
{ echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
fi
ac_feature=`echo $ac_feature| sed 's/-/_/g'`
eval "enable_${ac_feature}=no" ;;
-enable-* | --enable-*)
ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
{ echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
fi
ac_feature=`echo $ac_feature| sed 's/-/_/g'`
case "$ac_option" in
*=*) ;;
*) ac_optarg=yes ;;
esac
eval "enable_${ac_feature}='$ac_optarg'" ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
| --exec | --exe | --ex)
ac_prev=exec_prefix ;;
-exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
| --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
| --exec=* | --exe=* | --ex=*)
exec_prefix="$ac_optarg" ;;
-gas | --gas | --ga | --g)
# Obsolete; use --with-gas.
with_gas=yes ;;
-help | --help | --hel | --he)
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat << EOF
Usage: configure [options] [host]
Options: [defaults in brackets after descriptions]
Configuration:
--cache-file=FILE cache test results in FILE
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
[$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
[same as prefix]
--bindir=DIR user executables in DIR [EPREFIX/bin]
--sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
--libexecdir=DIR program executables in DIR [EPREFIX/libexec]
--datadir=DIR read-only architecture-independent data in DIR
[PREFIX/share]
--sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data in DIR
[PREFIX/com]
--localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
--libdir=DIR object code libraries in DIR [EPREFIX/lib]
--includedir=DIR C header files in DIR [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
--infodir=DIR info documentation in DIR [PREFIX/info]
--mandir=DIR man documentation in DIR [PREFIX/man]
--srcdir=DIR find the sources in DIR [configure dir or ..]
--program-prefix=PREFIX prepend PREFIX to installed program names
--program-suffix=SUFFIX append SUFFIX to installed program names
--program-transform-name=PROGRAM
run sed PROGRAM on installed program names
EOF
cat << EOF
Host type:
--build=BUILD configure for building on BUILD [BUILD=HOST]
--host=HOST configure for HOST [guessed]
--target=TARGET configure for TARGET [TARGET=HOST]
Features and packages:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--x-includes=DIR X include files are in DIR
--x-libraries=DIR X library files are in DIR
EOF
if test -n "$ac_help"; then
echo "--enable and --with options recognized:$ac_help"
fi
exit 0 ;;
-host | --host | --hos | --ho)
ac_prev=host ;;
-host=* | --host=* | --hos=* | --ho=*)
host="$ac_optarg" ;;
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
-includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
| --includ=* | --inclu=* | --incl=* | --inc=*)
includedir="$ac_optarg" ;;
-infodir | --infodir | --infodi | --infod | --info | --inf)
ac_prev=infodir ;;
-infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
infodir="$ac_optarg" ;;
-libdir | --libdir | --libdi | --libd)
ac_prev=libdir ;;
-libdir=* | --libdir=* | --libdi=* | --libd=*)
libdir="$ac_optarg" ;;
-libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
| --libexe | --libex | --libe)
ac_prev=libexecdir ;;
-libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
| --libexe=* | --libex=* | --libe=*)
libexecdir="$ac_optarg" ;;
-localstatedir | --localstatedir | --localstatedi | --localstated \
| --localstate | --localstat | --localsta | --localst \
| --locals | --local | --loca | --loc | --lo)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
| --localstate=* | --localstat=* | --localsta=* | --localst=* \
| --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
localstatedir="$ac_optarg" ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
ac_prev=mandir ;;
-mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
mandir="$ac_optarg" ;;
-nfp | --nfp | --nf)
# Obsolete; use --without-fp.
with_fp=no ;;
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c)
no_create=yes ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
no_recursion=yes ;;
-oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
| --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
| --oldin | --oldi | --old | --ol | --o)
ac_prev=oldincludedir ;;
-oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
| --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
| --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
oldincludedir="$ac_optarg" ;;
-prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
ac_prev=prefix ;;
-prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
prefix="$ac_optarg" ;;
-program-prefix | --program-prefix | --program-prefi | --program-pref \
| --program-pre | --program-pr | --program-p)
ac_prev=program_prefix ;;
-program-prefix=* | --program-prefix=* | --program-prefi=* \
| --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
program_prefix="$ac_optarg" ;;
-program-suffix | --program-suffix | --program-suffi | --program-suff \
| --program-suf | --program-su | --program-s)
ac_prev=program_suffix ;;
-program-suffix=* | --program-suffix=* | --program-suffi=* \
| --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
program_suffix="$ac_optarg" ;;
-program-transform-name | --program-transform-name \
| --program-transform-nam | --program-transform-na \
| --program-transform-n | --program-transform- \
| --program-transform | --program-transfor \
| --program-transfo | --program-transf \
| --program-trans | --program-tran \
| --progr-tra | --program-tr | --program-t)
ac_prev=program_transform_name ;;
-program-transform-name=* | --program-transform-name=* \
| --program-transform-nam=* | --program-transform-na=* \
| --program-transform-n=* | --program-transform-=* \
| --program-transform=* | --program-transfor=* \
| --program-transfo=* | --program-transf=* \
| --program-trans=* | --program-tran=* \
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name="$ac_optarg" ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
| --sbi=* | --sb=*)
sbindir="$ac_optarg" ;;
-sharedstatedir | --sharedstatedir | --sharedstatedi \
| --sharedstated | --sharedstate | --sharedstat | --sharedsta \
| --sharedst | --shareds | --shared | --share | --shar \
| --sha | --sh)
ac_prev=sharedstatedir ;;
-sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
| --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
| --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
| --sha=* | --sh=*)
sharedstatedir="$ac_optarg" ;;
-site | --site | --sit)
ac_prev=site ;;
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
srcdir="$ac_optarg" ;;
-sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
| --syscon | --sysco | --sysc | --sys | --sy)
ac_prev=sysconfdir ;;
-sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
| --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
sysconfdir="$ac_optarg" ;;
-target | --target | --targe | --targ | --tar | --ta | --t)
ac_prev=target ;;
-target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
target="$ac_optarg" ;;
-v | -verbose | --verbose | --verbos | --verbo | --verb)
verbose=yes ;;
-version | --version | --versio | --versi | --vers)
echo "configure generated by autoconf version 2.9"
exit 0 ;;
-with-* | --with-*)
ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
{ echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
fi
ac_package=`echo $ac_package| sed 's/-/_/g'`
case "$ac_option" in
*=*) ;;
*) ac_optarg=yes ;;
esac
eval "with_${ac_package}='$ac_optarg'" ;;
-without-* | --without-*)
ac_package=`echo $ac_option|sed -e 's/-*without-//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
{ echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
fi
ac_package=`echo $ac_package| sed 's/-/_/g'`
eval "with_${ac_package}=no" ;;
--x)
# Obsolete; use --with-x.
with_x=yes ;;
-x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
| --x-incl | --x-inc | --x-in | --x-i)
ac_prev=x_includes ;;
-x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
| --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
x_includes="$ac_optarg" ;;
-x-libraries | --x-libraries | --x-librarie | --x-librari \
| --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
ac_prev=x_libraries ;;
-x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries="$ac_optarg" ;;
-*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
;;
*)
if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
echo "configure: warning: $ac_option: invalid host type" 1>&2
fi
if test "x$nonopt" != xNONE; then
{ echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
fi
nonopt="$ac_option"
;;
esac
done
if test -n "$ac_prev"; then
{ echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
fi
trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
# File descriptor usage:
# 0 standard input
# 1 file creation
# 2 errors and warnings
# 3 some systems may open it to /dev/tty
# 4 used on the Kubota Titan
# 6 checking for... messages and results
# 5 compiler messages saved in config.log
if test "$silent" = yes; then
exec 6>/dev/null
else
exec 6>&1
fi
exec 5>./config.log
echo "\
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
" 1>&5
# Strip out --no-create and --no-recursion so they do not pile up.
# Also quote any args containing shell metacharacters.
ac_configure_args=
for ac_arg
do
case "$ac_arg" in
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c) ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
*" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
ac_configure_args="$ac_configure_args '$ac_arg'" ;;
*) ac_configure_args="$ac_configure_args $ac_arg" ;;
esac
done
# NLS nuisances.
# Only set LANG and LC_ALL to C if already set.
# These must not be set unconditionally because not all systems understand
# e.g. LANG=C (notably SCO).
if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
if test "${LANG+set}" = set; then LANG=C; export LANG; fi
# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -rf conftest* confdefs.h
# AIX cpp loses on an empty file, so make sure it contains at least a newline.
echo > confdefs.h
# A filename unique to this package, relative to the directory that
# configure is in, which we can look for to find out if srcdir is correct.
ac_unique_file=Makefile.in
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
# Try the directory containing this script, then its parent.
ac_prog=$0
ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
srcdir=$ac_confdir
if test ! -r $srcdir/$ac_unique_file; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
if test ! -r $srcdir/$ac_unique_file; then
if test "$ac_srcdir_defaulted" = yes; then
{ echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
else
{ echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
fi
fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
if test -z "$CONFIG_SITE"; then
if test "x$prefix" != xNONE; then
CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
else
CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
fi
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
echo "loading site script $ac_site_file"
. "$ac_site_file"
fi
done
if test -r "$cache_file"; then
echo "loading cache $cache_file"
. $cache_file
else
echo "creating cache $cache_file"
> $cache_file
fi
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
# Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
ac_n= ac_c='
' ac_t=' '
else
ac_n=-n ac_c= ac_t=
fi
else
ac_n= ac_c='\c' ac_t=
fi
all_subdirs=`cat $srcdir/*/PLUGIN/REQ $srcdir/*/PLUGIN/OPT /dev/null | tsort | xargs echo`
req_subdirs=`cat $srcdir/*/PLUGIN/REQ /dev/null | tsort | xargs echo`
opt_subdirs=`cat $srcdir/*/PLUGIN/OPT /dev/null | tsort | xargs echo`
ac_aux_dir=
for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
if test -f $ac_dir/install-sh; then
ac_aux_dir=$ac_dir
ac_install_sh="$ac_aux_dir/install-sh -c"
break
elif test -f $ac_dir/install.sh; then
ac_aux_dir=$ac_dir
ac_install_sh="$ac_aux_dir/install.sh -c"
break
fi
done
if test -z "$ac_aux_dir"; then
{ echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
fi
ac_config_guess=$ac_aux_dir/config.guess
ac_config_sub=$ac_aux_dir/config.sub
ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
subdirs="$all_subdirs"
existingdirs=
for d in $all_subdirs; do
if test -d $srcdir/$d ; then
existingdirs="$existingdirs $d"
if test "x$verbose" = xyes; then
if test -f $srcdir/$d/PLUGIN/greet ; then
cat $srcdir/$d/PLUGIN/greet
else
echo ===
echo === Configuring plug-in component $d
echo ===
fi
fi
fi
done
for d in $req_subdirs; do
if test ! -d $srcdir/$d ; then
echo "*******"
echo "*******"
echo "**\+/**"
echo "**=*=**" ERROR: Missing required package: $d
echo "**/+\**"
echo "*******"
echo "*******"
exit 1
fi
done
if test "x$verbose" = xyes; then
for d in $opt_subdirs; do
if test ! -d $srcdir/$d ; then
echo "*****"
echo "*===*"
echo "*=*=*" WARNING: Missing suggested package: $d
echo "*===*"
echo "*****"
fi
done
fi
trap '' 1 2 15
cat > confcache <<\EOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs. It is not useful on other systems.
# If it contains results you don't want to keep, you may remove or edit it.
#
# By default, configure uses ./config.cache as the cache file,
# creating it if it does not exist already. You can give configure
# the --cache-file=FILE option to use a different cache file; that is
# what configure does when it calls configure scripts in
# subdirectories, so they share the cache.
# Giving --cache-file=/dev/null disables caching, for debugging configure.
# config.status only pays attention to the cache file if you give it the
# --recheck option to rerun configure.
#
EOF
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(set) 2>&1 |
sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \
>> confcache
if cmp -s $cache_file confcache; then
:
else
if test -w $cache_file; then
echo "updating cache $cache_file"
cat confcache > $cache_file
else
echo "not updating unwritable cache $cache_file"
fi
fi
rm -f confcache
trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
# Any assignment to VPATH causes Sun make to only execute
# the first set of double-colon rules, so remove it if not needed.
# If there is a colon in the path, we need to keep it.
if test "x$srcdir" = x.; then
ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
fi
trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
cat > conftest.defs <<\EOF
s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
s%\[%\\&%g
s%\]%\\&%g
s%\$%$$%g
EOF
DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
rm -f conftest.defs
# Without the "./", some shells look in PATH for config.status.
: ${CONFIG_STATUS=./config.status}
echo creating $CONFIG_STATUS
rm -f $CONFIG_STATUS
cat > $CONFIG_STATUS <<EOF
#! /bin/sh
# Generated automatically by configure.
# Run this file to recreate the current configuration.
# This directory was configured as follows,
# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
#
# $0 $ac_configure_args
#
# Compiler output produced by configure, useful for debugging
# configure, is in ./config.log if it exists.
ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
for ac_option
do
case "\$ac_option" in
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-version | --version | --versio | --versi | --vers | --ver | --ve | --v)
echo "$CONFIG_STATUS generated by autoconf version 2.9"
exit 0 ;;
-help | --help | --hel | --he | --h)
echo "\$ac_cs_usage"; exit 0 ;;
*) echo "\$ac_cs_usage"; exit 1 ;;
esac
done
ac_given_srcdir=$srcdir
trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
# Protect against being on the right side of a sed subst in config.status.
sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
$ac_vpsub
$extrasub
s%@CFLAGS@%$CFLAGS%g
s%@CPPFLAGS@%$CPPFLAGS%g
s%@CXXFLAGS@%$CXXFLAGS%g
s%@DEFS@%$DEFS%g
s%@LDFLAGS@%$LDFLAGS%g
s%@LIBS@%$LIBS%g
s%@exec_prefix@%$exec_prefix%g
s%@prefix@%$prefix%g
s%@program_transform_name@%$program_transform_name%g
s%@bindir@%$bindir%g
s%@sbindir@%$sbindir%g
s%@libexecdir@%$libexecdir%g
s%@datadir@%$datadir%g
s%@sysconfdir@%$sysconfdir%g
s%@sharedstatedir@%$sharedstatedir%g
s%@localstatedir@%$localstatedir%g
s%@libdir@%$libdir%g
s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
s%@subdirs@%$subdirs%g
s%@existingdirs@%$existingdirs%g
CEOF
EOF
cat >> $CONFIG_STATUS <<EOF
CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
EOF
cat >> $CONFIG_STATUS <<\EOF
for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
# Support "outfile[:infile]", defaulting infile="outfile.in".
case "$ac_file" in
*:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'`
ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
*) ac_file_in="${ac_file}.in" ;;
esac
# Adjust relative srcdir, etc. for subdirectories.
# Remove last slash and all that follows it. Not all systems have dirname.
ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
# The file is in a subdirectory.
test ! -d "$ac_dir" && mkdir "$ac_dir"
ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
# A "../" for each directory in $ac_dir_suffix.
ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
else
ac_dir_suffix= ac_dots=
fi
case "$ac_given_srcdir" in
.) srcdir=.
if test -z "$ac_dots"; then top_srcdir=.
else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
/*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
*) # Relative path.
srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
echo creating "$ac_file"
rm -f "$ac_file"
configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
case "$ac_file" in
*Makefile*) ac_comsub="1i\\
# $configure_input" ;;
*) ac_comsub= ;;
esac
sed -e "$ac_comsub
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
" -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file
fi; done
rm -f conftest.subs
exit 0
EOF
chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
if test "$no_recursion" != yes; then
# Remove --cache-file and --srcdir arguments so they do not pile up.
ac_sub_configure_args=
ac_prev=
for ac_arg in $ac_configure_args; do
if test -n "$ac_prev"; then
ac_prev=
continue
fi
case "$ac_arg" in
-cache-file | --cache-file | --cache-fil | --cache-fi \
| --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
ac_prev=cache_file ;;
-cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
| --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
;;
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
;;
*) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
esac
done
for ac_config_dir in $all_subdirs; do
# Do not complain, so a configure script can configure whichever
# parts of a large source tree are present.
if test ! -d $srcdir/$ac_config_dir; then
continue
fi
echo configuring in $ac_config_dir
case "$srcdir" in
.) ;;
*)
if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :;
else
{ echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; }
fi
;;
esac
ac_popdir=`pwd`
cd $ac_config_dir
case "$srcdir" in
.) # No --srcdir option. We are building in place.
ac_sub_srcdir=$srcdir ;;
/*) # Absolute path.
ac_sub_srcdir=$srcdir/$ac_config_dir ;;
*) # Relative path.
ac_sub_srcdir=../$srcdir/$ac_config_dir ;;
esac
# Check for guested configure; otherwise get Cygnus style configure.
if test -f $ac_sub_srcdir/configure; then
ac_sub_configure=$ac_sub_srcdir/configure
elif test -f $ac_sub_srcdir/configure.in; then
ac_sub_configure=$ac_configure
else
echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2
ac_sub_configure=
fi
# The recursion is here.
if test -n "$ac_sub_configure"; then
# Make the cache file name correct relative to the subdirectory.
# A "../" for each directory in /$ac_config_dir.
ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'`
case "$cache_file" in
/*) ac_sub_cache_file=$cache_file ;;
*) # Relative path.
ac_sub_cache_file="$ac_dots$cache_file" ;;
esac
echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir"
# The eval makes quoting arguments work.
if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir
then :
else
{ echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; }
fi
fi
cd $ac_popdir
done
fi

50
configure.in Normal file
View file

@ -0,0 +1,50 @@
AC_INIT(Makefile.in)
all_subdirs=`cat $srcdir/*/PLUGIN/REQ $srcdir/*/PLUGIN/OPT /dev/null | tsort | xargs echo`
req_subdirs=`cat $srcdir/*/PLUGIN/REQ /dev/null | tsort | xargs echo`
opt_subdirs=`cat $srcdir/*/PLUGIN/OPT /dev/null | tsort | xargs echo`
AC_CONFIG_SUBDIRS($all_subdirs)
existingdirs=
for d in $all_subdirs; do
if test -d $srcdir/$d ; then
existingdirs="$existingdirs $d"
if test "x$verbose" = xyes; then
if test -f $srcdir/$d/PLUGIN/greet ; then
cat $srcdir/$d/PLUGIN/greet
else
echo ===
echo === Configuring plug-in component $d
echo ===
fi
fi
fi
done
for d in $req_subdirs; do
if test ! -d $srcdir/$d ; then
echo "*******"
echo "*******"
echo "**\+/**"
echo "**=*=**" ERROR: Missing required package: $d
echo "**/+\**"
echo "*******"
echo "*******"
exit 1
fi
done
if test "x$verbose" = xyes; then
for d in $opt_subdirs; do
if test ! -d $srcdir/$d ; then
echo "*****"
echo "*===*"
echo "*=*=*" WARNING: Missing suggested package: $d
echo "*===*"
echo "*****"
fi
done
fi
AC_SUBST(existingdirs)
AC_OUTPUT(Makefile)

339
ice-9/COPYING Normal file
View file

@ -0,0 +1,339 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991, 1992, 1993 Free Software Foundation, Inc.
675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

5
ice-9/ChangeLog Normal file
View file

@ -0,0 +1,5 @@
Fri Apr 19 13:53:08 1996 Tom Lord <lord@beehive>
* The more things change...

71
ice-9/Makefile.in Normal file
View file

@ -0,0 +1,71 @@
# Copyright (C) 1995 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this software; see the file COPYING. If not, write to
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#
SHELL = /bin/sh
srcdir = @srcdir@
VPATH = @srcdir@
prefix = @prefix@
VERSION=@GUILE_VERSION@
libparent=$(prefix)/lib
libdir=$(libparent)/guile$(VERSION)
install_path=$(libdir)/@library_name@
INSTALL = $(srcdir)/../install-sh -c
INSTALL_DATA = $(INSTALL) -m 644
scm_files= @scm_files@
aux_files = @aux_files@
all:
install: all
test -d $(libparent) || mkdir $(libparent)
test -d $(libdir) || mkdir $(libdir)
test -d $(install_path) || mkdir $(install_path)
cd $(srcdir); \
for file in $(scm_files); do \
$(INSTALL_DATA) $$file $(install_path); \
done
uninstall:
for file in $(scm_files) ; do \
rm -f $(install_path)/$$file; \
done;
-rmdir $(install_path)
-rmdir $(libdir)
SUBDIR=.
manifest:
srcdir=./$(SUBDIR) ; \
. $(SUBDIR)/PLUGIN/this.configure; \
for file in $$scm_files $$aux_files ; \
do echo $(SUBDIR)/$$file ; \
done
clean:
distclean:
-rm -f config.log config.status Makefile
realclean:

3663
ice-9/boot-9.scm Normal file
View file

File diff suppressed because it is too large Load diff

722
ice-9/configure vendored Executable file
View file

@ -0,0 +1,722 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated automatically using autoconf version 2.9
# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
# Defaults:
ac_help=
ac_default_prefix=/usr/local
# Any additions from configure.in:
# Initialize some variables set by options.
# The variables have the same names as the options, with
# dashes changed to underlines.
build=NONE
cache_file=./config.cache
exec_prefix=NONE
host=NONE
no_create=
nonopt=NONE
no_recursion=
prefix=NONE
program_prefix=NONE
program_suffix=NONE
program_transform_name=s,x,x,
silent=
site=
srcdir=
target=NONE
verbose=
x_includes=NONE
x_libraries=NONE
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
datadir='${prefix}/share'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
infodir='${prefix}/info'
mandir='${prefix}/man'
# Initialize some other variables.
subdirs=
MFLAGS= MAKEFLAGS=
ac_prev=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
eval "$ac_prev=\$ac_option"
ac_prev=
continue
fi
case "$ac_option" in
-*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
*) ac_optarg= ;;
esac
# Accept the important Cygnus configure options, so we can diagnose typos.
case "$ac_option" in
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
-bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
bindir="$ac_optarg" ;;
-build | --build | --buil | --bui | --bu)
ac_prev=build ;;
-build=* | --build=* | --buil=* | --bui=* | --bu=*)
build="$ac_optarg" ;;
-cache-file | --cache-file | --cache-fil | --cache-fi \
| --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
ac_prev=cache_file ;;
-cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
| --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
cache_file="$ac_optarg" ;;
-datadir | --datadir | --datadi | --datad | --data | --dat | --da)
ac_prev=datadir ;;
-datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
| --da=*)
datadir="$ac_optarg" ;;
-disable-* | --disable-*)
ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
{ echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
fi
ac_feature=`echo $ac_feature| sed 's/-/_/g'`
eval "enable_${ac_feature}=no" ;;
-enable-* | --enable-*)
ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
{ echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
fi
ac_feature=`echo $ac_feature| sed 's/-/_/g'`
case "$ac_option" in
*=*) ;;
*) ac_optarg=yes ;;
esac
eval "enable_${ac_feature}='$ac_optarg'" ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
| --exec | --exe | --ex)
ac_prev=exec_prefix ;;
-exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
| --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
| --exec=* | --exe=* | --ex=*)
exec_prefix="$ac_optarg" ;;
-gas | --gas | --ga | --g)
# Obsolete; use --with-gas.
with_gas=yes ;;
-help | --help | --hel | --he)
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat << EOF
Usage: configure [options] [host]
Options: [defaults in brackets after descriptions]
Configuration:
--cache-file=FILE cache test results in FILE
--help print this message
--no-create do not create output files
--quiet, --silent do not print \`checking...' messages
--version print the version of autoconf that created configure
Directory and file names:
--prefix=PREFIX install architecture-independent files in PREFIX
[$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
[same as prefix]
--bindir=DIR user executables in DIR [EPREFIX/bin]
--sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
--libexecdir=DIR program executables in DIR [EPREFIX/libexec]
--datadir=DIR read-only architecture-independent data in DIR
[PREFIX/share]
--sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
--sharedstatedir=DIR modifiable architecture-independent data in DIR
[PREFIX/com]
--localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
--libdir=DIR object code libraries in DIR [EPREFIX/lib]
--includedir=DIR C header files in DIR [PREFIX/include]
--oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
--infodir=DIR info documentation in DIR [PREFIX/info]
--mandir=DIR man documentation in DIR [PREFIX/man]
--srcdir=DIR find the sources in DIR [configure dir or ..]
--program-prefix=PREFIX prepend PREFIX to installed program names
--program-suffix=SUFFIX append SUFFIX to installed program names
--program-transform-name=PROGRAM
run sed PROGRAM on installed program names
EOF
cat << EOF
Host type:
--build=BUILD configure for building on BUILD [BUILD=HOST]
--host=HOST configure for HOST [guessed]
--target=TARGET configure for TARGET [TARGET=HOST]
Features and packages:
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--x-includes=DIR X include files are in DIR
--x-libraries=DIR X library files are in DIR
EOF
if test -n "$ac_help"; then
echo "--enable and --with options recognized:$ac_help"
fi
exit 0 ;;
-host | --host | --hos | --ho)
ac_prev=host ;;
-host=* | --host=* | --hos=* | --ho=*)
host="$ac_optarg" ;;
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
-includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
| --includ=* | --inclu=* | --incl=* | --inc=*)
includedir="$ac_optarg" ;;
-infodir | --infodir | --infodi | --infod | --info | --inf)
ac_prev=infodir ;;
-infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
infodir="$ac_optarg" ;;
-libdir | --libdir | --libdi | --libd)
ac_prev=libdir ;;
-libdir=* | --libdir=* | --libdi=* | --libd=*)
libdir="$ac_optarg" ;;
-libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
| --libexe | --libex | --libe)
ac_prev=libexecdir ;;
-libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
| --libexe=* | --libex=* | --libe=*)
libexecdir="$ac_optarg" ;;
-localstatedir | --localstatedir | --localstatedi | --localstated \
| --localstate | --localstat | --localsta | --localst \
| --locals | --local | --loca | --loc | --lo)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
| --localstate=* | --localstat=* | --localsta=* | --localst=* \
| --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
localstatedir="$ac_optarg" ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
ac_prev=mandir ;;
-mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
mandir="$ac_optarg" ;;
-nfp | --nfp | --nf)
# Obsolete; use --without-fp.
with_fp=no ;;
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c)
no_create=yes ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
no_recursion=yes ;;
-oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
| --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
| --oldin | --oldi | --old | --ol | --o)
ac_prev=oldincludedir ;;
-oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
| --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
| --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
oldincludedir="$ac_optarg" ;;
-prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
ac_prev=prefix ;;
-prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
prefix="$ac_optarg" ;;
-program-prefix | --program-prefix | --program-prefi | --program-pref \
| --program-pre | --program-pr | --program-p)
ac_prev=program_prefix ;;
-program-prefix=* | --program-prefix=* | --program-prefi=* \
| --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
program_prefix="$ac_optarg" ;;
-program-suffix | --program-suffix | --program-suffi | --program-suff \
| --program-suf | --program-su | --program-s)
ac_prev=program_suffix ;;
-program-suffix=* | --program-suffix=* | --program-suffi=* \
| --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
program_suffix="$ac_optarg" ;;
-program-transform-name | --program-transform-name \
| --program-transform-nam | --program-transform-na \
| --program-transform-n | --program-transform- \
| --program-transform | --program-transfor \
| --program-transfo | --program-transf \
| --program-trans | --program-tran \
| --progr-tra | --program-tr | --program-t)
ac_prev=program_transform_name ;;
-program-transform-name=* | --program-transform-name=* \
| --program-transform-nam=* | --program-transform-na=* \
| --program-transform-n=* | --program-transform-=* \
| --program-transform=* | --program-transfor=* \
| --program-transfo=* | --program-transf=* \
| --program-trans=* | --program-tran=* \
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name="$ac_optarg" ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
-sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
ac_prev=sbindir ;;
-sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
| --sbi=* | --sb=*)
sbindir="$ac_optarg" ;;
-sharedstatedir | --sharedstatedir | --sharedstatedi \
| --sharedstated | --sharedstate | --sharedstat | --sharedsta \
| --sharedst | --shareds | --shared | --share | --shar \
| --sha | --sh)
ac_prev=sharedstatedir ;;
-sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
| --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
| --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
| --sha=* | --sh=*)
sharedstatedir="$ac_optarg" ;;
-site | --site | --sit)
ac_prev=site ;;
-site=* | --site=* | --sit=*)
site="$ac_optarg" ;;
-srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
ac_prev=srcdir ;;
-srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
srcdir="$ac_optarg" ;;
-sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
| --syscon | --sysco | --sysc | --sys | --sy)
ac_prev=sysconfdir ;;
-sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
| --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
sysconfdir="$ac_optarg" ;;
-target | --target | --targe | --targ | --tar | --ta | --t)
ac_prev=target ;;
-target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
target="$ac_optarg" ;;
-v | -verbose | --verbose | --verbos | --verbo | --verb)
verbose=yes ;;
-version | --version | --versio | --versi | --vers)
echo "configure generated by autoconf version 2.9"
exit 0 ;;
-with-* | --with-*)
ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
{ echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
fi
ac_package=`echo $ac_package| sed 's/-/_/g'`
case "$ac_option" in
*=*) ;;
*) ac_optarg=yes ;;
esac
eval "with_${ac_package}='$ac_optarg'" ;;
-without-* | --without-*)
ac_package=`echo $ac_option|sed -e 's/-*without-//'`
# Reject names that are not valid shell variable names.
if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
{ echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
fi
ac_package=`echo $ac_package| sed 's/-/_/g'`
eval "with_${ac_package}=no" ;;
--x)
# Obsolete; use --with-x.
with_x=yes ;;
-x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
| --x-incl | --x-inc | --x-in | --x-i)
ac_prev=x_includes ;;
-x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
| --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
x_includes="$ac_optarg" ;;
-x-libraries | --x-libraries | --x-librarie | --x-librari \
| --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
ac_prev=x_libraries ;;
-x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries="$ac_optarg" ;;
-*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
;;
*)
if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
echo "configure: warning: $ac_option: invalid host type" 1>&2
fi
if test "x$nonopt" != xNONE; then
{ echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
fi
nonopt="$ac_option"
;;
esac
done
if test -n "$ac_prev"; then
{ echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
fi
trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
# File descriptor usage:
# 0 standard input
# 1 file creation
# 2 errors and warnings
# 3 some systems may open it to /dev/tty
# 4 used on the Kubota Titan
# 6 checking for... messages and results
# 5 compiler messages saved in config.log
if test "$silent" = yes; then
exec 6>/dev/null
else
exec 6>&1
fi
exec 5>./config.log
echo "\
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
" 1>&5
# Strip out --no-create and --no-recursion so they do not pile up.
# Also quote any args containing shell metacharacters.
ac_configure_args=
for ac_arg
do
case "$ac_arg" in
-no-create | --no-create | --no-creat | --no-crea | --no-cre \
| --no-cr | --no-c) ;;
-no-recursion | --no-recursion | --no-recursio | --no-recursi \
| --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
*" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
ac_configure_args="$ac_configure_args '$ac_arg'" ;;
*) ac_configure_args="$ac_configure_args $ac_arg" ;;
esac
done
# NLS nuisances.
# Only set LANG and LC_ALL to C if already set.
# These must not be set unconditionally because not all systems understand
# e.g. LANG=C (notably SCO).
if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
if test "${LANG+set}" = set; then LANG=C; export LANG; fi
# confdefs.h avoids OS command line length limits that DEFS can exceed.
rm -rf conftest* confdefs.h
# AIX cpp loses on an empty file, so make sure it contains at least a newline.
echo > confdefs.h
# A filename unique to this package, relative to the directory that
# configure is in, which we can look for to find out if srcdir is correct.
ac_unique_file=boot-9.scm
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
# Try the directory containing this script, then its parent.
ac_prog=$0
ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
srcdir=$ac_confdir
if test ! -r $srcdir/$ac_unique_file; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
if test ! -r $srcdir/$ac_unique_file; then
if test "$ac_srcdir_defaulted" = yes; then
{ echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
else
{ echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
fi
fi
srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
# Prefer explicitly selected file to automatically selected ones.
if test -z "$CONFIG_SITE"; then
if test "x$prefix" != xNONE; then
CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
else
CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
fi
fi
for ac_site_file in $CONFIG_SITE; do
if test -r "$ac_site_file"; then
echo "loading site script $ac_site_file"
. "$ac_site_file"
fi
done
if test -r "$cache_file"; then
echo "loading cache $cache_file"
. $cache_file
else
echo "creating cache $cache_file"
> $cache_file
fi
ac_ext=c
# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
ac_cpp='$CPP $CPPFLAGS'
ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
ac_link='${CC-cc} -o conftest $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
# Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
ac_n= ac_c='
' ac_t=' '
else
ac_n=-n ac_c= ac_t=
fi
else
ac_n= ac_c='\c' ac_t=
fi
. $srcdir/../GUILE-VERSION
scm_files=""
aux_files=""
. $srcdir/PLUGIN/this.configure
trap '' 1 2 15
cat > confcache <<\EOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
# scripts and configure runs. It is not useful on other systems.
# If it contains results you don't want to keep, you may remove or edit it.
#
# By default, configure uses ./config.cache as the cache file,
# creating it if it does not exist already. You can give configure
# the --cache-file=FILE option to use a different cache file; that is
# what configure does when it calls configure scripts in
# subdirectories, so they share the cache.
# Giving --cache-file=/dev/null disables caching, for debugging configure.
# config.status only pays attention to the cache file if you give it the
# --recheck option to rerun configure.
#
EOF
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
(set) 2>&1 |
sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=\${\1='\2'}/p" \
>> confcache
if cmp -s $cache_file confcache; then
:
else
if test -w $cache_file; then
echo "updating cache $cache_file"
cat confcache > $cache_file
else
echo "not updating unwritable cache $cache_file"
fi
fi
rm -f confcache
trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
# Any assignment to VPATH causes Sun make to only execute
# the first set of double-colon rules, so remove it if not needed.
# If there is a colon in the path, we need to keep it.
if test "x$srcdir" = x.; then
ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
fi
trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
cat > conftest.defs <<\EOF
s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
s%\[%\\&%g
s%\]%\\&%g
s%\$%$$%g
EOF
DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
rm -f conftest.defs
# Without the "./", some shells look in PATH for config.status.
: ${CONFIG_STATUS=./config.status}
echo creating $CONFIG_STATUS
rm -f $CONFIG_STATUS
cat > $CONFIG_STATUS <<EOF
#! /bin/sh
# Generated automatically by configure.
# Run this file to recreate the current configuration.
# This directory was configured as follows,
# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
#
# $0 $ac_configure_args
#
# Compiler output produced by configure, useful for debugging
# configure, is in ./config.log if it exists.
ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
for ac_option
do
case "\$ac_option" in
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
-version | --version | --versio | --versi | --vers | --ver | --ve | --v)
echo "$CONFIG_STATUS generated by autoconf version 2.9"
exit 0 ;;
-help | --help | --hel | --he | --h)
echo "\$ac_cs_usage"; exit 0 ;;
*) echo "\$ac_cs_usage"; exit 1 ;;
esac
done
ac_given_srcdir=$srcdir
trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
EOF
cat >> $CONFIG_STATUS <<EOF
# Protect against being on the right side of a sed subst in config.status.
sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
$ac_vpsub
$extrasub
s%@CFLAGS@%$CFLAGS%g
s%@CPPFLAGS@%$CPPFLAGS%g
s%@CXXFLAGS@%$CXXFLAGS%g
s%@DEFS@%$DEFS%g
s%@LDFLAGS@%$LDFLAGS%g
s%@LIBS@%$LIBS%g
s%@exec_prefix@%$exec_prefix%g
s%@prefix@%$prefix%g
s%@program_transform_name@%$program_transform_name%g
s%@bindir@%$bindir%g
s%@sbindir@%$sbindir%g
s%@libexecdir@%$libexecdir%g
s%@datadir@%$datadir%g
s%@sysconfdir@%$sysconfdir%g
s%@sharedstatedir@%$sharedstatedir%g
s%@localstatedir@%$localstatedir%g
s%@libdir@%$libdir%g
s%@includedir@%$includedir%g
s%@oldincludedir@%$oldincludedir%g
s%@infodir@%$infodir%g
s%@mandir@%$mandir%g
s%@scm_files@%$scm_files%g
s%@aux_files@%$aux_files%g
s%@library_name@%$library_name%g
s%@info_files@%$info_files%g
s%@GUILE_VERSION@%$GUILE_VERSION%g
CEOF
EOF
cat >> $CONFIG_STATUS <<EOF
CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
EOF
cat >> $CONFIG_STATUS <<\EOF
for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
# Support "outfile[:infile]", defaulting infile="outfile.in".
case "$ac_file" in
*:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'`
ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
*) ac_file_in="${ac_file}.in" ;;
esac
# Adjust relative srcdir, etc. for subdirectories.
# Remove last slash and all that follows it. Not all systems have dirname.
ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
# The file is in a subdirectory.
test ! -d "$ac_dir" && mkdir "$ac_dir"
ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
# A "../" for each directory in $ac_dir_suffix.
ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
else
ac_dir_suffix= ac_dots=
fi
case "$ac_given_srcdir" in
.) srcdir=.
if test -z "$ac_dots"; then top_srcdir=.
else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
/*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
*) # Relative path.
srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
top_srcdir="$ac_dots$ac_given_srcdir" ;;
esac
echo creating "$ac_file"
rm -f "$ac_file"
configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
case "$ac_file" in
*Makefile*) ac_comsub="1i\\
# $configure_input" ;;
*) ac_comsub= ;;
esac
sed -e "$ac_comsub
s%@configure_input@%$configure_input%g
s%@srcdir@%$srcdir%g
s%@top_srcdir@%$top_srcdir%g
" -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file
fi; done
rm -f conftest.subs
exit 0
EOF
chmod +x $CONFIG_STATUS
rm -fr confdefs* $ac_clean_files
test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1

17
ice-9/configure.in Normal file
View file

@ -0,0 +1,17 @@
#
# Process this file with autoconf to produce a configure script.
#
AC_INIT(boot-9.scm)
. $srcdir/../GUILE-VERSION
scm_files=""
aux_files=""
. $srcdir/PLUGIN/this.configure
AC_SUBST(scm_files)
AC_SUBST(aux_files)
AC_SUBST(library_name)
AC_SUBST(info_files)
AC_SUBST(GUILE_VERSION)
AC_OUTPUT(Makefile)

76
ice-9/hcons.scm Normal file
View file

@ -0,0 +1,76 @@
;;; installed-scm-file
;;;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;;
(define-module #/ice-9/hcons)
;;; {Eq? hash-consing}
;;;
;;; A hash conser maintains a private universe of pairs s.t. if
;;; two cons calls pass eq? arguments, the pairs returned are eq?.
;;;
;;; A hash conser does not contribute life to the pairs it returns.
;;;
(define-public (hashq-cons-hash pair n)
(modulo (logxor (hashq (car pair) 4194303)
(hashq (cdr pair) 4194303))
n))
(define-public (hashq-cons-assoc key l)
(and l (or (and (pair? l)
(pair? (car l))
(pair? (caar l))
(eq? (car key) (caaar l))
(eq? (cdr key) (cdaar l))
(car l))
(hashq-cons-assoc key (cdr l)))))
(define-public (hashq-cons-get-handle table key)
(hashx-get-handle hashq-cons-hash hashq-cons-assoc table key #f))
(define-public (hashq-cons-create-handle! table key init)
(hashx-create-handle! hashq-cons-hash hashq-cons-assoc table key init))
(define-public (hashq-cons-ref table key)
(hashx-ref hashq-cons-hash hashq-cons-assoc table key #f))
(define-public (hashq-cons-set! table key val)
(hashx-set! hashq-cons-hash hashq-cons-assoc table key val))
(define-public (hashq-cons table a d)
(car (hashq-cons-create-handle! table (cons a d) #f)))
(define-public (hashq-conser hash-tab-or-size)
(let ((table (if (vector? hash-tab-or-size)
hash-tab-or-size
(make-doubly-weak-hash-table hash-tab-or-size))))
(lambda (a d) (hashq-cons table a d))))
(define-public (make-gc-buffer n)
(let ((ring (make-list n #f)))
(append! ring ring)
(lambda (next)
(set-car! ring next)
(set! ring (cdr ring))
next)))

112
ice-9/lineio.scm Normal file
View file

@ -0,0 +1,112 @@
;;; installed-scm-file
;;;; Copyright (C) 1996 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;;
(define-module #/ice-9/lineio)
;;; {Line Buffering Input Ports}
;;;
;;; [This is a work-around to get past certain deficiencies in the capabilities
;;; of ports. Eventually, ports should be fixed and this module nuked.]
;;;
;;; A line buffering input port supports:
;;;
;;; read-string which returns the next line of input
;;; unread-string which pushes a line back onto the stream
;;;
;;; Normally a "line" is all characters up to and including a newline.
;;; If lines are put back using unread-string, they can be broken arbitrarily
;;; -- that is, read-string returns strings passed to unread-string (or
;;; shared substrings of them).
;;;
;; read-string port
;; unread-string port str
;; Read (or buffer) a line from PORT.
;;
;; Not all ports support these functions -- only those with
;; 'unread-string and 'read-string properties, bound to hooks
;; implementing these functions.
;;
(define-public (unread-string str line-buffering-input-port)
((object-property line-buffering-input-port 'unread-string) str))
;;
(define-public (read-string line-buffering-input-port)
((object-property line-buffering-input-port 'read-string)))
(define-public (lineio-port? port)
(not (not (object-property port 'read-string))))
;; make-line-buffering-input-port port
;; Return a wrapper for PORT. The wrapper handles read-string/unread-string.
;;
;; The port returned by this function reads newline terminated lines from PORT.
;; It buffers these characters internally, and parsels them out via calls
;; to read-char, read-string, and unread-string.
;;
(define-public (make-line-buffering-input-port underlying-port)
(let* (;; buffers - a list of strings put back by unread-string or cached
;; using read-line.
;;
(buffers '())
;; getc - return the next character from a buffer or from the underlying
;; port.
;;
(getc (lambda ()
(if (not buffers)
(read-char underlying-port)
(let ((c (string-ref (car buffers))))
(if (= 1 (string-length (car buffers)))
(set! buffers (cdr buffers))
(set-car! buffers (make-shared-substring (car buffers) 1)))
c))))
(propogate-close (lambda () (close-port underlying-port)))
(self (make-soft-port (vector #f #f #f getc propogate-close) "r"))
(unread-string (lambda (str)
(and (< 0 (string-length str))
(if (ungetc-char-ready? self)
(set! buffers (append! (list str (string (read-char self))) buffers))
(set! buffers (cons str buffers))))))
(read-string (lambda ()
(cond
(buffers (let ((answer (car buffers)))
(set! buffers (cdr buffers))
answer))
((ungetc-char-ready? self) (read-line self 'include-newline))
(else (read-line underlying-port 'include-newline)))))
)
(set-object-property! self 'unread-string unread-string)
(set-object-property! self 'read-string read-string)
self))

120
ice-9/mapping.scm Normal file
View file

@ -0,0 +1,120 @@
;;; installed-scm-file
;;;; Copyright (C) 1996 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;;
(define-module #/ice-9/mapping
:use-module #/ice-9/poe)
(define-public mapping-hooks-type (make-record-type 'mapping-hooks '(get-handle
create-handle
remove)))
(define-public make-mapping-hooks (perfect-funcq 17 (record-constructor mapping-hooks-type)))
(define-public mapping-hooks? (record-predicate mapping-hooks-type))
(define-public mapping-hooks-get-handle (record-accessor mapping-hooks-type 'get-handle))
(define-public mapping-hooks-create-handle (record-accessor mapping-hooks-type 'create-handle))
(define-public mapping-hooks-remove (record-accessor mapping-hooks-type 'remove))
(define-public mapping-type (make-record-type 'mapping '(hooks data)))
(define-public make-mapping (record-constructor mapping-type))
(define-public mapping? (record-predicate mapping-type))
(define-public mapping-hooks (record-accessor mapping-type 'hooks))
(define-public mapping-data (record-accessor mapping-type 'data))
(define-public set-mapping-hooks! (record-modifier mapping-type 'hooks))
(define-public set-mapping-data! (record-modifier mapping-type 'data))
(define-public (mapping-get-handle map key)
((mapping-hooks-get-handle (mapping-hooks map)) map key))
(define-public (mapping-create-handle! map key . opts)
(apply (mapping-hooks-create-handle (mapping-hooks map)) map key opts))
(define-public (mapping-remove! map key)
((mapping-hooks-remove (mapping-hooks map)) map key))
(define-public (mapping-ref map key . dflt)
(cond
((mapping-get-handle map key) => cdr)
(dflt => car)
(else #f)))
(define-public (mapping-set! map key val)
(set-cdr! (mapping-create-handle! map key #f) val))
(define-public hash-table-mapping-hooks
(let ((wrap (lambda (proc) (lambda (1st . rest) (apply proc (mapping-data 1st) rest)))))
(perfect-funcq 17
(lambda (hash-proc assoc-proc delete-proc)
(let ((procs (list hash-proc assoc-proc delete-proc)))
(cond
((equal? procs `(,hashq ,assq ,delq!))
(make-mapping-hooks (wrap hashq-get-handle)
(wrap hashq-create-handle!)
(wrap hashq-remove!)))
((equal? procs `(,hashv ,assv ,delv!))
(make-mapping-hooks (wrap hashv-get-handle)
(wrap hashv-create-handle!)
(wrap hashv-remove!)))
((equal? procs `(,hash ,assoc ,delete!))
(make-mapping-hooks (wrap hash-get-handle)
(wrap hash-create-handle!)
(wrap hash-remove!)))
(else
(make-mapping-hooks (wrap
(lambda (table key)
(hashx-get-handle hash-proc assoc-proc table key)))
(wrap
(lambda (table key)
(hashx-create-handle hash-proc assoc-proc table key)))
(wrap
(lambda (table key)
(hashx-get-handle hash-proc assoc-proc delete-proc table key)))))))))))
(define-public (make-hash-table-mapping table hash-proc assoc-proc delete-proc)
(make-mapping (hash-table-mapping-hooks hash-proc assoc-proc delete-proc) table))
(define-public (hash-table-mapping . options)
(let* ((size (or (and options (number? (car options)) (car options))
71))
(hash-proc (or (kw-arg-ref options :hash-proc) hash))
(assoc-proc (or (kw-arg-ref options :assoc-proc)
(cond
((eq? hash-proc hash) assoc)
((eq? hash-proc hashv) assv)
((eq? hash-proc hashq) assq)
(else (error 'hash-table-mapping
"Hash-procedure specified with no known assoc function."
hash-proc)))))
(delete-proc (or (kw-arg-ref options :delete-proc)
(cond
((eq? hash-proc hash) delete!)
((eq? hash-proc hashv) delv!)
((eq? hash-proc hashq) delq!)
(else (error 'hash-table-mapping
"Hash-procedure specified with no known delete function."
hash-proc)))))
(table-constructor (or (kw-arg-ref options :table-constructor) make-vector)))
(make-hash-table-mapping (table-constructor size)
hash-proc
assoc-proc
delete-proc)))

117
ice-9/poe.scm Normal file
View file

@ -0,0 +1,117 @@
;;; installed-scm-file
;;;; Copyright (C) 1996 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;;
(define-module #/ice-9/poe
:use-module #/ice-9/hcons)
;;; {Pure Functions}
;;;
;;; A pure function (of some sort) is characterized by two equality
;;; relations: one on argument lists and one on return values.
;;; A pure function is one that when applied to equal arguments lists
;;; yields equal results.
;;;
;;; If the equality relationship on return values can be eq?, it may make
;;; sense to cache values returned by the function. Choosing the right
;;; equality relation on arguments is tricky.
;;;
;;; {pure-funcq}
;;;
;;; The simplest case of pure functions are those in which results
;;; are only certainly eq? if all of the arguments are. These functions
;;; are called "pure-funcq", for obvious reasons.
;;;
(define funcq-memo (make-weak-hash-table 523)) ; !!! randomly selected values
(define funcq-buffer (make-gc-buffer 256))
(define (funcq-hash arg-list n)
(let ((it (let loop ((x 0)
(arg-list arg-list))
(if (null? arg-list)
(modulo x n)
(loop (logior x (hashq (car arg-list) 4194303))
(cdr arg-list))))))
it))
(define (funcq-assoc arg-list alist)
(let ((it (and alist
(let and-map ((key arg-list)
(entry (caar alist)))
(or (and (and (not key) (not entry))
(car alist))
(and key entry
(eq? (car key) (car entry))
(and-map (cdr key) (cdr entry))))))))
it))
(define-public (pure-funcq base-func)
(lambda args
(let ((cached (hashx-get-handle funcq-hash funcq-assoc funcq-memo (cons base-func args))))
(if cached
(begin
(funcq-buffer (car cached))
(cdr cached))
(let ((val (apply base-func args))
(key (cons base-func args)))
(funcq-buffer key)
(hashx-set! funcq-hash funcq-assoc funcq-memo key val)
val)))))
;;; {Perfect funq}
;;;
;;; A pure funq may sometimes forget its past but a perfect
;;; funcq never does.
;;;
(define-public (perfect-funcq size base-func)
(define funcq-memo (make-hash-table size))
(lambda args
(let ((cached (hashx-get-handle funcq-hash funcq-assoc funcq-memo (cons base-func args))))
(if cached
(begin
(funcq-buffer (car cached))
(cdr cached))
(let ((val (apply base-func args))
(key (cons base-func args)))
(funcq-buffer key)
(hashx-set! funcq-hash funcq-assoc funcq-memo key val)
val)))))

144
ice-9/slib.scm Normal file
View file

@ -0,0 +1,144 @@
;;; installed-scm-file
(define-module #/ice-9/slib)
(define (eval-load <filename> evl)
(if (not (file-exists? <filename>))
(set! <filename> (string-append <filename> (scheme-file-suffix))))
(call-with-input-file <filename>
(lambda (port)
(let ((old-load-pathname *load-pathname*))
(set! *load-pathname* <filename>)
(do ((o (read port #t read-sharp) (read port #t read-sharp)))
((eof-object? o))
(evl o))
(set! *load-pathname* old-load-pathname)))))
(define slib:exit quit)
(define slib:error error)
(define slib:eval eval)
(define defmacro:eval eval)
(define logical:logand logand)
(define logical:logior logior)
(define logical:logxor logxor)
(define logical:lognot lognot)
(define logical:ash ash)
(define logical:logcount logcount)
(define logical:integer-length integer-length)
(define logical:bit-extract bit-extract)
(define logical:integer-expt integer-expt)
(define logical:ipow-by-squaring ipow-by-squaring)
(define slib:eval-load eval-load)
(define slib:tab #\tab)
(define slib:form-feed #\page)
(define slib:features
(append '(source
eval
abort
alist
defmacro
delay
dynamic-wind
full-continuation
hash
hash-table
line-i/o
logical
multiarg/and-
multiarg-apply
promise
rev2-procedures
rev4-optional-procedures
string-port
with-file)
(if (defined? getenv)
'(getenv)
'())
(if (defined? current-time)
'(current-time)
'())
(if (defined? system)
'(system)
'())
(if (defined? array?)
'(array)
'())
(if (defined? char-ready?)
'(char-ready?)
'())
(if (defined? array-for-each)
'(array-for-each)
'())
(if (and (string->number "0.0") (inexact? (string->number "0.0")))
'(inexact)
'())
(if (rational? (string->number "1/19"))
'(rational)
'())
(if (real? (string->number "0.0"))
'(real)
())
(if (complex? (string->number "1+i"))
'(complex)
'())
(let ((n (string->number "9999999999999999999999999999999")))
(if (and n (exact? n))
'(bignum)
'()))))
(define slib-module (current-module))
(define (slib:load name)
(save-module-excursion
(lambda ()
(set-current-module slib-module)
(load name))))
(define slib:load-source slib:load)
(define defmacro:load slib:load)
(define (library-vicinity) (string-append (implementation-vicinity) "slib/"))
(define (scheme-implementation-type) 'guile)
(define (scheme-implementation-version) "")
(define (output-port-width . arg) 80)
(define (output-port-height . arg) 24)
;;; {Time}
;;;
(define difftime -)
(define offset-time +)
(define %system-define define)
(define define
(procedure->memoizing-macro
(lambda (exp env)
(if (= (length env) 1)
`(define-public ,@(cdr exp))
`(%system-define ,@(cdr exp))))))
(define (software-type) 'UNIX)
(slib:load "require.scm")
(define-public require require:require)

23
ice-9/tags.scm Normal file
View file

@ -0,0 +1,23 @@
;;; installed-scm-file
;;;; Copyright (C) 1996 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;;;
(define-module #/ice-9/tags)

238
install-sh Executable file
View file

@ -0,0 +1,238 @@
#!/bin/sh
#
# install - install a program, script, or datafile
# This comes from X11R5.
#
# Calling this script install-sh is preferred over install.sh, to prevent
# `make' implicit rules from creating a file called install from it
# when there is no Makefile.
#
# This script is compatible with the BSD install script, but was written
# from scratch.
#
# set DOITPROG to echo to test this script
# Don't use :- since 4.3BSD and earlier shells don't like it.
doit="${DOITPROG-}"
# put in absolute paths if you don't have them in your path; or use env. vars.
mvprog="${MVPROG-mv}"
cpprog="${CPPROG-cp}"
chmodprog="${CHMODPROG-chmod}"
chownprog="${CHOWNPROG-chown}"
chgrpprog="${CHGRPPROG-chgrp}"
stripprog="${STRIPPROG-strip}"
rmprog="${RMPROG-rm}"
mkdirprog="${MKDIRPROG-mkdir}"
tranformbasename=""
transform_arg=""
instcmd="$mvprog"
chmodcmd="$chmodprog 0755"
chowncmd=""
chgrpcmd=""
stripcmd=""
rmcmd="$rmprog -f"
mvcmd="$mvprog"
src=""
dst=""
dir_arg=""
while [ x"$1" != x ]; do
case $1 in
-c) instcmd="$cpprog"
shift
continue;;
-d) dir_arg=true
shift
continue;;
-m) chmodcmd="$chmodprog $2"
shift
shift
continue;;
-o) chowncmd="$chownprog $2"
shift
shift
continue;;
-g) chgrpcmd="$chgrpprog $2"
shift
shift
continue;;
-s) stripcmd="$stripprog"
shift
continue;;
-t=*) transformarg=`echo $1 | sed 's/-t=//'`
shift
continue;;
-b=*) transformbasename=`echo $1 | sed 's/-b=//'`
shift
continue;;
*) if [ x"$src" = x ]
then
src=$1
else
# this colon is to work around a 386BSD /bin/sh bug
:
dst=$1
fi
shift
continue;;
esac
done
if [ x"$src" = x ]
then
echo "install: no input file specified"
exit 1
else
true
fi
if [ x"$dir_arg" != x ]; then
dst=$src
src=""
if [ -d $dst ]; then
instcmd=:
else
instcmd=mkdir
fi
else
# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
# might cause directories to be created, which would be especially bad
# if $src (and thus $dsttmp) contains '*'.
if [ -f $src -o -d $src ]
then
true
else
echo "install: $src does not exist"
exit 1
fi
if [ x"$dst" = x ]
then
echo "install: no destination specified"
exit 1
else
true
fi
# If destination is a directory, append the input filename; if your system
# does not like double slashes in filenames, you may need to add some logic
if [ -d $dst ]
then
dst="$dst"/`basename $src`
else
true
fi
fi
## this sed command emulates the dirname command
dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
# Make sure that the destination directory exists.
# this part is taken from Noah Friedman's mkinstalldirs script
# Skip lots of stat calls in the usual case.
if [ ! -d "$dstdir" ]; then
defaultIFS='
'
IFS="${IFS-${defaultIFS}}"
oIFS="${IFS}"
# Some sh's can't handle IFS=/ for some reason.
IFS='%'
set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
IFS="${oIFS}"
pathcomp=''
while [ $# -ne 0 ] ; do
pathcomp="${pathcomp}${1}"
shift
if [ ! -d "${pathcomp}" ] ;
then
$mkdirprog "${pathcomp}"
else
true
fi
pathcomp="${pathcomp}/"
done
fi
if [ x"$dir_arg" != x ]
then
$doit $instcmd $dst &&
if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
else
# If we're going to rename the final executable, determine the name now.
if [ x"$transformarg" = x ]
then
dstfile=`basename $dst`
else
dstfile=`basename $dst $transformbasename |
sed $transformarg`$transformbasename
fi
# don't allow the sed command to completely eliminate the filename
if [ x"$dstfile" = x ]
then
dstfile=`basename $dst`
else
true
fi
# Make a temp file name in the proper directory.
dsttmp=$dstdir/#inst.$$#
# Move or copy the file name to the temp name
$doit $instcmd $src $dsttmp &&
trap "rm -f ${dsttmp}" 0 &&
# and set any options; do chmod last to preserve setuid bits
# If any of these fail, we abort the whole thing. If we want to
# ignore errors from any of these, just make sure not to ignore
# errors from the above "$doit $instcmd $src $dsttmp" command.
if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
# Now rename the file to the real destination.
$doit $rmcmd -f $dstdir/$dstfile &&
$doit $mvcmd $dsttmp $dstdir/$dstfile
fi &&
exit 0

339
libguile/COPYING Normal file
View file

@ -0,0 +1,339 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991, 1992, 1993 Free Software Foundation, Inc.
675 Mass Ave, Cambridge, MA 02139, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Library General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19yy name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Library General
Public License instead of this License.

521
libguile/ChangeLog Normal file
View file

@ -0,0 +1,521 @@
Wed Jun 12 00:28:31 1996 Tom Lord <lord@beehive>
* struct.c (scm_init_struct): new file.
Fri Jun 7 14:02:00 1996 Tom Lord <lord@beehive>
* list.c (scm_list_tail): list-cdr-ref is the same as list-tail.
(scm_list_head): added list-head for rapidly chopping argument
lists off of longer lists (and similar).
Tue Jun 4 09:40:33 1996 Tom Lord <lord@beehive>
* objprop.c (scm_object_property): assq the cdr of the whash
handle for obj, not the handle itself.
Mon Jun 3 17:19:30 1996 Tom Lord <lord@beehive>
* gc.c (scm_mark_weak_vector_spines): Mark the spines (alists) of
weak hash tables last of all marking to avoid an obscure gc bug.
WARNING: circular lists stored in a weak hash table will hose us.
Fri May 24 09:53:39 1996 Tom Lord <lord@beehive>
* vectors.c (scm_vector_move_left_x, scm_vector_move_right_x):
new functions similar to scm_substring_move_left_x and
scm_substring_move_right_x.
Wed May 22 20:07:01 1996 Tom Lord <lord@beehive>
* init.c (scm_boot_guile): prevent gc with scm_block_gc not
scm_gc_heap_lock!
Wed May 15 16:13:29 1996 Tom Lord <lord@beehive>
* ports.c (scm_unread_char): scm_gen_ungetc as a scheme procedure.
Thu May 9 09:33:17 1996 Tom Lord <lord@beehive>
* strports.c (scm_strprint_obj): convenience function. C for
(lambda (obj) (call-with-output-string (lambda (p) (write obj p))))
* guile-{tcl,tk}.[ch], events.[ch], keysyms.[ch], tcl-channels.[ch]
removed to a separate library
* init.c (scm_boot_guile): copied from guile-tcl.c.
Initialization specific to tcl interpreters removed.
Wed May 8 15:07:37 1996 Tom Lord <lord@beehive>
* ports.c (scm_ports_prehistory): size malloced here doesn't
matter so long as it is non-0 (got rid of "* 4").
Tue May 7 11:43:37 1996 Tom Lord <lord@beehive>
* gscm.h: gscm_mkarray eliminated (presumably was not being used
since its definition was bogus).
Mon May 6 13:02:56 1996 Tom Lord <lord@beehive>
* mallocs.[ch]: back again (for rx at least).
Wed Apr 17 08:54:20 1996 Tom Lord <lord@beehive>
* ports.c: removed functions relating to the mapping between ports
and descriptors. (That stuff is unix-specific and should be collected
in a separate library).
* ramap.c (scm_array_copy): return #<unspecified> not #<undefined>.
(Tom Mckay@avanticorp.com)
Mon Apr 15 14:16:55 1996 Tom Lord <lord@beehive>
* gc.c (scm_gc_sweep): Immediates in weak vectors were not
handled correctly (SCM_FREEP was applied to them) -- test for
NIMP. Keys in weak hash tables were spuriously (though harmlessly)
being overwritten with #f. (brown@grettir.bibliotech.com)
Tue Apr 2 22:25:00 1996 Tom Lord <lord@beehive>
* gc.c (scm_unhash_name): new procedure, unhash-name, flushes glocs
for a specific symbol or for all symbols.
Mon Apr 1 10:34:55 1996 Tom Lord <lord@beehive>
* gc.c (scm_gc_mark): mark weak hash tables correctly (was getting weak
keys and weak values confused).
Thu Mar 14 22:20:20 1996 Tom Lord <lord@beehive>
* list.c (scm_last_pair): map '()=>'()
Wed Mar 13 16:43:34 1996 Tom Lord <lord@beehive>
* pairs.c, hashtab.c, list.c, alist.c append.c, sequences.c:
Generalized assoc and hash-table functions.
Factored pairs.c into multiple files.
Fri Mar 8 14:44:39 1996 Tom Lord <lord@beehive>
* gscm.c (gscm_run_scm): got rid of objprop.
Fri Mar 1 10:39:52 1996 Tom Lord <lord@beehive>
* genio.c (scm_getc):
NOTE: fgetc may not be interruptable.
* procprop.c (scm_stand_in_scm_proc):
NOTE: don't use a alist here.
(scm_set_procedure_properties_x): fix type checking throughout this file.
* gc.c (scm_gc_sweep): free heap segments with free, not must_free.
* ports.c (scm_remove_from_port_table): adjust scm_mallocated
after freeing part of the port table.
Thu Feb 29 16:21:17 1996 Tom Lord <lord@beehive>
* strports.c (scm_mkstrport):
* vports.c (scm_make_soft_port): allocate a port table entry
(possibly triggering gc) before setting the tag of the corresponding
ports handle.
* pairs.c (scm_delq_x): never throw an error.
* vectors.c (scm_make_vector): made the default vector fill argument
into '() (much more useful than the previous value, "#unspecified")
Mon Feb 26 17:19:09 1996 Tom Lord <lord@beehive>
* ports.c (scm_add_to_port_table): Added fields
to port table entries: file_name, line_num, col.
Update these in open_file, gen_getc and gen_ungetc.
Added procedures to access those fields.
Sun Feb 25 00:10:36 1996 Tom Lord <lord@beehive>
* procs.c (scm_make_subr_opt): new entry point for making
anonymous subrs.
Sat Feb 24 17:11:31 1996 Tom Lord <lord@beehive>
* gc.h: SCM_STACK_GROWS_UP is now set by autoconf.
Fri Feb 23 10:26:29 1996 Tom Lord <lord@beehive>
* numbers.c (scm_exact_p): This function no longer
implements "integer?".
Thu Feb 22 20:56:16 1996 Tom Lord <lord@beehive>
* gc.c (scm_gc_end): simulate a signal at the end of each GC.
(scm_gc_stats): return an assoc of useful data. Replaces "room"
and the stats reporting formerlly built into repl.
* repl.[ch]: removed.
GC statistics keeping moved to gc.c.
Other statistics keeping can be done from Scheme.
REPLS are now written in Scheme.
Wed Feb 21 10:28:53 1996 Tom Lord <lord@beehive>
* cnsvobj.c (gscm_is_gscm_obj): new file for old functions (icky
conservatively marked objects).
* throw.c (scm_ithrow): Unwind up to the right catch during a throw!
* error.c (scm_init_error): init system_error_sym here, not in repl.c.
* feature.c (scm_compiled_library_path): moved here from repl.c.
This file is for stuff relating specifically to Scheme libraries
like slib.
* eval.c (scm_m_define): don't give warning about redefinition, don't
check verbosity.
NOTE: this should throw a resumable exception with parameters --
the name, the top-level env, the variable, the definition, #t/#f: redefining builtin?
* repl.c (scm_gc_begin/end): don't print a message, don't check verbosity.
* error.c: scm_warn eliminated.
* read.c (scm_lreadr): extra right paren gets an error, not a warning.
* repl.c, marksweep.c, gc.c (various):
lose exit_report, growth_mon.
* gscm.c: got rid of verbosity functions.
Tue Feb 20 00:19:10 1996 Tom Lord <lord@beehive>
* throw.c (scm_ithrow): guard against the bad-throw hook changing
between the call to procedurep and use.
* error.c (scm_everr):
* gc.c (fixconfig):
* gsubr.c (scm_make_gsubr): use exit, not scm_quit. still wrong,
but less so.
* strports.c: don't reveal the port's string to the caller
because it changes size.
(stputc stwrite): check/change the strings length with interrupts
blocked.
* objprop.c (scm_set_object_property_x &c): use the generic
hashing functions and be threadsafe.
* eval.c (scm_unmemocar): do this operation in a thread-safe way.
(per suggestion jaffer@gnu.ai.mit.edu).
* mbstrings.c (scm_multi_byte_string): guard against argument list
changing length.
* strings.c (scm_make_string): loop cleanup
* unif.c (scm_vector_set_length_x): scm_vector_set_length_x no longer
a scheme function.
* weaks.c (scm_weak_vector): guard against argument list
changing length.
* variable.c (scm_builtin_variable): check for/make a built-in
variable automicly.
* vectors.c (scm_vector): while filling the new array,
guard against a list of fill elements that grows after
the vector is allocated.
* hashtab.c -- new file: general hash table
functions. hash, hashq, hashv, hashx.
* tags.h: made wvect an option bit of vector.
Mon Feb 19 09:38:05 1996 Tom Lord <lord@beehive>
* symbols.c: made the basic symbol table operations atomic.
* root.c &c.: collected stack-specific global state.
linum/colnum etc *should* be port-specific state.
* struct.c (scm_init_struct): init the first struct type during
initialization to fix a race condition.
* continuations.c (scm_dynthrow): pass throwval in the 'regs'
object, not in a global.
(suggested by green@cygnus, jaffer@gnu.ai.mit.edu)
* throw.c (_scm_throw): Pass throwval on the stack, not in a global
(suggested by green@cygnus, jaffer@gnu.ai.mit.edu)
* *.[ch]: namespace cleanup. Changed all (nearly) exported CPP
and C symbols to begin with SCM_ or scm_.
Sun Feb 18 15:55:38 1996 Tom Lord <lord@beehive>
* gsubr.c (scm_gsubr_apply): statically allocate the
array of arguments (bothner@cygnus.com).
Sat Feb 17 20:20:40 1996 Tom Lord <lord@beehive>
* scmsigs.c: Simplified to use async rountines.
* async.c: New support for interrupt handlers.
Thu Feb 15 11:39:09 1996 Tom Lord <lord@beehive>
* symbols.c (scm_string_to_symbol et al.): number of tweaky changes to
set the multi_byte flag correctly in symbols. This is wrong.
intern_obbary_soft and msymbolize should take an extra parameter.
Also, weird multibyte symbols don't print correctly.
The weird symbol syntax is also a bit bogus (emacs doesn't quite
cope).
Tue Feb 13 11:39:37 1996 Tom Lord <lord@beehive>
* symbols.c (scm_string_to_obarray_symbol): obarray == #f means
use the system symhash. == #t means create an uninterned symbol.
Wed Feb 7 09:28:02 1996 Tom Lord <lord@beehive>
* strings.c (scm_make_shared_substring): build'em.
It might better to keep a table of these and use one
less cons-pair per shared-substring.
Tue Feb 6 17:45:21 1996 Tom Lord <lord@beehive>
* strings.c (scm_string_shared_substring): create shared
substrings. (Doesn't handle mb strings yet).
* mbstrings.c (scm_print_mb_string): handle RO strings.
* print.c (scm_iprin1): print substrings as their non-substring
counterparts (dubious).
* marksweep.c (scm_gc_mark scm_gc_sweep): handle RO and MB
strings.
* hash.c (scm_hasher): hash RO and MB strings as bytestrings.
* eval.c (SCM_CEVAL): self-evaluate RO and MB strings.
* eq.c (scm_equal_p): handle RO and MB strings.
* symbols.c (scm_string_to_symbol):
(scm_string_to_obarray_symbol):
* strop.c (scm_i_index):
(scm_i_rindex):
(scm_string_null_p):
(scm_string_to_list):
* strings.c (scm_string_length):
(scm_string_ref):
(scm_substring):
(scm_string_append):
* simpos.c (scm_system):
(scm_getenv):
* fports.c (scm_open_file):
* strorder.c (scm_string_equal_p):
(scm_string_ci_equal_p):
(scm_string_less_p):
(scm_string_ci_less_p):
* pairs.c (scm_obj_length):
* mbstrings.c (scm_multi_byte_string_length):
Use RO string macros for RO strings.
Tue Jan 30 09:19:08 1996 Tom Lord <lord@beehive>
* Makefile.in (CFLAGS ALL_CFLAGS): be more standard.
* strop.c (scm_i_rindex, scm_i_index): Don't use the BSD functions
index/rindex. Do handle embedded \000 characters.
Sun Jan 28 13:16:18 1996 Tom Lord <lord@beehive>
* error.c (def_err_response): (int)scm_err_pos => (long)scm_err_pos
Eliminate a (presumed) warning on some systems.
* gscm.c (gscm_run_scm): SCM_INIT_PATH => GUILE_INIT_PATH
(Mikael Djurfeldt <mdj@nada.kth.se>)
Sat Jan 27 12:36:55 1996 Tom Lord <lord@beehive>
* eval.c (scm_map): added argument type checking.
(kawai@sail.t.u-tokyo.ac.jp)
* gscm.c (gscm_set_procedure_properties_x): parameter "new" => "new_val"
for C++. (Seth Alves <alves@gryphon.com>)
(gscm_cstr): uses an uninitialized local variable causing
segv. (kawai@sail.t.u-tokyo.ac.jp)
* lvectors.c (scm_get_lvector_hook):
In guile-ii, the lvector code was broken. It was fixed in guile-iii.
It seems to me like if it is broken again in guile-iv...Here is a patch.
"! || (LENGTH (keyvec) == 0))"
(From: Mikael Djurfeldt <mdj@nada.kth.se>)
* gscm.c (gscm_sys_default_verbosity):
incorrectly declared for non-__STDC__
(Tom_Mckay@avanticorp.com)
* ports.c (scm_setfileno): Tweak the macro a bit
to make it easier to port to systems that use
more than a single structure field to hold a descriptor.
* debug.c (change_mode): Avoid GNUCism "int foo[n];"
Give a warning, not an error, for unrecognized modes.
* eval.c (SCM_CEVAL):
static char scm_s_for_each[];
static char scm_s_map[];
not needed.
* strings.c (scm_string_p):
static char s_string[];
(see next entry)
* struct.c (scm_sys_struct_set_x):
static char s_sys_make_struct[];
static char s_sys_struct_ref[];
static char s_sys_struct_set_x[];
Rearrange code to eliminate those forward decls for the sake of
broken compilers.
* variable.c (make_vcell_variable): static char s_make_variable[];
isn't needed.
* fports.c (scm_port_mode):
chars modes[3] = "";
to
chars modes[3];
modes[0] = '\0';
(Tom_Mckay@avanticorp.com)
* pairs.c (scm_set_cdr_x): non-__STDC__ declaration of
scm_cons2(), scm_acons(), and scm_set_cdr_x() missing semicolon
(Tom_Mckay@avanticorp.com)
* numbers.c (scm_num_eq_p): Non-__STDC__ declaration of
scm_num_eq_p() was scm_equal_p().
(Tom_Mckay@avanticorp.com)
* symbols.c (msymbolize): "CHARS(X) = " => "SETCHARS..."
(Tom_Mckay@avanticorp.com)
Fri Jan 26 14:03:01 1996 Tom Lord <lord@beehive>
* weaks.c (scm_make_weak_vector): "VELTS(X) =" => "SETVELTS..."
(Tom_Mckay@avanticorp.com)
* strop.c (scm_substring_fill_x):
Non-__STDC__ declaration of scm_substring_fill_x() missing semicolon
(Tom_Mckay@avanticorp.com)
* eval.c (SCM_APPLY): variables "debug_info" -> dbg_info.
Works around a compiler bug on some machines. (Tom_Mckay@avanticorp.com)
* _scm.h (CxR functions): #define CxR SCM_CxR => #define CxR(X) SCM_CxR(X)
Works around a compiler bug on some machines. (Tom_Mckay@avanticorp.com)
* lvectors.c (scm_lvector_set_x): avoid VELTS (VELTS (...)[..]) which
can turn into an obscure gc bug.
* chars.c (scm_char_p): fixed PROC call.
* gscm.h (gscm_vset): use scm_vector_set_x not (the missing)
scm_vector_set.
Tue Jan 23 13:29:40 1996 Tom Lord <lord@beehive>
* elisp.c (new file): dynamic scoping and other bits for
elisp. Don't use this yet unless you specificly want to
hack on elisp emulation.
* dynwind.c (scm_dowinds): When entering or leaving a dynamic
scope created by scm_with_dynamic_bindings_operation_x, swap
the bindings of that scope with the corresponding globals.
* continuations.c (scm_make_cont): when a continuation is captured,
relocate the continuation stack chunks registered on the wind chain
to the heap.
Sun Jan 21 19:31:17 1996 Tom Lord <lord@beehive>
* eval.c (SCM_CEVAL): if the function position evaluates
to a macro, process it accordingly. (Previously, macros were
handled only if the function position was a symbol naming a
variable bound to a macro).
Sat Jan 20 23:21:37 1996 Tom Lord <lord@beehive>
* eval.c (scm_m_set): allow multi-variable set! like
(set! x 1 y 2 z 3).
Wed Dec 6 02:40:49 1995 Tom Lord <lord@beehive>
* ports.h fports.c vports.c marksweep.c gc.c strports.c: moved the STREAM
of ports into the port table and replaced it with a port-table
index.
* repl.c (iprin1): added tc7_mb_string -- same as tc7_string.
* marksweep.c (scm_gc_mark): added tc7_mb_string -- same as tc7_string.
* mbstrings.c (new file): functions on multi-byte strings.
* tags.h (scm_typ7_string, scm_typ7_mb_string): added a tag
for multi-byte strings. Moved the string tag.
* chars.h chars.c repl.c (many functions): made scm_upcase and scm_downcase
functions that are safe for extended character sets.
Changed the range of integer->char.
Changed the tyep of SCM_ICHR.
Tue May 16 17:49:58 1995 Mikael Djurfeldt <mdj@sanscalc.nada.kth.se>
* guile.c: Changed init file name from "SCM_INIT_PATH" to
"GUILE_INIT_PATH"
Sun Aug 6 15:14:46 1995 Andrew McCallum <mccallum@vein.cs.rochester.edu>
* guile.c (gscm_is_gscm_type): New function. (Without this how will we
know that it's safe to pass an object to gscm_get_type?)
(gscm_get_type): Fix tyop in error message.
* variable.c (scm_variable_ref): fixed assertion test.
(Robert STRANDH <strandh@labri.u-bordeaux.fr>)
* gscm.h: fixed several prototypes, notably gscm_vref.
Add gscm_is_eq and temporarily commented out gscm_eq (see
the note in gscm.h near gscm_eq if this change effects your
code).
(Reported by Mark Galassi <rosalia@sstcx1.lanl.gov>)
* pairs.c (scm_obj_length): see next entry.
* gscm.h (gscm_obj_length): A way to get an integer
length for lists, strings, symbols (treated as strings),
and vectors. Returns -1 on error.
* eq.c (scm_equal_p): fixed smob case.
(William Gribble <grib@arlut.utexas.edu>)
* Makefile.in (X_CFLAGS): defined.
(William Gribble <grib@arlut.utexas.edu>)
* gscm.h (gscm_2_double): provided now
(reported by Mark Galassi <rosalia@sstcx1.lanl.gov>)
Tue Jun 13 01:04:09 1995 gnu
* Vrooom!

984
libguile/Makefile.in Normal file
View file

@ -0,0 +1,984 @@
# @configure_input@
# Copyright (C) 1995 Free Software Foundation, Inc.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this software; see the file COPYING. If not, write to
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#
#
# Makefile for libguile
#
VPATH = @srcdir@
srcdir = @srcdir@
SHELL = /bin/sh
VERSION=@GUILE_VERSION@
# Common prefix for machine-independent installed files.
prefix = @prefix@
# Common prefix for machine-dependent installed files.
exec_prefix = @exec_prefix@
# Directory in which to install init files &c
libdir = $(exec_prefix)/lib
# Directory to search by default for included makefiles.
includedir = $(prefix)/include
# Directory to install `guile' in.
bindir = $(exec_prefix)/bin
INSTALL = $(srcdir)/../install-sh -c
INSTALL_DATA = $(INSTALL) -m 644
# Programs to make tags files.
ETAGS = etags
CTAGS = ctags -tw
# where the init files are found
IMPLPATH=$(libdir)/gls/guile
# where the Tcl and Tk sources are found
TCL_SRC_DIR = @TCL_SRC_DIR@
TK_SRC_DIR = @TK_SRC_DIR@
# CC
X11_INCLUDES = @XINCLUDES@
XFLAGS = @X_CFLAGS@
CFLAGS = @CFLAGS@
INCLUDE_CFLAGS = -I. -I$(srcdir) -I$(TCL_SRC_DIR)/generic -I$(TK_SRC_DIR)/generic
ALL_CFLAGS = $(CFLAGS) $(X_CFLAGS) $(INCLUDE_CFLAGS) $(X11_INCLUDES) -DLIBRARY_PATH=\"$(libdir)/\" @DEFS@
CC = @CC@ $(ALL_CFLAGS) -Wall
# CC used as a front end for ld
LDFLAGS = @LDFLAGS@
CCLD= $(CC) $(LDFLAGS)
# AR
AR = ar
AR_FLAGS = rc
RANLIB = @RANLIB@
# Any extra object files your system needs.
extras = @LIBOBJS@
libobjs= alist.o \
append.o \
appinit.o \
arbiters.o \
async.o \
boolean.o \
chars.o \
continuations.o \
dynwind.o \
eq.o \
error.o \
eval.o \
extchrs.o \
fdsocket.o \
feature.o \
files.o \
filesys.o \
fports.o \
gc.o \
genio.o \
gsubr.o \
hash.o \
hashtab.o \
init.o \
ioext.o \
kw.o \
list.o \
load.o \
mallocs.o \
markers.o \
markers.o \
marksweep.o \
mbstrings.o \
numbers.o \
objprop.o \
pairs.o \
ports.o \
posix.o \
print.o \
procprop.o \
procs.o \
ramap.o \
read.o \
root.o \
scmsigs.o \
sequences.o \
simpos.o \
smob.o \
socket.o \
stackchk.o \
stime.o \
strings.o \
strop.o \
strorder.o \
strports.o \
struct.o \
symbols.o \
tag.o \
throw.o \
unif.o \
variable.o \
vectors.o \
vports.o \
weaks.o \
$(extras)
uninstalled_h_files= _scm.h __scm.hd
installed_h_files= __scm.h \
alist.h \
append.h \
arbiters.h \
async.h \
boolean.h \
chars.h \
continuations.h \
dynwind.h \
eq.h \
error.h \
eval.h \
extchrs.h \
fdsocket.h \
feature.h \
fports.h \
files.h \
filesys.h \
gc.h \
genio.h \
gsubr.h \
hash.h \
hashtab.h \
init.h \
ioext.h \
kw.h \
list.h \
load.h \
libguile.h \
mallocs.h \
markers.h \
marksweep.h \
markers.h \
mbstrings.h \
numbers.h \
objprop.h \
pairs.h \
ports.h \
posix.h \
params.h \
print.h \
procs.h \
procprop.h \
ramap.h \
read.h \
root.h \
scmsigs.h \
sequences.h \
simpos.h \
smob.h \
socket.h \
stackchk.h \
strports.h \
struct.h \
symbols.h \
tag.h \
stime.h \
tags.h \
variable.h \
vectors.h \
vports.h \
weaks.h \
unif.h \
scmhob.h \
strings.h \
strop.h \
strorder.h \
throw.h \
unif.h
h_files=$(uninstalled_h_files) $(installed_h_files)
c_files= alist.c \
append.c \
appinit.c \
arbiters.c \
async.c \
boolean.c \
chars.c \
continuations.c \
dynwind.c \
eq.c \
error.c \
eval.c \
extchrs.c \
fdsocket.c \
feature.c \
files.c \
filesys.c \
fports.c \
gc.c \
genio.c \
gsubr.c \
hash.c \
hashtab.c \
inet_aton.c \
init.c \
ioext.c \
kw.c \
list.c \
load.c \
mallocs.c \
markers.c \
markers.c \
marksweep.c \
mbstrings.c \
numbers.c \
objprop.c \
pairs.c \
ports.c \
posix.c \
print.c \
procprop.c \
procs.c \
ramap.c \
read.c \
root.c \
scmsigs.c \
sequences.c \
simpos.c \
smob.c \
socket.c \
stackchk.c \
stime.c \
strings.c \
strop.c \
strorder.c \
strports.c \
struct.c \
symbols.c \
tag.c \
throw.c \
unif.c \
variable.c \
vectors.c \
vports.c \
weaks.c
gen_c_files= alist.x \
append.x \
arbiters.x \
async.x \
boolean.x \
chars.x \
continuations.x \
dynwind.x \
eq.x \
error.x \
eval.x \
extchrs.x \
fdsocket.x \
feature.x \
files.x \
filesys.x \
fports.x \
gc.x \
genio.x \
gsubr.x \
hash.x \
hashtab.x \
init.x \
ioext.x \
kw.x \
list.x \
load.x \
mallocs.x \
markers.x \
marksweep.x \
mbstrings.x \
numbers.x \
objprop.x \
pairs.x \
ports.x \
posix.x \
print.x \
procprop.x \
procs.x \
ramap.x \
read.x \
root.x \
scmsigs.x \
sequences.x \
simpos.x \
smob.x \
socket.x \
stackchk.x \
stime.x \
strings.x \
strop.x \
strorder.x \
strports.x \
struct.x \
symbols.x \
tag.x \
throw.x \
unif.x \
variable.x \
vectors.x \
vports.x \
weaks.x
ancillery = gscm.c \
gscm.h \
COPYING \
ChangeLog \
ChangeLog.scm \
Makefile.in \
PLUGIN \
acconfig-1.5.h \
configure \
configure.in \
def.sed \
scmconfig.h.in \
fd.h.in \
../doc/guile.texi \
../doc/guile.ps \
../doc/guile.info \
../doc/guile.info-1 \
../doc/guile.info-2 \
../doc/guile.info-3 \
../doc/guile.info-4 \
../doc/guile.info-5 \
../doc/in.texi \
../doc/in.info \
../doc/in.ps \
../doc/agenda \
../doc/texinfo.tex
c_sources = $(c_files) $(h_files)
manifest = $(ancillery) $(c_sources)
.SUFFIXES:
.SUFFIXES: .o .c .h .ps .dvi .info .texinfo .scm .cd .x .hd
.cd.c:
( echo "/* DO NOT EDIT --- AUTO-GENERATED --- DO NOT EDIT */" > $@ \
&& echo -n "#line 1" \" \
&& echo $<\" | sed -e "s,^.*/,," >> $@ \
&& sed -f $(srcdir)/def.sed $< >> $@) \
|| rm -f $@
.hd.h:
( echo "/* DO NOT EDIT --- AUTO-GENERATED --- DO NOT EDIT */" > $@ \
&& echo -n "#line 1" \" >> $@ \
&& echo $<\" | sed -e "s,^.*/,," >> $@ \
&& sed -f $(srcdir)/def.sed $< >> $@) \
|| rm -f $@
.c.x:
if test ! -escmconfig.h ; then \
touch scmconfig.h; \
fake_scmconfig=1; \
else \
fake_scmconfig=0; \
fi; \
$(CC) $(ALL_CFLAGS) -I. -DSCM_MAGIC_SNARFER -E $< | grep "^%%%" | sed -e "s/^%%%//" > $@ ; \
if test $$fake_scmconfig -eq 1 ; then \
rm scmconfig.h; \
fi
.PHONY: all
all: libguile.a
SUBDIR=.
manifest:
for file in $(manifest) ; \
do echo $(SUBDIR)/$$file ; \
done
libguile.a: $(libobjs)
rm -f libguile.a
$(AR) $(AR_FLAGS) libguile.a $(libobjs)
$(RANLIB) libguile.a
install: all
test -d $(prefix) || mkdir $(prefix)
test -d $(libdir) || mkdir $(libdir)
test -d $(includedir) || mkdir $(includedir)
test -d $(includedir)/guile$(VERSION) || mkdir $(includedir)/guile$(VERSION)
$(INSTALL_DATA) libguile.a $(libdir)/libguile$(VERSION).a
$(RANLIB) $(libdir)/libguile$(VERSION).a
$(INSTALL_DATA) scmconfig.h $(includedir)/guile$(VERSION)
for h in $(h_files); do \
$(INSTALL_DATA) $(srcdir)/$$h $(includedir)/guile$(VERSION); \
done
uninstall:
-for h in $(h_files); do \
rm -f $(includedir)/guile$(VERSION)/$$h; \
done
rm -f $(includedir)/guile$(VERSION)/scmconfig.h
-rmdir $(includedir)/guile$(VERSION)
-rm $(libdir)/libguile$(VERSION).a
TAGS:
etags $(c_sources)
info:
clean:
-rm -f libguile.a
-rm -f $(libobjs)
-rm -f $(gen_c_files)
distclean: clean
-rm -f config.cache
-rm -f config.log
-rm -f config.status
-rm -f Makefile
-rm -f scmconfig.h
realclean: distclean
-rm -f $(gen_c_files)
-rm -f scmconfig.h
xfiles: $(gen_c_files)
DEPENDS_CFLAGS=
depends:
touch scmconfig.h
touch $(gen_c_files)
gcc -MM -I. $(DEPENDS_CFLAGS) $(c_files)
rm $(gen_c_files)
rm scmconfig.h
$(srcdir)/__scm.h: __scm.hd
###
alist.o : alist.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h alist.x
append.o : append.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h append.x
appinit.o : appinit.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h
arbiters.o : arbiters.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h arbiters.x
async.o : async.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h async.x
boolean.o : boolean.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h boolean.x
chars.o : chars.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h chars.x
continuations.o : continuations.c _scm.h libguile.h __scm.h tags.h smob.h params.h \
alist.h append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h \
eq.h error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h \
fports.h gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h \
kw.h list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h \
print.h procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h \
socket.h stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h \
tag.h throw.h unif.h variable.h vectors.h vports.h weaks.h continuations.x
dynwind.o : dynwind.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h dynwind.x
eq.o : eq.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h eq.x
error.o : error.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h error.x
eval.o : eval.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h eval.x
extchrs.o : extchrs.c extchrs.h
fdsocket.o : fdsocket.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h fdsocket.x
feature.o : feature.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h feature.x
files.o : files.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h files.x
filesys.o : filesys.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h filesys.x
fports.o : fports.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h fports.x
gc.o : gc.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h gc.x
genio.o : genio.c extchrs.h _scm.h libguile.h __scm.h tags.h smob.h params.h \
alist.h append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h \
eq.h error.h pairs.h eval.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h
gsubr.o : gsubr.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h
hash.o : hash.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h hash.x
hashtab.o : hashtab.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h hashtab.x
inet_aton.o : inet_aton.c
init.o : init.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h
ioext.o : ioext.c ioext.x
kw.o : kw.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h kw.x
list.o : list.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h list.x
load.o : load.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h load.x
mallocs.o : mallocs.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h
markers.o : markers.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h
markers.o : markers.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h
marksweep.o : marksweep.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h
mbstrings.o : mbstrings.c extchrs.h _scm.h libguile.h __scm.h tags.h smob.h \
params.h alist.h append.h arbiters.h async.h boolean.h chars.h continuations.h \
dynwind.h eq.h error.h pairs.h eval.h fdsocket.h feature.h files.h filesys.h \
fports.h gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h \
kw.h list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h \
print.h procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h \
socket.h stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h \
tag.h throw.h unif.h variable.h vectors.h vports.h weaks.h mbstrings.x
numbers.o : numbers.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h numbers.x
objprop.o : objprop.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h objprop.x
pairs.o : pairs.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h pairs.x
ports.o : ports.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h ports.x
posix.o : posix.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h posix.x
print.o : print.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h print.x
procprop.o : procprop.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h procprop.x
procs.o : procs.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h procs.x
ramap.o : ramap.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h ramap.x
read.o : read.c extchrs.h _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h read.x
root.o : root.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h
scmsigs.o : scmsigs.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h scmsigs.x
sequences.o : sequences.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h sequences.x
simpos.o : simpos.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h simpos.x
smob.o : smob.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h
socket.o : socket.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h socket.x
stackchk.o : stackchk.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h stackchk.x
stime.o : stime.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h stime.x
strings.o : strings.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h strings.x
strop.o : strop.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h strop.x
strorder.o : strorder.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h strorder.x
strports.o : strports.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h strports.x
struct.o : struct.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h struct.x
symbols.o : symbols.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h symbols.x
tag.o : tag.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h tag.x
throw.o : throw.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h throw.x
unif.o : unif.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h unif.x
variable.o : variable.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h variable.x
vectors.o : vectors.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h vectors.x
vports.o : vports.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h \
append.h arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h \
error.h pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h \
gc.h marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h \
list.h load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h \
procprop.h procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h \
stackchk.h stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h \
unif.h variable.h vectors.h vports.h weaks.h vports.x
weaks.o : weaks.c _scm.h libguile.h __scm.h tags.h smob.h params.h alist.h append.h \
arbiters.h async.h boolean.h chars.h continuations.h dynwind.h eq.h error.h \
pairs.h eval.h extchrs.h fdsocket.h feature.h files.h filesys.h fports.h gc.h \
marksweep.h genio.h ports.h gsubr.h hash.h hashtab.h init.h ioext.h kw.h list.h \
load.h mallocs.h markers.h mbstrings.h symbols.h numbers.h posix.h print.h procprop.h \
procs.h ramap.h read.h root.h scmsigs.h sequences.h simpos.h socket.h stackchk.h \
stime.h strings.h strop.h strorder.h strports.h struct.h tag.h throw.h unif.h \
variable.h vectors.h vports.h weaks.h weaks.x

375
libguile/__scm.h Normal file
View file

@ -0,0 +1,375 @@
/* DO NOT EDIT --- AUTO-GENERATED --- DO NOT EDIT */
#line 1 "__scm.hd"
/* classes: h_files */
#ifndef __SCMH
#define __SCMH
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
/* {Supported Options}
*
* These may be defined or undefined.
*/
/* If the compile FLAG `CAUTIOUS' is #defined then the number of
* arguments is always checked for application of closures. If the
* compile FLAG `RECKLESS' is #defined then they are not checked.
* Otherwise, number of argument checks for closures are made only when
* the function position (whose value is the closure) of a combination is
* not an ILOC or GLOC. When the function position of a combination is a
* symbol it will be checked only the first time it is evaluated because
* it will then be replaced with an ILOC or GLOC.
*/
#undef RECKLESS
#define CAUTIOUS
/* After looking up a local for the first time, rewrite the
* code graph, caching its position.
*/
#define MEMOIZE_LOCALS
/* All the number support there is.
*/
#define SCM_FLOATS
#define BIGNUMS
/* GC should relinquish empty cons-pair arenas.
*/
#define GC_FREE_SEGMENTS
/* Provide a scheme-accessible count-down timer that
* generates a pseudo-interrupt.
*/
#define TICKS
/* Use engineering notation when converting numbers strings?
*/
#undef ENGNOT
/* Include support for uniform arrays?
*
* Possibly some of the initialization code depends on this
* being defined, but that is a bug and should be fixed.
*/
#define ARRAYS
#undef SCM_CAREFUL_INTS
/* {Unsupported Options}
*
* These must be defined.
*/
#define CCLO
#define SICP
/* Random options (net yet supported or in final form). */
#undef DEBUG_EXTENSIONS
#undef READER_EXTENSIONS
#undef SCM_STACK_LIMIT 20000
#undef NO_CEVAL_STACK_CHECK
#undef LONGLONGS
/* Some auto-generated .h files contain unused prototypes
* that need these typedefs.
*/
typedef long long_long;
typedef unsigned long ulong_long;
/* Define
*
* SCM_CHAR_SCM_CODE_LIMIT == UCHAR_MAX + 1
* SCM_MOST_POSITIVE_FIXNUM (LONG_MAX>>2)
* SCM_MOST_NEGATIVE_FIXNUM == SCM_SRS((long)LONG_MIN, 2)
*/
#ifdef HAVE_LIMITSH
# include <limits.h>
# ifdef UCHAR_MAX
# define SCM_CHAR_SCM_CODE_LIMIT (UCHAR_MAX+1L)
# else
# define SCM_CHAR_SCM_CODE_LIMIT 256L
# endif /* def UCHAR_MAX */
# define SCM_MOST_POSITIVE_FIXNUM (LONG_MAX>>2)
# ifdef _UNICOS /* Stupid cray bug */
# define SCM_MOST_NEGATIVE_FIXNUM ((long)LONG_MIN/4)
# else
# define SCM_MOST_NEGATIVE_FIXNUM SCM_SRS((long)LONG_MIN, 2)
# endif /* UNICOS */
#else
# define SCM_CHAR_SCM_CODE_LIMIT 256L
# define SCM_MOST_POSITIVE_FIXNUM ((long)((unsigned long)~0L>>3))
# if (0 != ~0)
# define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM-1)
# else
# define SCM_MOST_NEGATIVE_FIXNUM (-SCM_MOST_POSITIVE_FIXNUM)
# endif /* (0 != ~0) */
#endif /* def HAVE_LIMITSH */
#include <scmconfig.h>
#include "tags.h"
#ifdef vms
# ifndef CHEAP_CONTINUATIONS
typedef int jmp_buf[17];
extern int setjump(jmp_buf env);
extern int longjump(jmp_buf env, int ret);
# define setjmp setjump
# define longjmp longjump
# else
# include <setjmp.h>
# endif
#else /* ndef vms */
# ifdef _CRAY1
typedef int jmp_buf[112];
extern int setjump(jmp_buf env);
extern int longjump(jmp_buf env, int ret);
# define setjmp setjump
# define longjmp longjump
# else /* ndef _CRAY1 */
# include <setjmp.h>
# endif /* ndef _CRAY1 */
#endif /* ndef vms */
/* 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.
*/
#ifdef sparc
# define SCM_FLUSH_REGISTER_WINDOWS asm("ta 3")
#else
# define SCM_FLUSH_REGISTER_WINDOWS /* empty */
#endif
/* If stack is not longword aligned then
*/
/* #define SHORT_ALIGN */
#ifdef THINK_C
# define SHORT_ALIGN
#endif
#ifdef MSDOS
# define SHORT_ALIGN
#endif
#ifdef atarist
# define SHORT_ALIGN
#endif
#ifdef SHORT_ALIGN
typedef short SCM_STACKITEM;
#else
typedef long SCM_STACKITEM;
#endif
extern unsigned int scm_async_clock;
#define SCM_ASYNC_TICK if (0 == --scm_async_clock) scm_async_click ()
#ifdef SCM_CAREFUL_INTS
#define SCM_CHECK_NOT_DISABLED \
if (scm_ints_disabled) \
fputs("ints already disabled\n", stderr); \
#define SCM_CHECK_NOT_ENABLED \
if (!scm_ints_disabled) \
fputs("ints already enabled\n", stderr); \
#else
#define SCM_CHECK_NOT_DISABLED
#define SCM_CHECK_NOT_ENABLED
#endif
#define SCM_DEFER_INTS \
{ \
SCM_CHECK_NOT_DISABLED; \
scm_ints_disabled = 1; \
} \
#define SCM_ALLOW_INTS_ONLY \
{ \
scm_ints_disabled = 0; \
} \
#define SCM_ALLOW_INTS \
{ \
SCM_CHECK_NOT_ENABLED; \
scm_ints_disabled = 0; \
SCM_ASYNC_TICK; \
} \
#define SCM_REDEFER_INTS \
{ \
++scm_ints_disabled; \
} \
#define SCM_REALLOW_INTS \
{ \
--scm_ints_disabled; \
if (!scm_ints_disabled) \
SCM_ASYNC_TICK; \
} \
/** SCM_ASSERT
**
**/
#ifdef SCM_RECKLESS
#define SCM_ASSERT(_cond, _arg, _pos, _subr)
#define SCM_ASRTGO(_cond, _label)
#else
#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
if (!(_cond)) \
scm_wta(_arg, (char *)(_pos), _subr)
#define SCM_ASRTGO(_cond, _label) \
if (!(_cond)) \
goto _label
#endif
#define SCM_ARGn 0
#define SCM_ARG1 1
#define SCM_ARG2 2
#define SCM_ARG3 3
#define SCM_ARG4 4
#define SCM_ARG5 5
#define SCM_ARG6 6
#define SCM_ARG7 7
#define SCM_ARGERR(X) ((X) < SCM_WNA \
? (char *)(X) \
: "wrong type argument")
/* Following must match entry indexes in scm_errmsgs[].
* Also, SCM_WNA must follow the last SCM_ARGn in sequence.
*/
#define SCM_WNA 8
#define SCM_OVSCM_FLOW 9
#define SCM_OUTOFRANGE 10
#define SCM_NALLOC 11
#define SCM_STACK_SCM_OVSCM_FLOW 12
#define SCM_EXIT 13
/* (...still matching scm_errmsgs) These
* are signals. Signals may become errors
* but are distinguished because they first
* try to invoke a handler that can resume
* the interrupted routine.
*/
#define SCM_HUP_SIGNAL 14
#define SCM_INT_SIGNAL 15
#define SCM_FPE_SIGNAL 16
#define SCM_BUS_SIGNAL 17
#define SCM_SEGV_SIGNAL 18
#define SCM_ALRM_SIGNAL 19
#define SCM_GC_SIGNAL 20
#define SCM_TICK_SIGNAL 21
#define SCM_SIG_ORD(X) ((X) - SCM_HUP_SIGNAL)
#define SCM_ORD_SIG(X) ((X) + SCM_HUP_SIGNAL)
#define SCM_NUM_SIGS (SCM_SIG_ORD (SCM_TICK_SIGNAL) + 1)
struct errdesc
{
char *msg;
char *s_response;
short parent_err;
};
extern struct errdesc scm_errmsgs[];
/* SCM_EXIT_SUCCESS is the default code to return from SCM if no errors
* were encountered. SCM_EXIT_FAILURE is the default code to return from
* SCM if errors were encountered. The return code can be explicitly
* specified in a SCM program with (scm_quit <n>).
*/
#ifndef SCM_EXIT_SUCCESS
#ifdef vms
#define SCM_EXIT_SUCCESS 1
#else
#define SCM_EXIT_SUCCESS 0
#endif /* def vms */
#endif /* ndef SCM_EXIT_SUCCESS */
#ifndef SCM_EXIT_FAILURE
#ifdef vms
#define SCM_EXIT_FAILURE 2
#else
#define SCM_EXIT_FAILURE 1
#endif /* def vms */
#endif /* ndef SCM_EXIT_FAILURE */
#ifdef __STDC__
#else /* STDC */
#endif /* STDC */
#endif /* __SCMH */

0
libguile/__scm.hd Normal file
View file

130
libguile/_scm.h Normal file
View file

@ -0,0 +1,130 @@
/* classes: h_files */
#ifndef _SCMH
#define _SCMH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "libguile.h"
/* On VMS, GNU C's errno.h contains a special hack to get link attributes
* for errno correct for linking to the C RTL.
*/
#include <errno.h>
/* SCM_SYSCALL retries system calls that have been interrupted (EINTR) */
#ifdef vms
# ifndef __GNUC__
# include <ssdef.h>
# define SCM_SYSCALL(line) do{errno = 0;line;} \
while(EVMSERR==errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3))
# endif /* ndef __GNUC__ */
#endif /* def vms */
#ifndef SCM_SYSCALL
# ifdef EINTR
# if (EINTR > 0)
# define SCM_SYSCALL(line) do{errno = 0;line;}while(EINTR==errno)
# endif /* (EINTR > 0) */
# endif /* def EINTR */
#endif /* ndef SCM_SYSCALL */
#ifndef SCM_SYSCALL
# define SCM_SYSCALL(line) {line;}
#endif /* ndef SCM_SYSCALL */
#ifndef MSDOS
# ifdef ARM_ULIB
extern volatile int errno;
# else
extern int errno;
# endif /* def ARM_ULIB */
#endif /* ndef MSDOS */
#ifdef __TURBOC__
# if (__TURBOC__==1)
/* Needed for TURBOC V1.0 */
extern int errno;
# endif /* (__TURBOC__==1) */
#endif /* def __TURBOC__ */
#ifndef SCM_MAGIC_SNARFER
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
static char RANAME[]=STR;
#define SCM_PROC1(RANAME, STR, TYPE, CFN) \
static char RANAME[]=STR;
#else
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
%%% scm_make_gsubr (RANAME, REQ, OPT, VAR, CFN)
#define SCM_PROC1(RANAME, STR, TYPE, CFN) \
%%% scm_make_subr(RANAME, TYPE, CFN)
#endif
#ifndef SCM_MAGIC_SNARFER
#define SCM_SYMBOL(c_name, scheme_name) \
static SCM c_name = SCM_BOOL_F
#else
#define SCM_SYMBOL(C_NAME, SCHEME_NAME) \
%%% C_NAME = scm_permanent_object (SCM_CAR (scm_intern0 (SCHEME_NAME)))
#endif
#ifndef SCM_MAGIC_SNARFER
#define SCM_GLOBAL(c_name, scheme_name) \
static SCM c_name = SCM_BOOL_F
#else
#define SCM_GLOBAL(C_NAME, SCHEME_NAME) \
%%% C_NAME = scm_permanent_object (scm_intern0 (SCHEME_NAME)); SCM_SETCDR (C_NAME, SCM_BOOL_F)
#endif
#ifndef SCM_MAGIC_SNARFER
#define SCM_CONST_LONG(C_NAME, SCHEME_NAME,VALUE) \
static SCM C_NAME = SCM_BOOL_F
#else
#define SCM_CONST_LONG(C_NAME, SCHEME_NAME,VALUE) \
%%% C_NAME = scm_permanent_object (scm_intern0 (SCHEME_NAME)); SCM_SETCDR (C_NAME, scm_long2num (VALUE))
#endif
#endif /* _SCMH */

455
libguile/alist.c Normal file
View file

@ -0,0 +1,455 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
SCM_PROC(s_acons, "acons", 3, 0, 0, scm_acons);
#ifdef __STDC__
SCM
scm_acons (SCM w, SCM x, SCM y)
#else
SCM
scm_acons (w, x, y)
SCM w;
SCM x;
SCM y;
#endif
{
register SCM z;
SCM_NEWCELL (z);
SCM_CAR (z) = w;
SCM_CDR (z) = x;
x = z;
SCM_NEWCELL (z);
SCM_CAR (z) = x;
SCM_CDR (z) = y;
return z;
}
SCM_PROC (s_sloppy_assq, "sloppy-assq", 2, 0, 0, scm_sloppy_assq);
#ifdef __STDC__
SCM
scm_sloppy_assq(SCM x, SCM alist)
#else
SCM
scm_sloppy_assq(x, alist)
SCM x;
SCM alist;
#endif
{
SCM tmp;
for(;SCM_NIMP(alist);alist = SCM_CDR(alist))
{
if (SCM_CONSP(alist))
{
tmp = SCM_CAR(alist);
if (SCM_NIMP (tmp) && SCM_CONSP (tmp) && (SCM_CAR (tmp)==x))
return tmp;
}
}
return SCM_BOOL_F;
}
SCM_PROC (s_sloppy_assv, "sloppy-assv", 2, 0, 0, scm_sloppy_assv);
#ifdef __STDC__
SCM
scm_sloppy_assv(SCM x, SCM alist)
#else
SCM
scm_sloppy_assv(x, alist)
SCM x;
SCM alist;
#endif
{
SCM tmp;
for(;SCM_NIMP(alist);alist = SCM_CDR(alist))
{
if (SCM_CONSP(alist))
{
tmp = SCM_CAR(alist);
if ( SCM_NIMP (tmp)
&& SCM_CONSP (tmp)
&& SCM_NFALSEP (scm_eqv_p (SCM_CAR (tmp), x)))
return tmp;
}
}
return SCM_BOOL_F;
}
SCM_PROC (s_sloppy_assoc, "sloppy-assoc", 2, 0, 0, scm_sloppy_assoc);
#ifdef __STDC__
SCM
scm_sloppy_assoc(SCM x, SCM alist)
#else
SCM
scm_sloppy_assoc(x, alist)
SCM x;
SCM alist;
#endif
{
SCM tmp;
for(;SCM_NIMP(alist);alist = SCM_CDR(alist))
{
if (SCM_CONSP(alist))
{
tmp = SCM_CAR(alist);
if ( SCM_NIMP (tmp)
&& SCM_CONSP (tmp)
&& SCM_NFALSEP (scm_equal_p (SCM_CAR (tmp), x)))
return tmp;
}
}
return SCM_BOOL_F;
}
SCM_PROC(s_assq, "assq", 2, 0, 0, scm_assq);
#ifdef __STDC__
SCM
scm_assq(SCM x, SCM alist)
#else
SCM
scm_assq(x, alist)
SCM x;
SCM alist;
#endif
{
SCM tmp;
for(;SCM_NIMP(alist);alist = SCM_CDR(alist)) {
SCM_ASSERT(SCM_CONSP(alist), alist, SCM_ARG2, s_assq);
tmp = SCM_CAR(alist);
SCM_ASSERT(SCM_NIMP(tmp) && SCM_CONSP(tmp), alist, SCM_ARG2, s_assq);
if (SCM_CAR(tmp)==x) return tmp;
}
SCM_ASSERT(SCM_NULLP(alist), alist, SCM_ARG2, s_assq);
return SCM_BOOL_F;
}
SCM_PROC(s_assv, "assv", 2, 0, 0, scm_assv);
#ifdef __STDC__
SCM
scm_assv(SCM x, SCM alist)
#else
SCM
scm_assv(x, alist)
SCM x;
SCM alist;
#endif
{
SCM tmp;
for(;SCM_NIMP(alist);alist = SCM_CDR(alist)) {
SCM_ASRTGO(SCM_CONSP(alist), badlst);
tmp = SCM_CAR(alist);
SCM_ASRTGO(SCM_NIMP(tmp) && SCM_CONSP(tmp), badlst);
if SCM_NFALSEP(scm_eqv_p(SCM_CAR(tmp), x)) return tmp;
}
# ifndef RECKLESS
if (!(SCM_NULLP(alist)))
badlst: scm_wta(alist, (char *)SCM_ARG2, s_assv);
# endif
return SCM_BOOL_F;
}
SCM_PROC(s_assoc, "assoc", 2, 0, 0, scm_assoc);
#ifdef __STDC__
SCM
scm_assoc(SCM x, SCM alist)
#else
SCM
scm_assoc(x, alist)
SCM x;
SCM alist;
#endif
{
SCM tmp;
for(;SCM_NIMP(alist);alist = SCM_CDR(alist)) {
SCM_ASSERT(SCM_CONSP(alist), alist, SCM_ARG2, s_assoc);
tmp = SCM_CAR(alist);
SCM_ASSERT(SCM_NIMP(tmp) && SCM_CONSP(tmp), alist, SCM_ARG2, s_assoc);
if SCM_NFALSEP(scm_equal_p(SCM_CAR(tmp), x)) return tmp;
}
SCM_ASSERT(SCM_NULLP(alist), alist, SCM_ARG2, s_assoc);
return SCM_BOOL_F;
}
SCM_PROC (s_assq_ref, "assq-ref", 2, 0, 0, scm_assq_ref);
#ifdef __STDC__
SCM
scm_assq_ref (SCM alist, SCM key)
#else
SCM
scm_assq_ref (alist, key)
SCM alist;
SCM key;
#endif
{
SCM handle;
handle = scm_sloppy_assq (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
return SCM_CDR (handle);
}
return SCM_BOOL_F;
}
SCM_PROC (s_assv_ref, "assv-ref", 2, 0, 0, scm_assv_ref);
#ifdef __STDC__
SCM
scm_assv_ref (SCM alist, SCM key)
#else
SCM
scm_assv_ref (alist, key)
SCM alist;
SCM key;
#endif
{
SCM handle;
handle = scm_sloppy_assv (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
return SCM_CDR (handle);
}
return SCM_BOOL_F;
}
SCM_PROC (s_assoc_ref, "assoc-ref", 2, 0, 0, scm_assoc_ref);
#ifdef __STDC__
SCM
scm_assoc_ref (SCM alist, SCM key)
#else
SCM
scm_assoc_ref (alist, key)
SCM alist;
SCM key;
#endif
{
SCM handle;
handle = scm_sloppy_assoc (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
return SCM_CDR (handle);
}
return SCM_BOOL_F;
}
SCM_PROC (s_assq_set_x, "assq-set!", 3, 0, 0, scm_assq_set_x);
#ifdef __STDC__
SCM
scm_assq_set_x (SCM alist, SCM key, SCM val)
#else
SCM
scm_assq_set_x (alist, key, val)
SCM alist;
SCM key;
SCM val;
#endif
{
SCM handle;
handle = scm_sloppy_assq (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
SCM_SETCDR (handle, val);
return alist;
}
else
return scm_acons (key, val, alist);
}
SCM_PROC (s_assv_set_x, "assv-set!", 3, 0, 0, scm_assv_set_x);
#ifdef __STDC__
SCM
scm_assv_set_x (SCM alist, SCM key, SCM val)
#else
SCM
scm_assv_set_x (alist, key, val)
SCM alist;
SCM key;
SCM val;
#endif
{
SCM handle;
handle = scm_sloppy_assv (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
SCM_SETCDR (handle, val);
return alist;
}
else
return scm_acons (key, val, alist);
}
SCM_PROC (s_assoc_set_x, "assoc-set!", 3, 0, 0, scm_assoc_set_x);
#ifdef __STDC__
SCM
scm_assoc_set_x (SCM alist, SCM key, SCM val)
#else
SCM
scm_assoc_set_x (alist, key, val)
SCM alist;
SCM key;
SCM val;
#endif
{
SCM handle;
handle = scm_sloppy_assoc (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
SCM_SETCDR (handle, val);
return alist;
}
else
return scm_acons (key, val, alist);
}
SCM_PROC (s_assq_remove_x, "assq-remove!", 2, 0, 0, scm_assq_remove_x);
#ifdef __STDC__
SCM
scm_assq_remove_x (SCM alist, SCM key)
#else
SCM
scm_assq_remove_x (alist, key)
SCM alist;
SCM key;
#endif
{
SCM handle;
handle = scm_sloppy_assq (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
return scm_delq_x (handle, alist);
}
else
return alist;
}
SCM_PROC (s_assv_remove_x, "assv-remove!", 2, 0, 0, scm_assv_remove_x);
#ifdef __STDC__
SCM
scm_assv_remove_x (SCM alist, SCM key)
#else
SCM
scm_assv_remove_x (alist, key)
SCM alist;
SCM key;
#endif
{
SCM handle;
handle = scm_sloppy_assv (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
return scm_delv_x (handle, alist);
}
else
return alist;
}
SCM_PROC (s_assoc_remove_x, "assoc-remove!", 2, 0, 0, scm_assoc_remove_x);
#ifdef __STDC__
SCM
scm_assoc_remove_x (SCM alist, SCM key)
#else
SCM
scm_assoc_remove_x (alist, key)
SCM alist;
SCM key;
#endif
{
SCM handle;
handle = scm_sloppy_assoc (key, alist);
if (SCM_NIMP (handle) && SCM_CONSP (handle))
{
return scm_delete_x (handle, alist);
}
else
return alist;
}
#ifdef __STDC__
void
scm_init_alist (void)
#else
void
scm_init_alist ()
#endif
{
#include "alist.x"
}

97
libguile/alist.h Normal file
View file

@ -0,0 +1,97 @@
/* classes: h_files */
#ifndef ALISTH
#define ALISTH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_acons (SCM w, SCM x, SCM y);
extern SCM scm_sloppy_assq(SCM x, SCM alist);
extern SCM scm_sloppy_assv(SCM x, SCM alist);
extern SCM scm_sloppy_assoc(SCM x, SCM alist);
extern SCM scm_assq(SCM x, SCM alist);
extern SCM scm_assv(SCM x, SCM alist);
extern SCM scm_assoc(SCM x, SCM alist);
extern SCM scm_assq_ref (SCM alist, SCM key);
extern SCM scm_assv_ref (SCM alist, SCM key);
extern SCM scm_assoc_ref (SCM alist, SCM key);
extern SCM scm_assq_set_x (SCM alist, SCM key, SCM val);
extern SCM scm_assv_set_x (SCM alist, SCM key, SCM val);
extern SCM scm_assoc_set_x (SCM alist, SCM key, SCM val);
extern SCM scm_assq_remove_x (SCM alist, SCM key);
extern SCM scm_assv_remove_x (SCM alist, SCM key);
extern SCM scm_assoc_remove_x (SCM alist, SCM key);
extern void scm_init_alist (void);
#else /* STDC */
extern SCM scm_acons ();
extern SCM scm_sloppy_assq();
extern SCM scm_sloppy_assv();
extern SCM scm_sloppy_assoc();
extern SCM scm_assq();
extern SCM scm_assv();
extern SCM scm_assoc();
extern SCM scm_assq_ref ();
extern SCM scm_assv_ref ();
extern SCM scm_assoc_ref ();
extern SCM scm_assq_set_x ();
extern SCM scm_assv_set_x ();
extern SCM scm_assoc_set_x ();
extern SCM scm_assq_remove_x ();
extern SCM scm_assv_remove_x ();
extern SCM scm_assoc_remove_x ();
extern void scm_init_alist ();
#endif /* STDC */
#endif /* ALISTH */

88
libguile/append.c Normal file
View file

@ -0,0 +1,88 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
SCM_PROC (s_append, "append", 0, 0, 1, scm_append);
#ifdef __STDC__
SCM
scm_append (SCM objs)
#else
SCM
scm_append (objs)
SCM objs;
#endif
{
return scm_list_append (objs);
}
SCM_PROC (s_append_x, "append!", 0, 0, 1, scm_append_x);
#ifdef __STDC__
SCM
scm_append_x (SCM objs)
#else
SCM
scm_append_x (objs)
SCM objs;
#endif
{
return scm_list_append_x (objs);
}
#ifdef __STDC__
void
scm_init_append (void)
#else
void
scm_init_append ()
#endif
{
#include "append.x"
}

68
libguile/append.h Normal file
View file

@ -0,0 +1,68 @@
/* classes: h_files */
#ifndef APPENDH
#define APPENDH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_append (SCM objs);
extern SCM scm_append_x (SCM objs);
extern void scm_init_append (void);
#else /* STDC */
extern SCM scm_append ();
extern SCM scm_append_x ();
extern void scm_init_append ();
#endif /* STDC */
#endif /* APPENDH */

57
libguile/appinit.c Normal file
View file

@ -0,0 +1,57 @@
/* Copyright (C) 1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifdef __STDC__
void
scm_appinit (void)
#else
void
scm_appinit ()
#endif
{
}

150
libguile/arbiters.c Normal file
View file

@ -0,0 +1,150 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
/* {Arbiters}
*
* These procedures implement synchronization primitives. Processors
* with an atomic test-and-set instruction can use it here (and not
* SCM_DEFER_INTS).
*/
static long scm_tc16_arbiter;
#ifdef __STDC__
static int
prinarb (SCM exp, SCM port, int writing)
#else
static int
prinarb (exp, port, writing)
SCM exp;
SCM port;
int writing;
#endif
{
scm_gen_puts (scm_regular_string, "#<arbiter ", port);
if (SCM_CAR (exp) & (1L << 16))
scm_gen_puts (scm_regular_string, "locked ", port);
scm_iprin1 (SCM_CDR (exp), port, writing);
scm_gen_putc ('>', port);
return !0;
}
static scm_smobfuns arbsmob =
{
scm_markcdr, scm_free0, prinarb, 0
};
SCM_PROC(s_make_arbiter, "make-arbiter", 1, 0, 0, scm_make_arbiter);
#ifdef __STDC__
SCM
scm_make_arbiter (SCM name)
#else
SCM
scm_make_arbiter (name)
SCM name;
#endif
{
register SCM z;
SCM_NEWCELL (z);
SCM_CDR (z) = name;
SCM_CAR (z) = scm_tc16_arbiter;
return z;
}
SCM_PROC(s_try_arbiter, "try-arbiter", 1, 0, 0, scm_try_arbiter);
#ifdef __STDC__
SCM
scm_try_arbiter (SCM arb)
#else
SCM
scm_try_arbiter (arb)
SCM arb;
#endif
{
SCM_ASSERT ((SCM_TYP16 (arb) == scm_tc16_arbiter), arb, SCM_ARG1, s_try_arbiter);
SCM_DEFER_INTS;
if (SCM_CAR (arb) & (1L << 16))
arb = SCM_BOOL_F;
else
{
SCM_CAR (arb) = scm_tc16_arbiter | (1L << 16);
arb = SCM_BOOL_T;
}
SCM_ALLOW_INTS;
return arb;
}
SCM_PROC(s_release_arbiter, "release-arbiter", 1, 0, 0, scm_release_arbiter);
#ifdef __STDC__
SCM
scm_release_arbiter (SCM arb)
#else
SCM
scm_release_arbiter (arb)
SCM arb;
#endif
{
SCM_ASSERT ((SCM_TYP16 (arb) == scm_tc16_arbiter), arb, SCM_ARG1, s_release_arbiter);
if (!(SCM_CAR (arb) & (1L << 16)))
return SCM_BOOL_F;
SCM_CAR (arb) = scm_tc16_arbiter;
return SCM_BOOL_T;
}
#ifdef __STDC__
void
scm_init_arbiters (void)
#else
void
scm_init_arbiters ()
#endif
{
scm_tc16_arbiter = scm_newsmob (&arbsmob);
#include "arbiters.x"
}

68
libguile/arbiters.h Normal file
View file

@ -0,0 +1,68 @@
/* classes: h_files */
#ifndef ARBITERSH
#define ARBITERSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_make_arbiter (SCM name);
extern SCM scm_try_arbiter (SCM arb);
extern SCM scm_release_arbiter (SCM arb);
extern void scm_init_arbiters (void);
#else /* STDC */
extern SCM scm_make_arbiter ();
extern SCM scm_try_arbiter ();
extern SCM scm_release_arbiter ();
extern void scm_init_arbiters ();
#endif /* STDC */
#endif /* ARBITERSH */

737
libguile/async.c Normal file
View file

@ -0,0 +1,737 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include <signal.h>
#include "_scm.h"
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
/* {Asynchronous Events}
*
*
* Async == thunk + mark.
*
* Setting the mark guarantees future execution of the thunk. More
* than one set may be satisfied by a single execution.
*
* scm_tick_clock decremented once per SCM_ALLOW_INTS.
* Async execution triggered by SCM_ALLOW_INTS when scm_tick_clock drops to 0.
* Async execution prevented by scm_mask_ints != 0.
*
* If the clock reaches 0 when scm_mask_ints != 0, then reset the clock
* to 1.
*
* If the clock reaches 0 any other time, run marked asyncs.
*
* From a unix signal handler, mark a corresponding async and set the clock
* to 1. Do SCM_REDEFER_INTS;/SCM_REALLOW_INTS so that if the signal handler is not
* called in the dynamic scope of a critical section, it is excecuted immediately.
*
* Overall, closely timed signals of a particular sort may be combined. Pending signals
* are delivered in a fixed priority order, regardless of arrival order.
*
*/
#define min(A,B) ((A) < (B) ? (A) : (B))
unsigned int scm_async_clock = 20;
static unsigned int scm_async_rate = 20;
unsigned int scm_mask_ints = 1;
static unsigned int scm_tick_clock = 0;
static unsigned int scm_tick_rate = 0;
static unsigned int scm_desired_tick_rate = 0;
static unsigned int scm_switch_clock = 0;
static unsigned int scm_switch_rate = 0;
static unsigned int scm_desired_switch_rate = 0;
static SCM system_signal_asyncs[SCM_NUM_SIGS];
static SCM handler_var;
static SCM symbol_signal;
struct scm_async
{
int got_it; /* needs to be delivered? */
SCM thunk; /* the handler. */
};
static long scm_tc16_async;
#define SCM_ASYNCP(X) (scm_tc16_async == SCM_GCTYP16 (X))
#define SCM_ASYNC(X) ((struct scm_async *)SCM_CDR (X))
#ifdef __STDC__
static int
asyncs_pending (void)
#else
static int
asyncs_pending ()
#endif
{
SCM pos;
pos = scm_asyncs;
while (pos != SCM_EOL)
{
SCM a;
struct scm_async * it;
a = SCM_CAR (pos);
it = SCM_ASYNC (a);
if (it->got_it)
return 1;
pos = SCM_CDR (pos);
}
return 0;
}
#ifdef __STDC__
void
scm_async_click (void)
#else
void
scm_async_click ()
#endif
{
int owe_switch;
int owe_tick;
if (!scm_switch_rate)
{
owe_switch = 0;
scm_switch_clock = scm_switch_rate = scm_desired_switch_rate;
scm_desired_switch_rate = 0;
}
else
{
owe_switch = (scm_async_rate >= scm_switch_clock);
if (owe_switch)
{
if (scm_desired_switch_rate)
{
scm_switch_clock = scm_switch_rate = scm_desired_switch_rate;
scm_desired_switch_rate = 0;
}
else
scm_switch_clock = scm_switch_rate;
}
else
{
if (scm_desired_switch_rate)
{
scm_switch_clock = scm_switch_rate = scm_desired_switch_rate;
scm_desired_switch_rate = 0;
}
else
scm_switch_clock -= scm_async_rate;
}
}
if (scm_mask_ints)
{
if (owe_switch)
scm_switch ();
scm_async_clock = 1;
return;;
}
if (!scm_tick_rate)
{
unsigned int r;
owe_tick = 0;
r = scm_desired_tick_rate;
if (r)
{
scm_desired_tick_rate = 0;
scm_tick_rate = r;
scm_tick_clock = r;
}
}
else
{
owe_tick = (scm_async_rate >= scm_tick_clock);
if (owe_tick)
{
scm_tick_clock = scm_tick_rate = scm_desired_tick_rate;
scm_desired_tick_rate = 0;
}
else
{
if (scm_desired_tick_rate)
{
scm_tick_clock = scm_tick_rate = scm_desired_tick_rate;
scm_desired_tick_rate = 0;
}
else
scm_tick_clock -= scm_async_rate;
}
}
if (owe_tick)
scm_async_mark (system_signal_asyncs[SCM_SIG_ORD(SCM_TICK_SIGNAL)]);
SCM_DEFER_INTS;
if (scm_tick_rate && scm_switch_rate)
{
scm_async_rate = min (scm_tick_clock, scm_switch_clock);
scm_async_clock = scm_async_rate;
}
else if (scm_tick_rate)
{
scm_async_clock = scm_async_rate = scm_tick_clock;
}
else if (scm_switch_rate)
{
scm_async_clock = scm_async_rate = scm_switch_clock;
}
else
scm_async_clock = scm_async_rate = 1 << 16;
SCM_ALLOW_INTS_ONLY;
tail:
scm_run_asyncs (scm_asyncs);
SCM_DEFER_INTS;
if (asyncs_pending ())
{
SCM_ALLOW_INTS_ONLY;
goto tail;
}
SCM_ALLOW_INTS;
if (owe_switch)
scm_switch ();
}
#ifdef __STDC__
void
scm_switch (void)
#else
void
scm_switch ()
#endif
{}
#ifdef __STDC__
static void
scm_deliver_signal (int num)
#else
static void
scm_deliver_signal (num)
int num;
#endif
{
SCM handler;
handler = SCM_CDR (handler_var);
if (handler != SCM_BOOL_F)
scm_apply (handler, SCM_MAKINUM (num), scm_listofnull);
else
{
scm_mask_ints = 0;
scm_throw (symbol_signal,
scm_listify (SCM_MAKINUM (num), SCM_UNDEFINED));
}
}
#ifdef __STDC__
static int
print_async (SCM exp, SCM port, int writing)
#else
static int
print_async (exp, port, writing)
SCM exp;
SCM port;
int writing;
#endif
{
scm_gen_puts (scm_regular_string, "#<async ", port);
scm_intprint(exp, 16, port);
scm_gen_putc('>', port);
return 1;
}
#ifdef __STDC__
static SCM
mark_async (SCM obj)
#else
static SCM
mark_async (obj)
SCM obj;
#endif
{
struct scm_async * it;
if (SCM_GC8MARKP (obj))
return SCM_BOOL_F;
SCM_SETGC8MARK (obj);
it = SCM_ASYNC (obj);
return it->thunk;
}
#ifdef __STDC__
static scm_sizet
free_async (SCM obj)
#else
static scm_sizet
free_async (SCM obj)
SCM obj;
#endif
{
struct scm_async * it;
it = SCM_ASYNC (obj);
scm_must_free ((char *)it);
return (sizeof (*it));
}
static scm_smobfuns async_smob =
{
mark_async,
free_async,
print_async,
0
};
SCM_PROC(s_async, "async", 1, 0, 0, scm_async);
#ifdef __STDC__
SCM
scm_async (SCM thunk)
#else
SCM
scm_async (thunk)
SCM thunk;
#endif
{
SCM it;
struct scm_async * async;
SCM_NEWCELL (it);
SCM_DEFER_INTS;
SCM_SETCDR (it, SCM_EOL);
async = (struct scm_async *)scm_must_malloc (sizeof (*async), s_async);
async->got_it = 0;
async->thunk = thunk;
SCM_SETCDR (it, (SCM)async);
SCM_SETCAR (it, (SCM)scm_tc16_async);
SCM_ALLOW_INTS;
return it;
}
SCM_PROC(s_system_async, "system-async", 1, 0, 0, scm_system_async);
#ifdef __STDC__
SCM
scm_system_async (SCM thunk)
#else
SCM
scm_system_async (thunk)
SCM thunk;
#endif
{
SCM it;
SCM list;
it = scm_async (thunk);
SCM_NEWCELL (list);
SCM_DEFER_INTS;
SCM_SETCAR (list, it);
SCM_SETCDR (list, scm_asyncs);
scm_asyncs = list;
SCM_ALLOW_INTS;
return it;
}
SCM_PROC(s_async_mark, "async-mark", 1, 0, 0, scm_async_mark);
#ifdef __STDC__
SCM
scm_async_mark (SCM a)
#else
SCM
scm_async_mark (a)
SCM a;
#endif
{
struct scm_async * it;
SCM_ASSERT (SCM_NIMP (a) && SCM_ASYNCP (a), a, SCM_ARG1, s_async_mark);
it = SCM_ASYNC (a);
it->got_it = 1;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_system_async_mark, "system-async-mark", 1, 0, 0, scm_system_async_mark);
#ifdef __STDC__
SCM
scm_system_async_mark (SCM a)
#else
SCM
scm_system_async_mark (a)
SCM a;
#endif
{
struct scm_async * it;
SCM_ASSERT (SCM_NIMP (a) && SCM_ASYNCP (a), a, SCM_ARG1, s_async_mark);
it = SCM_ASYNC (a);
SCM_REDEFER_INTS;
it->got_it = 1;
scm_async_rate = 1 + scm_async_rate - scm_async_clock;
scm_async_clock = 1;
SCM_REALLOW_INTS;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_run_asyncs, "run-asyncs", 1, 0, 0, scm_run_asyncs);
#ifdef __STDC__
SCM
scm_run_asyncs (SCM list_of_a)
#else
SCM
scm_run_asyncs (list_of_a)
SCM list_of_a;
#endif
{
SCM pos;
if (scm_mask_ints)
return SCM_BOOL_F;
pos = list_of_a;
while (pos != SCM_EOL)
{
SCM a;
struct scm_async * it;
SCM_ASSERT (SCM_NIMP (pos) && SCM_CONSP (pos), pos, SCM_ARG1, s_run_asyncs);
a = SCM_CAR (pos);
SCM_ASSERT (SCM_NIMP (a) && SCM_ASYNCP (a), a, SCM_ARG1, s_run_asyncs);
it = SCM_ASYNC (a);
scm_mask_ints = 1;
if (it->got_it)
{
it->got_it = 0;
scm_apply (it->thunk, SCM_EOL, SCM_EOL);
}
scm_mask_ints = 0;
pos = SCM_CDR (pos);
}
return SCM_BOOL_T;
}
SCM_PROC(s_noop, "noop", 0, 0, 1, scm_noop);
#ifdef __STDC__
SCM
scm_noop (SCM args)
#else
SCM
scm_noop (args)
SCM args;
#endif
{
return (SCM_NULLP (args)
? SCM_BOOL_F
: SCM_CAR (args));
}
SCM_PROC(s_set_tick_rate, "set-tick-rate", 1, 0, 0, scm_set_tick_rate);
#ifdef __STDC__
SCM
scm_set_tick_rate (SCM n)
#else
SCM
scm_set_tick_rate (n)
SCM n;
#endif
{
unsigned int old_n;
SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_set_tick_rate);
old_n = scm_tick_rate;
scm_desired_tick_rate = SCM_INUM (n);
scm_async_rate = 1 + scm_async_rate - scm_async_clock;
scm_async_clock = 1;
return SCM_MAKINUM (old_n);
}
SCM_PROC(s_set_switch_rate, "set-switch-rate", 1, 0, 0, scm_set_switch_rate);
#ifdef __STDC__
SCM
scm_set_switch_rate (SCM n)
#else
SCM
scm_set_switch_rate (n)
SCM n;
#endif
{
unsigned int old_n;
SCM_ASSERT (SCM_INUMP (n), n, SCM_ARG1, s_set_switch_rate);
old_n = scm_switch_rate;
scm_desired_switch_rate = SCM_INUM (n);
scm_async_rate = 1 + scm_async_rate - scm_async_clock;
scm_async_clock = 1;
return SCM_MAKINUM (old_n);
}
#ifdef __STDC__
static SCM
scm_sys_hup_async_thunk (void)
#else
static SCM
scm_sys_hup_async_thunk ()
#endif
{
scm_deliver_signal (SCM_HUP_SIGNAL);
return SCM_BOOL_F;
}
#ifdef __STDC__
static SCM
scm_sys_int_async_thunk (void)
#else
static SCM
scm_sys_int_async_thunk ()
#endif
{
scm_deliver_signal (SCM_INT_SIGNAL);
return SCM_BOOL_F;
}
#ifdef __STDC__
static SCM
scm_sys_fpe_async_thunk (void)
#else
static SCM
scm_sys_fpe_async_thunk ()
#endif
{
scm_deliver_signal (SCM_FPE_SIGNAL);
return SCM_BOOL_F;
}
#ifdef __STDC__
static SCM
scm_sys_bus_async_thunk (void)
#else
static SCM
scm_sys_bus_async_thunk ()
#endif
{
scm_deliver_signal (SCM_BUS_SIGNAL);
return SCM_BOOL_F;
}
#ifdef __STDC__
static SCM
scm_sys_segv_async_thunk (void)
#else
static SCM
scm_sys_segv_async_thunk ()
#endif
{
scm_deliver_signal (SCM_SEGV_SIGNAL);
return SCM_BOOL_F;
}
#ifdef __STDC__
static SCM
scm_sys_alrm_async_thunk (void)
#else
static SCM
scm_sys_alrm_async_thunk ()
#endif
{
scm_deliver_signal (SCM_ALRM_SIGNAL);
return SCM_BOOL_F;
}
#ifdef __STDC__
static SCM
scm_sys_gc_async_thunk (void)
#else
static SCM
scm_sys_gc_async_thunk ()
#endif
{
scm_deliver_signal (SCM_GC_SIGNAL);
return SCM_BOOL_F;
}
#ifdef __STDC__
static SCM
scm_sys_tick_async_thunk (void)
#else
static SCM
scm_sys_tick_async_thunk ()
#endif
{
scm_deliver_signal (SCM_TICK_SIGNAL);
return SCM_BOOL_F;
}
#ifdef __STDC__
SCM
scm_take_signal (int n)
#else
SCM
scm_take_signal (n)
int n;
#endif
{
SCM ignored;
if (!scm_ints_disabled)
{
SCM_NEWCELL (ignored); /* In case we interrupted SCM_NEWCELL,
* throw out the possibly already allocated
* free cell.
*/
}
scm_system_async_mark (system_signal_asyncs[SCM_SIG_ORD(n)]);
return SCM_BOOL_F;
}
SCM_PROC(s_unmask_signals, "unmask-signals", 0, 0, 0, scm_unmask_signals);
#ifdef __STDC__
SCM
scm_unmask_signals (void)
#else
SCM
scm_unmask_signals ()
#endif
{
scm_mask_ints = 0;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_mask_signals, "mask-signals", 0, 0, 0, scm_mask_signals);
#ifdef __STDC__
SCM
scm_mask_signals (void)
#else
SCM
scm_mask_signals ()
#endif
{
scm_mask_ints = 1;
return SCM_UNSPECIFIED;
}
#ifdef __STDC__
void
scm_init_async (void)
#else
void
scm_init_async ()
#endif
{
SCM a_thunk;
scm_tc16_async = scm_newsmob (&async_smob);
symbol_signal = SCM_CAR (scm_sysintern ("signal", strlen ("signal")));
scm_permanent_object (symbol_signal);
/* These are in the opposite order of delivery priortity.
*
* Error conditions are given low priority:
*/
a_thunk = scm_make_gsubr ("%hup-thunk", 0, 0, 0, scm_sys_hup_async_thunk);
system_signal_asyncs[SCM_SIG_ORD(SCM_HUP_SIGNAL)] = scm_system_async (a_thunk);
a_thunk = scm_make_gsubr ("%int-thunk", 0, 0, 0, scm_sys_int_async_thunk);
system_signal_asyncs[SCM_SIG_ORD(SCM_INT_SIGNAL)] = scm_system_async (a_thunk);
a_thunk = scm_make_gsubr ("%fpe-thunk", 0, 0, 0, scm_sys_fpe_async_thunk);
system_signal_asyncs[SCM_SIG_ORD(SCM_FPE_SIGNAL)] = scm_system_async (a_thunk);
a_thunk = scm_make_gsubr ("%bus-thunk", 0, 0, 0, scm_sys_bus_async_thunk);
system_signal_asyncs[SCM_SIG_ORD(SCM_BUS_SIGNAL)] = scm_system_async (a_thunk);
a_thunk = scm_make_gsubr ("%segv-thunk", 0, 0, 0, scm_sys_segv_async_thunk);
system_signal_asyncs[SCM_SIG_ORD(SCM_SEGV_SIGNAL)] = scm_system_async (a_thunk);
a_thunk = scm_make_gsubr ("%gc-thunk", 0, 0, 0, scm_sys_gc_async_thunk);
system_signal_asyncs[SCM_SIG_ORD(SCM_GC_SIGNAL)] = scm_system_async (a_thunk);
/* Clock and PC driven conditions are given highest priority. */
a_thunk = scm_make_gsubr ("%tick-thunk", 0, 0, 0, scm_sys_tick_async_thunk);
system_signal_asyncs[SCM_SIG_ORD(SCM_TICK_SIGNAL)] = scm_system_async (a_thunk);
a_thunk = scm_make_gsubr ("%alrm-thunk", 0, 0, 0, scm_sys_alrm_async_thunk);
system_signal_asyncs[SCM_SIG_ORD(SCM_ALRM_SIGNAL)] = scm_system_async (a_thunk);
handler_var = scm_sysintern ("signal-handler", strlen ("signal"));
SCM_SETCDR (handler_var, SCM_BOOL_F);
scm_permanent_object (handler_var);
#include "async.x"
}

91
libguile/async.h Normal file
View file

@ -0,0 +1,91 @@
/* classes: h_files */
#ifndef ASYNCH
#define ASYNCH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
extern unsigned int scm_async_clock;
extern unsigned int scm_mask_ints;
#ifdef __STDC__
extern void scm_async_click (void);
extern void scm_switch (void);
extern SCM scm_async (SCM thunk);
extern SCM scm_system_async (SCM thunk);
extern SCM scm_async_mark (SCM a);
extern SCM scm_system_async_mark (SCM a);
extern SCM scm_run_asyncs (SCM list_of_a);
extern SCM scm_noop (SCM args);
extern SCM scm_set_tick_rate (SCM n);
extern SCM scm_set_switch_rate (SCM n);
extern SCM scm_take_signal (int n);
extern SCM scm_unmask_signals (void);
extern SCM scm_mask_signals (void);
extern void scm_init_async (void);
#else /* STDC */
extern void scm_async_click ();
extern void scm_switch ();
extern SCM scm_async ();
extern SCM scm_system_async ();
extern SCM scm_async_mark ();
extern SCM scm_system_async_mark ();
extern SCM scm_run_asyncs ();
extern SCM scm_noop ();
extern SCM scm_set_tick_rate ();
extern SCM scm_set_switch_rate ();
extern SCM scm_take_signal ();
extern SCM scm_unmask_signals ();
extern SCM scm_mask_signals ();
extern void scm_init_async ();
#endif /* STDC */
#endif /* ASYNCH */

88
libguile/boolean.c Normal file
View file

@ -0,0 +1,88 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
SCM_PROC(s_not, "not", 1, 0, 0, scm_not);
#ifdef __STDC__
SCM
scm_not(SCM x)
#else
SCM
scm_not(x)
SCM x;
#endif
{
return SCM_FALSEP(x) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_boolean_p, "boolean?", 1, 0, 0, scm_boolean_p);
#ifdef __STDC__
SCM
scm_boolean_p(SCM obj)
#else
SCM
scm_boolean_p(obj)
SCM obj;
#endif
{
if (SCM_BOOL_F==obj) return SCM_BOOL_T;
if (SCM_BOOL_T==obj) return SCM_BOOL_T;
return SCM_BOOL_F;
}
#ifdef __STDC__
void
scm_init_boolean (void)
#else
void
scm_init_boolean ()
#endif
{
#include "boolean.x"
}

76
libguile/boolean.h Normal file
View file

@ -0,0 +1,76 @@
/* classes: h_files */
#ifndef BOOLEANH
#define BOOLEANH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
/* Boolean Values
*
*/
#define SCM_FALSEP(x) (SCM_BOOL_F == (x))
#define SCM_NFALSEP(x) (SCM_BOOL_F != (x))
/* SCM_BOOL_NOT returns the other boolean.
* The order of ^s here is important for Borland C++ (!?!?!)
*/
#define SCM_BOOL_NOT(x) ((x) ^ (SCM_BOOL_T ^ SCM_BOOL_F))
#ifdef __STDC__
extern SCM scm_not(SCM x);
extern SCM scm_boolean_p(SCM obj);
extern void scm_init_boolean (void);
#else /* STDC */
extern SCM scm_not();
extern SCM scm_boolean_p();
extern void scm_init_boolean ();
#endif /* STDC */
#endif /* BOOLEANH */

507
libguile/chars.c Normal file
View file

@ -0,0 +1,507 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include <ctype.h>
#include "_scm.h"
SCM_PROC(s_char_p, "char?", 1, 0, 0, scm_char_p);
#ifdef __STDC__
SCM
scm_char_p(SCM x)
#else
SCM
scm_char_p(x)
SCM x;
#endif
{
return SCM_ICHRP(x) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_eq_p, "char=?", scm_tc7_rpsubr, scm_char_eq_p);
#ifdef __STDC__
SCM
scm_char_eq_p(SCM x, SCM y)
#else
SCM
scm_char_eq_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_eq_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_eq_p);
return (SCM_ICHR(x) == SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_less_p, "char<?", scm_tc7_rpsubr, scm_char_less_p);
#ifdef __STDC__
SCM
scm_char_less_p(SCM x, SCM y)
#else
SCM
scm_char_less_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_less_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_less_p);
return (SCM_ICHR(x) < SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_leq_p, "char<=?", scm_tc7_rpsubr, scm_char_leq_p);
#ifdef __STDC__
SCM
scm_char_leq_p(SCM x, SCM y)
#else
SCM
scm_char_leq_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_leq_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_leq_p);
return (SCM_ICHR(x) <= SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_gr_p, "char>?", scm_tc7_rpsubr, scm_char_gr_p);
#ifdef __STDC__
SCM
scm_char_gr_p(SCM x, SCM y)
#else
SCM
scm_char_gr_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_gr_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_gr_p);
return (SCM_ICHR(x) > SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_geq_p, "char>=?", scm_tc7_rpsubr, scm_char_geq_p);
#ifdef __STDC__
SCM
scm_char_geq_p(SCM x, SCM y)
#else
SCM
scm_char_geq_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_geq_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_geq_p);
return (SCM_ICHR(x) >= SCM_ICHR(y)) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_ci_eq_p, "char-ci=?", scm_tc7_rpsubr, scm_char_ci_eq_p);
#ifdef __STDC__
SCM
scm_char_ci_eq_p(SCM x, SCM y)
#else
SCM
scm_char_ci_eq_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_eq_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_eq_p);
return (scm_upcase(SCM_ICHR(x))==scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_ci_less_p, "char-ci<?", scm_tc7_rpsubr, scm_char_ci_less_p);
#ifdef __STDC__
SCM
scm_char_ci_less_p(SCM x, SCM y)
#else
SCM
scm_char_ci_less_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_less_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_less_p);
return (scm_upcase(SCM_ICHR(x)) < scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_ci_leq_p, "char-ci<=?", scm_tc7_rpsubr, scm_char_ci_leq_p);
#ifdef __STDC__
SCM
scm_char_ci_leq_p(SCM x, SCM y)
#else
SCM
scm_char_ci_leq_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_leq_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_leq_p);
return (scm_upcase(SCM_ICHR(x)) <= scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_ci_gr_p, "char-ci>?", scm_tc7_rpsubr, scm_char_ci_gr_p);
#ifdef __STDC__
SCM
scm_char_ci_gr_p(SCM x, SCM y)
#else
SCM
scm_char_ci_gr_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_gr_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_gr_p);
return (scm_upcase(SCM_ICHR(x)) > scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC1 (s_char_ci_geq_p, "char-ci>=?", scm_tc7_rpsubr, scm_char_ci_geq_p);
#ifdef __STDC__
SCM
scm_char_ci_geq_p(SCM x, SCM y)
#else
SCM
scm_char_ci_geq_p(x, y)
SCM x;
SCM y;
#endif
{
SCM_ASSERT(SCM_ICHRP(x), x, SCM_ARG1, s_char_ci_geq_p);
SCM_ASSERT(SCM_ICHRP(y), y, SCM_ARG2, s_char_ci_geq_p);
return (scm_upcase(SCM_ICHR(x)) >= scm_upcase(SCM_ICHR(y))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_char_alphabetic_p, "char-alphabetic?", 1, 0, 0, scm_char_alphabetic_p);
#ifdef __STDC__
SCM
scm_char_alphabetic_p(SCM chr)
#else
SCM
scm_char_alphabetic_p(chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_alphabetic_p);
return (isascii(SCM_ICHR(chr)) && isalpha(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_char_numeric_p, "char-numeric?", 1, 0, 0, scm_char_numeric_p);
#ifdef __STDC__
SCM
scm_char_numeric_p(SCM chr)
#else
SCM
scm_char_numeric_p(chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_numeric_p);
return (isascii(SCM_ICHR(chr)) && isdigit(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_char_whitespace_p, "char-whitespace?", 1, 0, 0, scm_char_whitespace_p);
#ifdef __STDC__
SCM
scm_char_whitespace_p(SCM chr)
#else
SCM
scm_char_whitespace_p(chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_whitespace_p);
return (isascii(SCM_ICHR(chr)) && isspace(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_char_upper_case_p, "char-upper-case?", 1, 0, 0, scm_char_upper_case_p);
#ifdef __STDC__
SCM
scm_char_upper_case_p(SCM chr)
#else
SCM
scm_char_upper_case_p(chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_upper_case_p);
return (isascii(SCM_ICHR(chr)) && isupper(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_char_lower_case_p, "char-lower-case?", 1, 0, 0, scm_char_lower_case_p);
#ifdef __STDC__
SCM
scm_char_lower_case_p(SCM chr)
#else
SCM
scm_char_lower_case_p(chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_lower_case_p);
return (isascii(SCM_ICHR(chr)) && islower(SCM_ICHR(chr))) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC (s_char_is_both_p, "char-is-both?", 1, 0, 0, scm_char_is_both_p);
#ifdef __STDC__
SCM
scm_char_is_both_p (SCM chr)
#else
SCM
scm_char_is_both_p (chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_upper_case_p);
return ((isascii(SCM_ICHR(chr)) && (isupper(SCM_ICHR(chr)) || islower(SCM_ICHR(chr))))
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_char_to_integer, "char->integer", 1, 0, 0, scm_char_to_integer);
#ifdef __STDC__
SCM
scm_char_to_integer(SCM chr)
#else
SCM
scm_char_to_integer(chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_to_integer);
return scm_ulong2num((unsigned long)SCM_ICHR(chr));
}
SCM_PROC(s_integer_to_char, "integer->char", 1, 0, 0, scm_integer_to_char);
#ifdef __STDC__
SCM
scm_integer_to_char(SCM n)
#else
SCM
scm_integer_to_char(n)
SCM n;
#endif
{
unsigned long ni;
ni = 0xffff & scm_num2ulong (n, (char *)SCM_ARG1, s_integer_to_char);
return SCM_MAKICHR(SCM_INUM(n));
}
SCM_PROC(s_char_upcase, "char-upcase", 1, 0, 0, scm_char_upcase);
#ifdef __STDC__
SCM
scm_char_upcase(SCM chr)
#else
SCM
scm_char_upcase(chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_upcase);
return SCM_MAKICHR(scm_upcase(SCM_ICHR(chr)));
}
SCM_PROC(s_char_downcase, "char-downcase", 1, 0, 0, scm_char_downcase);
#ifdef __STDC__
SCM
scm_char_downcase(SCM chr)
#else
SCM
scm_char_downcase(chr)
SCM chr;
#endif
{
SCM_ASSERT(SCM_ICHRP(chr), chr, SCM_ARG1, s_char_downcase);
return SCM_MAKICHR(scm_downcase(SCM_ICHR(chr)));
}
static unsigned char scm_upcase_table[SCM_CHAR_SCM_CODE_LIMIT];
static unsigned char scm_downcase_table[SCM_CHAR_SCM_CODE_LIMIT];
static unsigned char scm_lowers[] = "abcdefghijklmnopqrstuvwxyz";
static unsigned char scm_uppers[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
#ifdef __STDC__
void
scm_tables_prehistory (void)
#else
void
scm_tables_prehistory ()
#endif
{
int i;
for (i = 0; i < SCM_CHAR_SCM_CODE_LIMIT; i++)
scm_upcase_table[i] = scm_downcase_table[i] = i;
for (i = 0; i < sizeof scm_lowers / sizeof (char); i++)
{
scm_upcase_table[scm_lowers[i]] = scm_uppers[i];
scm_downcase_table[scm_uppers[i]] = scm_lowers[i];
}
}
#ifdef __STDC__
int
scm_upcase (unsigned int c)
#else
int
scm_upcase (c)
unsigned int c;
#endif
{
if (c < sizeof (scm_upcase_table))
return scm_upcase_table[c];
else
return c;
}
#ifdef __STDC__
int
scm_downcase (unsigned int c)
#else
int
scm_downcase (c)
unsigned int c;
#endif
{
if (c < sizeof (scm_downcase_table))
return scm_downcase_table[c];
else
return c;
}
#ifdef _DCC
# define ASCII
#else
# if (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301'))
# define EBCDIC
# endif /* (('\n'=='\025') && (' '=='\100') && ('a'=='\201') && ('A'=='\301')) */
# if (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101'))
# define ASCII
# endif /* (('\n'=='\012') && (' '=='\040') && ('a'=='\141') && ('A'=='\101')) */
#endif /* def _DCC */
#ifdef EBCDIC
char *scm_charnames[] =
{
"nul","soh","stx","etx", "pf", "ht", "lc","del",
0 , 0 ,"smm", "vt", "ff", "cr", "so", "si",
"dle","dc1","dc2","dc3","res", "nl", "bs", "il",
"can", "em", "cc", 0 ,"ifs","igs","irs","ius",
"ds","sos", "fs", 0 ,"byp", "lf","eob","pre",
0 , 0 , "sm", 0 , 0 ,"enq","ack","bel",
0 , 0 ,"syn", 0 , "pn", "rs", "uc","eot",
0 , 0 , 0 , 0 ,"dc4","nak", 0 ,"sub",
"space", scm_s_newline, "tab", "backspace", "return", "page", "null"};
char scm_charnums[] =
"\000\001\002\003\004\005\006\007\
\010\011\012\013\014\015\016\017\
\020\021\022\023\024\025\026\027\
\030\031\032\033\034\035\036\037\
\040\041\042\043\044\045\046\047\
\050\051\052\053\054\055\056\057\
\060\061\062\063\064\065\066\067\
\070\071\072\073\074\075\076\077\
\n\t\b\r\f\0";
#endif /* def EBCDIC */
#ifdef ASCII
char *scm_charnames[] =
{
"nul","soh","stx","etx","eot","enq","ack","bel",
"bs", "ht", "nl", "vt", "np", "cr", "so", "si",
"dle","dc1","dc2","dc3","dc4","nak","syn","etb",
"can", "em","sub","esc", "fs", "gs", "rs", "us",
"space", "newline", "tab", "backspace", "return", "page", "null", "del"};
char scm_charnums[] =
"\000\001\002\003\004\005\006\007\
\010\011\012\013\014\015\016\017\
\020\021\022\023\024\025\026\027\
\030\031\032\033\034\035\036\037\
\n\t\b\r\f\0\177";
#endif /* def ASCII */
int scm_n_charnames = sizeof (scm_charnames) / sizeof (char *);
#ifdef __STDC__
void
scm_init_chars (void)
#else
void
scm_init_chars ()
#endif
{
#include "chars.x"
}

126
libguile/chars.h Normal file
View file

@ -0,0 +1,126 @@
/* classes: h_files */
#ifndef SCM_CHARSH
#define SCM_CHARSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
/* Immediate Characters
*/
#define SCM_ICHRP(x) (SCM_ITAG8(x) == scm_tc8_char)
#define SCM_ICHR(x) ((unsigned int)SCM_ITAG8_DATA(x))
#define SCM_MAKICHR(x) SCM_MAKE_ITAG8(x, scm_tc8_char)
extern char *scm_charnames[];
extern int scm_n_charnames;
extern char scm_charnums[];
#ifdef __STDC__
extern SCM scm_char_p(SCM x);
extern SCM scm_char_eq_p(SCM x, SCM y);
extern SCM scm_char_less_p(SCM x, SCM y);
extern SCM scm_char_leq_p(SCM x, SCM y);
extern SCM scm_char_gr_p(SCM x, SCM y);
extern SCM scm_char_geq_p(SCM x, SCM y);
extern SCM scm_char_ci_eq_p(SCM x, SCM y);
extern SCM scm_char_ci_less_p(SCM x, SCM y);
extern SCM scm_char_ci_leq_p(SCM x, SCM y);
extern SCM scm_char_ci_gr_p(SCM x, SCM y);
extern SCM scm_char_ci_geq_p(SCM x, SCM y);
extern SCM scm_char_alphabetic_p(SCM chr);
extern SCM scm_char_numeric_p(SCM chr);
extern SCM scm_char_whitespace_p(SCM chr);
extern SCM scm_char_upper_case_p(SCM chr);
extern SCM scm_char_lower_case_p(SCM chr);
extern SCM scm_char_is_both_p (SCM chr);
extern SCM scm_char_to_integer(SCM chr);
extern SCM scm_integer_to_char(SCM n);
extern SCM scm_char_upcase(SCM chr);
extern SCM scm_char_downcase(SCM chr);
extern void scm_tables_prehistory (void);
extern int scm_upcase (unsigned int c);
extern int scm_downcase (unsigned int c);
extern void scm_init_chars (void);
#else /* STDC */
extern SCM scm_char_p();
extern SCM scm_char_eq_p();
extern SCM scm_char_less_p();
extern SCM scm_char_leq_p();
extern SCM scm_char_gr_p();
extern SCM scm_char_geq_p();
extern SCM scm_char_ci_eq_p();
extern SCM scm_char_ci_less_p();
extern SCM scm_char_ci_leq_p();
extern SCM scm_char_ci_gr_p();
extern SCM scm_char_ci_geq_p();
extern SCM scm_char_alphabetic_p();
extern SCM scm_char_numeric_p();
extern SCM scm_char_whitespace_p();
extern SCM scm_char_upper_case_p();
extern SCM scm_char_lower_case_p();
extern SCM scm_char_is_both_p ();
extern SCM scm_char_to_integer();
extern SCM scm_integer_to_char();
extern SCM scm_char_upcase();
extern SCM scm_char_downcase();
extern void scm_tables_prehistory ();
extern int scm_upcase ();
extern int scm_downcase ();
extern void scm_init_chars ();
#endif /* STDC */
#endif /* SCM_CHARSH */

1994
libguile/configure vendored Executable file
View file

File diff suppressed because it is too large Load diff

107
libguile/configure.in Normal file
View file

@ -0,0 +1,107 @@
AC_INIT(eval.c)
AC_CONFIG_HEADER(scmconfig.h)
. $srcdir/../GUILE-VERSION
test -z "$CFLAGS" && CFLAGS=-g
test -z "$LDFLAGS" && LDFLAGS=-g
AC_PROG_CC
AC_PROG_CPP
AC_PROG_RANLIB
AC_AIX
AC_ISC_POSIX
AC_MINIX
AC_C_CONST
AC_HEADER_STDC
AC_HEADER_DIRENT
AC_HEADER_TIME
AC_HEADER_SYS_WAIT
AC_CHECK_HEADERS(unistd.h string.h malloc.h memory.h limits.h time.h sys/types.h sys/select.h sys/time.h sys/timeb.h sys/times.h)
AC_TYPE_GETGROUPS
AC_TYPE_SIGNAL
AC_CHECK_FUNCS(ftime times geteuid seteuid setegid select uname mkdir rmdir getcwd rename putenv setlocale strftime strptime mknod nice lstat readlink symlink sync)
AC_REPLACE_FUNCS(inet_aton)
AC_STRUCT_ST_RDEV
AC_STRUCT_ST_BLKSIZE
AC_STRUCT_ST_BLOCKS
#--------------------------------------------------------------------
#
# Which way does the stack grow?
#
#--------------------------------------------------------------------
AC_TRY_RUN(aux (l) unsigned long l;
{ int x; exit (l >= ((unsigned long)&x)); }
main () { int q; aux((unsigned long)&q); },
AC_DEFINE(SCM_STACK_GROWS_UP),,AC_MSG_WARN(Guessing that stack grows down -- see scmconfig.h.in))
AC_TRY_RUN(main () { exit (sizeof(float) != sizeof(long)); },
AC_DEFINE(SCM_SINGLES),,AC_DEFINE(SCM_SINGLES)
AC_MSG_WARN(Guessing that sizeof(long) == sizeof(float) -- see scmconfig.h.in))
#--------------------------------------------------------------------
#
# How can you violate a stdio abstraction by setting a stream's fd?
#
#--------------------------------------------------------------------
FD_SETTER=""
if test "x$FD_SETTER" = x; then
AC_TRY_COMPILE(#include <stdio.h>
, stdout->_file = 1,
FD_SETTER="((F)->_file = (D))")
fi
if test "x$FD_SETTER" = x; then
AC_TRY_COMPILE(#include <stdio.h>
, stdout->_fileno,
FD_SETTER="((F)->_fileno = (D))")
fi
dnl
dnl Add FD_SETTER tests for other systems here. Your test should
dnl try a particular style of assigning to the descriptor
dnl field(s) of a FILE* and define FD_SETTER accordingly.
dnl
dnl The value of FD_SETTER is used as a macro body, as in:
dnl
dnl #define SET_FILE_FD_FIELD(F,D) @FD_SETTER@
dnl
dnl F is a FILE* and D a descriptor (int).
dnl
test "x$FD_SETTER" != x && AC_DEFINE(HAVE_FD_SETTER)
AC_SUBST(CFLAGS)
AC_SUBST(LDFLAGS)
AC_SUBST(LIBOBJS)
AC_SUBST(FD_SETTER)
AC_SUBST(TCL_SRC_DIR)
AC_SUBST(TK_SRC_DIR)
AC_SUBST(XINCLUDES)
AC_SUBST(GUILE_MAJOR_VERSION)
AC_SUBST(GUILE_MINOR_VERSION)
AC_SUBST(GUILE_VERSION)
AC_OUTPUT(Makefile fd.h)
dnl Local Variables:
dnl comment-start: "dnl "
dnl comment-end: ""
dnl comment-start-skip: "\\bdnl\\b\\s *"
dnl End:

227
libguile/continuations.c Normal file
View file

@ -0,0 +1,227 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
/* {Continuations}
*/
static char s_cont[] = "continuation";
#ifdef __STDC__
SCM
scm_make_cont (SCM * answer)
#else
SCM
scm_make_cont (answer)
SCM * answer;
#endif
{
long j;
SCM cont;
#ifdef CHEAP_CONTINUATIONS
SCM_NEWCELL (cont);
*answer = cont;
SCM_DEFER_INTS;
SCM_SETJMPBUF (cont, scm_must_malloc ((long) sizeof (regs), s_cont));
SCM_CAR (cont) = scm_tc7_contin;
SCM_DYNENV (cont) = dynwinds;
SCM_THROW_VALUE = SCM_EOL;
SCM_BASE (cont) = SCM_BASE (rootcont);
SCM_SEQ (cont) = SCM_SEQ (rootcont);
SCM_ALLOW_INTS;
#else
register SCM_STACKITEM *src, *dst;
{
SCM winds;
for (winds = scm_dynwinds; winds != SCM_EOL; winds = SCM_CDR (winds))
{
#if 0
if (SCM_INUMP (SCM_CAR (winds)))
{
scm_relocate_chunk_to_heap (SCM_CAR (winds));
}
#endif
}
}
SCM_NEWCELL (cont);
*answer = cont;
SCM_DEFER_INTS;
SCM_FLUSH_REGISTER_WINDOWS;
j = scm_stack_size (SCM_BASE (scm_rootcont));
SCM_SETJMPBUF (cont,
scm_must_malloc ((long) (sizeof (regs) + j * sizeof (SCM_STACKITEM)),
s_cont));
SCM_SETLENGTH (cont, j, scm_tc7_contin);
SCM_DYNENV (cont) = scm_dynwinds;
SCM_THROW_VALUE (cont) = SCM_EOL;
src = SCM_BASE (cont) = SCM_BASE (scm_rootcont);
SCM_SEQ (cont) = SCM_SEQ (scm_rootcont);
SCM_ALLOW_INTS;
#ifndef SCM_STACK_GROWS_UP
src -= SCM_LENGTH (cont);
#endif /* ndef SCM_STACK_GROWS_UP */
dst = (SCM_STACKITEM *) (SCM_CHARS (cont) + sizeof (regs));
for (j = SCM_LENGTH (cont); 0 <= --j;)
*dst++ = *src++;
#endif /* def CHEAP_CONTINUATIONS */
#ifdef DEBUG_EXTENSIONS
SCM_DFRAME (cont) = last_debug_info_frame;
#endif
return cont;
}
void scm_dynthrow SCM_P ((SCM *a));
/* Grow the stack so that there is room */
/* to copy in the continuation. Then */
#ifndef CHEAP_CONTINUATIONS
#ifdef __STDC__
static void
grow_throw (SCM *a)
#else
static void
grow_throw (a)
SCM *a;
#endif
{ /* retry the throw. */
SCM growth[100];
growth[0] = a[0];
growth[1] = a[1];
growth[2] = a[2] + 1;
growth[3] = (SCM) a;
scm_dynthrow (growth);
}
#endif /* ndef CHEAP_CONTINUATIONS */
#ifdef __STDC__
void
scm_dynthrow (SCM *a)
#else
void
scm_dynthrow (a)
SCM *a;
#endif
{
SCM cont = a[0], val = a[1];
#ifndef CHEAP_CONTINUATIONS
register long j;
register SCM_STACKITEM *src, *dst = SCM_BASE (scm_rootcont);
#ifdef SCM_STACK_GROWS_UP
if (a[2] && (a - ((SCM *) a[3]) < 100))
#else
if (a[2] && (((SCM *) a[3]) - a < 100))
#endif
fputs ("grow_throw: check if SCM growth[100]; being optimized out\n",
stderr);
/* if (a[2]) fprintf(stderr, " ct = %ld, dist = %ld\n",
a[2], (((SCM *)a[3]) - a)); */
#ifdef SCM_STACK_GROWS_UP
if (SCM_PTR_GE (dst + SCM_LENGTH (cont), (SCM_STACKITEM *) & a))
grow_throw (a);
#else
dst -= SCM_LENGTH (cont);
if (SCM_PTR_LE (dst, (SCM_STACKITEM *) & a))
grow_throw (a);
#endif /* def SCM_STACK_GROWS_UP */
SCM_FLUSH_REGISTER_WINDOWS;
src = (SCM_STACKITEM *) (SCM_CHARS (cont) + sizeof (regs));
for (j = SCM_LENGTH (cont); 0 <= --j;)
*dst++ = *src++;
#ifdef sparc /* clear out stack up to this stackframe */
/* maybe this would help, maybe not */
/* bzero((void *)&a, sizeof(SCM_STACKITEM) * (((SCM_STACKITEM *)&a) -
(dst - SCM_LENGTH(cont)))) */
#endif
#endif /* ndef CHEAP_CONTINUATIONS */
#ifdef DEBUG_EXTENSIONS
last_debug_info_frame = SCM_DFRAME (cont);
#endif
SCM_THROW_VALUE(cont) = val;
longjmp (SCM_JMPBUF (cont), 1);
}
#ifdef __STDC__
SCM
scm_call_continuation (SCM cont, SCM val)
#else
SCM
scm_call_continuation (cont, val)
SCM cont;
SCM val;
#endif
{
SCM a[3];
a[0] = cont;
a[1] = val;
a[2] = 0;
if ( (SCM_SEQ (cont) != SCM_SEQ (scm_rootcont))
|| (SCM_BASE (cont) != SCM_BASE (scm_rootcont))) /* base compare not needed */
scm_wta (cont, "continuation from wrong top level", s_cont);
scm_dowinds (SCM_DYNENV (cont),
scm_ilength (scm_dynwinds) - scm_ilength (SCM_DYNENV (cont)));
scm_dynthrow (a);
return SCM_UNSPECIFIED; /* not reached */
}
#ifdef __STDC__
void
scm_init_continuations (void)
#else
void
scm_init_continuations ()
#endif
{
#include "continuations.x"
}

86
libguile/continuations.h Normal file
View file

@ -0,0 +1,86 @@
/* classes: h_files */
#ifndef CONTINUATIONSH
#define CONTINUATIONSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
typedef struct
{
SCM throw_value;
jmp_buf jmpbuf;
SCM dynenv;
SCM_STACKITEM *base;
unsigned long seq;
#ifdef DEBUG_EXTENSIONS
struct scm_debug_frame *dframe;
#endif
} regs;
#define SCM_JMPBUF(x) (((regs *)SCM_CHARS(x))->jmpbuf)
#define SCM_SETJMPBUF SCM_SETCDR
#define SCM_DYNENV(x) (((regs *)SCM_CHARS(x))->dynenv)
#define SCM_THROW_VALUE(x) (((regs *)SCM_CHARS(x))->throw_value)
#define SCM_BASE(x) (((regs *)SCM_CHARS(x))->base)
#define SCM_SEQ(x) (((regs *)SCM_CHARS(x))->seq)
#define SCM_DFRAME(x) (((regs *)SCM_CHARS(x))->dframe)
#ifdef __STDC__
extern SCM scm_make_cont (SCM * answer);
extern void scm_dynthrow (SCM *a);
extern SCM scm_call_continuation (SCM cont, SCM val);
extern void scm_init_continuations (void);
#else /* STDC */
extern SCM scm_make_cont ();
extern void scm_dynthrow ();
extern SCM scm_call_continuation ();
extern void scm_init_continuations ();
#endif /* STDC */
#endif /* CONTINUATIONSH */

0
libguile/def.sed Normal file
View file

148
libguile/dynwind.c Normal file
View file

@ -0,0 +1,148 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
/* {Dynamic wind}
*/
SCM_PROC(s_dynamic_wind, "dynamic-wind", 3, 0, 0, scm_dynamic_wind);
#ifdef __STDC__
SCM
scm_dynamic_wind (SCM thunk1, SCM thunk2, SCM thunk3)
#else
SCM
scm_dynamic_wind (thunk1, thunk2, thunk3)
SCM thunk1;
SCM thunk2;
SCM thunk3;
#endif
{
SCM ans;
scm_apply (thunk1, SCM_EOL, SCM_EOL);
scm_dynwinds = scm_acons (thunk1, thunk3, scm_dynwinds);
ans = scm_apply (thunk2, SCM_EOL, SCM_EOL);
scm_dynwinds = SCM_CDR (scm_dynwinds);
scm_apply (thunk3, SCM_EOL, SCM_EOL);
return ans;
}
#ifdef __STDC__
void
scm_dowinds (SCM to, long delta)
#else
void
scm_dowinds (to, delta)
SCM to;
long delta;
#endif
{
tail:
if (scm_dynwinds == to);
else if (0 > delta)
{
SCM wind_elt;
SCM wind_key;
scm_dowinds (SCM_CDR (to), 1 + delta);
wind_elt = SCM_CAR (to);
#if 0
if (SCM_INUMP (wind_elt))
{
scm_cross_dynwind_binding_scope (wind_elt, 0);
}
else
#endif
{
wind_key = SCM_CAR (wind_elt);
if ( !(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
&& (wind_key != SCM_BOOL_F)
&& (wind_key != SCM_BOOL_T))
scm_apply (wind_key, SCM_EOL, SCM_EOL);
}
scm_dynwinds = to;
}
else
{
SCM from;
SCM wind_elt;
SCM wind_key;
from = SCM_CDR (SCM_CAR (scm_dynwinds));
wind_elt = SCM_CAR (scm_dynwinds);
scm_dynwinds = SCM_CDR (scm_dynwinds);
#if 0
if (SCM_INUMP (wind_elt))
{
scm_cross_dynwind_binding_scope (wind_elt, 0);
}
else
#endif
{
wind_key = SCM_CAR (wind_elt);
if ( !(SCM_NIMP (wind_key) && SCM_SYMBOLP (wind_key))
&& (wind_key != SCM_BOOL_F)
&& (wind_key != SCM_BOOL_T))
scm_apply (from, SCM_EOL, SCM_EOL);
}
delta--;
goto tail; /* scm_dowinds(to, delta-1); */
}
}
#ifdef __STDC__
void
scm_init_dynwind (void)
#else
void
scm_init_dynwind ()
#endif
{
#include "dynwind.x"
}

66
libguile/dynwind.h Normal file
View file

@ -0,0 +1,66 @@
/* classes: h_files */
#ifndef DYNWINDH
#define DYNWINDH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_dynamic_wind (SCM thunk1, SCM thunk2, SCM thunk3);
extern void scm_dowinds (SCM to, long delta);
extern void scm_init_dynwind (void);
#else /* STDC */
extern SCM scm_dynamic_wind ();
extern void scm_dowinds ();
extern void scm_init_dynwind ();
#endif /* STDC */
#endif /* DYNWINDH */

162
libguile/eq.c Normal file
View file

@ -0,0 +1,162 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
SCM_PROC1 (s_eq_p, "eq?", scm_tc7_rpsubr, scm_eq_p);
#ifdef __STDC__
SCM
scm_eq_p (SCM x, SCM y)
#else
SCM
scm_eq_p (x, y)
SCM x;
SCM y;
#endif
{
return ((x==y)
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC1 (s_eqv_p, "eqv?", scm_tc7_rpsubr, scm_eqv_p);
#ifdef __STDC__
SCM
scm_eqv_p (SCM x, SCM y)
#else
SCM
scm_eqv_p (x, y)
SCM x;
SCM y;
#endif
{
if (x==y) return SCM_BOOL_T;
if SCM_IMP(x) return SCM_BOOL_F;
if SCM_IMP(y) return SCM_BOOL_F;
/* this ensures that types and scm_length are the same. */
if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;
if SCM_NUMP(x) {
# ifdef SCM_BIGDIG
if SCM_BIGP(x) return (0==scm_bigcomp(x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
# endif
#ifdef SCM_FLOATS
if (SCM_REALPART(x) != SCM_REALPART(y)) return SCM_BOOL_F;
if (SCM_CPLXP(x) && (SCM_IMAG(x) != SCM_IMAG(y))) return SCM_BOOL_F;
#endif
return SCM_BOOL_T;
}
return SCM_BOOL_F;
}
SCM_PROC1 (s_equal_p, "equal?", scm_tc7_rpsubr, scm_equal_p);
#ifdef __STDC__
SCM
scm_equal_p (SCM x, SCM y)
#else
SCM
scm_equal_p (x, y)
SCM x;
SCM y;
#endif
{
SCM_CHECK_STACK;
tailrecurse: SCM_ASYNC_TICK;
if (x==y) return SCM_BOOL_T;
if (SCM_IMP(x)) return SCM_BOOL_F;
if (SCM_IMP(y)) return SCM_BOOL_F;
if (SCM_CONSP(x) && SCM_CONSP(y)) {
if SCM_FALSEP(scm_equal_p(SCM_CAR(x), SCM_CAR(y))) return SCM_BOOL_F;
x = SCM_CDR(x);
y = SCM_CDR(y);
goto tailrecurse;
}
/* this ensures that types and scm_length are the same. */
if (SCM_CAR(x) != SCM_CAR(y)) return SCM_BOOL_F;
switch (SCM_TYP7(x)) {
default: return SCM_BOOL_F;
case scm_tc7_substring:
case scm_tc7_mb_substring:
case scm_tc7_mb_string:
case scm_tc7_string: return scm_string_equal_p(x, y);
case scm_tc7_vector:
case scm_tc7_wvect:
return scm_vector_equal_p(x, y);
case scm_tc7_smob: {
int i = SCM_SMOBNUM(x);
if (!(i < scm_numsmob)) return SCM_BOOL_F;
if (scm_smobs[i].equalp)
return (scm_smobs[i].equalp)(x, y);
else
return SCM_BOOL_F;
}
case scm_tc7_bvect: case scm_tc7_uvect: case scm_tc7_ivect:
case scm_tc7_fvect: case scm_tc7_cvect: case scm_tc7_dvect:
case scm_tc7_svect:
#ifdef LONGLONGS
case scm_tc7_llvect:
#endif
case scm_tc7_byvect:
if ( scm_tc16_array
&& scm_smobs[0x0ff & (scm_tc16_array >> 8)].equalp)
return scm_array_equal_p(x, y);
}
return SCM_BOOL_F;
}
#ifdef __STDC__
void
scm_init_eq (void)
#else
void
scm_init_eq ()
#endif
{
#include "eq.x"
}

63
libguile/eq.h Normal file
View file

@ -0,0 +1,63 @@
/* classes: h_files */
#ifndef EQH
#define EQH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#ifdef __STDC__
extern SCM scm_eq_p (SCM x, SCM y);
extern SCM scm_eqv_p (SCM x, SCM y);
extern SCM scm_equal_p (SCM x, SCM y);
extern void scm_init_eq (void);
#else /* STDC */
extern SCM scm_eq_p ();
extern SCM scm_eqv_p ();
extern SCM scm_equal_p ();
extern void scm_init_eq ();
#endif /* STDC */
#endif /* EQH */

205
libguile/error.c Normal file
View file

@ -0,0 +1,205 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
/* {Errors and Exceptional Conditions}
*/
SCM system_error_sym;
/* True between SCM_DEFER_INTS and SCM_ALLOW_INTS, and
* when the interpreter is not running at all.
*/
int scm_ints_disabled = 1;
extern int errno;
#ifdef __STDC__
static void
err_head (char *str)
#else
static void
err_head (str)
char *str;
#endif
{
int oerrno = errno;
if (SCM_NIMP (scm_cur_outp))
scm_fflush (scm_cur_outp);
scm_gen_putc ('\n', scm_cur_errp);
#if 0
if (SCM_BOOL_F != *scm_loc_loadpath)
{
scm_iprin1 (*scm_loc_loadpath, scm_cur_errp, 1);
scm_gen_puts (scm_regular_string, ", line ", scm_cur_errp);
scm_intprint ((long) scm_linum, 10, scm_cur_errp);
scm_gen_puts (scm_regular_string, ": ", scm_cur_errp);
}
#endif
scm_fflush (scm_cur_errp);
errno = oerrno;
if (scm_cur_errp == scm_def_errp)
{
if (errno > 0)
perror (str);
fflush (stderr);
return;
}
}
SCM_PROC(s_errno, "errno", 0, 1, 0, scm_errno);
#ifdef __STDC__
SCM
scm_errno (SCM arg)
#else
SCM
scm_errno (arg)
SCM arg;
#endif
{
int old = errno;
if (!SCM_UNBNDP (arg))
{
if (SCM_FALSEP (arg))
errno = 0;
else
errno = SCM_INUM (arg);
}
return SCM_MAKINUM (old);
}
SCM_PROC(s_perror, "perror", 1, 0, 0, scm_perror);
#ifdef __STDC__
SCM
scm_perror (SCM arg)
#else
SCM
scm_perror (arg)
SCM arg;
#endif
{
SCM_ASSERT (SCM_NIMP (arg) && SCM_STRINGP (arg), arg, SCM_ARG1, s_perror);
err_head (SCM_CHARS (arg));
return SCM_UNSPECIFIED;
}
#ifdef __STDC__
void
scm_everr (SCM exp, SCM env, SCM arg, char *pos, char *s_subr)
#else
void
scm_everr (exp, env, arg, pos, s_subr)
SCM exp;
SCM env;
SCM arg;
char *pos;
char *s_subr;
#endif
{
SCM desc;
SCM args;
if ((~0x1fL) & (long) pos)
desc = scm_makfrom0str (pos);
else
desc = SCM_MAKINUM ((long)pos);
{
SCM sym;
if (!s_subr || !*s_subr)
sym = SCM_BOOL_F;
else
sym = SCM_CAR (scm_intern0 (s_subr));
args = scm_listify (desc, sym, arg, SCM_UNDEFINED);
}
/* (throw (quote %%system-error) <desc> <proc-name> arg)
*
* <desc> is a string or an integer (see %%system-errors).
* <proc-name> is a symbol or #f in some annoying cases (e.g. cddr).
*/
scm_ithrow (system_error_sym, args, 1);
/* No return, but just in case: */
write (2, "unhandled system error", sizeof ("unhandled system error"));
exit (1);
}
#ifdef __STDC__
SCM
scm_wta (SCM arg, char *pos, char *s_subr)
#else
SCM
scm_wta (arg, pos, s_subr)
SCM arg;
char *pos;
char *s_subr;
#endif
{
scm_everr (SCM_UNDEFINED, SCM_EOL, arg, pos, s_subr);
return SCM_UNSPECIFIED;
}
#ifdef __STDC__
void
scm_init_error (void)
#else
void
scm_init_error ()
#endif
{
system_error_sym = SCM_CAR (scm_intern0 ("%%system-error"));
scm_permanent_object (system_error_sym);
#include "error.x"
}

79
libguile/error.h Normal file
View file

@ -0,0 +1,79 @@
/* classes: h_files */
#ifndef ERRORH
#define ERRORH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#include "pairs.h"
extern int scm_ints_disabled;
extern SCM system_error_sym;
#ifdef __STDC__
extern int scm_handle_it (int i);
extern void scm_warn (char *str1, char *str2);
extern SCM scm_errno (SCM arg);
extern SCM scm_perror (SCM arg);
extern void scm_def_err_response (void);
extern void scm_everr (SCM exp, SCM env, SCM arg, char *pos, char *s_subr);
extern SCM scm_wta (SCM arg, char *pos, char *s_subr);
extern void scm_init_error (void);
#else /* STDC */
extern int scm_handle_it ();
extern void scm_warn ();
extern SCM scm_errno ();
extern SCM scm_perror ();
extern void scm_def_err_response ();
extern void scm_everr ();
extern SCM scm_wta ();
extern void scm_init_error ();
#endif /* STDC */
#endif /* ERRORH */

2513
libguile/eval.c Normal file
View file

File diff suppressed because it is too large Load diff

218
libguile/eval.h Normal file
View file

@ -0,0 +1,218 @@
/* classes: h_files */
#ifndef EVALH
#define EVALH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
/* {Ilocs}
*
* Ilocs are relative pointers into local environment structures.
*
*/
#define SCM_ILOCP(n) (SCM_ITAG8(n)==scm_tc8_iloc)
#define SCM_ILOC00 SCM_MAKE_ITAG8(0L, scm_tc8_iloc)
#define SCM_IDINC (0x00100000L)
#define SCM_ICDR (0x00080000L)
#define SCM_IFRINC (0x00000100L)
#define SCM_IDSTMSK (-SCM_IDINC)
#define SCM_IFRAME(n) ((int)((SCM_ICDR-SCM_IFRINC)>>8) & ((int)(n)>>8))
#define SCM_IDIST(n) (((unsigned long)(n))>>20)
#define SCM_ICDRP(n) (SCM_ICDR & (n))
/* Evaluator */
#ifdef DEBUG_EXTENSIONS
#define EVAL(x, env) (SCM_IMP(x) \
? (x) \
: (*scm_ceval_ptr) ((x), (env)))
#else
#define EVAL(x, env) (SCM_IMP(x)?(x):scm_ceval((x), (env)))
#endif /* DEBUG_EXTENSIONS */
#define SCM_CEVAL scm_ceval
#define SCM_APPLY scm_apply
#define SIDEVAL(x, env) if SCM_NIMP(x) SCM_CEVAL((x), (env))
#define SCM_EXTEND_SCM_ENV scm_acons
extern SCM scm_i_dot;
extern SCM scm_i_quote;
extern SCM scm_i_quasiquote;
extern SCM scm_i_lambda;
extern SCM scm_i_let;
extern SCM scm_i_arrow;
extern SCM scm_i_else;
extern SCM scm_i_unquote;
extern SCM scm_i_uq_splicing;
extern SCM scm_i_apply;
extern SCM scm_top_level_lookup_thunk_var;
extern SCM scm_i_name;
/* A resolved global variable reference in the CAR position
* of a list is stored (in code only) as a pointer to a pair with a
* tag of 1. This is called a "gloc".
*/
#define SCM_GLOC_SYM(x) (SCM_CAR((x)-1L))
#define SCM_GLOC_VAL(x) (SCM_CDR((x)-1L))
#ifdef __STDC__
extern SCM * scm_ilookup (SCM iloc, SCM env);
extern SCM * scm_lookupcar (SCM vloc, SCM genv);
extern SCM scm_unmemocar (SCM form, SCM env);
extern SCM scm_eval_car (SCM pair, SCM env);
extern SCM scm_m_quote (SCM xorig, SCM env);
extern SCM scm_m_begin (SCM xorig, SCM env);
extern SCM scm_m_if (SCM xorig, SCM env);
extern SCM scm_m_set (SCM xorig, SCM env);
extern SCM scm_m_vref (SCM xorig, SCM env);
extern SCM scm_m_vset (SCM xorig, SCM env);
extern SCM scm_m_and (SCM xorig, SCM env);
extern SCM scm_m_or (SCM xorig, SCM env);
extern SCM scm_m_case (SCM xorig, SCM env);
extern SCM scm_m_cond (SCM xorig, SCM env);
extern SCM scm_m_lambda (SCM xorig, SCM env);
extern SCM scm_m_letstar (SCM xorig, SCM env);
extern SCM scm_m_do (SCM xorig, SCM env);
extern SCM scm_m_quasiquote (SCM xorig, SCM env);
extern SCM scm_m_delay (SCM xorig, SCM env);
extern SCM scm_m_define (SCM x, SCM env);
extern SCM scm_m_letrec (SCM xorig, SCM env);
extern SCM scm_m_let (SCM xorig, SCM env);
extern SCM scm_m_apply (SCM xorig, SCM env);
extern SCM scm_m_cont (SCM xorig, SCM env);
extern int scm_badargsp (SCM formals, SCM args);
extern SCM scm_ceval (SCM x, SCM env);
extern SCM scm_deval (SCM x, SCM env);
extern SCM scm_procedure_documentation (SCM proc);
extern SCM scm_nconc2last (SCM lst);
extern SCM scm_apply (SCM proc, SCM arg1, SCM args);
extern SCM scm_dapply (SCM proc, SCM arg1, SCM args);
extern SCM SCM_APPLY (SCM proc, SCM arg1, SCM args);
extern SCM scm_map (SCM proc, SCM arg1, SCM args);
extern SCM scm_for_each (SCM proc, SCM arg1, SCM args);
extern SCM scm_closure (SCM code, SCM env);
extern SCM scm_makprom (SCM code);
extern SCM scm_makacro (SCM code);
extern SCM scm_makmacro (SCM code);
extern SCM scm_makmmacro (SCM code);
extern SCM scm_force (SCM x);
extern SCM scm_promise_p (SCM x);
extern SCM scm_copy_tree (SCM obj);
extern SCM scm_eval_3 (SCM obj, int copyp, SCM env);
extern SCM scm_top_level_env (SCM thunk);
extern SCM scm_eval2 (SCM obj, SCM env_thunk);
extern SCM scm_eval (SCM obj);
extern SCM scm_eval_x (SCM obj);
extern SCM scm_macro_eval_x (SCM exp, SCM env);
extern SCM scm_definedp (SCM x, SCM env);
extern SCM scm_make_synt (char *name, SCM (*macroizer) (), SCM (*fcn) ());
extern void scm_init_eval (void);
#else /* STDC */
extern SCM * scm_ilookup ();
extern SCM * scm_lookupcar ();
extern SCM scm_unmemocar ();
extern SCM scm_eval_car ();
extern SCM scm_m_quote ();
extern SCM scm_m_begin ();
extern SCM scm_m_if ();
extern SCM scm_m_set ();
extern SCM scm_m_vref ();
extern SCM scm_m_vset ();
extern SCM scm_m_and ();
extern SCM scm_m_or ();
extern SCM scm_m_case ();
extern SCM scm_m_cond ();
extern SCM scm_m_lambda ();
extern SCM scm_m_letstar ();
extern SCM scm_m_do ();
extern SCM scm_m_quasiquote ();
extern SCM scm_m_delay ();
extern SCM scm_m_define ();
extern SCM scm_m_letrec ();
extern SCM scm_m_let ();
extern SCM scm_m_apply ();
extern SCM scm_m_cont ();
extern int scm_badargsp ();
extern SCM scm_ceval ();
extern SCM scm_deval ();
extern SCM scm_procedure_documentation ();
extern SCM scm_nconc2last ();
extern SCM scm_apply ();
extern SCM scm_dapply ();
extern SCM SCM_APPLY ();
extern SCM scm_map ();
extern SCM scm_for_each ();
extern SCM scm_closure ();
extern SCM scm_makprom ();
extern SCM scm_makacro ();
extern SCM scm_makmacro ();
extern SCM scm_makmmacro ();
extern SCM scm_force ();
extern SCM scm_promise_p ();
extern SCM scm_copy_tree ();
extern SCM scm_eval_3 ();
extern SCM scm_top_level_env ();
extern SCM scm_eval2 ();
extern SCM scm_eval ();
extern SCM scm_eval_x ();
extern SCM scm_macro_eval_x ();
extern SCM scm_definedp ();
extern SCM scm_make_synt ();
extern void scm_init_eval ();
#endif /* STDC */
#endif /* EVALH */

146
libguile/extchrs.c Normal file
View file

@ -0,0 +1,146 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "extchrs.h"
#ifdef FAKE_EXT_SCM_CHARS
#ifdef __STDC__
int
xmblen (const char * str, size_t size)
#else
int
xmblen (str, size)
const char * str;
size_t size;
#endif
{
if (!str)
return 0;
if (*(unsigned char *)str > 127)
return ((size < 4)
? -1
: 4);
else if (!*str)
return 0;
else
return 1;
}
#ifdef __STDC__
int
xwctomb (char * _str, int c)
#else
int
xwctomb (_str, c)
char * _str;
int c;
#endif
{
unsigned char * str;
str = (unsigned char *)_str;
if (!str)
return 0;
if (!c)
{
*str = 0;
return 0;
}
if (c < 127)
{
*str = c;
return 1;
}
str[0] = 255;
str[1] = 0x80 | ((c >> 10) & 0x3f);
str[2] = 0x80 | ((c >> 4) & 0x3f);
str[3] = 0x80 | (c & 0xf);
return 4;
}
#ifdef __STDC__
int
xmbtowc (xwchar_t * result, const unsigned char * _str, size_t size)
#else
int
xmbtowc (result, str, size)
xwchar_t * result;
const unsigned char * _str;
size_t size;
#endif
{
const unsigned char * str;
str = (const unsigned char *)_str;
if (!str)
return 0;
if ((size == 0) || !*str)
{
*result = 0;
return 0;
}
if (*str < 128)
{
*result = *str;
return 1;
}
if ( (*str != 255)
|| (size < 4))
return -1;
*result = ( ((str[1] & 0x3f) << 10)
| ((str[2] & 0x3f) << 4)
| (str[3] & 0xf));
return 4;
}
#endif /* FAKE_EXT_SCM_CHARS */

83
libguile/extchrs.h Normal file
View file

@ -0,0 +1,83 @@
/* classes: h_files */
#ifndef EXTCHRSH
#define EXTCHRSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdlib.h>
#define FAKE_EXT_SCM_CHARS 1
#if !defined(FAKE_EXT_SCM_CHARS)
#define xmblen mblen
#define xwctomb wctomb
#define xmbtowc mbtowc
#define XMB_CUR_MAX MB_CUR_MAX
typedef wchar_t xwchar_t;
#else
typedef unsigned short xwchar_t;
#define XMB_CUR_MAX 4
#endif
#ifdef __STDC__
extern int xmblen (const char * str, size_t size);
extern int xwctomb (char * _str, int c);
extern int xmbtowc (xwchar_t * result, const unsigned char * _str, size_t size);
#else /* STDC */
extern int xmblen ();
extern int xwctomb ();
extern int xmbtowc ();
#endif /* STDC */
#endif /* EXTCHRSH */

135
libguile/feature.c Normal file
View file

@ -0,0 +1,135 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
SCM *scm_loc_features;
#ifdef __STDC__
void
scm_add_feature(char* str)
#else
void
scm_add_feature(str)
char* str;
#endif
{
*scm_loc_features = scm_cons(SCM_CAR(scm_intern(str, strlen(str))), *scm_loc_features);
}
/* {Help finding slib}
*/
SCM_PROC(s_compiled_library_path, "compiled-library-path", 0, 0, 0, scm_compiled_library_path);
#ifdef __STDC__
SCM
scm_compiled_library_path (void)
#else
SCM
scm_compiled_library_path ()
#endif
{
#ifndef LIBRARY_PATH
return SCM_BOOL_F;
#else
return scm_makfrom0str (LIBRARY_PATH);
#endif
}
SCM_PROC(s_program_arguments, "program-arguments", 0, 0, 0, scm_program_arguments);
#ifdef __STDC__
SCM
scm_program_arguments (void)
#else
SCM
scm_program_arguments ()
#endif
{
return scm_progargs;
}
#ifdef __STDC__
void
scm_init_feature(void)
#else
void
scm_init_feature()
#endif
{
scm_loc_features = &SCM_CDR(scm_sysintern("*features*", SCM_EOL));
#ifdef RECKLESS
scm_add_feature("reckless");
#endif
#ifndef _Windows
scm_add_feature("system");
#endif
#ifdef vms
scm_add_feature(s_ed);
#endif
#ifdef SICP
scm_add_feature("sicp");
#endif
#ifndef GO32
scm_add_feature("char-ready?");
#endif
#ifndef CHEAP_CONTINUATIONS
scm_add_feature ("full-continuation");
#endif
scm_sysintern ("char-code-limit", SCM_MAKINUM (SCM_CHAR_SCM_CODE_LIMIT));
#include "feature.x"
}

69
libguile/feature.h Normal file
View file

@ -0,0 +1,69 @@
/* classes: h_files */
#ifndef FEATUREH
#define FEATUREH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
extern SCM *scm_loc_features;
#ifdef __STDC__
extern void scm_add_feature(char* str);
extern SCM scm_compiled_library_path (void);
extern SCM scm_program_arguments (void);
extern void scm_init_feature(void);
#else /* STDC */
extern void scm_add_feature();
extern SCM scm_compiled_library_path ();
extern SCM scm_program_arguments ();
extern void scm_init_feature();
#endif /* STDC */
#endif /* FEATUREH */

1278
libguile/filesys.c Normal file
View file

File diff suppressed because it is too large Load diff

135
libguile/filesys.h Normal file
View file

@ -0,0 +1,135 @@
/* classes: h_files */
#ifndef FILESYSH
#define FILESYSH
/* Copyright (C) 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
extern long scm_tc16_fd;
#define SCM_FD_P(x) (SCM_TYP16(x)==(scm_tc16_fd))
#define SCM_FD_FLAGS(x) (SCM_CAR(x) >> 16)
#define SCM_FD(x) ((int)SCM_CDR (x))
enum scm_fd_flags
{
scm_fd_is_open = 1,
scm_close_fd_on_gc = 2
};
extern long scm_tc16_dir;
#define SCM_DIRP(x) (SCM_TYP16(x)==(scm_tc16_dir))
#define SCM_OPDIRP(x) (SCM_CAR(x)==(scm_tc16_dir | SCM_OPN))
#ifdef __STDC__
extern SCM scm_sys_chown (SCM path, SCM owner, SCM group);
extern SCM scm_sys_chmod (SCM port_or_path, SCM mode);
extern SCM scm_umask (SCM mode);
extern SCM scm_intern_fd (int fd, int flags);
extern SCM scm_sys_open (SCM path, SCM flags, SCM mode);
extern SCM scm_sys_create (SCM path, SCM mode);
extern SCM scm_sys_close (SCM sfd);
extern SCM scm_sys_write_fd (SCM sfd, SCM buf);
extern SCM scm_sys_read_fd (SCM sfd, SCM buf, SCM offset, SCM length);
extern SCM scm_sys_lseek (SCM sfd, SCM offset, SCM whence);
extern SCM scm_sys_dup (SCM oldfd, SCM newfd);
extern SCM scm_sys_stat (SCM fd_or_path);
extern SCM scm_sys_link (SCM oldpath, SCM newpath);
extern SCM scm_sys_rename (SCM oldname, SCM newname);
extern SCM scm_sys_mkdir (SCM path, SCM mode);
extern SCM scm_sys_rmdir (SCM path);
extern SCM scm_sys_opendir (SCM dirname);
extern SCM scm_sys_readdir (SCM port);
extern SCM scm_rewinddir (SCM port);
extern SCM scm_sys_closedir (SCM port);
extern SCM scm_sys_chdir (SCM str);
extern SCM scm_sys_getcwd (void);
extern SCM scm_sys_select (SCM reads, SCM writes, SCM excepts, SCM secs, SCM msecs);
extern SCM scm_sys_symlink(SCM oldpath, SCM newpath);
extern SCM scm_sys_readlink(SCM path);
extern SCM scm_sys_lstat(SCM str);
extern SCM scm_sys_copy_file (SCM oldfile, SCM newfile);
extern void scm_init_filesys (void);
#else /* STDC */
extern SCM scm_sys_chown ();
extern SCM scm_sys_chmod ();
extern SCM scm_umask ();
extern SCM scm_intern_fd ();
extern SCM scm_sys_open ();
extern SCM scm_sys_create ();
extern SCM scm_sys_close ();
extern SCM scm_sys_write_fd ();
extern SCM scm_sys_read_fd ();
extern SCM scm_sys_lseek ();
extern SCM scm_sys_dup ();
extern SCM scm_sys_stat ();
extern SCM scm_sys_link ();
extern SCM scm_sys_rename ();
extern SCM scm_sys_mkdir ();
extern SCM scm_sys_rmdir ();
extern SCM scm_sys_opendir ();
extern SCM scm_sys_readdir ();
extern SCM scm_rewinddir ();
extern SCM scm_sys_closedir ();
extern SCM scm_sys_chdir ();
extern SCM scm_sys_getcwd ();
extern SCM scm_sys_select ();
extern SCM scm_sys_symlink();
extern SCM scm_sys_readlink();
extern SCM scm_sys_lstat();
extern SCM scm_sys_copy_file ();
extern void scm_init_filesys ();
#endif /* STDC */
#endif /* FILESYSH */

391
libguile/fports.c Normal file
View file

@ -0,0 +1,391 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#else
char *ttyname ();
char *tmpnam ();
scm_sizet fwrite ();
#endif
#ifdef HAVE_STRING_H
#include "string.h"
#endif
#ifdef __IBMC__
#include <io.h>
#include <direct.h>
#define ttyname(x) "CON:"
#else
#ifndef MSDOS
#ifndef ultrix
#ifndef vms
#ifdef _DCC
#include <ioctl.h>
#define setbuf(stream, buf) setvbuf(stream, buf, _IONBF, 0)
#else
#ifdef MWC
#include <sys/io.h>
#else
#ifndef THINK_C
#ifndef ARM_ULIB
#include <sys/ioctl.h>
#endif
#endif
#endif
#endif
#endif
#endif
#endif
#endif
/* {Ports - file ports}
*
*/
/* should be called with SCM_DEFER_INTS active */
#ifdef __STDC__
SCM
scm_setbuf0 (SCM port)
#else
SCM
scm_setbuf0 (port)
SCM port;
#endif
{
#ifndef NOSETBUF
#ifndef MSDOS
#ifdef FIONREAD
#ifndef ultrix
SCM_SYSCALL (setbuf ((FILE *)SCM_STREAM (port), 0););
#endif
#endif
#endif
#endif
return SCM_UNSPECIFIED;
}
/* Return the flags that characterize a port based on the mode
* string used to open a file for that port.
*
* See PORT FLAGS in scm.h
*/
#ifdef __STDC__
long
scm_mode_bits (char *modes)
#else
long
scm_mode_bits (modes)
char *modes;
#endif
{
return (SCM_OPN
| (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
| ( strchr (modes, 'w')
|| strchr (modes, 'a')
|| strchr (modes, '+') ? SCM_WRTNG : 0)
| (strchr (modes, '0') ? SCM_BUF0 : 0));
}
/* scm_open_file
* Return a new port open on a given file.
*
* The mode string must match the pattern: [rwa+]** which
* is interpreted in the usual unix way.
*
* Return the new port.
*/
#ifdef __STDC__
SCM
scm_mkfile (char * name, char * modes)
#else
SCM
scm_mkfile (name, modes)
char * name;
char * modes;
#endif
{
register SCM port;
FILE *f;
SCM_NEWCELL (port);
SCM_DEFER_INTS;
SCM_SYSCALL (f = fopen (name, modes));
if (!f)
{
SCM_ALLOW_INTS;
port = SCM_BOOL_F;
}
else
{
struct scm_port_table * pt;
pt = scm_add_to_port_table (port);
SCM_SETPTAB_ENTRY (port, pt);
if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (modes)))
scm_setbuf0 (port);
SCM_SETSTREAM (port, (SCM)f);
SCM_PTAB_ENTRY (port)->file_name = scm_makfrom0str (name);
SCM_ALLOW_INTS;
}
return port;
}
SCM_PROC(s_open_file, "open-file", 2, 0, 0, scm_open_file);
#ifdef __STDC__
SCM
scm_open_file (SCM filename, SCM modes)
#else
SCM
scm_open_file (filename, modes)
SCM filename;
SCM modes;
#endif
{
SCM port;
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_open_file);
SCM_ASSERT (SCM_NIMP (modes) && SCM_ROSTRINGP (modes), modes, SCM_ARG2, s_open_file);
if (SCM_SUBSTRP (filename))
filename = scm_makfromstr (SCM_ROCHARS (filename), SCM_ROLENGTH (filename), 0);
if (SCM_SUBSTRP (modes))
modes = scm_makfromstr (SCM_ROCHARS (modes), SCM_ROLENGTH (modes), 0);
port = scm_mkfile (SCM_ROCHARS (filename), SCM_ROCHARS (modes));
/* Force the compiler to keep filename and modes alive:
*/
if (port == SCM_BOOL_F)
scm_cons (filename, modes);
return port;
}
/* Return the mode flags from an open port.
* Some modes such as "append" are only used when opening
* a file and are not returned here.
*/
SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
#ifdef __STDC__
SCM
scm_port_mode (SCM port)
#else
SCM
scm_port_mode (port)
SCM port;
#endif
{
char modes[3];
modes[0] = '\0';
SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);
if (SCM_CAR (port) & SCM_RDNG) {
if (SCM_CAR (port) & SCM_WRTNG)
strcpy (modes, "r+");
else
strcpy (modes, "r");
}
else if (SCM_CAR (port) & SCM_WRTNG)
strcpy (modes, "w");
if (SCM_CAR (port) & SCM_BUF0)
strcat (modes, "0");
return scm_makfromstr (modes, strlen (modes), 0);
}
#ifdef __STDC__
static int
prinfport (SCM exp, SCM port, int writing)
#else
static int
prinfport (exp, port, writing)
SCM exp;
SCM port;
int writing;
#endif
{
SCM name;
char * c;
if (SCM_CLOSEDP (exp))
{
c = "file";
}
else
{
name = SCM_PTAB_ENTRY (exp)->file_name;
if (SCM_NIMP (name) && SCM_ROSTRINGP (name))
c = SCM_ROCHARS (name);
else
c = "file";
}
scm_prinport (exp, port, c);
return !0;
}
#ifdef __STDC__
static int
scm_fgetc (FILE * s)
#else
static int
scm_fgetc (s)
FILE * s;
#endif
{
if (feof (s))
return EOF;
else
return fgetc (s);
}
#ifdef vms
#ifdef __STDC__
static scm_sizet
pwrite (char *ptr, scm_sizet size, nitems, FILE *port)
#else
static scm_sizet
pwrite (ptr, size, nitems, port)
char *ptr;
scm_sizet size, nitems;
FILE *port;
#endif
{
scm_sizet len = size * nitems;
scm_sizet i = 0;
for (; i < len; i++)
putc (ptr[i], port);
return len;
}
#define ffwrite pwrite
#else
#define ffwrite fwrite
#endif
/* This otherwise pointless code helps some poor
* crippled C compilers cope with life.
*/
static int
local_fclose (fp)
FILE * fp;
{
return fclose (fp);
}
static int
local_fflush (fp)
FILE * fp;
{
return fflush (fp);
}
static int
local_fputc (c, fp)
int c;
FILE * fp;
{
return fputc (c, fp);
}
static int
local_fputs (s, fp)
char * s;
FILE * fp;
{
return fputs (s, fp);
}
static scm_sizet
local_ffwrite (ptr, size, nitems, fp)
void * ptr;
int size;
int nitems;
FILE * fp;
{
return ffwrite (ptr, size, nitems, fp);
}
scm_ptobfuns scm_fptob =
{
scm_mark0,
local_fclose,
prinfport,
0,
local_fputc,
local_fputs,
local_ffwrite,
local_fflush,
scm_fgetc,
local_fclose
};
/* {Pipe ports}
*/
scm_ptobfuns scm_pipob =
{
scm_mark0,
0, /* replaced by pclose in scm_init_ioext() */
0, /* replaced by prinpipe in scm_init_ioext() */
0,
local_fputc,
local_fputs,
local_ffwrite,
local_fflush,
scm_fgetc,
0
}; /* replaced by pclose in scm_init_ioext() */
#ifdef __STDC__
void
scm_init_fports (void)
#else
void
scm_init_fports ()
#endif
{
#include "fports.x"
}

78
libguile/fports.h Normal file
View file

@ -0,0 +1,78 @@
/* classes: h_files */
#ifndef FPORTSH
#define FPORTSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
extern scm_ptobfuns scm_fptob;
extern scm_ptobfuns scm_pipob;
#ifdef __STDC__
extern SCM scm_setbuf0 (SCM port);
extern long scm_mode_bits (char *modes);
extern SCM scm_mkfile (char * name, char * modes);
extern SCM scm_open_file (SCM filename, SCM modes);
extern SCM scm_port_mode (SCM port);
extern void scm_init_fports (void);
#else /* STDC */
extern SCM scm_setbuf0 ();
extern long scm_mode_bits ();
extern SCM scm_mkfile ();
extern SCM scm_open_file ();
extern SCM scm_port_mode ();
extern void scm_init_fports ();
#endif /* STDC */
#endif /* FPORTSH */

1690
libguile/gc.c Normal file
View file

File diff suppressed because it is too large Load diff

118
libguile/gc.h Normal file
View file

@ -0,0 +1,118 @@
/* classes: h_files */
#ifndef GCH
#define GCH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#define SCM_FREEP(x) (SCM_CAR(x)==scm_tc_free_cell)
#define SCM_NFREEP(x) (!SCM_FREEP(x))
extern struct scm_heap_seg_data *scm_heap_table;
extern int scm_n_heap_segs;
extern int scm_take_stdin;
extern int scm_block_gc;
extern int scm_gc_heap_lock;
extern long scm_heap_size;
extern SCM_CELLPTR scm_heap_org;
extern SCM scm_freelist;
extern unsigned long scm_gc_cells_collected;
extern unsigned long scm_gc_malloc_collected;
extern unsigned long scm_gc_ports_collected;
extern unsigned long scm_cells_allocated;
extern unsigned long scm_mallocated;
extern long scm_mtrigger;
#ifdef __STDC__
extern SCM scm_gc_stats (void);
extern void scm_gc_start (char *what);
extern void scm_gc_end (void);
extern SCM scm_gc (void);
extern void scm_gc_for_alloc (int ncells, SCM * freelistp);
extern SCM scm_gc_for_newcell (void);
extern void scm_igc (char *what);
extern void scm_gc_mark (SCM p);
extern void scm_mark_locations (SCM_STACKITEM x[], scm_sizet n);
extern void scm_gc_sweep (void);
extern char * scm_must_malloc (long len, char *what);
extern char * scm_must_realloc (char *where, long olen, long len, char *what);
extern void scm_must_free (char *obj);
extern void scm_remember (SCM * ptr);
extern SCM scm_return_first (SCM elt, ...);
extern SCM scm_permanent_object (SCM obj);
extern SCM scm_protect_object (SCM obj);
extern SCM scm_unprotect_object (SCM obj);
extern int scm_init_storage (long init_heap_size);
extern void scm_init_gc (void);
#else /* STDC */
extern SCM scm_gc_stats ();
extern void scm_gc_start ();
extern void scm_gc_end ();
extern SCM scm_gc ();
extern void scm_gc_for_alloc ();
extern SCM scm_gc_for_newcell ();
extern void scm_igc ();
extern void scm_gc_mark ();
extern void scm_mark_locations ();
extern void scm_gc_sweep ();
extern char * scm_must_malloc ();
extern char * scm_must_realloc ();
extern void scm_must_free ();
extern void scm_remember ();
extern SCM scm_return_first ();
extern SCM scm_permanent_object ();
extern SCM scm_protect_object ();
extern SCM scm_unprotect_object ();
extern int scm_init_storage ();
extern void scm_init_gc ();
#endif /* STDC */
#include "marksweep.h"
#endif /* GCH */

533
libguile/genio.c Normal file
View file

@ -0,0 +1,533 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "extchrs.h"
#include <stdio.h>
#include "_scm.h"
#ifdef __STDC__
static void
scm_putc (int c, SCM port)
#else
static void
scm_putc (c, port)
int c;
SCM port;
#endif
{
scm_sizet i = SCM_PTOBNUM (port);
SCM_SYSCALL ((scm_ptobs[i].fputc) (c, SCM_STREAM (port)));
}
#ifdef __STDC__
static void
scm_puts (char *s, SCM port)
#else
static void
scm_puts (s, port)
char *s;
SCM port;
#endif
{
scm_sizet i = SCM_PTOBNUM (port);
SCM_SYSCALL ((scm_ptobs[i].fputs) (s, SCM_STREAM (port)));
#ifdef TRANSCRIPT_SUPPORT
if (scm_trans && (port == def_outp || port == cur_errp))
SCM_SYSCALL (fputs (s, scm_trans));
#endif
}
#ifdef __STDC__
static int
scm_lfwrite (char *ptr, scm_sizet size, scm_sizet nitems, SCM port)
#else
static int
scm_lfwrite (ptr, size, nitems, port)
char *ptr;
scm_sizet size;
scm_sizet nitems;
SCM port;
#endif
{
int ret;
scm_sizet i = SCM_PTOBNUM (port);
SCM_SYSCALL (ret = (scm_ptobs[i].fwrite(ptr, size, nitems, SCM_STREAM (port))));
#ifdef TRANSCRIPT_SUPPORT
if (scm_trans && (port == def_outp || port == cur_errp))
SCM_SYSCALL (fwrite (ptr, size, nitems, scm_trans));
#endif
return ret;
}
#ifdef __STDC__
void
scm_gen_putc (int c, SCM port)
#else
void
scm_gen_putc (c, port)
int c;
SCM port;
#endif
{
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
{
/* Nothing good to do with extended chars here...
* just truncate them.
*/
scm_putc ((unsigned char)c, port);
break;
}
case scm_mb_port:
{
char buf[256];
int len;
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_MAKICHR (c),
"huge translation", "scm_gen_putc");
len = xwctomb (buf, c);
SCM_ASSERT ((len >= 0), SCM_MAKICHR (c), "bogus character", "scm_gen_putc");
if (len == 0)
scm_putc (0, port);
else
{
int x;
for (x = 0; x < len; ++x)
scm_putc (buf[x], port);
}
break;
}
case scm_wchar_port:
{
scm_putc (((unsigned char)(c >> 8) & 0xff), port);
scm_putc ((unsigned char)(c & 0xff), port);
break;
}
}
}
#ifdef __STDC__
void
scm_gen_puts (enum scm_string_representation_type rep,
char *str_data,
SCM port)
#else
void
scm_gen_puts (rep, str_data, port)
enum scm_string_representation_type rep;
unsigned char *str_data;
SCM port;
#endif
{
switch (rep)
{
case scm_regular_string:
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
case scm_mb_port:
scm_puts (str_data, port);
return;
case scm_wchar_port:
{
while (*str_data)
{
scm_putc (0, port);
scm_putc (*str_data, port);
++str_data;
}
return;
}
}
case scm_mb_string:
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
case scm_mb_port:
scm_puts (str_data, port);
return;
case scm_wchar_port:
{
xwchar_t output;
int len;
int size;
size = strlen (str_data);
while (size)
{
len = xmbtowc (&output, str_data, size);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
scm_putc ((output >> 8) & 0xff, port);
scm_putc (output & 0xff, port);
size -= len;
str_data += len;
}
return;
}
}
case scm_wchar_string:
{
xwchar_t * wstr_data;
wstr_data = (xwchar_t *)wstr_data;
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
while (*wstr_data)
{
scm_putc ((unsigned char) *wstr_data, port);
++wstr_data;
}
return;
case scm_mb_port:
{
char buf[256];
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_puts");
while (*wstr_data)
{
int len;
len = xwctomb (buf, *wstr_data);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
{
int x;
for (x = 0; x < len; ++x)
scm_putc (buf[x], port);
}
++wstr_data;
}
return;
}
case scm_wchar_port:
{
int len;
for (len = 0; wstr_data[len]; ++len)
;
scm_lfwrite (str_data, sizeof (xwchar_t), len, port);
return;
}
}
}
}
}
#ifdef __STDC__
void
scm_gen_write (enum scm_string_representation_type rep, char *str_data, scm_sizet nitems, SCM port)
#else
void
scm_gen_write (rep, str_data, nitems, port)
enum scm_string_representation_type rep;
char *str_data;
scm_sizet nitems;
SCM port;
#endif
{
/* is nitems bytes or characters in the mb_string case? */
switch (rep)
{
case scm_regular_string:
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
case scm_mb_port:
scm_lfwrite (str_data, 1, nitems, port);
return;
case scm_wchar_port:
{
while (nitems)
{
scm_putc (0, port);
scm_putc (*str_data, port);
++str_data;
--nitems;
}
return;
}
}
case scm_mb_string:
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
case scm_mb_port:
scm_lfwrite (str_data, 1, nitems, port);
return;
case scm_wchar_port:
{
xwchar_t output;
int len;
while (nitems)
{
len = xmbtowc (&output, str_data, nitems);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*str_data), "bogus character", "scm_gen_puts");
scm_putc ((output >> 8) & 0xff, port);
scm_putc (output & 0xff, port);
nitems -= len;
str_data += len;
}
return;
}
}
case scm_wchar_string:
{
xwchar_t * wstr_data;
wstr_data = (xwchar_t *)wstr_data;
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
while (nitems)
{
scm_putc ((unsigned char) *wstr_data, port);
++wstr_data;
--nitems;
}
return;
case scm_mb_port:
{
char buf[256];
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_puts");
while (nitems)
{
int len;
len = xwctomb (buf, *wstr_data);
SCM_ASSERT ((len > 0), SCM_MAKINUM (*wstr_data), "bogus character", "scm_gen_puts");
{
int x;
for (x = 0; x < len; ++x)
scm_putc (buf[x], port);
}
++wstr_data;
--nitems;
}
return;
}
case scm_wchar_port:
{
scm_lfwrite (str_data, sizeof (xwchar_t), nitems, port);
return;
}
}
}
}
}
#ifdef __STDC__
static int
scm_getc (SCM port)
#else
static int
scm_getc (port)
SCM port;
#endif
{
FILE *f;
int c;
scm_sizet i;
f = (FILE *)SCM_STREAM (port);
i = SCM_PTOBNUM (port);
SCM_SYSCALL (c = (scm_ptobs[i].fgetc) (f));
return c;
}
#ifdef __STDC__
int
scm_gen_getc (SCM port)
#else
int
scm_gen_getc (port)
SCM port;
#endif
{
int c;
/* One char may be stored in the high bits of (car port) orre@nada.kth.se. */
if (SCM_CRDYP (port))
{
c = SCM_CGETUN (port);
SCM_CLRDY (port); /* Clear ungetted char */
return_c:
if (c == '\n')
{
SCM_INCLINE (port);
}
else if (c == '\t')
{
SCM_TABCOL (port);
}
else
{
SCM_INCCOL (port);
}
return c;
}
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
c = scm_getc (port);
goto return_c;
case scm_mb_port:
{
int x;
unsigned char buf[256];
int c;
SCM_ASSERT (XMB_CUR_MAX < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_puts");
x = 0;
while (1)
{
xwchar_t out;
c = scm_getc (port);
if (c == EOF)
return EOF;
buf[x] = c;
if (xmbtowc (&out, buf, x + 1) > 0)
{
c = out;
goto return_c;
}
SCM_ASSERT (x < sizeof (buf), SCM_BOOL_F,
"huge translation", "scm_gen_getc");
++x;
}
}
case scm_wchar_port:
{
int hi;
int lo;
hi = scm_getc (port);
lo = (hi == EOF
? EOF
: scm_getc (port));
c = ((hi == EOF)
? EOF
: ((hi << 8) | lo));
goto return_c;
}
default:
return EOF;
}
}
#ifdef __STDC__
void
scm_gen_ungetc (int c, SCM port)
#else
void
scm_gen_ungetc (c, port)
int c;
SCM port;
#endif
{
/* SCM_ASSERT(!SCM_CRDYP(port), port, SCM_ARG2, "too many scm_gen_ungetc");*/
SCM_CUNGET (c, port);
if (c == '\n')
{
/* What should col be in this case?
* We'll leave it at -1.
*/
SCM_LINUM (port) -= 1;
}
else
SCM_COL(port) -= 1;
}

69
libguile/genio.h Normal file
View file

@ -0,0 +1,69 @@
/* classes: h_files */
#ifndef GENIOH
#define GENIOH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#include "ports.h"
#ifdef __STDC__
extern void scm_gen_putc (int c, SCM port);
extern void scm_gen_puts (enum scm_string_representation_type rep,
char *str_data,
SCM port);
extern void scm_gen_write (enum scm_string_representation_type rep, char *str_data, scm_sizet nitems, SCM port);
extern int scm_gen_getc (SCM port);
extern void scm_gen_ungetc (int c, SCM port);
#else /* STDC */
extern void scm_gen_putc ();
extern void scm_gen_puts ();
extern void scm_gen_write ();
extern int scm_gen_getc ();
extern void scm_gen_ungetc ();
#endif /* STDC */
#endif /* GENIOH */

657
libguile/gscm.c Normal file
View file

@ -0,0 +1,657 @@
/* Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include <sys/param.h>
#include "gscm.h"
#include "_scm.h"
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_STRING_H
#include <string.h>
#endif
extern char *getenv ();
/* {Top Level Evaluation}
*
* Top level evaluation has to establish a dynamic root context,
* enable Scheme signal handlers, and catch global escapes (errors, quits,
* aborts, restarts, and execs) from the interpreter.
*/
/* {Printing Objects to Strings}
*/
#ifdef __STDC__
static GSCM_status
gscm_portprint_obj (SCM port, SCM obj)
#else
static GSCM_status
gscm_portprint_obj (port, obj)
SCM port;
SCM obj;
#endif
{
scm_iprin1 (obj, port, 1);
return GSCM_OK;
}
struct seval_str_frame
{
GSCM_status status;
SCM * answer;
GSCM_top_level top;
char * str;
};
#ifdef __STDC__
static void
_seval_str_fn (void * vframe)
#else
static void
_seval_str_fn (vframe)
void * vframe;
#endif
{
struct seval_str_frame * frame;
frame = (struct seval_str_frame *)vframe;
frame->status = gscm_seval_str (frame->answer, frame->top, frame->str);
}
#ifdef __STDC__
static GSCM_status
gscm_strprint_obj (SCM * answer, SCM obj)
#else
static GSCM_status
gscm_strprint_obj (answer, obj)
SCM * answer;
SCM obj;
#endif
{
SCM str;
SCM port;
GSCM_status stat;
str = scm_makstr (64, 0);
port = scm_mkstrport (SCM_MAKINUM (0), str, SCM_OPN | SCM_WRTNG, "gscm_strprint_obj");
stat = gscm_portprint_obj (port, obj);
if (stat == GSCM_OK)
*answer = str;
else
*answer = SCM_BOOL_F;
return stat;
}
#ifdef __STDC__
static GSCM_status
gscm_cstr (char ** answer, SCM obj)
#else
static GSCM_status
gscm_cstr (answer, obj)
char ** answer;
SCM obj;
#endif
{
GSCM_status stat;
*answer = (char *)malloc (SCM_LENGTH (obj));
stat = GSCM_OK;
if (!*answer)
stat = GSCM_OUT_OF_MEM;
else
memcpy (*answer, SCM_CHARS (obj), SCM_LENGTH (obj));
return stat;
}
/* {Invoking The Interpreter}
*/
#ifdef __STDC__
static SCM
gscm_silent_repl (SCM env)
#else
static SCM
gscm_silent_repl (env)
SCM env;
#endif
{
SCM source;
SCM answer;
answer = SCM_UNSPECIFIED;
while ((source = scm_read (SCM_UNDEFINED, SCM_UNDEFINED, SCM_UNDEFINED)) != SCM_EOF_VAL)
answer = scm_eval_x (source);
return answer;
}
#ifdef _UNICOS
typedef int setjmp_type;
#else
typedef long setjmp_type;
#endif
#ifdef __STDC__
static GSCM_status
_eval_port (SCM * answer, GSCM_top_level toplvl, SCM port, int printp)
#else
static GSCM_status
_eval_port (answer, toplvl, port, printp)
SCM * answer;
GSCM_top_level toplvl;
SCM port;
int printp;
#endif
{
SCM saved_inp;
GSCM_status status;
setjmp_type i;
static int deja_vu = 0;
SCM ignored;
if (deja_vu)
return GSCM_ILLEGALLY_REENTERED;
++deja_vu;
/* Take over signal handlers for all the interesting signals.
*/
scm_init_signals ();
/* Default return values:
*/
if (!answer)
answer = &ignored;
status = GSCM_OK;
*answer = SCM_BOOL_F;
/* Perform evalutation under a new dynamic root.
*
*/
SCM_BASE (scm_rootcont) = (SCM_STACKITEM *) & i;
#ifdef DEBUG_EXTENSIONS
SCM_DFRAME (scm_rootcont) = last_debug_info_frame = 0;
#endif
saved_inp = scm_cur_inp;
i = setjmp (SCM_JMPBUF (scm_rootcont));
#ifdef SCM_STACK_CHECK
scm_check_stack_p = 1;
#endif
if (!i)
{
scm_gc_heap_lock = 0;
scm_ints_disabled = 0;
/* need to close loading files here. */
scm_cur_inp = port;
{
SCM top_env;
top_env = SCM_EOL;
*answer = gscm_silent_repl (top_env);
}
scm_cur_inp = saved_inp;
if (printp)
status = gscm_strprint_obj (answer, *answer);
}
else
{
scm_cur_inp = saved_inp;
*answer = scm_exitval;
if (printp)
gscm_strprint_obj (answer, *answer);
status = GSCM_ERROR;
}
scm_gc_heap_lock = 1;
scm_ints_disabled = 1;
scm_restore_signals ();
--deja_vu;
return status;
}
#ifdef __STDC__
static GSCM_status
seval_str (SCM *answer, GSCM_top_level toplvl, char * str)
#else
static GSCM_status
seval_str (answer, toplvl, str)
SCM *answer;
GSCM_top_level toplvl;
char * str;
#endif
{
SCM scheme_str;
SCM port;
GSCM_status status;
scheme_str = scm_makfromstr (str, strlen (str), 0);
port = scm_mkstrport (SCM_MAKINUM (0), scheme_str, SCM_OPN | SCM_RDNG, "gscm_seval_str");
status = _eval_port (answer, toplvl, port, 0);
return status;
}
#ifdef __STDC__
GSCM_status
gscm_seval_str (SCM *answer, GSCM_top_level toplvl, char * str)
#else
GSCM_status
gscm_seval_str (answer, toplvl, str)
SCM *answer;
GSCM_top_level toplvl;
char * str;
#endif
{
SCM_STACKITEM i;
GSCM_status status;
scm_stack_base = &i;
status = seval_str (answer, toplvl, str);
scm_stack_base = 0;
return status;
}
#ifdef __STDC__
void
format_load_command (char * buf, char *file_name)
#else
void
format_load_command (buf, file_name)
char * buf;
char *file_name;
#endif
{
char quoted_name[MAXPATHLEN + 1];
int source;
int dest;
for (source = dest = 0; file_name[source]; ++source)
{
if (file_name[source] == '"')
quoted_name[dest++] = '\\';
quoted_name[dest++] = file_name[source];
}
quoted_name[dest] = 0;
sprintf (buf, "(%%try-load \"%s\")", quoted_name);
}
#ifdef __STDC__
GSCM_status
gscm_seval_file (SCM *answer, GSCM_top_level toplvl, char * file_name)
#else
GSCM_status
gscm_seval_file (answer, toplvl, file_name)
SCM *answer;
GSCM_top_level toplvl;
char * file_name;
#endif
{
char command[MAXPATHLEN * 3];
format_load_command (command, file_name);
return gscm_seval_str (answer, toplvl, command);
}
#ifdef __STDC__
static GSCM_status
eval_str (char ** answer, GSCM_top_level toplvl, char * str)
#else
static GSCM_status
eval_str (answer, toplvl, str)
char ** answer;
GSCM_top_level toplvl;
char * str;
#endif
{
SCM sanswer;
SCM scheme_str;
SCM port;
GSCM_status status;
scheme_str = scm_makfromstr (str, strlen (str), 0);
port = scm_mkstrport (SCM_MAKINUM(0), scheme_str, SCM_OPN | SCM_RDNG, "gscm_eval_str");
status = _eval_port (&sanswer, toplvl, port, 1);
if (answer)
{
if (status == GSCM_OK)
status = gscm_cstr (answer, sanswer);
else
*answer = 0;
}
return status;
}
#ifdef __STDC__
GSCM_status
gscm_eval_str (char ** answer, GSCM_top_level toplvl, char * str)
#else
GSCM_status
gscm_eval_str (answer, toplvl, str)
char ** answer;
GSCM_top_level toplvl;
char * str;
#endif
{
SCM_STACKITEM i;
GSCM_status status;
scm_stack_base = &i;
status = eval_str (answer, toplvl, str);
scm_stack_base = 0;
return status;
}
#ifdef __STDC__
GSCM_status
gscm_eval_file (char ** answer, GSCM_top_level toplvl, char * file_name)
#else
GSCM_status
gscm_eval_file (answer, toplvl, file_name)
char ** answer;
GSCM_top_level toplvl;
char * file_name;
#endif
{
char command[MAXPATHLEN * 3];
format_load_command (command, file_name);
return gscm_eval_str (answer, toplvl, command);
}
/* {Error Messages}
*/
#ifdef __GNUC__
# define AT(X) [X] =
#else
# define AT(X)
#endif
static char * gscm_error_msgs[] =
{
AT(GSCM_OK) "No error.",
AT(GSCM_ERROR) "ERROR in init file.",
AT(GSCM_ILLEGALLY_REENTERED) "Gscm function was illegally reentered.",
AT(GSCM_OUT_OF_MEM) "Out of memory.",
AT(GSCM_ERROR_OPENING_FILE) "Error opening file.",
AT(GSCM_ERROR_OPENING_INIT_FILE) "Error opening init file."
};
#ifdef __STDC__
char *
gscm_error_msg (int n)
#else
char *
gscm_error_msg (n)
int n;
#endif
{
if ((n < 0) || (n > (sizeof (gscm_error_msgs) / sizeof (char *))))
return "Unrecognized error.";
else
return gscm_error_msgs[n];
}
/* {Defining New Procedures}
*/
#ifdef __STDC__
SCM
gscm_make_subr (SCM (*fn)(), int req, int opt, int varp, char * doc)
#else
SCM
gscm_make_subr (fn, req, opt, varp, doc)
SCM (*fn)();
int req;
int opt;
int varp;
char * doc;
#endif
{
return scm_make_gsubr ("*anonymous*", req, opt, varp, fn);
}
#ifdef __STDC__
int
gscm_2_char (SCM c)
#else
int
gscm_2_char (c)
SCM c;
#endif
{
SCM_ASSERT (SCM_ICHRP (c), c, SCM_ARG1, "gscm_2_char");
return SCM_ICHR (c);
}
#ifdef __STDC__
void
gscm_2_str (char ** out, int * len_out, SCM * objp)
#else
void
gscm_2_str (out, len_out, objp)
char ** out;
int * len_out;
SCM * objp;
#endif
{
SCM_ASSERT (SCM_NIMP (*objp) && SCM_STRINGP (*objp), *objp, SCM_ARG3, "gscm_2_str");
if (out)
*out = SCM_CHARS (*objp);
if (len_out)
*len_out = SCM_LENGTH (*objp);
}
#ifdef __STDC__
void
gscm_error (char * message, SCM args)
#else
void
gscm_error (message, args)
char * message;
SCM args;
#endif
{
SCM errsym;
SCM str;
errsym = SCM_CAR (scm_intern ("error", 5));
str = scm_makfrom0str (message);
scm_throw (errsym, scm_cons (str, args));
}
#ifdef __STDC__
GSCM_status
gscm_run_scm (int argc, char ** argv, FILE * in, FILE * out, FILE * err, GSCM_status (*initfn)(), char * initfile, char * initcmd)
#else
GSCM_status
gscm_run_scm (argc, argv, in, out, err, initfn, initfile, initcmd)
int argc;
char ** argv;
FILE * in;
FILE * out;
FILE * err;
GSCM_status (*initfn)();
char * initfile;
char * initcmd;
#endif
{
SCM_STACKITEM i;
GSCM_status status;
GSCM_top_level top;
scm_ports_prehistory ();
scm_smob_prehistory ();
scm_tables_prehistory ();
scm_init_storage (0);
scm_start_stack (&i, in, out, err);
scm_init_gsubr ();
scm_init_curry ();
scm_init_feature ();
/* scm_init_debug (); */
scm_init_alist ();
scm_init_append ();
scm_init_arbiters ();
scm_init_async ();
scm_init_boolean ();
scm_init_chars ();
scm_init_continuations ();
scm_init_dynwind ();
scm_init_eq ();
scm_init_error ();
scm_init_fports ();
scm_init_files ();
scm_init_gc ();
scm_init_hash ();
scm_init_hashtab ();
scm_init_kw ();
scm_init_list ();
scm_init_lvectors ();
scm_init_numbers ();
scm_init_pairs ();
scm_init_ports ();
scm_init_procs ();
scm_init_procprop ();
scm_init_scmsigs ();
scm_init_stackchk ();
scm_init_strports ();
scm_init_struct ();
scm_init_symbols ();
scm_init_load ();
scm_init_print ();
scm_init_read ();
scm_init_sequences ();
scm_init_stime ();
scm_init_strings ();
scm_init_strorder ();
scm_init_mbstrings ();
scm_init_strop ();
scm_init_throw ();
scm_init_variable ();
scm_init_vectors ();
scm_init_weaks ();
scm_init_vports ();
scm_init_eval ();
scm_init_ramap ();
scm_init_unif ();
scm_init_simpos ();
scm_init_elisp ();
scm_init_mallocs ();
scm_init_cnsvobj ();
scm_init_guile ();
initfn ();
/* Save the argument list to be the return value of (program-arguments).
*/
scm_progargs = scm_makfromstrs (argc, argv);
scm_gc_heap_lock = 0;
errno = 0;
scm_ints_disabled = 1;
/* init_basic (); */
/* init_init(); */
if (initfile == NULL)
{
initfile = getenv ("GUILE_INIT_PATH");
if (initfile == NULL)
initfile = SCM_IMPLINIT;
}
if (initfile == NULL)
{
status = GSCM_OK;
}
else
{
SCM answer;
status = gscm_seval_file (&answer, -1, initfile);
if ((status == GSCM_OK) && (answer == SCM_BOOL_F))
status = GSCM_ERROR_OPENING_INIT_FILE;
}
top = SCM_EOL;
if (status == GSCM_OK)
{
scm_sysintern ("*stdin*", scm_cur_inp);
status = gscm_seval_str (0, top, initcmd);
}
return status;
}
#ifdef __STDC__
void
scm_init_guile (void)
#else
void
scm_init_guile ()
#endif
{
#include "gscm.x"
}

297
libguile/gscm.h Normal file
View file

@ -0,0 +1,297 @@
/* classes: h_files */
#ifndef GSCMH
#define GSCMH
/* Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "libguile.h"
/* {Locking Out Async Execution (including async GC) and Non-Local Exits}
*/
#define GSCM_DEFER_INTS SCM_DEFER_INTS
#define GSCM_ALLOW_INTS SCM_ALLOW_INTS
/* {Common Constants}
*/
#define GSCM_EOL SCM_EOL
#define GSCM_FALSE SCM_BOOL_F
#define GSCM_TRUE SCM_BOOL_T
#define GSCM_EOL_MARKER SCM_UNDEFINED
#define GSCM_NOT_PASSED SCM_UNDEFINED
#define GSCM_UNSPECIFIED SCM_UNSPECIFIED
/* {Booleans}
*/
#define gscm_bool(CBOOL) ((CBOOL) ? SCM_BOOL_T : SCM_BOOL_F)
#define gscm_2_bool(BOOL) (((BOOL) == SCM_BOOL_F) ? 0 : 1)
/* {Numbers}
*/
#define gscm_ulong scm_ulong2num
#define gscm_long scm_long2num
#define gscm_double(X) scm_makdbl ((X), 0.0)
#define gscm_2_ulong(OBJ) scm_num2ulong((OBJ), (char *)SCM_ARG1, "gscm_2_ulong")
#define gscm_2_long(OBJ) scm_num2long((OBJ), (char *)SCM_ARG1, "gscm_2_long")
#define gscm_2_double(OBJ) scm_num2dbl((OBJ), "gscm_2_double")
/* {Characters}
*/
#define gscm_char(C) SCM_MAKICHR(C)
/* extern int gscm_2_char P((SCM)); */
/* {Strings}
*/
#define gscm_str(SRC, LEN) scm_makfromstr (SRC, LEN, 0)
#define gscm_str0 scm_makfrom0str
/* {Pairs and Lists}
*/
#define gscm_cons scm_cons
#define gscm_list scm_listify
#define gscm_ilength scm_ilength
#define gscm_set_car(OBJ, VAL) \
((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
? (SCM_CAR(OBJ) = VAL) \
: scm_wta ((OBJ), (char *)SCM_ARG1, "set-car!"))
#define gscm_set_cdr(OBJ, VAL) \
((SCM_NIMP(OBJ) && SCM_CONSP(OBJ)) \
? (SCM_CDR(OBJ) = VAL) \
: scm_wta ((OBJ), (char *)SCM_ARG1, "set-cdr!"))
#define GSCM_SAFE_CAR(X) ((SCM_NIMP(X) && SCM_CONSP(X)) \
? SCM_CAR(X) \
: scm_wta ((X), (char *)SCM_ARG1, "car"))
#define GSCM_SAFE_CDR(X) ((SCM_NIMP(X) && SCM_CONSP(X)) \
? SCM_CDR(X) \
: scm_wta ((X), (char *)SCM_ARG1, "cdr"))
#define gscm_car(OBJ) GSCM_SAFE_CAR (OBJ)
#define gscm_cdr(OBJ) GSCM_SAFE_CDR (OBJ)
#define gscm_caar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))
#define gscm_cdar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))
#define gscm_cadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))
#define gscm_cddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))
#define gscm_caaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))
#define gscm_cdaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ)))
#define gscm_cadar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))
#define gscm_cddar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ)))
#define gscm_caadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))
#define gscm_cdadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ)))
#define gscm_caddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))
#define gscm_cdddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ)))
#define gscm_caaaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
#define gscm_cdaaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
#define gscm_cadaar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
#define gscm_cddaar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (OBJ))))
#define gscm_caadar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
#define gscm_cdadar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
#define gscm_caddar(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
#define gscm_cdddar(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (OBJ))))
#define gscm_caaadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
#define gscm_cdaadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
#define gscm_cadadr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
#define gscm_cddadr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (OBJ))))
#define gscm_caaddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
#define gscm_cdaddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
#define gscm_cadddr(OBJ) GSCM_SAFE_CAR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
#define gscm_cddddr(OBJ) GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (GSCM_SAFE_CDR (OBJ))))
/* {Symbols}
*/
#define gscm_symbol(STR, LEN) SCM_CAR(scm_intern (STR, LEN))
#define gscm_tmp_symbol(STR, LEN) SCM_CAR(scm_intern_obarray (STR, LEN, SCM_BOOL_F))
/* {Vectors}
*/
#define gscm_vector(N, FILL) scm_make_vector (SCM_MAKINUM(N), (FILL), SCM_UNDEFINED)
#define gscm_vref(V, I) scm_vector_ref ((V), SCM_MAKINUM(I))
#define gscm_vset(V, I, VAL) scm_vector_set_x ((V), SCM_MAKINUM(I), (VAL))
/* {Procedures}
*/
/* extern SCM gscm_make_subr P((SCM (*fn)(), int req, int opt, int varp, char * doc)); */
/* extern SCM gscm_curry P((SCM procedure, SCM first_arg)); */
#define gscm_apply(PROC, ARGS) scm_apply ((PROC), (ARGS), SCM_EOL)
/* {Non-local Exits}
*/
#define gscm_catch(T, TH, H) scm_catch ((T), (TH), (H))
#define gscm_throw(T, V) scm_throw ((T), (V))
#define gscm_dynamic_wind(E, T, L) scm_dynwind ((E), (T), (L))
/* extern void gscm_error P((char * message, SCM args)); */
/* {I/O}
*/
#define gscm_print_obj scm_iprin1
#define gscm_putc scm_putc
#define gscm_puts scm_puts
#define gscm_fwrite scm_fwrite
#define gscm_flush scm_flush
extern char * gscm_last_attempted_init_file;
/* {Equivalence}
*/
#define gscm_is_eq(OBJ) (SCM_BOOL_F != scm_eq (OBJ))
#define gscm_is_eqv(OBJ) (SCM_BOOL_F != scm_eqv (OBJ))
#define gscm_is_equal(OBJ) (SCM_BOOL_F != scm_equal_p (OBJ))
/* {Procedure Properties}
*/
#define gscm_procedure_properties scm_procedure_properties
#define gscm_set_procedure_properties_x scm_set_procedure_properties_x
#define gscm_procedure_property scm_procedure_property
#define gscm_set_procedure_property_x scm_set_procedure_property_x
/* {Generic Length Procedure}
*/
#define gscm_obj_length scm_obj_length
/* {Proc Declaration Macro}
*/
#ifndef GSCM_MAGIC_SNARFER
#define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR) \
static char RANAME[]=STR;
#else
#define GSCM_PROC(RANAME, CFN, STR, REQ, OPT, VAR) \
%%% gscm_define_procedure (RANAME, CFN, REQ, OPT, VAR, "")
#endif
#define gscm_define_procedure(NAME, FN, REQ, OPT, VARP, DOC) scm_make_gsubr(name, req, opt, varp, fn)
#define gscm_curry scm_curry
#define gscm_define scm_sysintern
typedef int GSCM_top_level;
/* {Error Returns}
*/
typedef int GSCM_status;
#define GSCM_OK 0
#define GSCM_ERROR 1
#define GSCM_ILLEGALLY_REENTERED 2
#define GSCM_OUT_OF_MEM 3
#define GSCM_ERROR_OPENING_FILE 4
#define GSCM_ERROR_OPENING_INIT_FILE 5
#ifdef __STDC__
extern GSCM_status gscm_seval_str (SCM *answer, GSCM_top_level toplvl, char * str);
extern GSCM_status gscm_seval_file (SCM *answer, GSCM_top_level toplvl, char * file_name);
extern GSCM_status gscm_eval_str (char ** answer, GSCM_top_level toplvl, char * str);
extern GSCM_status gscm_eval_file (char ** answer, GSCM_top_level toplvl, char * file_name);
extern GSCM_status gscm_run_scm (int argc, char ** argv, FILE * in, FILE * out, FILE * err, GSCM_status (*initfn)(), char * initfile, char * initcmd);
extern char * gscm_error_msg (int n);
extern SCM gscm_make_subr (SCM (*fn)(), int req, int opt, int varp, char * doc);
extern int gscm_2_char (SCM c);
extern void gscm_2_str (char ** out, int * len_out, SCM * objp);
extern void gscm_error (char * message, SCM args);
extern void scm_init_guile (void);
#else /* STDC */
extern GSCM_status gscm_seval_str ();
extern void format_load_command ();
extern GSCM_status gscm_seval_file ();
extern GSCM_status gscm_eval_str ();
extern GSCM_status gscm_eval_file ();
extern char * gscm_error_msg ();
extern SCM gscm_make_subr ();
extern int gscm_2_char ();
extern void gscm_2_str ();
extern void gscm_error ();
extern GSCM_status gscm_run_scm ();
extern void scm_init_guile ();
#endif /* STDC */
#endif /* GSCMH */

195
libguile/gsubr.c Normal file
View file

@ -0,0 +1,195 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
/*
* gsubr.c
* Provide `gsubrs' -- subrs taking a prescribed number of required, optional,
* and rest arguments.
*/
#include "gsubr.h"
#define GSUBR_TEST 1
#define GSUBR_MAKTYPE(req, opt, rst) ((req)|((opt)<<4)|((rst)<<8))
#define GSUBR_REQ(x) ((int)(x)&0xf)
#define GSUBR_OPT(x) (((int)(x)&0xf0)>>4)
#define GSUBR_REST(x) ((int)(x)>>8)
#define GSUBR_MAX 10
#define GSUBR_TYPE(cclo) (SCM_VELTS(cclo)[1])
#define GSUBR_PROC(cclo) (SCM_VELTS(cclo)[2])
static SCM f_gsubr_apply;
#ifdef __STDC__
SCM
scm_make_gsubr(char *name, int req, int opt, int rst, SCM (*fcn)())
#else
SCM
scm_make_gsubr(name, req, opt, rst, fcn)
char *name;
int req;
int opt;
int rst;
SCM (*fcn)();
#endif
{
switch GSUBR_MAKTYPE(req, opt, rst) {
case GSUBR_MAKTYPE(0, 0, 0): return scm_make_subr(name, scm_tc7_subr_0, fcn);
case GSUBR_MAKTYPE(1, 0, 0): return scm_make_subr(name, scm_tc7_subr_1, fcn);
case GSUBR_MAKTYPE(0, 1, 0): return scm_make_subr(name, scm_tc7_subr_1o, fcn);
case GSUBR_MAKTYPE(1, 1, 0): return scm_make_subr(name, scm_tc7_subr_2o, fcn);
case GSUBR_MAKTYPE(2, 0, 0): return scm_make_subr(name, scm_tc7_subr_2, fcn);
case GSUBR_MAKTYPE(3, 0, 0): return scm_make_subr(name, scm_tc7_subr_3, fcn);
case GSUBR_MAKTYPE(0, 0, 1): return scm_make_subr(name, scm_tc7_lsubr, fcn);
case GSUBR_MAKTYPE(2, 0, 1): return scm_make_subr(name, scm_tc7_lsubr_2, fcn);
default:
{
SCM symcell = scm_sysintern(name, SCM_UNDEFINED);
SCM z, cclo = scm_makcclo(f_gsubr_apply, 3L);
long tmp = ((((SCM_CELLPTR)(SCM_CAR(symcell)))-scm_heap_org)<<8);
if (GSUBR_MAX < req + opt + rst) {
fputs("ERROR in scm_make_gsubr: too many args\n", stderr);
exit (1);
}
if ((tmp>>8) != ((SCM_CELLPTR)(SCM_CAR(symcell))-scm_heap_org))
tmp = 0;
SCM_NEWCELL(z);
SCM_SUBRF(z) = fcn;
SCM_CAR(z) = tmp + scm_tc7_subr_0;
GSUBR_PROC(cclo) = z;
GSUBR_TYPE(cclo) = SCM_MAKINUM(GSUBR_MAKTYPE(req, opt, rst));
SCM_CDR(symcell) = cclo;
return cclo;
}
}
}
SCM_PROC(s_gsubr_apply, "gsubr-apply", 0, 0, 1, scm_gsubr_apply);
#ifdef __STDC__
SCM
scm_gsubr_apply(SCM args)
#else
SCM
scm_gsubr_apply(args)
SCM args;
#endif
{
SCM self = SCM_CAR(args);
SCM (*fcn)() = SCM_SUBRF(GSUBR_PROC(self));
SCM v[10]; /* must agree with greatest supported arity */
int typ = SCM_INUM(GSUBR_TYPE(self));
int i, n = GSUBR_REQ(typ) + GSUBR_OPT(typ) + GSUBR_REST(typ);
args = SCM_CDR(args);
for (i = 0; i < GSUBR_REQ(typ); i++) {
#ifndef RECKLESS
if (SCM_IMP(args))
scm_wta(SCM_UNDEFINED, (char *)SCM_WNA, SCM_CHARS(SCM_SNAME(GSUBR_PROC(self))));
#endif
v[i] = SCM_CAR(args);
args = SCM_CDR(args);
}
for (; i < GSUBR_REQ(typ) + GSUBR_OPT(typ); i++) {
if (SCM_NIMP(args)) {
v[i] = SCM_CAR(args);
args = SCM_CDR(args);
}
else
v[i] = SCM_UNDEFINED;
}
if (GSUBR_REST(typ))
v[i] = args;
switch (n) {
default: scm_wta(self, "internal programming error", s_gsubr_apply);
case 2: return (*fcn)(v[0], v[1]);
case 3: return (*fcn)(v[0], v[1], v[2]);
case 4: return (*fcn)(v[0], v[1], v[2], v[3]);
case 5: return (*fcn)(v[0], v[1], v[2], v[3], v[4]);
case 6: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5]);
case 7: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6]);
case 8: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7]);
case 9: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8]);
case 10: return (*fcn)(v[0], v[1], v[2], v[3], v[4], v[5], v[6], v[7], v[8], v[9]);
}
}
#ifdef GSUBR_TEST
/* A silly example, taking 2 required args, 1 optional, and
a scm_list of rest args
*/
SCM
gsubr_21l(req1, req2, opt, rst)
SCM req1, req2, opt, rst;
{
scm_gen_puts (scm_regular_string, "gsubr-2-1-l:\n req1: ", scm_cur_outp);
scm_display(req1, scm_cur_outp);
scm_gen_puts (scm_regular_string, "\n req2: ", scm_cur_outp);
scm_display(req2, scm_cur_outp);
scm_gen_puts (scm_regular_string, "\n opt: ", scm_cur_outp);
scm_display(opt, scm_cur_outp);
scm_gen_puts (scm_regular_string, "\n rest: ", scm_cur_outp);
scm_display(rst, scm_cur_outp);
scm_newline(scm_cur_outp);
return SCM_UNSPECIFIED;
}
#endif
#ifdef __STDC__
void
scm_init_gsubr(void)
#else
void
scm_init_gsubr()
#endif
{
f_gsubr_apply = scm_make_subr(s_gsubr_apply, scm_tc7_lsubr, scm_gsubr_apply);
#ifdef GSUBR_TEST
scm_make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */
#endif
}

65
libguile/gsubr.h Normal file
View file

@ -0,0 +1,65 @@
/* classes: h_files */
#ifndef GSUBRH
#define GSUBRH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_make_gsubr(char *name, int req, int opt, int rst, SCM (*fcn)());
extern SCM scm_gsubr_apply(SCM args);
extern void scm_init_gsubr(void);
#else /* STDC */
extern SCM scm_make_gsubr();
extern SCM scm_gsubr_apply();
extern void scm_init_gsubr();
#endif /* STDC */
#endif /* GSUBRH */

252
libguile/hash.c Normal file
View file

@ -0,0 +1,252 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifndef floor
extern double floor();
#endif
#ifdef __STDC__
unsigned long
scm_hasher(SCM obj, unsigned long n, scm_sizet d)
#else
unsigned long
scm_hasher(obj, n, d)
SCM obj;
unsigned long n;
scm_sizet d;
#endif
{
switch (7 & (int) obj) {
case 2: case 6: /* SCM_INUMP(obj) */
return SCM_INUM(obj) % n;
case 4:
if SCM_ICHRP(obj)
return (unsigned)(scm_downcase(SCM_ICHR(obj))) % n;
switch ((int) obj) {
#ifndef SICP
case (int) SCM_EOL: d = 256; break;
#endif
case (int) SCM_BOOL_T: d = 257; break;
case (int) SCM_BOOL_F: d = 258; break;
case (int) SCM_EOF_VAL: d = 259; break;
default: d = 263; /* perhaps should be error */
}
return d % n;
default: return 263 % n; /* perhaps should be error */
case 0:
switch SCM_TYP7(obj) {
default: return 263 % n;
case scm_tc7_smob:
switch SCM_TYP16(obj) {
case scm_tcs_bignums:
bighash: return SCM_INUM(scm_modulo(obj, SCM_MAKINUM(n)));
default: return 263 % n;
#ifdef SCM_FLOATS
case scm_tc16_flo:
if SCM_REALP(obj) {
double r = SCM_REALPART(obj);
if (floor(r)==r) {
obj = scm_inexact_to_exact (obj);
if SCM_IMP(obj) return SCM_INUM(obj) % n;
goto bighash;
}
}
obj = scm_number_to_string(obj, SCM_MAKINUM(10));
#endif
}
case scm_tcs_symbols:
case scm_tc7_string:
case scm_tc7_mb_string:
case scm_tc7_substring:
case scm_tc7_mb_substring:
return scm_strhash(SCM_ROUCHARS(obj), (scm_sizet) SCM_ROLENGTH(obj), n);
case scm_tc7_wvect:
case scm_tc7_vector:
{
scm_sizet len = SCM_LENGTH(obj);
SCM *data = SCM_VELTS(obj);
if (len>5)
{
scm_sizet i = d/2;
unsigned long h = 1;
while (i--) h = ((h<<8) + (scm_hasher(data[h % len], n, 2))) % n;
return h;
}
else
{
scm_sizet i = len;
unsigned long h = (n)-1;
while (i--) h = ((h<<8) + (scm_hasher(data[i], n, d/len))) % n;
return h;
}
}
case scm_tcs_cons_imcar: case scm_tcs_cons_nimcar:
if (d) return (scm_hasher(SCM_CAR(obj), n, d/2)+scm_hasher(SCM_CDR(obj), n, d/2)) % n;
else return 1;
case scm_tc7_port:
return ((SCM_RDNG & SCM_CAR(obj)) ? 260 : 261) % n;
case scm_tcs_closures: case scm_tc7_contin: case scm_tcs_subrs:
return 262 % n;
}
}
}
#ifdef __STDC__
unsigned int
scm_ihashq (SCM obj, unsigned int n)
#else
unsigned int
scm_ihashq (obj, n)
SCM obj;
unsigned int n;
#endif
{
return (((unsigned int) obj) >> 1) % n;
}
SCM_PROC(s_hashq, "hashq", 2, 0, 0, scm_hashq);
#ifdef __STDC__
SCM
scm_hashq(SCM obj, SCM n)
#else
SCM
scm_hashq(obj, n)
SCM obj;
SCM n;
#endif
{
SCM_ASSERT(SCM_INUMP(n) && 0 <= n, n, SCM_ARG2, s_hashq);
return SCM_MAKINUM(scm_ihashq (obj, SCM_INUM (n)));
}
#ifdef __STDC__
unsigned int
scm_ihashv (SCM obj, unsigned int n)
#else
unsigned int
scm_ihashv (obj, n)
SCM obj;
unsigned int n;
#endif
{
if (SCM_ICHRP(obj))
return ((unsigned int)(scm_downcase(SCM_ICHR(obj)))) % n; /* downcase!?!! */
if (SCM_NIMP(obj) && SCM_NUMP(obj))
return (unsigned int) scm_hasher(obj, n, 10);
else
return ((unsigned int)obj) % n;
}
SCM_PROC(s_hashv, "hashv", 2, 0, 0, scm_hashv);
#ifdef __STDC__
SCM
scm_hashv(SCM obj, SCM n)
#else
SCM
scm_hashv(obj, n)
SCM obj;
SCM n;
#endif
{
SCM_ASSERT(SCM_INUMP(n) && 0 <= n, n, SCM_ARG2, s_hashv);
return SCM_MAKINUM(scm_ihashv (obj, SCM_INUM (n)));
}
#ifdef __STDC__
unsigned int
scm_ihash (SCM obj, unsigned int n)
#else
unsigned int
scm_ihash (obj, n)
SCM obj;
unsigned int n;
#endif
{
return (unsigned int)scm_hasher (obj, n, 10);
}
SCM_PROC(s_hash, "hash", 2, 0, 0, scm_hash);
#ifdef __STDC__
SCM
scm_hash(SCM obj, SCM n)
#else
SCM
scm_hash(obj, n)
SCM obj;
SCM n;
#endif
{
SCM_ASSERT(SCM_INUMP(n) && 0 <= n, n, SCM_ARG2, s_hash);
return SCM_MAKINUM(scm_ihash(obj, SCM_INUM(n)));
}
#ifdef __STDC__
void
scm_init_hash (void)
#else
void
scm_init_hash ()
#endif
{
#include "hash.x"
}

77
libguile/hash.h Normal file
View file

@ -0,0 +1,77 @@
/* classes: h_files */
#ifndef HASHH
#define HASHH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern unsigned long scm_hasher(SCM obj, unsigned long n, scm_sizet d);
extern unsigned int scm_ihashq (SCM obj, unsigned int n);
extern SCM scm_hashq(SCM obj, SCM n);
extern unsigned int scm_ihashv (SCM obj, unsigned int n);
extern SCM scm_hashv(SCM obj, SCM n);
extern unsigned int scm_ihash (SCM obj, unsigned int n);
extern SCM scm_hash(SCM obj, SCM n);
extern void scm_init_hash (void);
#else /* STDC */
extern unsigned long scm_hasher();
extern unsigned int scm_ihashq ();
extern SCM scm_hashq();
extern unsigned int scm_ihashv ();
extern SCM scm_hashv();
extern unsigned int scm_ihash ();
extern SCM scm_hash();
extern void scm_init_hash ();
#endif /* STDC */
#endif /* HASHH */

651
libguile/hashtab.c Normal file
View file

@ -0,0 +1,651 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifdef __STDC__
SCM
scm_hash_fn_get_handle (SCM table, SCM obj, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
#else
SCM
scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure)
SCM table;
SCM obj;
unsigned int (*hash_fn)();
SCM (*assoc_fn)();
void * closure;
#endif
{
int k;
SCM h;
SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_get_handle");
if (SCM_LENGTH (table) == 0)
return SCM_EOL;
k = hash_fn (obj, SCM_LENGTH (table), closure);
SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
SCM_MAKINUM (k),
SCM_OUTOFRANGE,
"hash_fn_get_handle");
h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
return h;
}
#ifdef __STDC__
SCM
scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
#else
SCM
scm_hash_fn_create_handle_x (table, obj, init, hash_fn, assoc_fn, closure)
SCM table;
SCM obj;
SCM init;
unsigned int (*hash_fn)();
SCM (*assoc_fn)();
void * closure;
#endif
{
int k;
SCM it;
SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_create_handle_x");
if (SCM_LENGTH (table) == 0)
return SCM_EOL;
k = hash_fn (obj, SCM_LENGTH (table), closure);
SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
SCM_MAKINUM (k),
SCM_OUTOFRANGE,
"hash_fn_create_handle_x");
SCM_REDEFER_INTS;
it = assoc_fn (obj, SCM_VELTS (table)[k], closure);
if (SCM_NIMP (it))
{
return it;
}
{
SCM new_bucket;
SCM old_bucket;
old_bucket = SCM_VELTS (table)[k];
new_bucket = scm_acons (obj, init, old_bucket);
SCM_VELTS(table)[k] = new_bucket;
SCM_REALLOW_INTS;
return SCM_CAR (new_bucket);
}
}
#ifdef __STDC__
SCM
scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
#else
SCM
scm_hash_fn_ref (table, obj, dflt, hash_fn, assoc_fn, closure)
SCM table;
SCM obj;
SCM dflt;
unsigned int (*hash_fn)();
SCM (*assoc_fn)();
void * closure;
#endif
{
SCM it;
it = scm_hash_fn_get_handle (table, obj, hash_fn, assoc_fn, closure);
if (SCM_IMP (it))
return dflt;
else
return SCM_CDR (it);
}
#ifdef __STDC__
SCM
scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure)
#else
SCM
scm_hash_fn_set_x (table, obj, val, hash_fn, assoc_fn, closure)
SCM table;
SCM obj;
SCM val;
unsigned int (*hash_fn)();
SCM (*assoc_fn)();
void * closure;
#endif
{
SCM it;
it = scm_hash_fn_create_handle_x (table, obj, SCM_BOOL_F, hash_fn, assoc_fn, closure);
SCM_SETCDR (it, val);
return val;
}
#ifdef __STDC__
SCM
scm_hash_fn_remove_x (SCM table,
SCM obj,
unsigned int (*hash_fn)(),
SCM (*assoc_fn)(),
SCM (*delete_fn)(),
void * closure)
#else
SCM
scm_hash_fn_remove_x (table, obj, hash_fn, assoc_fn, delete_fn, closure)
SCM table;
SCM obj;
unsigned int (*hash_fn)();
SCM (*assoc_fn)();
SCM (*delete_fn)();
void * closure;
#endif
{
int k;
SCM h;
SCM_ASSERT (SCM_NIMP (table) && SCM_VECTORP (table), table, SCM_ARG1, "hash_fn_remove_x");
if (SCM_LENGTH (table) == 0)
return SCM_EOL;
k = hash_fn (obj, SCM_LENGTH (table), closure);
SCM_ASSERT ((0 <= k) && (k < SCM_LENGTH (table)),
SCM_MAKINUM (k),
SCM_OUTOFRANGE,
"hash_fn_remove_x");
h = assoc_fn (obj, SCM_VELTS (table)[k], closure);
SCM_VELTS(table)[k] = delete_fn (h, SCM_VELTS(table)[k]);
return h;
}
SCM_PROC (s_hashq_get_handle, "hashq-get-handle", 2, 0, 0, scm_hashq_get_handle);
#ifdef __STDC__
SCM
scm_hashq_get_handle (SCM table, SCM obj)
#else
SCM
scm_hashq_get_handle (table, obj)
SCM table;
SCM obj;
#endif
{
return scm_hash_fn_get_handle (table, obj, scm_ihashq, scm_sloppy_assq, 0);
}
SCM_PROC (s_hashq_create_handle_x, "hashq-create-handle!", 3, 0, 0, scm_hashq_create_handle_x);
#ifdef __STDC__
SCM
scm_hashq_create_handle_x (SCM table, SCM obj, SCM init)
#else
SCM
scm_hashq_create_handle_x (table, obj, init)
SCM table;
SCM obj;
SCM init;
#endif
{
return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashq, scm_sloppy_assq, 0);
}
SCM_PROC (s_hashq_ref, "hashq-ref", 2, 1, 0, scm_hashq_ref);
#ifdef __STDC__
SCM
scm_hashq_ref (SCM table, SCM obj, SCM dflt)
#else
SCM
scm_hashq_ref (table, obj, dflt)
SCM table;
SCM obj;
SCM dflt;
#endif
{
if (dflt == SCM_UNDEFINED)
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihashq, scm_sloppy_assq, 0);
}
SCM_PROC (s_hashq_set_x, "hashq-set!", 3, 0, 0, scm_hashq_set_x);
#ifdef __STDC__
SCM
scm_hashq_set_x (SCM table, SCM obj, SCM val)
#else
SCM
scm_hashq_set_x (table, obj, val)
SCM table;
SCM obj;
SCM val;
#endif
{
return scm_hash_fn_set_x (table, obj, val, scm_ihashq, scm_sloppy_assq, 0);
}
SCM_PROC (s_hashq_remove_x, "hashq-remove!", 2, 0, 0, scm_hashq_remove_x);
#ifdef __STDC__
SCM
scm_hashq_remove_x (SCM table, SCM obj)
#else
SCM
scm_hashq_remove_x (table, obj)
SCM table;
SCM obj;
#endif
{
return scm_hash_fn_remove_x (table, obj, scm_ihashq, scm_sloppy_assq, scm_delq_x, 0);
}
SCM_PROC (s_hashv_get_handle, "hashv-get-handle", 2, 0, 0, scm_hashv_get_handle);
#ifdef __STDC__
SCM
scm_hashv_get_handle (SCM table, SCM obj)
#else
SCM
scm_hashv_get_handle (table, obj)
SCM table;
SCM obj;
#endif
{
return scm_hash_fn_get_handle (table, obj, scm_ihashv, scm_sloppy_assv, 0);
}
SCM_PROC (s_hashv_create_handle_x, "hashv-create-handle!", 3, 0, 0, scm_hashv_create_handle_x);
#ifdef __STDC__
SCM
scm_hashv_create_handle_x (SCM table, SCM obj, SCM init)
#else
SCM
scm_hashv_create_handle_x (table, obj, init)
SCM table;
SCM obj;
SCM init;
#endif
{
return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashv, scm_sloppy_assv, 0);
}
SCM_PROC (s_hashv_ref, "hashv-ref", 2, 1, 0, scm_hashv_ref);
#ifdef __STDC__
SCM
scm_hashv_ref (SCM table, SCM obj, SCM dflt)
#else
SCM
scm_hashv_ref (table, obj, dflt)
SCM table;
SCM obj;
SCM dflt;
#endif
{
if (dflt == SCM_UNDEFINED)
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihashv, scm_sloppy_assv, 0);
}
SCM_PROC (s_hashv_set_x, "hashv-set!", 3, 0, 0, scm_hashv_set_x);
#ifdef __STDC__
SCM
scm_hashv_set_x (SCM table, SCM obj, SCM val)
#else
SCM
scm_hashv_set_x (table, obj, val)
SCM table;
SCM obj;
SCM val;
#endif
{
return scm_hash_fn_set_x (table, obj, val, scm_ihashv, scm_sloppy_assv, 0);
}
SCM_PROC (s_hashv_remove_x, "hashv-remove!", 2, 0, 0, scm_hashv_remove_x);
#ifdef __STDC__
SCM
scm_hashv_remove_x (SCM table, SCM obj)
#else
SCM
scm_hashv_remove_x (table, obj)
SCM table;
SCM obj;
#endif
{
return scm_hash_fn_remove_x (table, obj, scm_ihashv, scm_sloppy_assv, scm_delv_x, 0);
}
SCM_PROC (s_hash_get_handle, "hash-get-handle", 2, 0, 0, scm_hash_get_handle);
#ifdef __STDC__
SCM
scm_hash_get_handle (SCM table, SCM obj)
#else
SCM
scm_hash_get_handle (table, obj)
SCM table;
SCM obj;
#endif
{
return scm_hash_fn_get_handle (table, obj, scm_ihash, scm_sloppy_assoc, 0);
}
SCM_PROC (s_hash_create_handle_x, "hash-create-handle!", 3, 0, 0, scm_hash_create_handle_x);
#ifdef __STDC__
SCM
scm_hash_create_handle_x (SCM table, SCM obj, SCM init)
#else
SCM
scm_hash_create_handle_x (table, obj, init)
SCM table;
SCM obj;
SCM init;
#endif
{
return scm_hash_fn_create_handle_x (table, obj, init, scm_ihash, scm_sloppy_assoc, 0);
}
SCM_PROC (s_hash_ref, "hash-ref", 2, 1, 0, scm_hash_ref);
#ifdef __STDC__
SCM
scm_hash_ref (SCM table, SCM obj, SCM dflt)
#else
SCM
scm_hash_ref (table, obj, dflt)
SCM table;
SCM obj;
SCM dflt;
#endif
{
if (dflt == SCM_UNDEFINED)
dflt = SCM_BOOL_F;
return scm_hash_fn_ref (table, obj, dflt, scm_ihash, scm_sloppy_assoc, 0);
}
SCM_PROC (s_hash_set_x, "hash-set!", 3, 0, 0, scm_hash_set_x);
#ifdef __STDC__
SCM
scm_hash_set_x (SCM table, SCM obj, SCM val)
#else
SCM
scm_hash_set_x (table, obj, val)
SCM table;
SCM obj;
SCM val;
#endif
{
return scm_hash_fn_set_x (table, obj, val, scm_ihash, scm_sloppy_assoc, 0);
}
SCM_PROC (s_hash_remove_x, "hash-remove!", 2, 0, 0, scm_hash_remove_x);
#ifdef __STDC__
SCM
scm_hash_remove_x (SCM table, SCM obj)
#else
SCM
scm_hash_remove_x (table, obj)
SCM table;
SCM obj;
#endif
{
return scm_hash_fn_remove_x (table, obj, scm_ihash, scm_sloppy_assoc, scm_delete_x, 0);
}
struct scm_ihashx_closure
{
SCM hash;
SCM assoc;
SCM delete;
};
#ifdef __STDC__
static unsigned int
scm_ihashx (SCM obj, unsigned int n, struct scm_ihashx_closure * closure)
#else
static unsigned int
scm_ihashx (obj, n, closure)
SCM obj;
unsigned int n;
struct scm_ihashx_closure * closure;
#endif
{
SCM answer;
SCM_ALLOW_INTS;
answer = scm_apply (closure->hash,
scm_listify (obj, scm_ulong2num ((unsigned long)n), SCM_UNDEFINED),
SCM_EOL);
SCM_DEFER_INTS;
return SCM_INUM (answer);
}
#ifdef __STDC__
static SCM
scm_sloppy_assx (SCM obj, SCM alist, struct scm_ihashx_closure * closure)
#else
static SCM
scm_sloppy_assx (obj, alist, closure)
SCM obj;
SCM alist;
struct scm_ihashx_closure * closure;
#endif
{
SCM answer;
SCM_ALLOW_INTS;
answer = scm_apply (closure->assoc,
scm_listify (obj, alist, SCM_UNDEFINED),
SCM_EOL);
SCM_DEFER_INTS;
return answer;
}
#ifdef __STDC__
static SCM
scm_delx_x (SCM obj, SCM alist, struct scm_ihashx_closure * closure)
#else
static SCM
scm_delx_x (obj, alist, closure)
SCM obj;
SCM alist;
struct scm_ihashx_closure * closure;
#endif
{
SCM answer;
SCM_ALLOW_INTS;
answer = scm_apply (closure->delete,
scm_listify (obj, alist, SCM_UNDEFINED),
SCM_EOL);
SCM_DEFER_INTS;
return answer;
}
SCM_PROC (s_hashx_get_handle, "hashx-get-handle", 4, 0, 0, scm_hashx_get_handle);
#ifdef __STDC__
SCM
scm_hashx_get_handle (SCM hash, SCM assoc, SCM table, SCM obj)
#else
SCM
scm_hashx_get_handle (hash, assoc, table, obj)
SCM hash;
SCM assoc;
SCM table;
SCM obj;
#endif
{
struct scm_ihashx_closure closure;
closure.hash = hash;
closure.assoc = assoc;
return scm_hash_fn_get_handle (table, obj, scm_ihashx, scm_sloppy_assx, (void *)&closure);
}
SCM_PROC (s_hashx_create_handle_x, "hashx-create-handle!", 5, 0, 0, scm_hashx_create_handle_x);
#ifdef __STDC__
SCM
scm_hashx_create_handle_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM init)
#else
SCM
scm_hashx_create_handle_x (hash, assoc, table, obj, init)
SCM hash;
SCM assoc;
SCM table;
SCM obj;
SCM init;
#endif
{
struct scm_ihashx_closure closure;
closure.hash = hash;
closure.assoc = assoc;
return scm_hash_fn_create_handle_x (table, obj, init, scm_ihashx, scm_sloppy_assx, (void *)&closure);
}
SCM_PROC (s_hashx_ref, "hashx-ref", 4, 1, 0, scm_hashx_ref);
#ifdef __STDC__
SCM
scm_hashx_ref (SCM hash, SCM assoc, SCM table, SCM obj, SCM dflt)
#else
SCM
scm_hashx_ref (hash, assoc, table, obj, dflt)
SCM hash;
SCM assoc;
SCM table;
SCM obj;
SCM dflt;
#endif
{
struct scm_ihashx_closure closure;
if (dflt == SCM_UNDEFINED)
dflt = SCM_BOOL_F;
closure.hash = hash;
closure.assoc = assoc;
return scm_hash_fn_ref (table, obj, dflt, scm_ihashx, scm_sloppy_assx, (void *)&closure);
}
SCM_PROC (s_hashx_set_x, "hashx-set!", 5, 0, 0, scm_hashx_set_x);
#ifdef __STDC__
SCM
scm_hashx_set_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM val)
#else
SCM
scm_hashx_set_x (hash, assoc, table, obj, val)
SCM hash;
SCM assoc;
SCM table;
SCM obj;
SCM val;
#endif
{
struct scm_ihashx_closure closure;
closure.hash = hash;
closure.assoc = assoc;
return scm_hash_fn_set_x (table, obj, val, scm_ihashx, scm_sloppy_assx, (void *)&closure);
}
#ifdef __STDC__
SCM
scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj)
#else
SCM
scm_hashx_remove_x (hash, assoc, delete, table, obj)
SCM hash;
SCM assoc;
SCM delete;
SCM table;
SCM obj;
#endif
{
struct scm_ihashx_closure closure;
closure.hash = hash;
closure.assoc = assoc;
closure.delete = delete;
return scm_hash_fn_remove_x (table, obj, scm_ihashx, scm_sloppy_assx, scm_delx_x, 0);
}
#ifdef __STDC__
void
scm_init_hashtab (void)
#else
void
scm_init_hashtab ()
#endif
{
#include "hashtab.x"
}

118
libguile/hashtab.h Normal file
View file

@ -0,0 +1,118 @@
/* classes: h_files */
#ifndef HASHTABH
#define HASHTABH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#ifdef __STDC__
extern SCM scm_hash_fn_get_handle (SCM table, SCM obj, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure);
extern SCM scm_hash_fn_create_handle_x (SCM table, SCM obj, SCM init, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure);
extern SCM scm_hash_fn_ref (SCM table, SCM obj, SCM dflt, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure);
extern SCM scm_hash_fn_set_x (SCM table, SCM obj, SCM val, unsigned int (*hash_fn)(), SCM (*assoc_fn)(), void * closure);
extern SCM scm_hash_fn_remove_x (SCM table,
SCM obj,
unsigned int (*hash_fn)(),
SCM (*assoc_fn)(),
SCM (*delete_fn)(),
void * closure);
extern SCM scm_hashq_get_handle (SCM table, SCM obj);
extern SCM scm_hashq_create_handle_x (SCM table, SCM obj, SCM init);
extern SCM scm_hashq_ref (SCM table, SCM obj, SCM dflt);
extern SCM scm_hashq_set_x (SCM table, SCM obj, SCM val);
extern SCM scm_hashq_remove_x (SCM table, SCM obj);
extern SCM scm_hashv_get_handle (SCM table, SCM obj);
extern SCM scm_hashv_create_handle_x (SCM table, SCM obj, SCM init);
extern SCM scm_hashv_ref (SCM table, SCM obj, SCM dflt);
extern SCM scm_hashv_set_x (SCM table, SCM obj, SCM val);
extern SCM scm_hashv_remove_x (SCM table, SCM obj);
extern SCM scm_hash_get_handle (SCM table, SCM obj);
extern SCM scm_hash_create_handle_x (SCM table, SCM obj, SCM init);
extern SCM scm_hash_ref (SCM table, SCM obj, SCM dflt);
extern SCM scm_hash_set_x (SCM table, SCM obj, SCM val);
extern SCM scm_hash_remove_x (SCM table, SCM obj);
extern SCM scm_hashx_get_handle (SCM hash, SCM assoc, SCM table, SCM obj);
extern SCM scm_hashx_create_handle_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM init);
extern SCM scm_hashx_ref (SCM hash, SCM assoc, SCM table, SCM obj, SCM dflt);
extern SCM scm_hashx_set_x (SCM hash, SCM assoc, SCM table, SCM obj, SCM val);
extern SCM scm_hashx_remove_x (SCM hash, SCM assoc, SCM delete, SCM table, SCM obj);
extern void scm_init_hashtab (void);
#else /* STDC */
extern SCM scm_hash_fn_get_handle ();
extern SCM scm_hash_fn_create_handle_x ();
extern SCM scm_hash_fn_ref ();
extern SCM scm_hash_fn_set_x ();
extern SCM scm_hash_fn_remove_x ();
extern SCM scm_hashq_get_handle ();
extern SCM scm_hashq_create_handle_x ();
extern SCM scm_hashq_ref ();
extern SCM scm_hashq_set_x ();
extern SCM scm_hashq_remove_x ();
extern SCM scm_hashv_get_handle ();
extern SCM scm_hashv_create_handle_x ();
extern SCM scm_hashv_ref ();
extern SCM scm_hashv_set_x ();
extern SCM scm_hashv_remove_x ();
extern SCM scm_hash_get_handle ();
extern SCM scm_hash_create_handle_x ();
extern SCM scm_hash_ref ();
extern SCM scm_hash_set_x ();
extern SCM scm_hash_remove_x ();
extern SCM scm_hashx_get_handle ();
extern SCM scm_hashx_create_handle_x ();
extern SCM scm_hashx_ref ();
extern SCM scm_hashx_set_x ();
extern SCM scm_hashx_remove_x ();
extern void scm_init_hashtab ();
#endif /* STDC */
#endif /* HASHTABH */

157
libguile/inet_aton.c Normal file
View file

@ -0,0 +1,157 @@
/*
* Copyright (c) 1983, 1990, 1993
* The Regents of the University of California. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by the University of
* California, Berkeley and its contributors.
* 4. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
#if defined(LIBC_SCCS) && !defined(lint)
static char sccsid[] = "@(#)inet_addr.c 8.1 (Berkeley) 6/17/93";
#endif /* LIBC_SCCS and not lint */
#include <ctype.h>
#include <sys/param.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#ifdef 0
/*
* Ascii internet address interpretation routine.
* The value returned is in network order.
*/
u_long
inet_addr(cp)
register const char *cp;
{
struct in_addr val;
if (inet_aton(cp, &val))
return (val.s_addr);
return (INADDR_NONE);
}
#endif
/*
* Check whether "cp" is a valid ascii representation
* of an Internet address and convert to a binary address.
* Returns 1 if the address is valid, 0 if not.
* This replaces inet_addr, the return value from which
* cannot distinguish between failure and a local broadcast address.
*/
int
inet_aton(cp, addr)
register const char *cp;
struct in_addr *addr;
{
register unsigned long val;
register int base, n;
register char c;
unsigned int parts[4];
register unsigned int *pp = parts;
for (;;) {
/*
* Collect number up to ``.''.
* Values are specified as for C:
* 0x=hex, 0=octal, other=decimal.
*/
val = 0; base = 10;
if (*cp == '0') {
if (*++cp == 'x' || *cp == 'X')
base = 16, cp++;
else
base = 8;
}
while ((c = *cp) != '\0') {
if (isascii(c) && isdigit(c)) {
val = (val * base) + (c - '0');
cp++;
continue;
}
if (base == 16 && isascii(c) && isxdigit(c)) {
val = (val << 4) +
(c + 10 - (islower(c) ? 'a' : 'A'));
cp++;
continue;
}
break;
}
if (*cp == '.') {
/*
* Internet format:
* a.b.c.d
* a.b.c (with c treated as 16-bits)
* a.b (with b treated as 24 bits)
*/
if (pp >= parts + 3 || val > 0xff)
return (0);
*pp++ = val, cp++;
} else
break;
}
/*
* Check for trailing characters.
*/
if (*cp && (!isascii(*cp) || !isspace(*cp)))
return (0);
/*
* Concoct the address according to
* the number of parts specified.
*/
n = pp - parts + 1;
switch (n) {
case 1: /* a -- 32 bits */
break;
case 2: /* a.b -- 8.24 bits */
if (val > 0xffffff)
return (0);
val |= parts[0] << 24;
break;
case 3: /* a.b.c -- 8.8.16 bits */
if (val > 0xffff)
return (0);
val |= (parts[0] << 24) | (parts[1] << 16);
break;
case 4: /* a.b.c.d -- 8.8.8.8 bits */
if (val > 0xff)
return (0);
val |= (parts[0] << 24) | (parts[1] << 16) | (parts[2] << 8);
break;
}
if (addr)
addr->s_addr = htonl(val);
return (1);
}

453
libguile/init.c Normal file
View file

@ -0,0 +1,453 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifdef __STDC__
void
scm_start_stack (void * base, FILE * in, FILE * out, FILE * err)
#else
void
scm_start_stack (base, in, out, err)
void * base;
FILE * in;
FILE * out;
FILE * err;
#endif
{
struct scm_port_table * pt;
scm_stack_base = base;
/* Create standar ports from stdio files, if requested to do so.
*/
if (!in)
{
scm_def_inp = SCM_BOOL_F;
}
else
{
SCM_NEWCELL (scm_def_inp);
pt = scm_add_to_port_table (scm_def_inp);
SCM_CAR (scm_def_inp) = (scm_tc16_fport | SCM_OPN | SCM_RDNG);
SCM_SETPTAB_ENTRY (scm_def_inp, pt);
SCM_SETSTREAM (scm_def_inp, (SCM)in);
if (isatty (fileno (in)))
{
scm_setbuf0 (scm_def_inp); /* turn off stdin buffering */
SCM_CAR (scm_def_inp) |= SCM_BUF0;
}
scm_set_port_revealed_x (scm_def_inp, SCM_MAKINUM (1));
}
if (!out)
{
scm_def_outp = SCM_BOOL_F;
}
else
{
SCM_NEWCELL (scm_def_outp);
pt = scm_add_to_port_table (scm_def_outp);
SCM_CAR (scm_def_outp) = (scm_tc16_fport | SCM_OPN | SCM_WRTNG);
SCM_SETPTAB_ENTRY (scm_def_outp, pt);
SCM_SETSTREAM (scm_def_outp, (SCM)out);
scm_set_port_revealed_x (scm_def_outp, SCM_MAKINUM (1));
}
if (!err)
{
scm_def_errp = SCM_BOOL_F;
}
else
{
SCM_NEWCELL (scm_def_errp);
pt = scm_add_to_port_table (scm_def_errp);
SCM_CAR (scm_def_errp) = (scm_tc16_fport | SCM_OPN | SCM_WRTNG);
SCM_SETPTAB_ENTRY (scm_def_errp, pt);
SCM_SETSTREAM (scm_def_errp, (SCM)err);
scm_set_port_revealed_x (scm_def_errp, SCM_MAKINUM (1));
}
scm_cur_inp = scm_def_inp;
scm_cur_outp = scm_def_outp;
scm_cur_errp = scm_def_errp;
scm_progargs = SCM_BOOL_F; /* vestigial */
scm_exitval = SCM_BOOL_F; /* vestigial */
scm_top_level_lookup_thunk_var = SCM_BOOL_F;
scm_system_transformer = SCM_BOOL_F;
/* Create an object to hold the root continuation.
*/
SCM_NEWCELL (scm_rootcont);
SCM_SETJMPBUF (scm_rootcont, scm_must_malloc ((long) sizeof (regs), "continuation"));
SCM_CAR (scm_rootcont) = scm_tc7_contin;
/* The root continuation if further initialized by scm_restart_stack. */
/* Create the look-aside stack for variables that are shared between
* captured continuations.
*/
scm_continuation_stack = scm_make_vector (SCM_MAKINUM (512), SCM_UNDEFINED, SCM_UNDEFINED);
/* The continuation stack is further initialized by scm_restart_stack. */
/* The remainder of stack initialization is factored out to another function so that
* if this stack is ever exitted, it can be re-entered using scm_restart_stack.
*/
scm_restart_stack (base);
}
#ifdef __STDC__
void
scm_restart_stack (void * base)
#else
void
scm_restart_stack (base)
void * base;
#endif
{
scm_dynwinds = SCM_EOL;
SCM_DYNENV (scm_rootcont) = SCM_EOL;
SCM_THROW_VALUE (scm_rootcont) = SCM_EOL;
SCM_BASE (scm_rootcont) = base;
scm_continuation_stack_ptr = SCM_MAKINUM (0);
}
#if 0
static char remsg[] = "remove\n#define ", addmsg[] = "add\n#define ";
#ifdef __STDC__
static void
fixconfig (char *s1, char *s2, int s)
#else
static void
fixconfig (s1, s2, s)
char *s1;
char *s2;
int s;
#endif
{
fputs (s1, stderr);
fputs (s2, stderr);
fputs ("\nin ", stderr);
fputs (s ? "setjump" : "scmfig", stderr);
fputs (".h and recompile scm\n", stderr);
exit (1);
}
static void
check_config ()
{
scm_sizet j;
j = HEAP_SEG_SIZE;
if (HEAP_SEG_SIZE != j)
fixconfig ("reduce", "size of HEAP_SEG_SIZE", 0);
#ifdef SCM_SINGLES
if (sizeof (float) != sizeof (long))
fixconfig (remsg, "SCM_SINGLES", 0);
#endif /* def SCM_SINGLES */
#ifdef SCM_BIGDIG
if (2 * SCM_BITSPERDIG / SCM_CHAR_BIT > sizeof (long))
fixconfig (remsg, "SCM_BIGDIG", 0);
#ifndef SCM_DIGSTOOBIG
if (SCM_DIGSPERLONG * sizeof (SCM_BIGDIG) > sizeof (long))
fixconfig (addmsg, "SCM_DIGSTOOBIG", 0);
#endif
#endif
#ifdef SCM_STACK_GROWS_UP
if (((SCM_STACKITEM *) & j - stack_start_ptr) < 0)
fixconfig (remsg, "SCM_STACK_GROWS_UP", 1);
#else
if ((stack_start_ptr - (SCM_STACKITEM *) & j) < 0)
fixconfig (addmsg, "SCM_STACK_GROWS_UP", 1);
#endif
}
#endif
#ifdef _UNICOS
typedef int setjmp_type;
#else
typedef long setjmp_type;
#endif
/* Fire up Scheme.
*
* argc and argv are made the return values of program-arguments.
*
* in, out, and err, if not NULL, become the standard ports.
* If NULL is passed, your "scm_appinit" should set up the
* standard ports.
*
* boot_cmd is a string containing a Scheme expression to evaluate
* to get things rolling.
*
* result is returned a string containing a printed result of evaluating
* the boot command.
*
* the return value is:
* scm_boot_ok - evaluation concluded normally
* scm_boot_error - evaluation concluded with a Scheme error
* scm_boot_emem - allocation error mallocing *result
* scm_boot_ereenter - scm_boot_guile was called re-entrantly, which is prohibited.
*/
#ifdef __STDC__
int
scm_boot_guile (char ** result, int argc, char ** argv, FILE * in, FILE * out, FILE * err, char * boot_cmd)
#else
int
scm_boot_guile (result, argc, argv, in, out, err, boot_cmd)
char ** result;
int argc;
char ** argv;
FILE * in;
FILE * out;
FILE * err;
char * boot_cmd;
#endif
{
static int initialized = 0;
static int live = 0;
SCM_STACKITEM i;
setjmp_type setjmp_val;
int stat;
if (live) /* This function is not re-entrant. */
{
return scm_boot_ereenter;
}
live = 1;
scm_ints_disabled = 1;
scm_block_gc = 1;
if (initialized)
{
scm_restart_stack (&i);
}
else
{
scm_ports_prehistory ();
scm_smob_prehistory ();
scm_tables_prehistory ();
scm_init_storage (0);
scm_start_stack (&i, in, out, err);
scm_init_gsubr ();
scm_init_feature ();
scm_init_alist ();
scm_init_append ();
scm_init_arbiters ();
scm_init_async ();
scm_init_boolean ();
scm_init_chars ();
scm_init_continuations ();
scm_init_dynwind ();
scm_init_eq ();
scm_init_error ();
scm_init_fdsocket ();
scm_init_fports ();
scm_init_files ();
scm_init_filesys ();
scm_init_gc ();
scm_init_hash ();
scm_init_hashtab ();
scm_init_ioext ();
scm_init_kw ();
scm_init_list ();
scm_init_mallocs ();
scm_init_numbers ();
scm_init_objprop ();
scm_init_pairs ();
scm_init_ports ();
scm_init_posix ();
scm_init_procs ();
scm_init_procprop ();
scm_init_rgx ();
scm_init_scmsigs ();
scm_init_socket ();
scm_init_stackchk ();
scm_init_strports ();
scm_init_struct ();
scm_init_symbols ();
scm_init_tag ();
scm_init_load ();
scm_init_print ();
scm_init_read ();
scm_init_sequences ();
scm_init_stime ();
scm_init_strings ();
scm_init_strorder ();
scm_init_mbstrings ();
scm_init_strop ();
scm_init_throw ();
scm_init_variable ();
scm_init_vectors ();
scm_init_weaks ();
scm_init_vports ();
scm_init_eval ();
scm_init_ramap ();
scm_init_unif ();
scm_init_simpos ();
scm_appinit ();
scm_progargs = scm_makfromstrs (argc, argv);
initialized = 1;
}
scm_block_gc = 0; /* permit the gc to run */
/* ints still disabled */
{
SCM command;
command = scm_makfrom0str (boot_cmd);
setjmp_val = setjmp (SCM_JMPBUF (scm_rootcont));
if (!setjmp_val)
{
SCM last;
scm_init_signals ();
{
SCM p;
SCM form;
p = scm_mkstrport (SCM_MAKINUM (0),
command,
SCM_OPN | SCM_RDNG,
"boot_guile");
while (1)
{
form = scm_read (p, SCM_BOOL_F, SCM_BOOL_F);
if (SCM_EOF_VAL == form)
break;
last = scm_eval_x (form);
}
}
scm_restore_signals ();
/* This tick gives any pending
* asyncs a chance to run. This must be done after
* the call to scm_restore_signals.
*/
SCM_ASYNC_TICK;
scm_ints_disabled = 1; /* Hopefully redundant but just to be sure. */
{
SCM str_answer;
str_answer = scm_strprint_obj (last);
*result = (char *)malloc (1 + SCM_LENGTH (str_answer));
if (!*result)
stat = scm_boot_emem;
else
{
memcpy (*result, SCM_CHARS (str_answer), SCM_LENGTH (str_answer));
(*result)[SCM_LENGTH (str_answer)] = 0;
stat = scm_boot_ok;
}
}
}
else
{
/* This is reached if an unhandled throw terminated Scheme.
* Such an occurence should be extremely unlikely -- it indicates
* a programming error in the boot code.
*
* Details of the bogus exception are stored in scm_exitval even
* though that isn't currently reflected in the return value.
* !!!
*/
scm_restore_signals ();
/* This tick gives any pending
* asyncs a chance to run. This must be done after
* the call to scm_restore_signals.
*
* Note that an unhandled exception during signal handling
* will put as back at the call to scm_restore_signals immediately
* preceeding. A sufficiently bogus signal handler could
* conceivably cause an infinite loop here.
*/
SCM_ASYNC_TICK;
scm_ints_disabled = 1; /* Hopefully redundant but just to be sure. */
{
SCM str_answer;
str_answer = scm_strprint_obj (scm_exitval);
*result = (char *)malloc (1 + SCM_LENGTH (str_answer));
if (!*result)
stat = scm_boot_emem;
else
{
memcpy (*result, SCM_CHARS (str_answer), SCM_LENGTH (str_answer));
(*result)[SCM_LENGTH (str_answer)] = 0;
stat = scm_boot_error;
}
}
}
}
scm_block_gc = 1;
live = 0;
return stat;
}

75
libguile/init.h Normal file
View file

@ -0,0 +1,75 @@
/* classes: h_files */
#ifndef INITH
#define INITH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
enum scm_boot_status
{
scm_boot_ok = 0,
scm_boot_error,
scm_boot_emem,
scm_boot_ereenter
};
#ifdef __STDC__
extern void scm_start_stack (void * base, FILE * in, FILE * out, FILE * err);
extern void scm_restart_stack (void * base);
#else /* STDC */
extern void scm_start_stack ();
extern void scm_restart_stack ();
#endif /* STDC */
#endif /* INITH */

535
libguile/ioext.c Normal file
View file

@ -0,0 +1,535 @@
/* Copyright (C) 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include <unistd.h>
#include "fd.h"
#include "_scm.h"
SCM_PROC (s_sys_ftell, "%ftell", 1, 0, 0, scm_sys_ftell);
#ifdef __STDC__
SCM
scm_sys_ftell (SCM port)
#else
SCM
scm_sys_ftell (port)
SCM port;
#endif
{
long pos;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_ftell);
SCM_SYSCALL (pos = ftell ((FILE *)SCM_STREAM (port)));
if (pos < 0)
return SCM_BOOL_F;
if (pos > 0 && SCM_CRDYP (port))
pos--;
return SCM_MAKINUM (pos);
}
SCM_PROC (s_sys_fseek, "%fseek", 3, 0, 0, scm_sys_fseek);
#ifdef __STDC__
SCM
scm_sys_fseek (SCM port, SCM offset, SCM whence)
#else
SCM
scm_sys_fseek (port, offset, whence)
SCM port;
SCM offset;
SCM whence;
#endif
{
int rv;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fseek);
SCM_ASSERT (SCM_INUMP (offset), offset, SCM_ARG2, s_sys_fseek);
SCM_ASSERT (SCM_INUMP (whence) && (SCM_INUM (whence) < 3) && (SCM_INUM (whence) >= 0),
whence, SCM_ARG3, s_sys_fseek);
SCM_CLRDY (port); /* Clear ungetted char */
/* Values of whence are interned in scm_init_ioext. */
rv = fseek ((FILE *)SCM_STREAM (port), SCM_INUM (offset), SCM_INUM (whence));
return rv ? SCM_MAKINUM (errno) : SCM_BOOL_T;
}
SCM_PROC (s_sys_freopen, "%freopen", 3, 0, 0, scm_sys_freopen);
#ifdef __STDC__
SCM
scm_sys_freopen (SCM filename, SCM modes, SCM port)
#else
SCM
scm_sys_freopen (filename, modes, port)
SCM filename;
SCM modes;
SCM port;
#endif
{
FILE *f;
SCM_ASSERT (SCM_NIMP (filename) && SCM_STRINGP (filename), filename, SCM_ARG1, s_sys_freopen);
SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_freopen);
SCM_DEFER_INTS;
SCM_ASSERT (SCM_NIMP (port) && SCM_FPORTP (port), port, SCM_ARG3, s_sys_freopen);
SCM_SYSCALL (f = freopen (SCM_CHARS (filename), SCM_CHARS (modes), (FILE *)SCM_STREAM (port)));
if (!f)
{
SCM p;
p = port;
port = SCM_MAKINUM (errno);
SCM_CAR (p) &= ~SCM_OPN;
scm_remove_from_port_table (p);
}
else
{
SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes));
SCM_SETSTREAM (port, (SCM)f);
if (SCM_BUF0 & (SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes))))
scm_setbuf0 (port);
}
SCM_ALLOW_INTS;
return port;
}
SCM_PROC (s_sys_duplicate_port, "%duplicate-port", 2, 0, 0, scm_sys_duplicate_port);
#ifdef __STDC__
SCM
scm_sys_duplicate_port (SCM oldpt, SCM modes)
#else
SCM
scm_sys_duplicate_port (oldpt, modes)
SCM oldpt;
SCM modes;
#endif
{
int oldfd;
int newfd;
FILE *f;
SCM newpt;
SCM_ASSERT (SCM_NIMP (oldpt) && SCM_OPPORTP (oldpt), oldpt, SCM_ARG1, s_sys_duplicate_port);
SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_duplicate_port);
SCM_NEWCELL (newpt);
SCM_DEFER_INTS;
oldfd = fileno ((FILE *)SCM_STREAM (oldpt));
if (oldfd == -1)
{
SCM_ALLOW_INTS;
return SCM_BOOL_F;
};
SCM_SYSCALL (newfd = dup (oldfd));
if (newfd == -1)
{
SCM_ALLOW_INTS;
return SCM_BOOL_F;
};
f = fdopen (newfd, SCM_CHARS (modes));
if (!f)
{
SCM_SYSCALL (close (newfd));
SCM_ALLOW_INTS;
return SCM_BOOL_F;
}
{
struct scm_port_table * pt;
pt = scm_add_to_port_table (newpt);
SCM_SETPTAB_ENTRY (newpt, pt);
if (SCM_BUF0 & (SCM_CAR (newpt) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes))))
scm_setbuf0 (newpt);
SCM_SETSTREAM (newpt, (SCM)f);
SCM_PTAB_ENTRY (newpt)->file_name = SCM_PTAB_ENTRY (oldpt)->file_name;
}
SCM_ALLOW_INTS;
return newpt;
}
SCM_PROC (s_sys_redirect_port, "%redirect-port", 2, 0, 0, scm_sys_redirect_port);
#ifdef __STDC__
SCM
scm_sys_redirect_port (SCM into_pt, SCM from_pt)
#else
SCM
scm_sys_redirect_port (into_pt, from_pt)
SCM into_pt;
SCM from_pt;
#endif
{
int ans, oldfd, newfd;
SCM_DEFER_INTS;
SCM_ASSERT (SCM_NIMP (into_pt) && SCM_OPPORTP (into_pt), into_pt, SCM_ARG1, s_sys_redirect_port);
SCM_ASSERT (SCM_NIMP (from_pt) && SCM_OPPORTP (from_pt), from_pt, SCM_ARG2, s_sys_redirect_port);
oldfd = fileno ((FILE *)SCM_STREAM (into_pt));
newfd = fileno ((FILE *)SCM_STREAM (from_pt));
if (oldfd == -1 || newfd == -1)
ans = -1;
else
SCM_SYSCALL (ans = dup2 (oldfd, newfd));
SCM_ALLOW_INTS;
return (ans == -1) ? SCM_MAKINUM (errno) : SCM_BOOL_T;
}
SCM_PROC (s_sys_fileno, "%fileno", 1, 0, 0, scm_sys_fileno);
#ifdef __STDC__
SCM
scm_sys_fileno (SCM port)
#else
SCM
scm_sys_fileno (port)
SCM port;
#endif
{
int fd;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_fileno);
fd = fileno ((FILE *)SCM_STREAM (port));
return (fd == -1) ? SCM_BOOL_F : SCM_MAKINUM (fd);
}
SCM_PROC (s_sys_soft_fileno, "%soft-fileno", 1, 0, 0, scm_sys_soft_fileno);
#ifdef __STDC__
SCM
scm_sys_soft_fileno (SCM port)
#else
SCM
scm_sys_soft_fileno (port)
SCM port;
#endif
{
int fd;
SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_sys_fileno);
if (!SCM_OPFPORTP (port))
return SCM_BOOL_F;
fd = fileno ((FILE *)SCM_STREAM (port));
return (fd == -1) ? SCM_BOOL_F : SCM_MAKINUM (fd);
}
SCM_PROC (s_sys_isatty, "%isatty?", 1, 0, 0, scm_sys_isatty_p);
#ifdef __STDC__
SCM
scm_sys_isatty_p (SCM port)
#else
SCM
scm_sys_isatty_p (port)
SCM port;
#endif
{
int rv;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_isatty);
rv = fileno ((FILE *)SCM_STREAM (port));
if (rv == -1)
return SCM_MAKINUM (errno);
else
{
rv = isatty (rv);
return rv ? SCM_BOOL_T : SCM_BOOL_F;
}
}
SCM_PROC (s_sys_fdopen, "%fdopen", 2, 0, 0, scm_sys_fdopen);
#ifdef __STDC__
SCM
scm_sys_fdopen (SCM fdes, SCM modes)
#else
SCM
scm_sys_fdopen (fdes, modes)
SCM fdes;
SCM modes;
#endif
{
FILE *f;
SCM port;
SCM_ASSERT (SCM_INUMP (fdes), fdes, SCM_ARG1, s_sys_fdopen);
SCM_ASSERT (SCM_NIMP (modes) && SCM_STRINGP (modes), modes, SCM_ARG2, s_sys_fdopen);
SCM_DEFER_INTS;
f = fdopen (SCM_INUM (fdes), SCM_CHARS (modes));
if (f == NULL)
{
SCM_ALLOW_INTS;
return SCM_MAKINUM (errno);
}
SCM_NEWCELL (port);
SCM_CAR (port) = scm_tc16_fport | scm_mode_bits (SCM_CHARS (modes));
SCM_SETSTREAM (port,(SCM)f);
scm_add_to_port_table (port);
SCM_ALLOW_INTS;
return port;
}
/* Move a port's underlying file descriptor to a given value.
* Returns: #f for error.
* 0 if fdes is already the given value.
* 1 if fdes moved.
* MOVE->FDES is implemented in Scheme and calls this primitive.
*/
SCM_PROC (s_sys_primitive_move_to_fdes, "%primitive-move->fdes", 2, 0, 0, scm_sys_primitive_move_to_fdes);
#ifdef __STDC__
SCM
scm_sys_primitive_move_to_fdes (SCM port, SCM fd)
#else
SCM
scm_sys_primitive_move_to_fdes (port, fd)
SCM port;
SCM fd;
#endif
{
FILE *stream;
int old_fd;
int new_fd;
int rv;
SCM_ASSERT (SCM_NIMP (port) && SCM_OPFPORTP (port), port, SCM_ARG1, s_sys_primitive_move_to_fdes);
SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG2, s_sys_primitive_move_to_fdes);
SCM_DEFER_INTS;
stream = (FILE *)SCM_STREAM (port);
old_fd = fileno (stream);
new_fd = SCM_INUM (fd);
if (old_fd == new_fd)
{
SCM_ALLOW_INTS;
return SCM_MAKINUM (0);
}
scm_evict_ports (new_fd);
rv = dup2 (old_fd, new_fd);
if (rv == -1)
{
SCM_ALLOW_INTS;
return SCM_BOOL_F;
}
scm_setfileno (stream, new_fd);
SCM_SYSCALL (close (old_fd));
SCM_ALLOW_INTS;
return SCM_MAKINUM (1);
}
/* FIXME */
#ifdef __STDC__
void
scm_setfileno (FILE *fs, int fd)
#else
void
scm_setfileno (fs, fd)
FILE *fs;
int fd;
#endif
{
#ifdef SET_FILE_FD_FIELD
SET_FILE_FD_FIELD(fs, fd);
#else
Configure could not guess the name of the correct field in a FILE *.
This function needs to be ported to your system.
SET_FILE_FD_FIELD should change the descriptor refered to by a stdio
stream, and nothing else.
The way to port this file is to add cases to configure.in. Search
that file for "SET_FILE_FD_FIELD" and follow the examples there.
#endif
}
/* Move ports with the specified file descriptor to new descriptors,
* reseting the revealed count to 0.
* Should be called with SCM_DEFER_INTS active.
*/
#ifdef __STDC__
void
scm_evict_ports (int fd)
#else
void
scm_evict_ports (fd)
int fd;
#endif
{
int i;
for (i = 0; i < scm_port_table_size; i++)
{
if (SCM_FPORTP (scm_port_table[i]->port)
&& fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == fd)
{
scm_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd));
scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0));
}
}
}
/* Return a list of ports using a given file descriptor. */
SCM_PROC(s_fdes_to_ports, "fdes->ports", 1, 0, 0, scm_fdes_to_ports);
#ifdef __STDC__
SCM
scm_fdes_to_ports (SCM fd)
#else
SCM
scm_fdes_to_ports (fd)
SCM fd;
#endif
{
SCM result = SCM_EOL;
int int_fd;
int i;
SCM_ASSERT (SCM_INUMP (fd), fd, SCM_ARG1, s_fdes_to_ports);
int_fd = SCM_INUM (fd);
SCM_DEFER_INTS;
for (i = 0; i < scm_port_table_size; i++)
{
if (SCM_FPORTP (scm_port_table[i]->port)
&& fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == int_fd)
result = scm_cons (scm_port_table[i]->port, result);
}
SCM_ALLOW_INTS;
return result;
}
#ifdef __STDC__
void
scm_init_ioext (void)
#else
void
scm_init_ioext ()
#endif
{
/* fseek() symbols. */
scm_sysintern ("SEEK_SET", SCM_MAKINUM (SEEK_SET));
scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
scm_sysintern ("SEEK_END", SCM_MAKINUM (SEEK_END));
/* access() symbols. */
scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
/* File type/permission bits. */
#ifdef S_IRUSR
scm_sysintern ("S_IRUSR", SCM_MAKINUM (S_IRUSR));
#endif
#ifdef S_IWUSR
scm_sysintern ("S_IWUSR", SCM_MAKINUM (S_IWUSR));
#endif
#ifdef S_IXUSR
scm_sysintern ("S_IXUSR", SCM_MAKINUM (S_IXUSR));
#endif
#ifdef S_IRWXU
scm_sysintern ("S_IRWXU", SCM_MAKINUM (S_IRWXU));
#endif
#ifdef S_IRGRP
scm_sysintern ("S_IRGRP", SCM_MAKINUM (S_IRGRP));
#endif
#ifdef S_IWGRP
scm_sysintern ("S_IWGRP", SCM_MAKINUM (S_IWGRP));
#endif
#ifdef S_IXGRP
scm_sysintern ("S_IXGRP", SCM_MAKINUM (S_IXGRP));
#endif
#ifdef S_IRWXG
scm_sysintern ("S_IRWXG", SCM_MAKINUM (S_IRWXG));
#endif
#ifdef S_IROTH
scm_sysintern ("S_IROTH", SCM_MAKINUM (S_IROTH));
#endif
#ifdef S_IWOTH
scm_sysintern ("S_IWOTH", SCM_MAKINUM (S_IWOTH));
#endif
#ifdef S_IXOTH
scm_sysintern ("S_IXOTH", SCM_MAKINUM (S_IXOTH));
#endif
#ifdef S_IRWXO
scm_sysintern ("S_IRWXO", SCM_MAKINUM (S_IRWXO));
#endif
#ifdef S_ISUID
scm_sysintern ("S_ISUID", SCM_MAKINUM (S_ISUID));
#endif
#ifdef S_ISGID
scm_sysintern ("S_ISGID", SCM_MAKINUM (S_ISGID));
#endif
#ifdef S_ISVTX
scm_sysintern ("S_ISVTX", SCM_MAKINUM (S_ISVTX));
#endif
#ifdef S_IFMT
scm_sysintern ("S_IFMT", SCM_MAKINUM (S_IFMT));
#endif
#ifdef S_IFDIR
scm_sysintern ("S_IFDIR", SCM_MAKINUM (S_IFDIR));
#endif
#ifdef S_IFCHR
scm_sysintern ("S_IFCHR", SCM_MAKINUM (S_IFCHR));
#endif
#ifdef S_IFBLK
scm_sysintern ("S_IFBLK", SCM_MAKINUM (S_IFBLK));
#endif
#ifdef S_IFREG
scm_sysintern ("S_IFREG", SCM_MAKINUM (S_IFREG));
#endif
#ifdef S_IFLNK
scm_sysintern ("S_IFLNK", SCM_MAKINUM (S_IFLNK));
#endif
#ifdef S_IFSOCK
scm_sysintern ("S_IFSOCK", SCM_MAKINUM (S_IFSOCK));
#endif
#ifdef S_IFIFO
scm_sysintern ("S_IFIFO", SCM_MAKINUM (S_IFIFO));
#endif
#include "ioext.x"
}

87
libguile/ioext.h Normal file
View file

@ -0,0 +1,87 @@
/* classes: h_files */
#ifndef IOEXTH
#define IOEXTH
/* Copyright (C) 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_sys_ftell (SCM port);
extern SCM scm_sys_fseek (SCM port, SCM offset, SCM whence);
extern SCM scm_sys_freopen (SCM filename, SCM modes, SCM port);
extern SCM scm_sys_duplicate_port (SCM oldpt, SCM modes);
extern SCM scm_sys_redirect_port (SCM into_pt, SCM from_pt);
extern SCM scm_sys_fileno (SCM port);
extern SCM scm_sys_isatty (SCM port);
extern SCM scm_sys_fdopen (SCM fdes, SCM modes);
extern SCM scm_sys_primitive_move_to_fdes (SCM port, SCM fd);
extern void scm_setfileno (FILE *fs, int fd);
extern void scm_evict_ports (int fd);
extern SCM scm_fdes_to_ports (SCM fd);
extern void scm_init_ioext (void);
#else /* STDC */
extern SCM scm_sys_ftell ();
extern SCM scm_sys_fseek ();
extern SCM scm_sys_freopen ();
extern SCM scm_sys_duplicate_port ();
extern SCM scm_sys_redirect_port ();
extern SCM scm_sys_fileno ();
extern SCM scm_sys_isatty ();
extern SCM scm_sys_fdopen ();
extern SCM scm_sys_primitive_move_to_fdes ();
extern void scm_setfileno ();
extern void scm_evict_ports ();
extern SCM scm_fdes_to_ports ();
extern void scm_init_ioext ();
#endif /* STDC */
#endif /* IOEXTH */

164
libguile/kw.c Normal file
View file

@ -0,0 +1,164 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifdef __STDC__
static scm_sizet
free_kw (SCM obj)
#else
static scm_sizet
free_kw (obj)
SCM obj;
#endif
{
return 0;
}
#ifdef __STDC__
static int
prin_kw (SCM exp, SCM port, int writing)
#else
static int
prin_kw (exp, port, writing)
SCM exp;
SCM port;
int writing;
#endif
{
scm_gen_puts (scm_regular_string, ":", port);
scm_gen_puts((SCM_MB_STRINGP(SCM_CDR (exp))
? scm_mb_string
: scm_regular_string),
1 + SCM_CHARS (SCM_CDR (exp)),
port);
return 1;
}
int scm_tc16_kw;
static scm_smobfuns kw_smob = {scm_markcdr, free_kw, prin_kw, 0};
SCM_PROC (s_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol", 1, 0, 0, scm_make_keyword_from_dash_symbol);
#ifdef __STDC__
SCM
scm_make_keyword_from_dash_symbol (SCM symbol)
#else
SCM
scm_make_keyword_from_dash_symbol (symbol)
SCM symbol;
#endif
{
SCM vcell;
SCM_ASSERT (SCM_NIMP (symbol) && SCM_SYMBOLP(symbol) && ('-' == SCM_CHARS(symbol)[0]),
symbol, SCM_ARG1, s_make_keyword_from_dash_symbol);
SCM_DEFER_INTS;
vcell = scm_sym2ovcell_soft (symbol, scm_kw_obarray);
if (vcell == SCM_BOOL_F)
{
SCM kw;
SCM_NEWCELL(kw);
SCM_CAR(kw) = (SCM)scm_tc16_kw;
SCM_CDR(kw) = symbol;
scm_intern_symbol (scm_kw_obarray, symbol);
vcell = scm_sym2ovcell_soft (symbol, scm_kw_obarray);
SCM_CDR (vcell) = kw;
}
SCM_ALLOW_INTS;
return SCM_CDR (vcell);
}
SCM_PROC(s_keyword_p, "keyword?", 1, 0, 0, scm_keyword_p);
#ifdef __STDC__
SCM
scm_keyword_p (SCM obj)
#else
SCM
scm_keyword_p (obj)
SCM obj;
#endif
{
return ( (SCM_NIMP(obj) && SCM_KEYWORDP (obj))
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_keyword_dash_symbol, "keyword-dash-symbol", 1, 0, 0, scm_keyword_dash_symbol);
#ifdef __STDC__
SCM
scm_keyword_dash_symbol (SCM kw)
#else
SCM
scm_keyword_dash_symbol (kw)
SCM kw;
#endif
{
SCM_ASSERT (SCM_NIMP (kw) && SCM_KEYWORDP (kw), kw, SCM_ARG1, s_keyword_dash_symbol);
return SCM_CDR (kw);
}
#ifdef __STDC__
void
scm_init_kw (void)
#else
void
scm_init_kw ()
#endif
{
scm_tc16_kw = scm_newsmob (&kw_smob);
scm_kw_obarray = scm_make_vector (SCM_MAKINUM (256), SCM_EOL, SCM_UNDEFINED);
#include "kw.x"
}

70
libguile/kw.h Normal file
View file

@ -0,0 +1,70 @@
/* classes: h_files */
#ifndef KWH
#define KWH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
extern int scm_tc16_kw;
#define SCM_KEYWORDP(X) (SCM_CAR(X) == scm_tc16_kw)
#define SCM_KEYWORDSYM(X) (SCM_CDR(X))
#ifdef __STDC__
extern SCM scm_make_keyword_from_dash_symbol (SCM symbol);
extern SCM scm_keyword_p (SCM obj);
extern SCM scm_keyword_dash_symbol (SCM kw);
extern void scm_init_kw (void);
#else /* STDC */
extern SCM scm_make_keyword_from_dash_symbol ();
extern SCM scm_keyword_p ();
extern SCM scm_keyword_dash_symbol ();
extern void scm_init_kw ();
#endif /* STDC */
#endif /* KWH */

142
libguile/libguile.h Normal file
View file

@ -0,0 +1,142 @@
#ifndef LIBGUILEH
#define LIBGUILEH
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#ifdef STDC_HEADERS
# include <stdlib.h>
# ifdef AMIGA
# include <stddef.h>
# endif /* def AMIGA */
# define scm_sizet size_t
#else
# ifdef _SIZE_T
# define scm_sizet size_t
# else
# define scm_sizet unsigned int
# endif /* def _SIZE_T */
#endif /* def STDC_HEADERS */
#include "__scm.h"
#include "smob.h"
#include "alist.h"
#include "append.h"
#include "arbiters.h"
#include "async.h"
#include "boolean.h"
#include "chars.h"
#include "continuations.h"
#include "dynwind.h"
#include "eq.h"
#include "error.h"
#include "eval.h"
#include "extchrs.h"
#include "fdsocket.h"
#include "feature.h"
#include "files.h"
#include "filesys.h"
#include "fports.h"
#include "gc.h"
#include "genio.h"
#include "gsubr.h"
#include "hash.h"
#include "hashtab.h"
#include "init.h"
#include "ioext.h"
#include "kw.h"
#include "libguile.h"
#include "list.h"
#include "load.h"
#include "mallocs.h"
#include "markers.h"
#include "marksweep.h"
#include "mbstrings.h"
#include "numbers.h"
#include "pairs.h"
#include "params.h"
#include "ports.h"
#include "posix.h"
#include "print.h"
#include "procprop.h"
#include "procs.h"
#include "ramap.h"
#include "read.h"
#include "root.h"
#include "scmsigs.h"
#include "sequences.h"
#include "simpos.h"
#include "socket.h"
#include "stackchk.h"
#include "stime.h"
#include "strings.h"
#include "strop.h"
#include "strorder.h"
#include "strports.h"
#include "struct.h"
#include "symbols.h"
#include "tag.h"
#include "tags.h"
#include "throw.h"
#include "unif.h"
#include "variable.h"
#include "vectors.h"
#include "vports.h"
#include "weaks.h"
#ifdef __STDC__
#else /* STDC */
#endif /* STDC */
#endif /* LIBGUILEH */

791
libguile/list.c Normal file
View file

@ -0,0 +1,791 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifdef __STDC__
#include <stdarg.h>
#define var_start(x, y) va_start(x, y)
#else
#include <varargs.h>
#define var_start(x, y) va_start(x)
#endif
#ifdef __STDC__
SCM
scm_listify (SCM elt, ...)
#else
SCM
scm_listify (elt, va_alist)
SCM elt;
va_dcl
#endif
{
va_list foo;
SCM answer;
SCM *pos;
var_start (foo, elt);
answer = SCM_EOL;
pos = &answer;
while (elt != SCM_UNDEFINED)
{
*pos = scm_cons (elt, SCM_EOL);
pos = &SCM_CDR (*pos);
elt = va_arg (foo, SCM);
}
return answer;
}
SCM_PROC(s_list, "list", 0, 0, 1, scm_list);
#ifdef __STDC__
SCM
scm_list(SCM objs)
#else
SCM
scm_list(objs)
SCM objs;
#endif
{
return objs;
}
SCM_PROC(s_null_p, "null?", 1, 0, 0, scm_null_p);
#ifdef __STDC__
SCM
scm_null_p(SCM x)
#else
SCM
scm_null_p(x)
SCM x;
#endif
{
return SCM_NULLP(x) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_list_p, "list?", 1, 0, 0, scm_list_p);
#ifdef __STDC__
SCM
scm_list_p(SCM x)
#else
SCM
scm_list_p(x)
SCM x;
#endif
{
if (scm_ilength(x)<0)
return SCM_BOOL_F;
else
return SCM_BOOL_T;
}
#ifdef __STDC__
long
scm_ilength(SCM sx)
#else
long
scm_ilength(sx)
SCM sx;
#endif
{
register long i = 0;
register SCM x = sx;
do {
if SCM_IMP(x) return SCM_NULLP(x) ? i : -1;
if SCM_NCONSP(x) return -1;
x = SCM_CDR(x);
i++;
if SCM_IMP(x) return SCM_NULLP(x) ? i : -1;
if SCM_NCONSP(x) return -1;
x = SCM_CDR(x);
i++;
sx = SCM_CDR(sx);
}
while (x != sx);
return -1;
}
SCM_PROC(s_list_length, "list-length", 1, 0, 0, scm_list_length);
#ifdef __STDC__
SCM
scm_list_length(SCM x)
#else
SCM
scm_list_length(x)
SCM x;
#endif
{
int i;
i = scm_ilength(x);
SCM_ASSERT(i >= 0, x, SCM_ARG1, s_list_length);
return SCM_MAKINUM (i);
}
SCM_PROC (s_list_append, "list-append", 0, 0, 1, scm_list_append);
#ifdef __STDC__
SCM
scm_list_append(SCM args)
#else
SCM
scm_list_append(args)
SCM args;
#endif
{
SCM res = SCM_EOL;
SCM *lloc = &res, arg;
if SCM_IMP(args) {
SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_list_append);
return res;
}
SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_list_append);
while (1) {
arg = SCM_CAR(args);
args = SCM_CDR(args);
if SCM_IMP(args) {
*lloc = arg;
SCM_ASSERT(SCM_NULLP(args), args, SCM_ARGn, s_list_append);
return res;
}
SCM_ASSERT(SCM_CONSP(args), args, SCM_ARGn, s_list_append);
for(;SCM_NIMP(arg);arg = SCM_CDR(arg)) {
SCM_ASSERT(SCM_CONSP(arg), arg, SCM_ARGn, s_list_append);
*lloc = scm_cons(SCM_CAR(arg), SCM_EOL);
lloc = &SCM_CDR(*lloc);
}
SCM_ASSERT(SCM_NULLP(arg), arg, SCM_ARGn, s_list_append);
}
}
SCM_PROC (s_list_append_x, "list-append!", 0, 0, 1, scm_list_append_x);
#ifdef __STDC__
SCM
scm_list_append_x(SCM args)
#else
SCM
scm_list_append_x(args)
SCM args;
#endif
{
SCM arg;
tail:
if SCM_NULLP(args) return SCM_EOL;
arg = SCM_CAR(args);
SCM_ASSERT(SCM_NULLP(arg) || (SCM_NIMP(arg) && SCM_CONSP(arg)), arg, SCM_ARG1, s_list_append_x);
args = SCM_CDR(args);
if SCM_NULLP(args) return arg;
if SCM_NULLP(arg) goto tail;
SCM_CDR(scm_last_pair(arg)) = scm_list_append_x(args);
return arg;
}
SCM_PROC (s_list_reverse, "list-reverse", 1, 0, 0, scm_list_reverse);
#ifdef __STDC__
SCM
scm_list_reverse(SCM lst)
#else
SCM
scm_list_reverse(lst)
SCM lst;
#endif
{
SCM res = SCM_EOL;
SCM p = lst;
for(;SCM_NIMP(p);p = SCM_CDR(p)) {
SCM_ASSERT(SCM_CONSP(p), lst, SCM_ARG1, s_list_reverse);
res = scm_cons(SCM_CAR(p), res);
}
SCM_ASSERT(SCM_NULLP(p), lst, SCM_ARG1, s_list_reverse);
return res;
}
SCM_PROC (s_list_reverse_x, "list-reverse!", 1, 1, 0, scm_list_reverse_x);
#ifdef __STDC__
SCM
scm_list_reverse_x (SCM lst, SCM newtail)
#else
SCM
scm_list_reverse_x (lst, newtail)
SCM lst;
SCM newtail;
#endif
{
SCM old_tail;
if (newtail == SCM_UNDEFINED)
newtail = SCM_EOL;
loop:
if (!(SCM_NIMP (lst) && SCM_CONSP (lst)))
return lst;
old_tail = SCM_CDR (lst);
SCM_SETCDR (lst, newtail);
if (SCM_NULLP (old_tail))
return lst;
newtail = lst;
lst = old_tail;
goto loop;
}
SCM_PROC(s_list_ref, "list-ref", 2, 0, 0, scm_list_ref);
#ifdef __STDC__
SCM
scm_list_ref(SCM lst, SCM k)
#else
SCM
scm_list_ref(lst, k)
SCM lst;
SCM k;
#endif
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_ref);
i = SCM_INUM(k);
SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_ref);
while (i-- > 0) {
SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
lst = SCM_CDR(lst);
}
erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_ref);
return SCM_CAR(lst);
}
SCM_PROC(s_list_set_x, "list-set!", 3, 0, 0, scm_list_set_x);
#ifdef __STDC__
SCM
scm_list_set_x(SCM lst, SCM k, SCM val)
#else
SCM
scm_list_set_x(lst, k, val)
SCM lst;
SCM k;
SCM val;
#endif
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_set_x);
i = SCM_INUM(k);
SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_set_x);
while (i-- > 0) {
SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
lst = SCM_CDR(lst);
}
erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_set_x);
SCM_CAR (lst) = val;
return val;
}
SCM_PROC(s_list_cdr_set_x, "list-cdr-set!", 3, 0, 0, scm_list_cdr_set_x);
#ifdef __STDC__
SCM
scm_list_cdr_set_x(SCM lst, SCM k, SCM val)
#else
SCM
scm_list_cdr_set_x(lst, k, val)
SCM lst;
SCM k;
SCM val;
#endif
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_cdr_set_x);
i = SCM_INUM(k);
SCM_ASSERT(i >= 0, k, SCM_ARG2, s_list_cdr_set_x);
while (i-- > 0) {
SCM_ASRTGO(SCM_NIMP(lst) && SCM_CONSP(lst), erout);
lst = SCM_CDR(lst);
}
erout: SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst),
SCM_NULLP(lst)?k:lst, SCM_NULLP(lst)?SCM_OUTOFRANGE:SCM_ARG1, s_list_cdr_set_x);
SCM_SETCDR (lst, val);
return val;
}
SCM_PROC(s_last_pair, "last-pair", 1, 0, 0, scm_last_pair);
#ifdef __STDC__
SCM
scm_last_pair(SCM sx)
#else
SCM
scm_last_pair(sx)
SCM sx;
#endif
{
register SCM res = sx;
register SCM x;
if (SCM_NULLP (sx))
return SCM_EOL;
SCM_ASSERT(SCM_NIMP(res) && SCM_CONSP(res), res, SCM_ARG1, s_last_pair);
while (!0) {
x = SCM_CDR(res);
if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
res = x;
x = SCM_CDR(res);
if (SCM_IMP(x) || SCM_NCONSP(x)) return res;
res = x;
sx = SCM_CDR(sx);
SCM_ASSERT(x != sx, sx, SCM_ARG1, s_last_pair);
}
}
SCM_PROC(s_list_cdr_ref, "list-cdr-ref", 2, 0, 0, scm_list_tail);
SCM_PROC(s_list_tail, "list-tail", 2, 0, 0, scm_list_tail);
#ifdef __STDC__
SCM
scm_list_tail(SCM lst, SCM k)
#else
SCM
scm_list_tail(lst, k)
SCM lst;
SCM k;
#endif
{
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_tail);
i = SCM_INUM(k);
while (i-- > 0) {
SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_tail);
lst = SCM_CDR(lst);
}
return lst;
}
SCM_PROC(s_list_head, "list-head", 2, 0, 0, scm_list_head);
#ifdef __STDC__
SCM
scm_list_head(SCM lst, SCM k)
#else
SCM
scm_list_head(lst, k)
SCM lst;
SCM k;
#endif
{
SCM answer;
SCM * pos;
register long i;
SCM_ASSERT(SCM_INUMP(k), k, SCM_ARG2, s_list_head);
answer = SCM_EOL;
pos = &answer;
i = SCM_INUM(k);
while (i-- > 0)
{
SCM_ASSERT(SCM_NIMP(lst) && SCM_CONSP(lst), lst, SCM_ARG1, s_list_head);
*pos = scm_cons (SCM_CAR (lst), SCM_EOL);
pos = &SCM_CDR (*pos);
lst = SCM_CDR(lst);
}
return answer;
}
#ifdef __STDC__
static void
sloppy_mem_check (SCM obj, char * where, char * why)
#else
static void
sloppy_mem_check (obj, where, why)
SCM obj;
char * where;
char * why;
#endif
{
SCM_ASSERT ((scm_ilength (obj) >= 0), obj, where, why);
}
SCM_PROC (s_sloppy_memq, "sloppy-memq", 2, 0, 0, scm_sloppy_memq);
#ifdef __STDC__
SCM
scm_sloppy_memq(SCM x, SCM lst)
#else
SCM
scm_sloppy_memq(x, lst)
SCM x;
SCM lst;
#endif
{
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst))
{
if (SCM_CAR(lst)==x)
return lst;
}
return lst;
}
SCM_PROC (s_sloppy_memv, "sloppy-memv", 2, 0, 0, scm_sloppy_memv);
#ifdef __STDC__
SCM
scm_sloppy_memv(SCM x, SCM lst)
#else
SCM
scm_sloppy_memv(x, lst)
SCM x;
SCM lst;
#endif
{
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst))
{
if (SCM_BOOL_F != scm_eqv_p (SCM_CAR(lst), x))
return lst;
}
return lst;
}
SCM_PROC (s_sloppy_member, "sloppy-member", 2, 0, 0, scm_sloppy_member);
#ifdef __STDC__
SCM
scm_sloppy_member (SCM x, SCM lst)
#else
SCM
scm_sloppy_member (x, lst)
SCM x;
SCM lst;
#endif
{
for(; SCM_NIMP(lst) && SCM_CONSP (lst); lst = SCM_CDR(lst))
{
if (SCM_BOOL_F != scm_equal_p (SCM_CAR(lst), x))
return lst;
}
return lst;
}
SCM_PROC(s_memq, "memq", 2, 0, 0, scm_memq);
#ifdef __STDC__
SCM
scm_memq(SCM x, SCM lst)
#else
SCM
scm_memq(x, lst)
SCM x;
SCM lst;
#endif
{
SCM answer;
answer = scm_sloppy_memq (x, lst);
sloppy_mem_check (answer, (char *)SCM_ARG2, s_memq);
return answer;
}
SCM_PROC(s_memv, "memv", 2, 0, 0, scm_memv);
#ifdef __STDC__
SCM
scm_memv(SCM x, SCM lst)
#else
SCM
scm_memv(x, lst)
SCM x;
SCM lst;
#endif
{
SCM answer;
answer = scm_sloppy_memv (x, lst);
sloppy_mem_check (answer, (char *)SCM_ARG2, s_memv);
return answer;
}
SCM_PROC(s_member, "member", 2, 0, 0, scm_member);
#ifdef __STDC__
SCM
scm_member(SCM x, SCM lst)
#else
SCM
scm_member(x, lst)
SCM x;
SCM lst;
#endif
{
SCM answer;
answer = scm_sloppy_member (x, lst);
sloppy_mem_check (answer, (char *)SCM_ARG2, s_member);
return answer;
}
SCM_PROC(s_delq_x, "delq!", 2, 0, 0, scm_delq_x);
#ifdef __STDC__
SCM
scm_delq_x (SCM item, SCM lst)
#else
SCM
scm_delq_x (item, lst)
SCM item;
SCM lst;
#endif
{
SCM start;
if (SCM_IMP (lst) || SCM_NCONSP (lst))
return lst;
if (SCM_CAR (lst) == item)
return SCM_CDR (lst);
start = lst;
while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
{
if (SCM_CAR (SCM_CDR (lst)) == item)
{
SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
return start;
}
lst = SCM_CDR (lst);
}
return start;
}
SCM_PROC(s_delv_x, "delv!", 2, 0, 0, scm_delv_x);
#ifdef __STDC__
SCM
scm_delv_x (SCM item, SCM lst)
#else
SCM
scm_delv_x (item, lst)
SCM item;
SCM lst;
#endif
{
SCM start;
if (SCM_IMP (lst) || SCM_NCONSP (lst))
return lst;
if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (lst), item))
return SCM_CDR (lst);
start = lst;
while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
{
if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (SCM_CDR (lst)), item))
{
SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
return start;
}
lst = SCM_CDR (lst);
}
return start;
}
SCM_PROC(s_delete_x, "delete!", 2, 0, 0, scm_delete_x);
#ifdef __STDC__
SCM
scm_delete_x (SCM item, SCM lst)
#else
SCM
scm_delete_x (item, lst)
SCM item;
SCM lst;
#endif
{
SCM start;
if (SCM_IMP (lst) || SCM_NCONSP (lst))
return lst;
if (SCM_BOOL_F != scm_equal_p (SCM_CAR (lst), item))
return SCM_CDR (lst);
start = lst;
while (SCM_NIMP (SCM_CDR (lst)) && SCM_CONSP (SCM_CDR (lst)))
{
if (SCM_BOOL_F != scm_equal_p (SCM_CAR (SCM_CDR (lst)), item))
{
SCM_SETCDR (lst, SCM_CDR (SCM_CDR (lst)));
return start;
}
lst = SCM_CDR (lst);
}
return start;
}
SCM_PROC (s_list_copy, "list-copy", 1, 0, 0, scm_list_copy);
#ifdef __STDC__
SCM
scm_list_copy (SCM lst)
#else
SCM
scm_list_copy (lst)
SCM lst;
#endif
{
SCM newlst;
SCM * fill_here;
SCM from_here;
newlst = SCM_EOL;
fill_here = &newlst;
from_here = lst;
while (SCM_NIMP (from_here) && SCM_CONSP (from_here))
{
SCM c;
c = scm_cons (SCM_CAR (from_here), SCM_CDR (from_here));
*fill_here = c;
fill_here = &SCM_CDR (c);
from_here = SCM_CDR (from_here);
}
return newlst;
}
SCM_PROC (s_delq, "delq", 2, 0, 0, scm_delq);
#ifdef __STDC__
SCM
scm_delq (SCM item, SCM lst)
#else
SCM
scm_delq (item, lst)
SCM item;
SCM lst;
#endif
{
SCM copy;
copy = scm_list_copy (lst);
return scm_delq_x (item, copy);
}
SCM_PROC (s_delv, "delv", 2, 0, 0, scm_delv);
#ifdef __STDC__
SCM
scm_delv (SCM item, SCM lst)
#else
SCM
scm_delv (item, lst)
SCM item;
SCM lst;
#endif
{
SCM copy;
copy = scm_list_copy (lst);
return scm_delv_x (item, copy);
}
SCM_PROC (s_delete, "delete", 2, 0, 0, scm_delete);
#ifdef __STDC__
SCM
scm_delete (SCM item, SCM lst)
#else
SCM
scm_delete (item, lst)
SCM item;
SCM lst;
#endif
{
SCM copy;
copy = scm_list_copy (lst);
return scm_delete_x (item, copy);
}
#ifdef __STDC__
void
scm_init_list (void)
#else
void
scm_init_list ()
#endif
{
#include "list.x"
}

126
libguile/list.h Normal file
View file

@ -0,0 +1,126 @@
/* classes: h_files */
#ifndef LISTH
#define LISTH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_listify (SCM elt, ...);
extern SCM scm_list(SCM objs);
extern SCM scm_null_p(SCM x);
extern SCM scm_list_p(SCM x);
extern long scm_ilength(SCM sx);
extern SCM scm_list_length(SCM x);
extern SCM scm_list_append(SCM args);
extern SCM scm_list_append_x(SCM args);
extern SCM scm_list_reverse(SCM lst);
extern SCM scm_list_reverse_x (SCM lst, SCM newtail);
extern SCM scm_list_ref(SCM lst, SCM k);
extern SCM scm_list_set_x(SCM lst, SCM k, SCM val);
extern SCM scm_list_cdr_ref(SCM lst, SCM k);
extern SCM scm_list_cdr_set_x(SCM lst, SCM k, SCM val);
extern SCM scm_last_pair(SCM sx);
extern SCM scm_list_tail(SCM lst, SCM k);
extern SCM scm_sloppy_memq(SCM x, SCM lst);
extern SCM scm_sloppy_memv(SCM x, SCM lst);
extern SCM scm_sloppy_member (SCM x, SCM lst);
extern SCM scm_memq(SCM x, SCM lst);
extern SCM scm_memv(SCM x, SCM lst);
extern SCM scm_member(SCM x, SCM lst);
extern SCM scm_delq_x (SCM item, SCM lst);
extern SCM scm_delv_x (SCM item, SCM lst);
extern SCM scm_delete_x (SCM item, SCM lst);
extern SCM scm_list_copy (SCM lst);
extern SCM scm_delq (SCM item, SCM lst);
extern SCM scm_delv (SCM item, SCM lst);
extern SCM scm_delete (SCM item, SCM lst);
extern void scm_init_list (void);
#else /* STDC */
extern SCM scm_listify ();
extern SCM scm_list();
extern SCM scm_null_p();
extern SCM scm_list_p();
extern long scm_ilength();
extern SCM scm_list_length();
extern SCM scm_list_append();
extern SCM scm_list_append_x();
extern SCM scm_list_reverse();
extern SCM scm_list_reverse_x ();
extern SCM scm_list_ref();
extern SCM scm_list_set_x();
extern SCM scm_list_cdr_ref();
extern SCM scm_list_cdr_set_x();
extern SCM scm_last_pair();
extern SCM scm_list_tail();
extern SCM scm_sloppy_memq();
extern SCM scm_sloppy_memv();
extern SCM scm_sloppy_member ();
extern SCM scm_memq();
extern SCM scm_memv();
extern SCM scm_member();
extern SCM scm_delq_x ();
extern SCM scm_delv_x ();
extern SCM scm_delete_x ();
extern SCM scm_list_copy ();
extern SCM scm_delq ();
extern SCM scm_delv ();
extern SCM scm_delete ();
extern void scm_init_list ();
#endif /* STDC */
#endif /* LISTH */

91
libguile/load.c Normal file
View file

@ -0,0 +1,91 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
SCM_PROC(s_sys_try_load, "%try-load", 1, 2, 0, scm_sys_try_load);
#ifdef __STDC__
SCM
scm_sys_try_load (SCM filename, SCM case_insensative_p, SCM sharp)
#else
SCM
scm_sys_try_load (filename, case_insensative_p, sharp)
SCM filename;
SCM case_insensative_p;
SCM sharp;
#endif
{
SCM_ASSERT (SCM_NIMP (filename) && SCM_ROSTRINGP (filename), filename, SCM_ARG1, s_sys_try_load);
{
SCM form, port;
port = scm_open_file (filename,
scm_makfromstr ("r", (scm_sizet) sizeof (char), 0));
if (SCM_FALSEP (port))
return SCM_BOOL_F;
while (1)
{
form = scm_read (port, case_insensative_p, sharp);
if (SCM_EOF_VAL == form)
break;
scm_eval_x (form);
}
scm_close_port (port);
}
return SCM_BOOL_T;
}
#ifdef __STDC__
void
scm_init_load (void)
#else
void
scm_init_load ()
#endif
{
#include "load.x"
}

62
libguile/load.h Normal file
View file

@ -0,0 +1,62 @@
/* classes: h_files */
#ifndef LOADH
#define LOADH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#ifdef __STDC__
extern SCM scm_sys_try_load (SCM filename, SCM casep, SCM sharp);
extern void scm_init_load (void);
#else /* STDC */
extern SCM scm_sys_try_load ();
extern void scm_init_load ();
#endif /* STDC */
#endif /* LOADH */

113
libguile/mallocs.c Normal file
View file

@ -0,0 +1,113 @@
/* classes: src_files */
/* Copyright (C) 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#include <stdio.h>
#include "_scm.h"
#include "mallocs.h"
#ifdef HAVE_MALLOC_H
#include "malloc.h"
#endif
#ifdef HAVE_UNISTD_H
#include "unistd.h"
#endif
#ifdef __STDC__
static scm_sizet
fmalloc(SCM ptr)
#else
static scm_sizet
fmalloc(ptr)
SCM ptr;
#endif
{
if (SCM_MALLOCDATA (ptr))
free (SCM_MALLOCDATA (ptr));
return 0;
}
#ifdef __STDC__
static int
prinmalloc (SCM exp, SCM port, int writing)
#else
static int
prinmalloc (exp, port, writing)
SCM exp;
SCM port;
int writing;
#endif
{
scm_gen_puts(scm_regular_string, "#<malloc ", port);
scm_intprint(SCM_CDR(exp), 16, port);
scm_gen_putc('>', port);
return 1;
}
int scm_tc16_malloc;
static scm_smobfuns mallocsmob = {scm_mark0, fmalloc, prinmalloc, 0};
#ifdef __STDC__
SCM
scm_malloc_obj (scm_sizet n)
#else
SCM
scm_malloc_obj (n)
scm_sizet n;
#endif
{
SCM answer;
SCM mem;
SCM_NEWCELL (answer);
SCM_DEFER_INTS;
mem = (n
? (SCM)malloc (n)
: 0);
if (n && !mem)
{
SCM_ALLOW_INTS;
return SCM_BOOL_F;
}
SCM_CDR (answer) = mem;
SCM_CAR (answer) = scm_tc16_malloc;
SCM_ALLOW_INTS;
return answer;
}
#ifdef __STDC__
void
scm_init_mallocs (void)
#else
void
scm_init_mallocs ()
#endif
{
scm_tc16_malloc = scm_newsmob (&mallocsmob);
}

66
libguile/mallocs.h Normal file
View file

@ -0,0 +1,66 @@
/* classes: h_files */
#ifndef MALLOCSH
#define MALLOCSH
/* Copyright (C) 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
extern int scm_tc16_malloc;
#define SCM_MALLOCP(X) (SCM_TYP16 (X) == scm_tc16_malloc)
#define SCM_MALLOCDATA(obj) ((char *)SCM_CDR(obj))
#define SCM_SETMALLOCDATA(obj, val) ((char *)SCM_SETCDR(obj, val))
#ifdef __STDC__
extern SCM scm_malloc_obj (scm_sizet n);
extern void scm_init_mallocs (void);
#else /* STDC */
extern SCM scm_malloc_obj ();
extern void scm_init_mallocs ();
#endif /* STDC */
#endif /* MALLOCSH */

92
libguile/markers.c Normal file
View file

@ -0,0 +1,92 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
/* {GC marking}
*/
#ifdef __STDC__
SCM
scm_mark0 (SCM ptr)
#else
SCM
scm_mark0 (ptr)
SCM ptr;
#endif
{
SCM_SETGC8MARK (ptr);
return SCM_BOOL_F;
}
#ifdef __STDC__
SCM
scm_markcdr (SCM ptr)
#else
SCM
scm_markcdr (ptr)
SCM ptr;
#endif
{
if (SCM_GC8MARKP (ptr))
return SCM_BOOL_F;
SCM_SETGC8MARK (ptr);
return SCM_CDR (ptr);
}
#ifdef __STDC__
scm_sizet
scm_free0 (SCM ptr)
#else
scm_sizet
scm_free0 (ptr)
SCM ptr;
#endif
{
return 0;
}

68
libguile/markers.h Normal file
View file

@ -0,0 +1,68 @@
/* classes: h_files */
#ifndef MARKERSH
#define MARKERSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_mark0 (SCM ptr);
extern SCM scm_markcdr (SCM ptr);
extern scm_sizet scm_free0 (SCM ptr);
#else /* STDC */
extern SCM scm_mark0 ();
extern SCM scm_markcdr ();
extern scm_sizet scm_free0 ();
#endif /* STDC */
#endif /* MARKERSH */

568
libguile/mbstrings.c Normal file
View file

@ -0,0 +1,568 @@
/* Copyright (C) 1995, 1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "extchrs.h"
#include <stdio.h>
#include "_scm.h"
SCM_PROC(s_multi_byte_string_p, "multi-byte-string?", 1, 0, 0, scm_multi_byte_string_p);
#ifdef __STDC__
SCM
scm_multi_byte_string_p (SCM obj)
#else
SCM
scm_multi_byte_string_p (obj)
SCM obj;
#endif
{
return (SCM_MB_STRINGP (obj)
? SCM_BOOL_T
: SCM_BOOL_F);
}
#ifdef __STDC__
SCM
scm_regular_string_p (SCM obj)
#else
SCM
scm_regular_string_p (obj)
SCM obj;
#endif
{
return (SCM_REGULAR_STRINGP (obj)
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_list_to_multi_byte_string, "list->multi-byte-string", 1, 0, 0, scm_multi_byte_string);
SCM_PROC(s_multi_byte_string, "multi-byte-string", 0, 0, 1, scm_multi_byte_string);
#ifdef __STDC__
SCM
scm_multi_byte_string (SCM chrs)
#else
SCM
scm_multi_byte_string (chrs)
SCM chrs;
#endif
{
SCM res;
register char *data;
long i;
long byte_len;
i = scm_ilength (chrs);
SCM_ASSERT (i >= 0, chrs, SCM_ARG1, s_multi_byte_string);
i = i * XMB_CUR_MAX;
res = scm_makstr (i, 0);
SCM_SETLENGTH (res, SCM_LENGTH (res), scm_tc7_mb_string);
data = SCM_CHARS (res);
byte_len = 0;
xwctomb (0, 0);
while (i && SCM_NNULLP (chrs))
{
int used;
SCM ch;
ch = SCM_CAR (chrs);
SCM_ASSERT (SCM_ICHRP (ch), chrs, SCM_ARG1, s_multi_byte_string);
used = xwctomb (data + byte_len, SCM_ICHR (ch));
SCM_ASSERT (used >= 0, chrs, SCM_ARG1, s_multi_byte_string);
byte_len += (used ? used : 1);
chrs = SCM_CDR (chrs);
--i;
}
res = scm_vector_set_length_x (res, SCM_MAKINUM (byte_len));
return res;
}
#ifdef __STDC__
int
scm_mb_ilength (unsigned char * data, int size)
#else
int
scm_mb_ilength (data, size)
unsigned char * data;
int size;
#endif
{
int pos;
int len;
len = 0;
pos = 0;
xmblen (0, 0);
while (pos < size)
{
int inc;
inc = xmblen (data + pos, size - pos);
if (inc == 0)
++inc;
if (inc < 0)
return -1;
++len;
pos += inc;
}
return len;
}
SCM_PROC(s_multi_byte_string_length, "multi-byte-string-length", 1, 0, 0, scm_multi_byte_string_length);
#ifdef __STDC__
SCM
scm_multi_byte_string_length (SCM str)
#else
SCM
scm_multi_byte_string_length (str)
SCM str;
#endif
{
int size;
int len;
unsigned char * data;
SCM_ASSERT (SCM_NIMP (str) && SCM_ROSTRINGP (str), str, SCM_ARG1, s_multi_byte_string_length);
data = SCM_ROCHARS (str);
size = SCM_ROLENGTH (str);
len = scm_mb_ilength (data, size);
SCM_ASSERT (len >= 0, str, SCM_ARG1, s_multi_byte_string_length);
return SCM_MAKINUM (len);
}
SCM_PROC(s_symbol_multi_byte_p, "symbol-multi-byte?", 1, 0, 0, scm_symbol_multi_byte_p);
#ifdef __STDC__
SCM
scm_symbol_multi_byte_p (SCM symbol)
#else
SCM
scm_symbol_multi_byte_p (symbol)
SCM symbol;
#endif
{
return SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP(symbol);
}
SCM_PROC(s_set_symbol_multi_byte_x, "set-symbol-multi-byte!", 2, 0, 0, scm_set_symbol_multi_byte_x);
#ifdef __STDC__
SCM
scm_set_symbol_multi_byte_x (SCM symbol, SCM val)
#else
SCM
scm_set_symbol_multi_byte_x (symbol, val)
SCM symbol;
SCM val;
#endif
{
if (SCM_TYP7 (symbol) == scm_tc7_msymbol)
{
SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP(symbol) = (SCM_FALSEP (val)
? SCM_BOOL_F
: SCM_BOOL_T);
}
return SCM_UNSPECIFIED;
}
SCM_PROC(s_regular_port_p, "regular-port?", 1, 0, 0, scm_regular_port_p);
#ifdef __STDC__
SCM
scm_regular_port_p (SCM p)
#else
SCM
scm_regular_port_p (p)
SCM p;
#endif
{
return (SCM_PORT_REPRESENTATION(p) == scm_regular_port
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_regular_port_x, "regular-port!", 1, 0, 0, scm_regular_port_x);
#ifdef __STDC__
SCM
scm_regular_port_x (SCM p)
#else
SCM
scm_regular_port_x (p)
SCM p;
#endif
{
SCM_PORT_REPRESENTATION(p) = scm_regular_port;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_multi_byte_port_p, "multi-byte-port?", 1, 0, 0, scm_multi_byte_port_p);
#ifdef __STDC__
SCM
scm_multi_byte_port_p (SCM p)
#else
SCM
scm_multi_byte_port_p (p)
SCM p;
#endif
{
return (SCM_PORT_REPRESENTATION(p) == scm_mb_port
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_multi_byte_port_x, "multi-byte-port!", 1, 0, 0, scm_multi_byte_port_x);
#ifdef __STDC__
SCM
scm_multi_byte_port_x (SCM p)
#else
SCM
scm_multi_byte_port_x (p)
SCM p;
#endif
{
SCM_PORT_REPRESENTATION(p) = scm_mb_port;
return SCM_UNSPECIFIED;
}
SCM_PROC(s_wide_character_port_p, "wide-character-port?", 1, 0, 0, scm_wide_character_port_p);
#ifdef __STDC__
SCM
scm_wide_character_port_p (SCM p)
#else
SCM
scm_wide_character_port_p (p)
SCM p;
#endif
{
return (SCM_PORT_REPRESENTATION(p) == scm_wchar_port
? SCM_BOOL_T
: SCM_BOOL_F);
}
SCM_PROC(s_wide_character_port_x, "wide-character-port!", 1, 0, 0, scm_wide_character_port_x);
#ifdef __STDC__
SCM
scm_wide_character_port_x (SCM p)
#else
SCM
scm_wide_character_port_x (p)
SCM p;
#endif
{
SCM_PORT_REPRESENTATION(p) = scm_wchar_port;
return SCM_UNSPECIFIED;
}
#ifdef __STDC__
void
scm_put_wchar (int c, SCM port, int writing)
#else
void
scm_put_wchar (c, port, writing)
int c;
SCM port;
int writing;
#endif
{
if (writing)
scm_gen_puts (scm_regular_string, "#\\", port);
switch (SCM_PORT_REPRESENTATION (port))
{
case scm_regular_port:
{
if (c < 256)
{
if (!writing)
scm_gen_putc ((unsigned char)c, port);
else if ((c <= ' ') && scm_charnames[c])
scm_gen_puts (scm_regular_string, scm_charnames[c], port);
else if (c > '\177')
scm_intprint (c, 8, port);
else
scm_gen_putc ((int) c, port);
}
else
{
print_octal:
if (!writing)
scm_gen_putc ('\\', port);
scm_intprint (c, 8, port);
}
break;
}
case scm_mb_port:
{
char buf[256];
int len;
if (XMB_CUR_MAX > sizeof (buf))
goto print_octal;
len = xwctomb (buf, c);
if (len < 0)
goto print_octal;
if (len == 0)
scm_gen_putc (0, port);
else
scm_gen_putc (c, port);
break;
}
case scm_wchar_port:
{
scm_gen_putc (c, port);
break;
}
}
}
#ifdef __STDC__
void
scm_print_mb_string (SCM exp, SCM port, int writing)
#else
void
scm_print_mb_string (exp, port, writing)
SCM exp;
SCM port;
int writing;
#endif
{
if (writing)
{
int i;
int len;
char * data;
scm_gen_putc ('\"', port);
i = 0;
len = SCM_ROLENGTH (exp);
data = SCM_ROCHARS (exp);
while (i < len)
{
xwchar_t c;
int inc;
inc = xmbtowc (&c, data + i, len - i);
if (inc == 0)
inc = 1;
if (inc < 0)
{
inc = 1;
c = data[i];
}
i += inc;
switch (c)
{
case '\"':
case '\\':
scm_gen_putc ('\\', port);
default:
scm_gen_putc (c, port);
}
}
scm_gen_putc ('\"', port);
}
else
scm_gen_write (scm_mb_string, SCM_ROCHARS (exp), SCM_ROLENGTH (exp), port);
}
#ifdef __STDC__
void
scm_print_mb_symbol (SCM exp, SCM port)
#else
void
scm_print_mb_symbol (exp, port)
SCM exp;
SCM port;
#endif
{
int pos;
int end;
int len;
char * str;
int weird;
int maybe_weird;
int mw_pos;
int inc;
xwchar_t c;
len = SCM_LENGTH (exp);
str = SCM_CHARS (exp);
scm_remember (&exp);
pos = 0;
weird = 0;
maybe_weird = 0;
for (end = pos; end < len; end += inc)
{
inc = xmbtowc (&c, str + end, len - end);
if (inc < 0)
{
inc = 1;
c = str[end];
goto weird_handler;
}
if (inc == 0)
{
inc = 1;
goto weird_handler;
}
switch (c)
{
#ifdef BRACKETS_AS_PARENS
case '[':
case ']':
#endif
case '(':
case ')':
case '\"':
case ';':
case SCM_WHITE_SPACES:
case SCM_LINE_INCREMENTORS:
weird_handler:
if (maybe_weird)
{
end = mw_pos;
maybe_weird = 0;
}
if (!weird)
{
scm_gen_write (scm_regular_string, "#{", 2, port);
weird = 1;
}
if (pos < end)
{
int q;
int qinc;
q = pos;
while (q < end)
{
qinc = xmbtowc (&c, str + q, end - q);
if (inc <= 0)
{
inc = 1;
c = str[q];
}
scm_gen_putc (c, port);
q += qinc;
}
}
{
char buf[2];
buf[0] = '\\';
buf[1] = str[end];
scm_gen_write (scm_regular_string, buf, 2, port);
}
pos = end + 1;
break;
case '\\':
if (weird)
goto weird_handler;
if (!maybe_weird)
{
maybe_weird = 1;
mw_pos = pos;
}
break;
case '}':
case '#':
if (weird)
goto weird_handler;
break;
default:
break;
}
}
if (pos < end)
{
int q;
int qinc;
q = pos;
while (q < end)
{
qinc = xmbtowc (&c, str + q, end - q);
if (inc <= 0)
inc = 1;
scm_gen_putc (c, port);
q += qinc;
}
}
if (weird)
scm_gen_write (scm_regular_string, "}#", 2, port);
}
#ifdef __STDC__
void
scm_init_mbstrings (void)
#else
void
scm_init_mbstrings ()
#endif
{
#include "mbstrings.x"
}

100
libguile/mbstrings.h Normal file
View file

@ -0,0 +1,100 @@
/* classes: h_files */
#ifndef MBSTRINGSH
#define MBSTRINGSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#include "symbols.h"
#define SCM_MB_STRINGP(x) ( (SCM_TYP7(x)==scm_tc7_mb_string) \
|| ( (SCM_TYP7(x) == scm_tc7_msymbol) \
&& (SCM_SYMBOL_MULTI_BYTE_SCM_STRINGP (x) != SCM_BOOL_F)))
#define SCM_REGULAR_STRINGP(x) (SCM_TYP7D(x)==scm_tc7_string)
#ifdef __STDC__
extern SCM scm_multi_byte_string_p (SCM obj);
extern SCM scm_regular_string_p (SCM obj);
extern SCM scm_multi_byte_string (SCM chrs);
extern int scm_mb_ilength (unsigned char * data, int size);
extern SCM scm_multi_byte_string_length (SCM str);
extern SCM scm_symbol_multi_byte_p (SCM symbol);
extern SCM scm_set_symbol_multi_byte_x (SCM symbol, SCM val);
extern SCM scm_regular_port_p (SCM p);
extern SCM scm_regular_port_x (SCM p);
extern SCM scm_multi_byte_port_p (SCM p);
extern SCM scm_multi_byte_port_x (SCM p);
extern SCM scm_wide_character_port_p (SCM p);
extern SCM scm_wide_character_port_x (SCM p);
extern void scm_put_wchar (int c, SCM port, int writing);
extern void scm_print_mb_string (SCM exp, SCM port, int writing);
extern void scm_print_mb_symbol (SCM exp, SCM port);
extern void scm_init_mbstrings (void);
#else /* STDC */
extern SCM scm_multi_byte_string_p ();
extern SCM scm_regular_string_p ();
extern SCM scm_multi_byte_string ();
extern int scm_mb_ilength ();
extern SCM scm_multi_byte_string_length ();
extern SCM scm_symbol_multi_byte_p ();
extern SCM scm_set_symbol_multi_byte_x ();
extern SCM scm_regular_port_p ();
extern SCM scm_regular_port_x ();
extern SCM scm_multi_byte_port_p ();
extern SCM scm_multi_byte_port_x ();
extern SCM scm_wide_character_port_p ();
extern SCM scm_wide_character_port_x ();
extern void scm_put_wchar ();
extern void scm_print_mb_string ();
extern void scm_print_mb_symbol ();
extern void scm_init_mbstrings ();
#endif /* STDC */
#endif /* MBSTRINGSH */

4101
libguile/numbers.c Normal file
View file

File diff suppressed because it is too large Load diff

436
libguile/numbers.h Normal file
View file

@ -0,0 +1,436 @@
/* classes: h_files */
#ifndef NUMBERSH
#define NUMBERSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
/* Immediate Numbers
*
* Inums are exact integer data that fits within an SCM word.
*
* SCM_INUMP applies only to values known to be Scheme objects.
* In particular, SCM_INUMP (SCM_CAR (x)) is valid only if x is known
* to be a SCM_CONSP. If x is only known to be a SCM_NIMP,
* SCM_INUMP (SCM_CAR (x)) can give wrong answers.
*/
#define SCM_INUMP(x) (2 & (int)(x))
#define SCM_NINUMP(x) (!SCM_INUMP(x))
#ifdef __TURBOC__
/* shifts of more than one are done by a library call, single shifts are
* performed in registers
*/
# define SCM_MAKINUM(x) ((((x)<<1)<<1)+2L)
#else
# define SCM_MAKINUM(x) (((x)<<2)+2L)
#endif /* def __TURBOC__ */
/* SCM_SRS is signed right shift */
/* Turbo C++ v1.0 has a bug with right shifts of signed longs!
* It is believed to be fixed in Turbo C++ v1.01
*/
#if (-1==(((-1)<<2)+2)>>2) && (__TURBOC__ != 0x295)
# define SCM_SRS(x, y) ((x)>>y)
# ifdef __TURBOC__
# define SCM_INUM(x) (((x)>>1)>>1)
# else
# define SCM_INUM(x) SCM_SRS(x, 2)
# endif /* def __TURBOC__ */
#else
# define SCM_SRS(x, y) (((x)<0) ? ~((~(x))>>y) : (x)>>y)
# define SCM_INUM(x) SCM_SRS(x, 2)
#endif /* (-1==(((-1)<<2)+2)>>2) && (__TURBOC__ != 0x295) */
/* A name for 0.
*/
#define SCM_INUM0 ((SCM) 2)
/* SCM_FIXABLE is non-0 if its long argument can be encoded in an SCM_INUM.
*/
#define SCM_POSSCM_FIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM)
#define SCM_NEGSCM_FIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM)
#define SCM_UNEGSCM_FIXABLE(n) ((n) <= -SCM_MOST_NEGATIVE_FIXNUM)
#define SCM_FIXABLE(n) (SCM_POSSCM_FIXABLE(n) && SCM_NEGSCM_FIXABLE(n))
/* SCM_INTBUFLEN is the maximum number of characters neccessary for the
* printed or scm_string representation of an exact immediate.
*/
#ifndef SCM_CHAR_BIT
# define SCM_CHAR_BIT 8
#endif /* ndef SCM_CHAR_BIT */
#ifndef SCM_LONG_BIT
# define SCM_LONG_BIT (SCM_CHAR_BIT*sizeof(long)/sizeof(char))
#endif /* ndef SCM_LONG_BIT */
#define SCM_INTBUFLEN (5+SCM_LONG_BIT)
/* SCM_FLOBUFLEN is the maximum number of characters neccessary for the
* printed or scm_string representation of an inexact number.
*/
#define SCM_FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
/* Numbers
*/
#define SCM_INEXP(x) (SCM_TYP16(x)==scm_tc16_flo)
#define SCM_CPLXP(x) (SCM_CAR(x)==scm_tc_dblc)
#define SCM_REAL(x) (*(((scm_dbl *) (SCM2PTR(x)))->real))
#define SCM_IMAG(x) (*((double *)(SCM_CHARS(x)+sizeof(double))))
/* ((&SCM_REAL(x))[1]) */
#ifdef SCM_SINGLES
#define SCM_REALP(x) ((~SCM_REAL_PART & SCM_CAR(x))==scm_tc_flo)
#define SCM_SINGP(x) (SCM_CAR(x)==scm_tc_flo)
#define SCM_FLO(x) (((scm_flo *)(SCM2PTR(x)))->num)
#define SCM_REALPART(x) (SCM_SINGP(x)?0.0+SCM_FLO(x):SCM_REAL(x))
#else /* SCM_SINGLES */
#define SCM_REALP(x) (SCM_CAR(x)==scm_tc_dblr)
#define SCM_REALPART SCM_REAL
#endif /* SCM_SINGLES */
/* Define SCM_BIGDIG to an integer type whose size is smaller than long if
* you want bignums. SCM_BIGRAD is one greater than the biggest SCM_BIGDIG.
*
* Define SCM_DIGSTOOBIG if the digits equivalent to a long won't fit in a long.
*/
#ifdef BIGNUMS
# ifdef _UNICOS
# define SCM_DIGSTOOBIG
# if (1L << 31) <= SCM_USHRT_MAX
# define SCM_BIGDIG unsigned short
# else
# define SCM_BIGDIG unsigned int
# endif /* (1L << 31) <= USHRT_MAX */
# define SCM_BITSPERDIG 32
# else
# define SCM_BIGDIG unsigned short
# define SCM_BITSPERDIG (sizeof(SCM_BIGDIG)*SCM_CHAR_BIT)
# endif /* def _UNICOS */
# define SCM_BIGRAD (1L << SCM_BITSPERDIG)
# define SCM_DIGSPERLONG ((scm_sizet)((sizeof(long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
# define SCM_DIGSPERLONGLONG ((scm_sizet)((sizeof(long long)*SCM_CHAR_BIT+SCM_BITSPERDIG-1)/SCM_BITSPERDIG))
# define SCM_BIGUP(x) ((unsigned long)(x) << SCM_BITSPERDIG)
# define SCM_LONGLONGSCM_BIGUP(x) ((ulong_long)(x) << SCM_BITSPERDIG)
# define SCM_BIGDN(x) ((x) >> SCM_BITSPERDIG)
# define SCM_BIGLO(x) ((x) & (SCM_BIGRAD-1))
#endif /* def BIGNUMS */
#ifndef SCM_BIGDIG
/* Definition is not really used but helps various function
* prototypes to compile with conditionalization.
*/
# define SCM_BIGDIG unsigned short
# define NO_SCM_BIGDIG
# ifndef SCM_FLOATS
# define SCM_INUMS_ONLY
# endif /* ndef SCM_FLOATS */
#endif /* ndef SCM_BIGDIG */
#ifdef SCM_FLOATS
#define SCM_NUMBERP(x) (SCM_INUMP(x) || (SCM_NIMP(x) && SCM_NUMP(x)))
#else
#ifdef SCM_BIGDIG
#define SCM_NUMBERP(x) (SCM_INUMP(x) || (SCM_NIMP(x) && SCM_NUMP(x)))
#else
#define SCM_NUMBERP SCM_INUMP
#endif
#endif
#define SCM_NUMP(x) ((0xfcff & (int)SCM_CAR(x))==scm_tc7_smob)
#define SCM_BIGP(x) (SCM_TYP16S(x)==scm_tc16_bigpos)
#define SCM_BIGSIGN(x) (0x0100 & (int)SCM_CAR(x))
#define SCM_BDIGITS(x) ((SCM_BIGDIG *)(SCM_CDR(x)))
#define SCM_NUMDIGS(x) ((scm_sizet)(SCM_CAR(x)>>16))
#define SCM_SETNUMDIGS(x, v, t) SCM_CAR(x) = (((v)+0L)<<16)+(t)
#ifdef SCM_FLOATS
typedef struct scm_dblproc
{
char *scm_string;
double (*cproc) ();
} scm_dblproc;
#ifdef SCM_SINGLES
typedef struct scm_flo
{
SCM type;
float num;
} scm_flo;
#endif
typedef struct scm_dbl
{
SCM type;
double *real;
} scm_dbl;
#endif
#ifdef __STDC__
extern SCM scm_exact_p(SCM x);
extern SCM scm_odd_p(SCM n);
extern SCM scm_even_p(SCM n);
extern SCM scm_abs(SCM x);
extern SCM scm_quotient(SCM x, SCM y);
extern SCM scm_remainder(SCM x, SCM y);
extern SCM scm_modulo(SCM x, SCM y);
extern SCM scm_gcd(SCM x, SCM y);
extern SCM scm_lcm(SCM n1, SCM n2);
extern SCM scm_logand(SCM n1, SCM n2);
extern SCM scm_logior(SCM n1, SCM n2);
extern SCM scm_logxor(SCM n1, SCM n2);
extern SCM scm_logtest(SCM n1, SCM n2);
extern SCM scm_logbit_p(SCM n1, SCM n2);
extern SCM scm_logand(SCM n1, SCM n2);
extern SCM scm_logior(SCM n1, SCM n2);
extern SCM scm_logxor(SCM n1, SCM n2);
extern SCM scm_logtest(SCM n1, SCM n2);
extern SCM scm_logbit_p(SCM n1, SCM n2);
extern SCM scm_lognot(SCM n);
extern SCM scm_integer_expt(SCM z1, SCM z2);
extern SCM scm_ash(SCM n, SCM cnt);
extern SCM scm_bit_extract(SCM n, SCM start, SCM end);
extern SCM scm_logcount (SCM n);
extern SCM scm_integer_length(SCM n);
extern SCM scm_mkbig(scm_sizet nlen, int sign);
extern SCM scm_big2inum(SCM b, scm_sizet l);
extern SCM scm_adjbig(SCM b, scm_sizet nlen);
extern SCM scm_normbig(SCM b);
extern SCM scm_copybig(SCM b, int sign);
extern SCM scm_long2big(long n);
extern SCM scm_long_long2big(long_long n);
extern SCM scm_2ulong2big(unsigned long * np);
extern SCM scm_ulong2big(unsigned long n);
extern int scm_bigcomp(SCM x, SCM y);
extern long scm_pseudolong(long x);
extern void scm_longdigs(long x, SCM_BIGDIG digs[]);
extern SCM scm_addbig(SCM_BIGDIG *x, scm_sizet nx, int xsgn, SCM bigy, int sgny);
extern SCM scm_mulbig(SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn);
extern unsigned int scm_divbigdig(SCM_BIGDIG *ds, scm_sizet h, SCM_BIGDIG div);
extern SCM scm_divbigint(SCM x, long z, int sgn, int mode);
extern SCM scm_divbigbig(SCM_BIGDIG *x, scm_sizet nx, SCM_BIGDIG *y, scm_sizet ny, int sgn, int modes);
extern scm_sizet scm_iint2str(long num, int rad, char *p);
extern SCM scm_number_to_string(SCM x, SCM radix);
extern int scm_floprint(SCM sexp, SCM port, int writing);
extern int scm_bigprint(SCM exp, SCM port, int writing);
extern SCM scm_istr2int(char *str, long len, long radix);
extern SCM scm_istr2int(char *str, long len, long radix);
extern SCM scm_istr2flo(char *str, long len, long radix);
extern SCM scm_istring2number(char *str, long len, long radix);
extern SCM scm_string_to_number(SCM str, SCM radix);
extern SCM scm_makdbl (double x, double y);
extern SCM scm_bigequal(SCM x, SCM y);
extern SCM scm_floequal(SCM x, SCM y);
extern SCM scm_number_p(SCM x);
extern SCM scm_real_p(SCM x);
extern SCM scm_int_p(SCM x);
extern SCM scm_inexact_p(SCM x);
extern SCM scm_num_eq_p (SCM x, SCM y);
extern SCM scm_less_p(SCM x, SCM y);
extern SCM scm_gr_p(SCM x, SCM y);
extern SCM scm_leq_p(SCM x, SCM y);
extern SCM scm_geq_p(SCM x, SCM y);
extern SCM scm_zero_p(SCM z);
extern SCM scm_positive_p(SCM x);
extern SCM scm_negative_p(SCM x);
extern SCM scm_max(SCM x, SCM y);
extern SCM scm_min(SCM x, SCM y);
extern SCM scm_sum(SCM x, SCM y);
extern SCM scm_difference(SCM x, SCM y);
extern SCM scm_product(SCM x, SCM y);
extern double scm_num2dbl (SCM a, char * why);
extern SCM scm_fuck (SCM a);
extern SCM scm_divide(SCM x, SCM y);
extern double scm_asinh(double x);
extern double scm_acosh(double x);
extern double scm_atanh(double x);
extern double scm_truncate(double x);
extern double scm_round(double x);
extern double scm_exact_to_inexact(double z);
extern SCM scm_sys_expt(SCM z1, SCM z2);
extern SCM scm_sys_atan2(SCM z1, SCM z2);
extern SCM scm_make_rectangular(SCM z1, SCM z2);
extern SCM scm_make_polar(SCM z1, SCM z2);
extern SCM scm_real_part(SCM z);
extern SCM scm_imag_part(SCM z);
extern SCM scm_magnitude(SCM z);
extern SCM scm_angle(SCM z);
extern SCM scm_inexact_to_exact(SCM z);
extern SCM scm_trunc(SCM x);
extern SCM scm_dbl2big(double d);
extern double scm_big2dbl(SCM b);
extern SCM scm_long2num(long sl);
extern SCM scm_long_long2num(long_long sl);
extern SCM scm_ulong2num(unsigned long sl);
extern long scm_num2long(SCM num, char *pos, char *s_caller);
extern long num2long(SCM num, char *pos, char *s_caller);
extern long_long scm_num2long_long(SCM num, char *pos, char *s_caller);
extern unsigned long scm_num2ulong(SCM num, char *pos, char *s_caller);
extern void scm_init_numbers (void);
#else /* STDC */
extern SCM scm_exact_p();
extern SCM scm_odd_p();
extern SCM scm_even_p();
extern SCM scm_abs();
extern SCM scm_quotient();
extern SCM scm_remainder();
extern SCM scm_modulo();
extern SCM scm_gcd();
extern SCM scm_lcm();
extern SCM scm_logand();
extern SCM scm_logior();
extern SCM scm_logxor();
extern SCM scm_logtest();
extern SCM scm_logbit_p();
extern SCM scm_logand();
extern SCM scm_logior();
extern SCM scm_logxor();
extern SCM scm_logtest();
extern SCM scm_logbit_p();
extern SCM scm_lognot();
extern SCM scm_integer_expt();
extern SCM scm_ash();
extern SCM scm_bit_extract();
extern SCM scm_logcount ();
extern SCM scm_integer_length();
extern SCM scm_mkbig();
extern SCM scm_big2inum();
extern SCM scm_adjbig();
extern SCM scm_normbig();
extern SCM scm_copybig();
extern SCM scm_long2big();
extern SCM scm_long_long2big();
extern SCM scm_2ulong2big();
extern SCM scm_ulong2big();
extern int scm_bigcomp();
extern long scm_pseudolong();
extern void scm_longdigs();
extern SCM scm_addbig();
extern SCM scm_mulbig();
extern unsigned int scm_divbigdig();
extern SCM scm_divbigint();
extern SCM scm_divbigbig();
extern scm_sizet scm_iint2str();
extern SCM scm_number_to_string();
extern int scm_floprint();
extern int scm_bigprint();
extern SCM scm_istr2int();
extern SCM scm_istr2int();
extern SCM scm_istr2flo();
extern SCM scm_istring2number();
extern SCM scm_string_to_number();
extern SCM scm_makdbl ();
extern SCM scm_bigequal();
extern SCM scm_floequal();
extern SCM scm_number_p();
extern SCM scm_real_p();
extern SCM scm_int_p();
extern SCM scm_inexact_p();
extern SCM scm_num_eq_p ();
extern SCM scm_less_p();
extern SCM scm_gr_p();
extern SCM scm_leq_p();
extern SCM scm_geq_p();
extern SCM scm_zero_p();
extern SCM scm_positive_p();
extern SCM scm_negative_p();
extern SCM scm_max();
extern SCM scm_min();
extern SCM scm_sum();
extern SCM scm_difference();
extern SCM scm_product();
extern double scm_num2dbl ();
extern SCM scm_fuck ();
extern SCM scm_divide();
extern double scm_asinh();
extern double scm_acosh();
extern double scm_atanh();
extern double scm_truncate();
extern double scm_round();
extern double scm_exact_to_inexact();
extern SCM scm_sys_expt();
extern SCM scm_sys_atan2();
extern SCM scm_make_rectangular();
extern SCM scm_make_polar();
extern SCM scm_real_part();
extern SCM scm_imag_part();
extern SCM scm_magnitude();
extern SCM scm_angle();
extern SCM scm_inexact_to_exact();
extern SCM scm_trunc();
extern SCM scm_dbl2big();
extern double scm_big2dbl();
extern SCM scm_long2num();
extern SCM scm_long_long2num();
extern SCM scm_ulong2num();
extern long scm_num2long();
extern long num2long();
extern long_long scm_num2long_long();
extern unsigned long scm_num2ulong();
extern void scm_init_numbers ();
#endif /* STDC */
#endif /* NUMBERSH */

137
libguile/objprop.c Normal file
View file

@ -0,0 +1,137 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
/* {Object Properties}
*/
SCM_PROC(s_object_properties, "object-properties", 1, 0, 0, scm_object_properties);
#ifdef __STDC__
SCM
scm_object_properties (SCM obj)
#else
SCM
scm_object_properties (obj)
SCM obj;
#endif
{
return scm_hashq_create_handle_x (scm_object_whash, obj, SCM_EOL);
}
SCM_PROC(s_set_object_properties_x, "set-object-properties!", 2, 0, 0, scm_set_object_properties_x);
#ifdef __STDC__
SCM
scm_set_object_properties_x (SCM obj, SCM plist)
#else
SCM
scm_set_object_properties_x (obj, plist)
SCM obj;
SCM plist;
#endif
{
SCM handle;
scm_hashq_create_handle_x (scm_object_whash, obj, plist);
SCM_SETCDR (handle, plist);
return plist;
}
SCM_PROC(s_object_property, "object-property", 2, 0, 0, scm_object_property);
#ifdef __STDC__
SCM
scm_object_property (SCM obj, SCM key)
#else
SCM
scm_object_property (obj, key)
SCM obj;
SCM key;
#endif
{
SCM assoc;
assoc = scm_assq (key, SCM_CDR (scm_object_properties (obj)));
return (SCM_NIMP (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F);
}
SCM_PROC(s_set_object_property_x, "set-object-property!", 3, 0, 0, scm_set_object_property_x);
#ifdef __STDC__
SCM
scm_set_object_property_x (SCM obj, SCM key, SCM val)
#else
SCM
scm_set_object_property_x (obj, key, val)
SCM obj;
SCM key;
SCM val;
#endif
{
SCM h;
SCM assoc;
h = scm_hashq_create_handle_x (scm_object_whash, obj, SCM_EOL);
SCM_DEFER_INTS;
assoc = scm_assoc (key, SCM_CDR (h));
if (SCM_NIMP (assoc))
SCM_SETCDR (assoc, val);
else
{
assoc = scm_acons (key, val, SCM_CDR (h));
SCM_SETCDR (h, assoc);
}
SCM_ALLOW_INTS;
return val;
}
#ifdef __STDC__
void
scm_init_objprop (void)
#else
void
scm_init_objprop ()
#endif
{
scm_object_whash = scm_make_weak_hash_table (SCM_MAKINUM (511));
#include "objprop.x"
}

73
libguile/objprop.h Normal file
View file

@ -0,0 +1,73 @@
/* classes: h_files */
#ifndef OBJPROPH
#define OBJPROPH
/* Copyright (C) 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifdef __STDC__
extern SCM scm_object_properties (SCM obj);
extern SCM scm_set_object_properties_x (SCM obj, SCM plist);
extern SCM scm_object_property (SCM obj, SCM key);
extern SCM scm_set_object_property_x (SCM obj, SCM key, SCM val);
extern void scm_init_objprop (void);
#else /* STDC */
extern SCM scm_object_properties ();
extern SCM scm_set_object_properties_x ();
extern SCM scm_object_property ();
extern SCM scm_set_object_property_x ();
extern void scm_init_objprop ();
#endif /* STDC */
#endif /* OBJPROPH */

196
libguile/pairs.c Normal file
View file

@ -0,0 +1,196 @@
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include <stdio.h>
#include "_scm.h"
#ifdef __STDC__
#include <stdarg.h>
#define var_start(x, y) va_start(x, y)
#else
#include <varargs.h>
#define var_start(x, y) va_start(x)
#endif
/* {Pairs}
*/
SCM_PROC(s_cons, "cons", 2, 0, 0, scm_cons);
#ifdef __STDC__
SCM
scm_cons (SCM x, SCM y)
#else
SCM
scm_cons (x, y)
SCM x;
SCM y;
#endif
{
register SCM z;
SCM_NEWCELL (z);
SCM_CAR (z) = x;
SCM_CDR (z) = y;
return z;
}
#ifdef __STDC__
SCM
scm_cons2 (SCM w, SCM x, SCM y)
#else
SCM
scm_cons2 (w, x, y)
SCM w;
SCM x;
SCM y;
#endif
{
register SCM z;
SCM_NEWCELL (z);
SCM_CAR (z) = x;
SCM_CDR (z) = y;
x = z;
SCM_NEWCELL (z);
SCM_CAR (z) = w;
SCM_CDR (z) = x;
return z;
}
SCM_PROC(s_pair_p, "pair?", 1, 0, 0, scm_pair_p);
#ifdef __STDC__
SCM
scm_pair_p(SCM x)
#else
SCM
scm_pair_p(x)
SCM x;
#endif
{
if SCM_IMP(x) return SCM_BOOL_F;
return SCM_CONSP(x) ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM_PROC(s_set_car_x, "set-car!", 2, 0, 0, scm_set_car_x);
#ifdef __STDC__
SCM
scm_set_car_x(SCM pair, SCM value)
#else
SCM
scm_set_car_x(pair, value)
SCM pair;
SCM value;
#endif
{
SCM_ASSERT(SCM_NIMP(pair) && SCM_CONSP(pair), pair, SCM_ARG1, s_set_car_x);
SCM_CAR(pair) = value;
return value;
}
SCM_PROC(s_set_cdr_x, "set-cdr!", 2, 0, 0, scm_set_cdr_x);
#ifdef __STDC__
SCM
scm_set_cdr_x(SCM pair, SCM value)
#else
SCM
scm_set_cdr_x(pair, value)
SCM pair;
SCM value;
#endif
{
SCM_ASSERT(SCM_NIMP(pair) && SCM_CONSP(pair), pair, SCM_ARG1, s_set_cdr_x);
SCM_CDR(pair) = value;
return value;
}
static scm_iproc cxrs[] =
{
{"car", 0},
{"cdr", 0},
{"caar", 0},
{"cadr", 0},
{"cdar", 0},
{"cddr", 0},
{"caaar", 0},
{"caadr", 0},
{"cadar", 0},
{"caddr", 0},
{"cdaar", 0},
{"cdadr", 0},
{"cddar", 0},
{"cdddr", 0},
{"caaaar", 0},
{"caaadr", 0},
{"caadar", 0},
{"caaddr", 0},
{"cadaar", 0},
{"cadadr", 0},
{"caddar", 0},
{"cadddr", 0},
{"cdaaar", 0},
{"cdaadr", 0},
{"cdadar", 0},
{"cdaddr", 0},
{"cddaar", 0},
{"cddadr", 0},
{"cdddar", 0},
{"cddddr", 0},
{0, 0}
};
#ifdef __STDC__
void
scm_init_pairs (void)
#else
void
scm_init_pairs ()
#endif
{
scm_init_iprocs(cxrs, scm_tc7_cxr);
#include "pairs.x"
}

170
libguile/pairs.h Normal file
View file

@ -0,0 +1,170 @@
/* classes: h_files */
#ifndef PAIRSH
#define PAIRSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
typedef struct scm_cell
{
SCM car;
SCM cdr;
} scm_cell;
/* SCM_PTR_LT defines how to compare two SCM_CELLPTRs (which may not be in the
* same scm_array). SCM_CELLPTR is a pointer to a cons cell which may be
* compared or differenced. SCMPTR is used for stack bounds.
*/
#if !defined(__TURBOC__) || defined(__TOS__)
typedef scm_cell *SCM_CELLPTR;
typedef SCM *SCMPTR;
# ifdef nosve
# define SCM_PTR_MASK 0xffffffffffff
# define SCM_PTR_LT(x, y) (((int)(x)&SCM_PTR_MASK) < ((int)(y)&SCM_PTR_MASK))
# else
# define SCM_PTR_LT(x, y) ((x) < (y))
# endif /* def nosve */
#else /* defined(__TURBOC__) && !defined(__TOS__) */
# ifdef PROT386
typedef scm_cell *SCM_CELLPTR;
typedef SCM *SCMPTR;
# define SCM_PTR_LT(x, y) (((long)(x)) < ((long)(y)))
# else
typedef scm_cell huge *SCM_CELLPTR;
typedef SCM huge *SCMPTR;
# define SCM_PTR_LT(x, y) ((x) < (y))
# endif /* def PROT386 */
#endif /* defined(__TURBOC__) && !defined(__TOS__) */
#define SCM_PTR_GT(x, y) SCM_PTR_LT(y, x)
#define SCM_PTR_LE(x, y) (!SCM_PTR_GT(x, y))
#define SCM_PTR_GE(x, y) (!SCM_PTR_LT(x, y))
#define SCM_EOL SCM_BOOL_F
#define SCM_NULLP(x) (SCM_EOL == (x))
#define SCM_NNULLP(x) (SCM_EOL != (x))
/* Cons Pairs
*/
#define SCM_CAR(x) (((scm_cell *)(SCM2PTR(x)))->car)
#define SCM_CDR(x) (((scm_cell *)(SCM2PTR(x)))->cdr)
#define SCM_GCCDR(x) (~1L & SCM_CDR(x))
#define SCM_SETCDR(x, v) SCM_CDR(x) = (SCM)(v)
#define SCM_SETCAR(x, v) SCM_CAR(x) = (SCM)(v)
#define SCM_CAAR(OBJ) SCM_CAR (SCM_CAR (OBJ))
#define SCM_CDAR(OBJ) SCM_CDR (SCM_CAR (OBJ))
#define SCM_CADR(OBJ) SCM_CAR (SCM_CDR (OBJ))
#define SCM_CDDR(OBJ) SCM_CDR (SCM_CDR (OBJ))
#define SCM_CAAAR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (OBJ)))
#define SCM_CDAAR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (OBJ)))
#define SCM_CADAR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (OBJ)))
#define SCM_CDDAR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (OBJ)))
#define SCM_CAADR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (OBJ)))
#define SCM_CDADR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (OBJ)))
#define SCM_CADDR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (OBJ)))
#define SCM_CDDDR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (OBJ)))
#define SCM_CAAAAR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
#define SCM_CDAAAR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (SCM_CAR (OBJ))))
#define SCM_CADAAR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
#define SCM_CDDAAR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (SCM_CAR (OBJ))))
#define SCM_CAADAR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
#define SCM_CDADAR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (SCM_CAR (OBJ))))
#define SCM_CADDAR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
#define SCM_CDDDAR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (SCM_CAR (OBJ))))
#define SCM_CAAADR(OBJ) SCM_CAR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
#define SCM_CDAADR(OBJ) SCM_CDR (SCM_CAR (SCM_CAR (SCM_CDR (OBJ))))
#define SCM_CADADR(OBJ) SCM_CAR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
#define SCM_CDDADR(OBJ) SCM_CDR (SCM_CDR (SCM_CAR (SCM_CDR (OBJ))))
#define SCM_CAADDR(OBJ) SCM_CAR (SCM_CAR (SCM_CDR (SCM_CDR (OBJ))))
#define SCM_CDADDR(OBJ) SCM_CDR (SCM_CAR (SCM_CDR (SCM_CDR (OBJ))))
#define SCM_CADDDR(OBJ) SCM_CAR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
#define SCM_CDDDDR(OBJ) SCM_CDR (SCM_CDR (SCM_CDR (SCM_CDR (OBJ))))
#define SCM_NEWCELL(_into) \
{ \
if (SCM_IMP(scm_freelist)) \
_into = scm_gc_for_newcell();\
else \
{ \
_into = scm_freelist; \
scm_freelist = SCM_CDR(scm_freelist);\
++scm_cells_allocated; \
} \
}
#ifdef __STDC__
extern SCM scm_cons (SCM x, SCM y);
extern SCM scm_cons2 (SCM w, SCM x, SCM y);
extern SCM scm_pair_p(SCM x);
extern SCM scm_set_car_x(SCM pair, SCM value);
extern SCM scm_set_cdr_x(SCM pair, SCM value);
extern void scm_init_pairs (void);
#else /* STDC */
extern SCM scm_cons ();
extern SCM scm_cons2 ();
extern SCM scm_pair_p();
extern SCM scm_set_car_x();
extern SCM scm_set_cdr_x();
extern void scm_init_pairs ();
#endif /* STDC */
#endif /* PAIRSH */

1000
libguile/ports.c Normal file
View file

File diff suppressed because it is too large Load diff

229
libguile/ports.h Normal file
View file

@ -0,0 +1,229 @@
/* classes: h_files */
#ifndef PORTSH
#define PORTSH
/* Copyright (C) 1995,1996 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#include "smob.h"
enum scm_port_representation_type
{
scm_regular_port,
scm_mb_port,
scm_wchar_port
};
enum scm_string_representation_type
{
scm_regular_string = scm_regular_port,
scm_mb_string = scm_mb_port,
scm_wchar_string = scm_wchar_port
};
struct scm_port_table
{
SCM port; /* Open port. */
int revealed; /* 0 not revealed, > 1 revealed.
* Revealed ports do not get GC'd.
*/
SCM stream;
SCM file_name;
int unchr; /* pushed back character, if any */
int line_number;
int column_number;
enum scm_port_representation_type representation;
};
extern struct scm_port_table **scm_port_table;
extern scm_port_table_size; /* Number of ports in scm_port_table. */
/* PORT FLAGS
* A set of flags caracterizes a port.
*/
#define SCM_OPN (1L<<16) /* Is the port open? */
#define SCM_RDNG (2L<<16) /* Is it a readable port? */
#define SCM_WRTNG (4L<<16) /* Is it writable? */
#define SCM_BUF0 (8L<<16)
#define SCM_CRDY (32L<<16) /* Should char-ready? return #t? */
/* A mask used to clear the char-ready port flag. */
#define SCM_CUC 0x001fffffL
#define SCM_PORTP(x) (SCM_TYP7(x)==scm_tc7_port)
#define SCM_OPPORTP(x) (((0x7f | SCM_OPN) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN))
#define SCM_OPINPORTP(x) (((0x7f | SCM_OPN | SCM_RDNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))
#define SCM_OPOUTPORTP(x) (((0x7f | SCM_OPN | SCM_WRTNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))
#define SCM_FPORTP(x) (SCM_TYP16S(x)==scm_tc7_port)
#define SCM_OPFPORTP(x) (((0xfeff | SCM_OPN) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN))
#define SCM_OPINFPORTP(x) (((0xfeff | SCM_OPN | SCM_RDNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_RDNG))
#define SCM_OPOUTFPORTP(x) (((0xfeff | SCM_OPN | SCM_WRTNG) & SCM_CAR(x))==(scm_tc7_port | SCM_OPN | SCM_WRTNG))
#define SCM_INPORTP(x) (((0x7f | SCM_RDNG) & SCM_CAR(x))==(scm_tc7_port | SCM_RDNG))
#define SCM_OUTPORTP(x) (((0x7f | SCM_WRTNG) & SCM_CAR(x))==(scm_tc7_port | SCM_WRTNG))
#define SCM_OPENP(x) (SCM_OPN & SCM_CAR(x))
#define SCM_CLOSEDP(x) (!SCM_OPENP(x))
#define SCM_PTAB_ENTRY(x) ((struct scm_port_table *)SCM_CDR(x))
#define SCM_SETPTAB_ENTRY(x,ent) SCM_SETCDR ((x), (SCM)(ent))
#define SCM_STREAM(x) SCM_PTAB_ENTRY(x)->stream
#define SCM_SETSTREAM(x,s) (SCM_PTAB_ENTRY(x)->stream = s)
#define SCM_LINUM(x) SCM_PTAB_ENTRY(x)->line_number
#define SCM_COL(x) SCM_PTAB_ENTRY(x)->column_number
#define SCM_REVEALED(x) SCM_PTAB_ENTRY(x)->revealed
#define SCM_SETREVEALED(x,s) (SCM_PTAB_ENTRY(x)->revealed = s)
#define SCM_PORT_REPRESENTATION(x) SCM_PTAB_ENTRY(x)->representation
#define SCM_SET_PORT_REPRESENTATION(x,s) (SCM_PTAB_ENTRY(x)->representation = s)
#define SCM_CRDYP(port) (SCM_CAR(port) & SCM_CRDY)
#define SCM_CLRDY(port) {SCM_CAR(port) &= SCM_CUC;}
#define SCM_SETRDY(port) {SCM_CAR(port) |= SCM_CRDY;}
#define SCM_CUNGET(c,port) {SCM_PTAB_ENTRY(port)->unchr = c; SCM_SETRDY(port);}
#define SCM_CGETUN(port) (SCM_PTAB_ENTRY(port)->unchr)
#define SCM_INCLINE(port) {SCM_LINUM (port) += 1; SCM_COL (port) = 0;}
#define SCM_INCCOL(port) {SCM_COL (port) += 1;}
#define SCM_TABCOL(port) {SCM_COL (port) += (SCM_COL (port) + 1) % 8;}
extern scm_ptobfuns *scm_ptobs;
extern scm_sizet scm_numptob;
extern int scm_port_table_room;
#ifdef __STDC__
extern SCM scm_markstream (SCM ptr);
extern long scm_newptob (scm_ptobfuns *ptob);
extern void scm_fflush (SCM port);
extern SCM scm_char_ready_p (SCM port);
extern SCM scm_ungetc_char_ready_p (SCM port);
extern SCM scm_current_input_port (void);
extern SCM scm_current_output_port (void);
extern SCM scm_current_error_port (void);
extern SCM scm_set_current_input_port (SCM port);
extern SCM scm_set_current_output_port (SCM port);
extern SCM scm_set_current_error_port (SCM port);
extern struct scm_port_table * scm_add_to_port_table (SCM port);
extern void scm_remove_from_port_table (SCM port);
extern SCM scm_pt_size (void);
extern SCM scm_pt_member (SCM member);
extern int scm_revealed_count (SCM port);
extern SCM scm_port_revealed (SCM port);
extern SCM scm_set_port_revealed_x (SCM port, SCM rcount);
extern SCM scm_close_port (SCM port);
extern SCM scm_input_port_p (SCM x);
extern SCM scm_output_port_p (SCM x);
extern SCM scm_eof_object_p (SCM x);
extern SCM scm_force_output (SCM port);
extern SCM scm_read_char (SCM port);
extern SCM scm_peek_char (SCM port);
extern SCM scm_unread_char (SCM cobj, SCM port);
extern SCM scm_line_number (SCM port);
extern SCM scm_column_number (SCM port);
extern SCM scm_port_file_name (SCM port);
extern void scm_prinport (SCM exp, SCM port, char *type);
extern void scm_ports_prehistory (void);
extern SCM scm_void_port (char * mode_str);
extern SCM scm_sys_make_void_port (SCM mode);
extern void scm_init_ports (void);
#else /* STDC */
extern SCM scm_markstream ();
extern long scm_newptob ();
extern void scm_fflush ();
extern SCM scm_char_ready_p ();
extern SCM scm_ungetc_char_ready_p ();
extern SCM scm_current_input_port ();
extern SCM scm_current_output_port ();
extern SCM scm_current_error_port ();
extern SCM scm_set_current_input_port ();
extern SCM scm_set_current_output_port ();
extern SCM scm_set_current_error_port ();
extern struct scm_port_table * scm_add_to_port_table ();
extern void scm_remove_from_port_table ();
extern SCM scm_pt_size ();
extern SCM scm_pt_member ();
extern int scm_revealed_count ();
extern SCM scm_port_revealed ();
extern SCM scm_set_port_revealed_x ();
extern SCM scm_close_port ();
extern SCM scm_input_port_p ();
extern SCM scm_output_port_p ();
extern SCM scm_eof_object_p ();
extern SCM scm_force_output ();
extern SCM scm_read_char ();
extern SCM scm_peek_char ();
extern SCM scm_unread_char ();
extern SCM scm_line_number ();
extern SCM scm_column_number ();
extern SCM scm_port_file_name ();
extern void scm_prinport ();
extern void scm_ports_prehistory ();
extern SCM scm_void_port ();
extern SCM scm_sys_make_void_port ();
extern void scm_init_ports ();
#endif /* STDC */
#endif /* PORTSH */

1510
libguile/posix.c Normal file
View file

File diff suppressed because it is too large Load diff

145
libguile/posix.h Normal file
View file

@ -0,0 +1,145 @@
/* classes: h_files */
#ifndef POSIXH
#define POSIXH
/* Copyright (C) 1995 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
#include "__scm.h"
#ifdef __STDC__
extern SCM scm_sys_pipe (void);
extern SCM scm_sys_getgroups(void);
extern SCM scm_sys_getpwuid (SCM user);
extern SCM scm_setpwent (SCM arg);
extern SCM scm_sys_getgrgid (SCM name);
extern SCM scm_setgrent (SCM arg);
extern SCM scm_sys_kill (SCM pid, SCM sig);
extern SCM scm_sys_waitpid (SCM pid, SCM options);
extern SCM scm_getppid (void);
extern SCM scm_getuid (void);
extern SCM scm_getgid (void);
extern SCM scm_geteuid (void);
extern SCM scm_getegid (void);
extern SCM scm_sys_setuid (SCM id);
extern SCM scm_sys_setgid (SCM id);
extern SCM scm_sys_seteuid (SCM id);
extern SCM scm_sys_setegid (SCM id);
extern SCM scm_ttyname (SCM port);
extern SCM scm_sys_execl (SCM args);
extern SCM scm_sys_execlp (SCM args);
extern SCM scm_sys_fork(void);
extern SCM scm_sys_uname (void);
extern SCM scm_environ (SCM env);
extern SCM scm_open_pipe (SCM pipestr, SCM modes);
extern SCM scm_open_input_pipe(SCM pipestr);
extern SCM scm_open_output_pipe(SCM pipestr);
extern SCM scm_sys_utime (SCM pathname, SCM actime, SCM modtime);
extern SCM scm_sys_access (SCM path, SCM how);
extern SCM scm_getpid (void);
extern SCM scm_sys_putenv (SCM str);
extern SCM scm_read_line (SCM port, SCM include_terminator);
extern SCM scm_read_line_x (SCM str, SCM port);
extern SCM scm_write_line (SCM obj, SCM port);
extern SCM scm_setlocale (SCM category, SCM locale);
extern SCM scm_strftime (SCM format, SCM stime);
extern SCM scm_sys_strptime (SCM format, SCM string);
extern SCM scm_sys_mknod(SCM path, SCM mode, SCM dev);
extern SCM scm_sys_nice(SCM incr);
extern SCM scm_sync(void);
extern void scm_init_posix (void);
#else /* STDC */
extern SCM scm_sys_pipe ();
extern SCM scm_sys_getgroups();
extern SCM scm_sys_getpwuid ();
extern SCM scm_setpwent ();
extern SCM scm_sys_getgrgid ();
extern SCM scm_setgrent ();
extern SCM scm_sys_kill ();
extern SCM scm_sys_waitpid ();
extern SCM scm_getppid ();
extern SCM scm_getuid ();
extern SCM scm_getgid ();
extern SCM scm_geteuid ();
extern SCM scm_getegid ();
extern SCM scm_sys_setuid ();
extern SCM scm_sys_setgid ();
extern SCM scm_sys_seteuid ();
extern SCM scm_sys_setegid ();
extern SCM scm_ttyname ();
extern SCM scm_sys_execl ();
extern SCM scm_sys_execlp ();
extern SCM scm_sys_fork();
extern SCM scm_sys_uname ();
extern SCM scm_environ ();
extern SCM scm_open_pipe ();
extern SCM scm_open_input_pipe();
extern SCM scm_open_output_pipe();
extern SCM scm_sys_utime ();
extern SCM scm_sys_access ();
extern SCM scm_getpid ();
extern SCM scm_sys_putenv ();
extern SCM scm_read_line ();
extern SCM scm_read_line_x ();
extern SCM scm_write_line ();
extern SCM scm_setlocale ();
extern SCM scm_strftime ();
extern SCM scm_sys_strptime ();
extern SCM scm_sys_mknod();
extern SCM scm_sys_nice();
extern SCM scm_sync();
extern void scm_init_posix ();
#endif /* STDC */
#endif /* POSIXH */

Some files were not shown because too many files have changed in this diff Show more