scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

GC_PROTECT some variables.

This commit is contained in:
mainzelm 2003-05-01 10:21:33 +00:00
parent 37210efdc5
commit 3e397f65c5
890 changed files with 144932 additions and 28421 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
.gitignore vendored
View File

@ -26,3 +26,11 @@ _$*
*.ln
core
# CVS default ignores end
Makefile
configure
config.log
config.cache
config.status
scsh.image
scshvm
go

7
COPYING
View File

@ -1,4 +1,8 @@
Copyright (c) 1993-1999 Richard Kelsey and Jonathan Rees
Copyright (c) 1993-2002 Richard Kelsey and Jonathan Rees
Copyright (c) 1994-2002 by Olin Shivers and Brian D. Carlstrom.
Copyright (c) 1999-2002 by Martin Gasbichler.
Copyright (c) 2001-2002 by Michael Sperber.
All rights reserved.
Redistribution and use in source and binary forms, with or without
@ -23,7 +27,6 @@ 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.
Distributing Autoconf Output
****************************

85
CVS_README Normal file
View File

@ -0,0 +1,85 @@
Welcome to the Scsh CVS Repository !!!
This file contains some instructions about how to build Scsh after you
freshly checked out the "scsh-0.6" module. These instructions do *not*
apply to the module named "scsh" or the Scsh distribution itself.
There is currently no scheme to tag working snapshots of the
repository, so anything may happen during the build process. The scsh
team does in general *not* provide support for code obtained from the
CVS repository.
During the build process a number of auto-generated files not included
in the CVS repository are built. It is highly recommended to follow
these instructions carefully as otherwise incompatible versions of
generated files may result. Note that you need GNU make for this
process.
To build Scsh, proceed as follows:
1.) You must have a working version of Scheme 48, version 0.53. Nothing
older, nothing newer. Just 0.53. If you don't have, get it from
http://www.s48.org/0.53/scheme48-0.53.tgz and install Scheme
48. Change to value of the variable BUILD_RUNNABLE in Makefile.in
so that it will point to the Scheme 48 executable.
2.) "cd" into the directory which contains the source code (normally
scsh-0.6) and run the script autogen.sh:
./autogen.sh
This will take several minutes and generate the source code for
the virtual machine and two images the Makefile relies
on. Furthermore the configure file will be generated. This script
calls autoheader and autoconf from the GNU Autoconf package. You
will need a recent version of Autoconf. Version 2.52 is okay,
version 2.13 is too old.
3.) Configure the system:
./configure
You presumably want to add the --prefix flag here to determine the
installation directory. This will generate the Makefile.
4.) Build the system:
make
If anything fails here, fix the problem and/or contact the authors.
5.) You should have a runnable version of the system that can be
started in the main directory like this:
./go
6.) To install Scsh, type:
make install
Note that it is not recommended to have a CVS version of Scsh for
daily use.
7.) If you intend to build on a different platform later, do a
make distclean
and restart at step 3.
You should repeat the whole build process whenever there are changes
to files in the directories scheme/vm, scheme/rts or
scheme/bcomp. Watch the run of cvs update carefully and/or subscribe
to the list scsh-checkins@lists.sourceforge.net.
Enjoy!!!
The Scsh developers

137
INSTALL
View File

@ -1,120 +1,49 @@
This is a generic INSTALL file for utilities distributions.
If this package does not come with, e.g., installable documentation or
data files, please ignore the references to them below.
Installing scsh
[For information specific to Scheme 48, see doc/install.txt.]
The `configure' shell script attempts to guess correct values for
various system-dependent variables used during compilation, and
creates the Makefile(s) (one in each subdirectory of the source
directory). In some packages it creates a C header file containing
system-dependent definitions. It also creates a file `config.status'
that you can run in the future to recreate the current configuration.
To compile this package:
This file describes how to install scsh from the source package. If
you have obtained the source tree from CVS refer to the file
CVS_README.
1. Configure the package for your system.
Normally, you just `cd' to the directory containing the package's
source code and type `./configure'. If you're using `csh' on an old
version of System V, you might need to type `sh configure' instead to
prevent `csh' from trying to execute `configure' itself.
Just `cd' to the directory containing this README file and type
Running `configure' takes a minute or two. While it is running, it
prints some messages that tell what it is doing. If you don't want to
see the messages, run `configure' with its standard output redirected
to `/dev/null'; for example, `./configure >/dev/null'.
./configure
You can pass some additional options to the configure script, along
them the installation directory with the
--prefix=/my/install/location option. Type ./configure --help to
get a list of all switches.
Running `configure' takes a minute or two. While it is running, it
prints some messages that tell what it is doing. Consult the file
config.log if anything went wrong.
To compile the package in a different directory from the one
containing the source code, you must use a version of `make' that
supports the `VPATH' variable, such as GNU `make'. `cd' to the
directory where you want the object files and executables to go and run
the `configure' script. `configure' automatically checks for the
source code in the directory that `configure' is in and in `..'. If
for some reason `configure' is not in the source code directory that
you are configuring, then it will report that it can't find the source
code. In that case, run `configure' with the option `--srcdir=DIR',
where DIR is the directory that contains the source code.
2. Type
By default, `make install' will install the package's files in
`/usr/local/bin', `/usr/local/man', etc. You can specify an
installation prefix other than `/usr/local' by giving `configure' the
option `--prefix=PATH'. Alternately, you can do so by consistently
giving a value for the `prefix' variable when you run `make', e.g.,
make prefix=/usr/gnu
make prefix=/usr/gnu install
make
to compile scsh.
You can specify separate installation prefixes for
architecture-specific files and architecture-independent files. If you
give `configure' the option `--exec-prefix=PATH' or set the `make'
variable `exec_prefix' to PATH, the package will use PATH as the prefix
for installing programs and libraries. Data files and documentation
will still use the regular prefix. Normally, all files are installed
using the same prefix.
3. After a successful build you can invoke scsh by typing
Some packages pay attention to `--with-PACKAGE' options to
`configure', where PACKAGE is something like `gnu-as' or `x' (for the X
Window System). The README should mention any `--with-' options that
the package recognizes.
./go
`configure' ignores any other arguments that you give it.
You should see the command prompt of scsh which you can exit by
typing `,exit'.
On systems that require unusual options for compilation or linking
that the package's `configure' script does not know about, you can give
`configure' initial values for variables by setting them in the
environment. In Bourne-compatible shells, you can do that on the
command line like this:
4. Type
CC='gcc -traditional' LIBS=-lposix ./configure
make install
Here are the `make' variables that you might want to override with
environment variables when running `configure'.
For these variables, any value given in the environment overrides the
value that `configure' would choose:
- Variable: CC
C compiler program. The default is `cc'.
- Variable: INSTALL
Program to use to install files. The default is `install' if you
have it, `cp' otherwise.
For these variables, any value given in the environment is added to
the value that `configure' chooses:
- Variable: DEFS
Configuration options, in the form `-Dfoo -Dbar...'. Do not use
this variable in packages that create a configuration header file.
- Variable: LIBS
Libraries to link with, in the form `-lfoo -lbar...'.
If you need to do unusual things to compile the package, we encourage
you to figure out how `configure' could check whether to do them, and
mail diffs or instructions to the address given in the README so we
can include them in the next release.
2. Type `make' to compile the package. If you want, you can override
the `make' variables CFLAGS and LDFLAGS like this:
make CFLAGS=-O2 LDFLAGS=-s
3. If the package comes with self-tests and you want to run them,
type `make check'. If you're not sure whether there are any, try it;
if `make' responds with something like
make: *** No way to make target `check'. Stop.
then the package does not come with self-tests.
4. Type `make install' to install programs, data files, and
documentation.
to install programs, data files, and documentation.
5. You can remove the program binaries and object files from the
source directory by typing `make clean'. To also remove the
Makefile(s), the header file containing system-dependent definitions
(if the package uses one), and `config.status' (all the files that
`configure' created), type `make distclean'.
source directory by typing `make clean'. To also remove the
Makefile, the header file containing system-dependent definitions
, `config.status' and `config.cache' (all the files that
`configure' created), type `make distclean'.
The file `configure.in' is used to create `configure' by a program
called `autoconf'. You only need it if you want to regenerate
`configure' using a newer version of `autoconf'.
For more information about scsh have a look into the README file and
the documentation in the `doc/' directory. There you can also read
documentation about Scheme 48, the Scheme implementation scsh is based
on.

546
Makefile.in
View File

@ -1,4 +1,4 @@
# Scheme 48 Makefile
# Scsh Makefile
# Documentation in files INSTALL and doc/install.txt
SHELL = /bin/sh
@ -14,18 +14,24 @@ INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
LDFLAGS = @LDFLAGS@
LDFLAGS = -g @LDFLAGS@
LIBOBJS = @LIBOBJS@
RM = rm -f
AR = @AR@
RANLIB = @RANLIB@
prefix = @prefix@
exec_prefix = @exec_prefix@
bindir = @bindir@
libdir = @libdir@
incdir = @includedir@
manext = 1
mandir = @mandir@/man$(manext)
### End of `configure' section###
bindir = $(exec_prefix)/bin
libdir = $(exec_prefix)/lib
incdir = $(exec_prefix)/include
manext = 1
mandir = $(prefix)/man/man$(manext)
htmldir = $(libdir)/scsh/doc/scsh-manual/html
# HP 9000 series, if you don't have gcc
# CC = cc
@ -36,10 +42,13 @@ mandir = $(prefix)/man/man$(manext)
# LDFLAGS = -N
.c.o:
$(CC) -c $(CPPFLAGS) $(DEFS) -I$(srcdir)/c $(CFLAGS) -o $@ $<
$(CC) -g -c $(DEFS) -I$(srcdir)/c -I$(srcdir)/cig $(CPPFLAGS) $(CFLAGS) -o $@ $<
# You might want to change RUNNABLE to "s48"
RUNNABLE = scheme48
# BUILD_RUNNABLE has to be Scheme 48 0.53. This is used for builds directly
# out of the CVS repository.
# We cannot use Scsh here since -i is not understood.
BUILD_RUNNABLE = /afs/wsi/i386_fbsd32/bin/scheme48
RUNNABLE = scsh
MANPAGE = $(RUNNABLE).$(manext)
LIB = $(libdir)/$(RUNNABLE)
@ -68,13 +77,19 @@ include $(srcdir)/build/filenames.make
# LINKER_RUNNABLE = $(RUNNABLE)
# These settings requires you to already have a $(RUNNABLE)
# command. This is desirable if you are making changes to the
# system that might break scheme48vm and/or scheme48.image. But it
# system that might break scshvm and/or scsh/scsh.image. But it
# requires you to have squirreled away a previous working version
# of scheme48.
# of scsh.
BIG_HEAP = -h 5500000
# 1. is broken if you build from CVS
# LINKER_VM = ./$(VM) $(BIG_HEAP)
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
# therefore according to 2. but we cannot use scsh since -i is not understood
LINKER_VM = $(BUILD_RUNNABLE) $(BIG_HEAP)
LINKER_RUNNABLE = $(BUILD_RUNNABLE)
BIG_HEAP = -h 5000000
LINKER_VM = ./$(VM) $(BIG_HEAP)
LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
LINKER_IMAGE = build/linker.image
LINKER = $(LINKER_VM) -i $(LINKER_IMAGE)
START_LINKER = echo ',batch' && echo ',bench on'
@ -87,9 +102,55 @@ START_LINKER = echo ',batch' && echo ',bench on'
IMAGE = scheme48.image
INITIAL = build/initial.image
VM = scheme48vm
VM = scshvm
LIBCIG = cig/lib$(VM).a
CIG = cig/cig
CIGOBJS = cig/libcig.o cig/libcig1.o
#scsh-lib
LIBSCSHVM = scsh/lib$(VM).a
LIBSCSH = scsh/libscsh.a
SCSHVMHACKS = scsh/proc2.o
#
#
SCSHOBJS = \
scsh/cstuff.o \
scsh/dirstuff1.o \
scsh/fdports1.o \
scsh/flock1.o \
scsh/machine/time_dep1.o \
scsh/signals1.o \
scsh/machine/libansi.o \
scsh/network1.o \
scsh/putenv.o \
scsh/rx/regexp1.o \
scsh/sleep1.o \
scsh/syscalls1.o \
scsh/syslog1.o \
scsh/time1.o \
scsh/tty1.o \
scsh/userinfo1.o \
scsh/sighandlers1.o \
scsh/libscsh.o \
scsh/md5.o
SCSH_INITIALIZERS = s48_init_syslog s48_init_posix_regexp \
s48_init_userinfo s48_init_sighandlers \
s48_init_syscalls s48_init_network s48_init_flock \
s48_init_dirstuff s48_init_time s48_init_tty \
s48_init_cig s48_init_libscsh s48_init_md5
UNIX_OBJS = c/unix/misc.o c/unix/io.o c/unix/fd-io.o c/unix/event.o
OBJS = c/scheme48vm.o c/scheme48heap.o c/extension.o c/external.o
SRFI_OBJS = c/srfi/srfi-27.o
SRFI_INITIALIZERS = s48_init_srfi_27
S48OBJS = c/scheme48vm.o c/scheme48heap.o c/extension.o c/external.o
OBJS = scsh/process_args.o c/init.o $(S48OBJS) $(CIGOBJS) $(SCSHOBJS) \
$(SCSHVMHACKS) $(SRFI_OBJS)
FAKEHS = c/fake/dlfcn.h c/fake/sigact.h c/fake/strerror.h \
c/fake/sys-select.h
@ -102,7 +163,7 @@ CONFIG_FILES = scheme/interfaces.scm scheme/low-packages.scm \
# The following is the first rule and therefore the "make" command's
# default target.
enough: $(VM) $(IMAGE) go .notify
enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH) $(LIBSCSHVM)
# --------------------
# External code to include in the VM
@ -110,7 +171,11 @@ enough: $(VM) $(IMAGE) go .notify
EXTERNAL_OBJECTS = $(SOCKET_OBJECTS) $(LOOKUP_OBJECTS)
EXTERNAL_FLAGS = $(SOCKET_FLAGS)
EXTERNAL_INITIALIZERS = $(SOCKET_INITIALIZERS) $(LOOKUP_INITIALIZERS)
EXTERNAL_INITIALIZERS = $(ADDITIONAL_INITIALIZER) $(SOCKET_INITIALIZERS) \
$(LOOKUP_INITIALIZERS) \
$(SCSH_INITIALIZERS) $(SRFI_INITIALIZERS) \
s48_init_cig
# Rules for any external code.
@ -132,15 +197,48 @@ LOOKUP_OBJECTS = c/unix/dynamo.o
LOOKUP_INITIALIZERS = s48_init_external_lookup
# End of lookup rules
# Initializer for s48_add_external_init
ADDITIONAL_INITIALIZER = s48_init_additional_inits
# End of external rules
# --------------------
# The developers are curious to know. Don't be concerned if this fails.
.notify: build/minor-version-number
touch .notify
-echo Another 0.`cat $(srcdir)/build/minor-version-number` \
installation. \
| mail scheme-48-notifications@martigny.ai.mit.edu
-echo SCSH 0.`cat $(srcdir)/scsh/minor-version-number` \
Scheme48 0.`cat $(srcdir)/minor-version-number` infestation. \
| mail scheme-48-notifications@zurich.ai.mit.edu
-echo Another scsh 0.`cat $(srcdir)/scsh/minor-version-number` \
infestation. | mail scsh-notifications@zurich.ai.mit.edu
# This says how to process .scm files with cig to make .c stubs.
#.SUFFIXES: .scm
#.scm.c:
# $(srcdir)/$(VM) -o $(srcdir)/$(VM) -i $(CIG) < $< > $*.c
# These .h files mediate between the code exported from foo1.c
# and imported into foo.scm's stub foo.c.
scsh/dirstuff1.o: scsh/dirstuff1.h
scsh/userinfo1.o: scsh/userinfo1.h
scsh/network1o: scsh/network1.h
scsh/flock1.o: scsh/flock1.h
scsh/fdports1.o scsh/fdports.o: scsh/fdports1.h
scsh/rx/regexp1.o: c/scheme48.h
scsh/sighandlers1.o: scsh/sighandlers1.h
scsh/syslog1.o: c/scheme48.h
include $(srcdir)/scsh/machine/Makefile.inc
# Berkeley make wants to see this instead: (or use GNU make on BSD. -bri)
#.include "$(srcdir)/scsh/machine/Makefile.inc"
$(VM): c/main.o $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)
rm -f /tmp/s48_external_$$$$.c && \
@ -148,15 +246,47 @@ $(VM): c/main.o $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)
$(EXTERNAL_INITIALIZERS) && \
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ c/main.o $(OBJS) $(UNIX_OBJS) \
/tmp/s48_external_$$$$.c \
$(LIBOBJS) $(LIBS) \
$(EXTERNAL_OBJECTS) $(EXTERNAL_LD_FLAGS) && \
$(EXTERNAL_OBJECTS) $(EXTERNAL_LD_FLAGS) \
$(LIBOBJS) $(LIBS) && \
rm -f /tmp/s48_external_$$$$.c
c/main.o: c/main.c c/scheme48vm.h c/scheme48heap.h
#JMG: again cig and scsh-lib
$(LIBCIG): c/main.o $(OBJS)
# $(CC) -r -o $@ main.o $(OBJS)
$(RM) $@
$(AR) $@ c/main.o $(OBJS)
$(RANLIB) $@
$(LIBSCSHVM): c/smain.o $(OBJS)
$(RM) $@
$(AR) $@ c/smain.o $(OBJS)
$(RANLIB) $@
$(LIBSCSH): $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)
$(RM) $@ \
rm -f /tmp/s48_external_$$$$.c && \
build/build-external-modules /tmp/s48_external_$$$$.c \
$(EXTERNAL_INITIALIZERS) && \
$(CC) -c $(CFLAGS) -o /tmp/s48_external_$$$$.o \
/tmp/s48_external_$$$$.c && \
$(AR) $@ $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS) \
/tmp/s48_external_$$$$.o && \
$(RANLIB) $@ && \
rm -f /tmp/s48_external_$$$$.c /tmp/s48_external_$$$$.o
c/main.o: c/main.c
$(CC) -c $(CFLAGS) -o $@ \
-DDEFAULT_IMAGE_NAME=\"$(LIB)/$(IMAGE)\" \
$(CPPFLAGS) $(DEFS) c/main.c
c/init.o: c/init.c c/scheme48vm.h c/scheme48heap.h
$(CC) -c $(CFLAGS) -o $@ \
-DDEFAULT_IMAGE_NAME=\"$(LIB)/$(IMAGE)\" \
$(CPPFLAGS) $(DEFS) c/init.c
c/scheme48vm.o: c/prescheme.h c/scheme48vm.h c/scheme48heap.h c/event.h \
c/io.h c/fd-io.h c/scheme48vm-prelude.h
c/scheme48heap.o: c/prescheme.h c/scheme48vm.h c/scheme48heap.h c/event.h \
@ -187,43 +317,80 @@ $(IMAGE): $(VM) scheme/env/init-defpackage.scm scheme/more-interfaces.scm \
### Fake targets: all clean install man dist
install: enough dirs inst-script inst-vm inst-misc inst-man inst-inc inst-image
install: enough dirs inst-script inst-vm inst-misc inst-man inst-inc \
inst-doc install-scsh
inst-vm:
inst-vm: $(VM)
$(INSTALL_PROGRAM) $(VM) $(LIB)
inst-image:
rm -f '/tmp/$(IMAGE)' && \
build/build-usual-image . '$(LIB)' '/tmp/$(IMAGE)' './$(VM)' \
'$(INITIAL)' && \
$(INSTALL_DATA) /tmp/$(IMAGE) $(LIB) && \
rm /tmp/$(IMAGE)
inst-man:
if [ -d $(mandir) -a -w $(mandir) ]; then \
sed 's=LBIN=$(bindir)=g' doc/scheme48.man | \
sed 's=LBIN=$(bindir)=g' doc/scsh.man | \
sed 's=LLIB=$(LIB)=g' | \
sed 's=LS48=$(RUNNABLE)=g' >$(MANPAGE) && \
sed 's=LSCSH=$(RUNNABLE)=g' >$(MANPAGE) && \
$(INSTALL_DATA) $(MANPAGE) $(mandir) && \
rm $(MANPAGE); \
$(RM) $(MANPAGE); \
else \
echo "$(mandir) not writable dir, not installing man page" \
>&2; \
fi
inst-inc:
$(INSTALL_DATA) c/scheme48.h $(incdir)
$(INSTALL_DATA) $(srcdir)/c/scheme48.h $(incdir)
$(INSTALL_DATA) $(srcdir)/c/write-barrier.h $(incdir)
install-cig: cig
$(INSTALL_PROGRAM) $(srcdir)/$(CIG) $(LIB)/cig
$(INSTALL_PROGRAM) $(srcdir)/$(CIG).image $(LIB)/cig
$(INSTALL_DATA) $(srcdir)/$(LIBCIG) $(LIB)/cig
$(INSTALL_DATA) $(srcdir)/cig/libcig.h $(LIB)/cig
inst-misc:
for stub in env big opt misc link; do \
for stub in env big opt misc link srfi; do \
for f in scheme/$$stub/*.scm; do \
$(INSTALL_DATA) $$f $(LIB)/$$stub || exit 1; \
done; \
done && \
for f in scheme/rts/*num.scm scheme/rts/jar-defrecord.scm; do \
$(INSTALL_DATA) $$f $(LIB)/rts || exit 1; \
done
inst-doc:
for f in $(srcdir)/doc/*.txt $(srcdir)/doc/*.ps; do \
$(INSTALL_DATA) $$f $(LIB)/doc/; \
done && \
for f in $(srcdir)/doc/src/*.tex \
$(srcdir)/doc/src/*.dvi \
$(srcdir)/doc/src/*.ps; \
do $(INSTALL_DATA) $$f $(LIB)/doc/s48-manual/; \
done && \
for f in $(srcdir)/doc/src/manual/*.html; \
do $(INSTALL_DATA) $$f $(LIB)/doc/s48-manual/html/; \
done && \
for f in $(srcdir)/doc/scsh-manual/*.tex \
$(srcdir)/doc/scsh-manual/*.sty \
$(srcdir)/doc/scsh-manual/*.dvi \
$(srcdir)/doc/scsh-manual/*.ps \
$(srcdir)/doc/scsh-manual/*.pdf; \
do $(INSTALL_DATA) $$f $(LIB)/doc/scsh-manual/; \
done && \
for f in $(srcdir)/doc/scsh-manual/html/*.html \
$(srcdir)/doc/scsh-manual/html/*.gif \
$(srcdir)/doc/scsh-manual/html/*.css; \
do $(INSTALL_DATA) $$f $(htmldir)/; \
done && \
for f in $(srcdir)/doc/scsh-paper/*.tex \
$(srcdir)/doc/scsh-paper/*.sty \
$(srcdir)/doc/scsh-paper/*.dvi \
$(srcdir)/doc/scsh-paper/*.ps; \
do $(INSTALL_DATA) $$f $(LIB)/doc/scsh-paper/; \
done && \
for f in $(srcdir)/doc/scsh-paper/html/*.html \
$(srcdir)/doc/scsh-paper/html/*.css; \
do $(INSTALL_DATA) $$f $(LIB)/doc/scsh-paper/html; \
done
inst-script:
script=$(bindir)/$(RUNNABLE) && \
echo '#!/bin/sh' >$$script && \
@ -233,46 +400,52 @@ inst-script:
>>$$script && \
chmod +x $$script
# Script to run scheme48 in this directory.
# Script to run scsh in this directory.
go:
echo '#!/bin/sh' >$@ && \
echo >>$@ && \
echo "lib=`pwd`" >>$@ && \
echo 'exec $$lib/$(VM) -o $$lib/$(VM) -i $$lib/$(IMAGE) "$$@"' \
echo 'exec $$lib/$(VM) -o $$lib/$(VM) -i $$lib/scsh/scsh.image "$$@"' \
>>$@ && \
chmod +x $@
dirs:
for dir in $(libdir) $(bindir) $(incdir); do \
[ -d $$dir -a -w $$dir ] || { \
echo "$$dir not a writable directory" >&2; \
exit 1; \
}; \
done
{ mkdir -p $(LIB) && [ -w $(LIB) ]; } || { \
echo "$(LIB) not a writable directory" >&2; \
exit 1; \
}
for dir in rts env big opt misc link; do \
{ mkdir -p $(LIB)/$$dir && [ -w $(LIB)/$$dir ]; } || { \
echo "$(LIB)/$$dir not a writable directory" >&2; \
exit 1; \
}; \
for dir in $(libdir) $(bindir) $(incdir) $(LIB) $(mandir) $(htmldir); do\
{ mkdir -p $$dir && [ -w $$dir ]; } || { \
echo "$$dir not a writable directory" >&2; \
exit 1; \
} \
done && \
for dir in \
rts env big opt misc link srfi scsh doc/scsh-manual \
doc/s48-manual/html doc/scsh-paper/html cig; do \
{ mkdir -p $(LIB)/$$dir && [ -w $(LIB)/$$dir ]; } || { \
echo "$(LIB)/$$dir not a writable directory" >&2; \
exit 1; \
}; \
done
configure: configure.in
autoheader && autoconf
clean:
-rm -f $(VM) *.o c/unix/*.o c/*.o c/fake/*.o \
TAGS $(IMAGE) \
clean: clean-cig clean-scsh
-rm -f $(VM) *.o c/*/*.o c/*.o \
$(IMAGE) \
build/*.tmp $(MANPAGE) build/linker.image \
scheme/debug/*.image scheme/debug/*.debug config.cache \
scheme/debug/*.image scheme/debug/*.debug \
scheme/vm/scheme48vm.c scheme/vm/scheme48heap.c \
go $(distname)
clean-cig:
-rm -f cig/*.o $(CIG) $(CIG).image $(LIBCIG)
distclean: clean
rm -f Makefile config.log config.status c/sysdep.h
rm -f Makefile config.log config.status c/sysdep.h config.cache \
scsh/machine \
scsh/endian.scm \
exportlist.aix
$(RM) a.exe $(VM).base $(VM).def $(VM).exp
-find . -name '*~' -o -name '#*' -o -name core -exec rm {} \;
check: $(VM) $(IMAGE) scheme/debug/check.scm
( \
@ -296,18 +469,17 @@ image: $(INITIAL)
$(MAKE) $(IMAGE)
tags:
etags scheme/vm/arch.scm scheme/rts/*.scm scheme/bcomp/*.scm \
scheme/*.scm scheme/env/*.scm scheme/big/*.scm scheme/link/*.scm \
scheme/opt/*.scm scheme/debug/*.scm scheme/misc/*.scm
find . -name "*.scm" -o -name "*.c" -o -name "*.h" | etags -
# --------------------
# Distribution...
# DISTFILES should include all sources.
DISTFILES = README COPYING INSTALL configure \
acconfig.h configure.in Makefile.in install-sh \
doc/*.ps doc/*.txt doc/html/*.html doc/scheme48.man \
doc/src/*.tex doc/src/*.sty \
DISTFILES = README COPYING INSTALL RELEASE configure config.sub config.guess \
scsh-config.in configure.in Makefile.in install-sh \
doc/*.ps doc/*.txt \
doc/src/*.tex doc/src/*.sty doc/src/manual.dvi \
doc/src/manual.ps \
emacs/README build/*-version-number build/*.exec \
build/*.lisp build/build-usual-image build/filenames.make \
build/filenames.scm build/initial.debug \
@ -316,14 +488,40 @@ DISTFILES = README COPYING INSTALL configure \
c/*.[ch] c/*/*.[ch] c/scheme48.h.in \
emacs/*.el gdbinit \
scheme/*.scm scheme/*/*.scm \
ps-compiler \
c/sysdep.h.in
ps-compiler/*.scm ps-compiler/minor-version-number \
ps-compiler/doc/*.txt ps-compiler/*/*.scm \
ps-compiler/*/*/*.scm \
ps-compiler/prescheme/test/fact.cps \
ps-compiler/prescheme/test/prescheme.h \
ps-compiler/prescheme/c-stuff \
c/sysdep.h.in \
scsh/*.scm scsh/*/*.scm \
scsh/*.[ch] scsh/*/*.[ch] \
scsh/*.scm.in scsh/*/Makefile.inc \
cig/*.scm cig/*.[ch] \
doc/scsh.man \
doc/scsh-manual/*.tex doc/scsh-manual/*.sty \
doc/scsh-manual/man.ps doc/scsh-manual/man.pdf \
doc/scsh-manual/man.dvi doc/scsh-manual/Makefile \
doc/scsh-manual/THANKS doc/scsh-manual/html/*.html \
doc/scsh-manual/html/*.gif doc/scsh-manual/html/*.css \
doc/src/manual/*.html \
doc/scsh-paper/*.sty doc/scsh-paper/*.tex \
doc/scsh-paper/mitlogo.ps doc/scsh-paper/scsh-paper.ps \
doc/scsh-paper/scsh-paper.dvi \
doc/scsh-paper/html/*.html doc/scsh-paper/html/*.css
distname = $(RUNNABLE)-0.`cat build/minor-version-number`
dist: build/initial.image
(cd doc/src && latex manual.tex && latex manual.tex && \
dvips manual -o manual.ps && hyperlatex manual.tex) && \
(cd doc/scsh-manual && makeindex man && make man.ps && \
make man.pdf && make html) && \
(cd doc/scsh-paper && make scsh-paper.ps && make html) && \
distname=$(distname) && \
distfile=$(distdir)/$$distname.tgz && \
distfile=$(distdir)/$$distname.tar.gz && \
if [ -d $(distdir) ] && \
[ -w $$distfile -o -w $(distdir) ]; then \
rm -f $$distname && \
@ -378,9 +576,7 @@ PACKAGES=scheme/packages.scm scheme/rts-packages.scm scheme/alt-packages.scm \
build/filenames.scm
build/filenames.make: $(PACKAGES)
$(MAKE) $(VM) PACKAGES=
./$(VM) -i $(srcdir)/$(INITIAL) -a batch <build/filenames.scm
# or: $(RUNNABLE) -a batch <build/filenames.scm
$(BUILD_RUNNABLE) -a batch <build/filenames.scm
# --------------------
# Static linker
@ -418,7 +614,8 @@ link/linker-in-lucid: build/lucid-script.lisp $(linker-files) \
# Scheme, the byte-code compiler, and a minimal command processor, but
# no debugging environment to speak of.
$(INITIAL): $(LINKER_IMAGE) $(CONFIG_FILES) build/initial.scm $(initial-files)
$(INITIAL): $(LINKER_IMAGE) $(CONFIG_FILES) build/initial.scm $(initial-files) \
scsh/here.scm # gross and Olin hates it -bri
($(START_LINKER); \
echo '(load-configuration "scheme/interfaces.scm")'; \
echo '(load-configuration "scheme/packages.scm")'; \
@ -466,9 +663,9 @@ scheme/debug/medium.image: $(LINKER_IMAGE) $(CONFIG_FILES)
# The following have not been updated for the new directory organization
c/smain.o: c/main.c
$(CC) -c $(CPPFLAGS) $(DEFS) $(CFLAGS) -DSTATIC_AREAS -o $@ c/main.c
$(CC) -c $(CPPFLAGS) $(DEFS) $(CFLAGS) -DSTATIC_AREAS -o $@ $(srcdir)/c/main.c
mini: mini-heap.o smain.o
mini: mini-heap.o c/smain.o
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ c/smain.o mini-heap.o $(OBJS) $(LIBS)
mini-heap.o: mini-heap.c
@ -477,7 +674,7 @@ mini-heap.o: mini-heap.c
mini-heap.c: scheme/debug/mini1.image
(echo ,exec ,load misc/load-static.scm; \
echo \(do-it 150000 \"$(srcdir)/scheme/debug/mini1.image\" \"$@\"\)) \
| $(RUNNABLE) -h 3000000 -a batch
| $(BUILD_RUNNABLE) -h 3000000 -a batch
scheme/debug/mini1.image: $(VM) scheme/debug/mini.image
echo "(write-image \"scheme/debug/mini1.image\" \
@ -502,7 +699,7 @@ c/scheme48.h: c/scheme48.h.in scheme/vm/arch.scm scheme/vm/data.scm \
\"$(srcdir)/scheme/vm/arch.scm\" \
\"$(srcdir)/scheme/vm/data.scm\" \
\"$(srcdir)/scheme/rts/record.scm\")" \
) | $(RUNNABLE)
) | $(BUILD_RUNNABLE)
# An old version of the above for legacy code.
@ -516,7 +713,7 @@ c/old-scheme48.h: scheme/vm/arch.scm scheme/vm/data.scm \
echo "(make-c-header-file \"$@\" \
\"$(srcdir)/scheme/vm/arch.scm\" \
\"$(srcdir)/scheme/vm/data.scm\")" \
) | $(RUNNABLE)
) | $(BUILD_RUNNABLE)
# Generate vm (scheme48vm.c and scheme48heap.c) from VM sources.
# Never called automatically. Do not use unless you are sure you
@ -531,5 +728,192 @@ i-know-what-i-am-doing:
echo ',exec ,load compile-vm-no-gc.scm'; \
echo ',exec ,load compile-gc.scm'; \
echo ',exit' \
) | $(RUNNABLE) -h 8000000 && \
) | $(BUILD_RUNNABLE) -h 5000000 && \
mv ../scheme/vm/scheme48vm.c ../scheme/vm/scheme48heap.c ../c
cig: $(CIG) $(CIG).image $(LIBCIG)
$(CIG): $(VM) $(IMAGE) $(srcdir)/cig/cig.scm $(srcdir)/cig/libcig.scm
(echo ",batch"; \
echo ",translate =scheme48/ $(srcdir)/scheme/"; \
echo ",config ,load $(srcdir)/cig/cig.scm"; \
echo ",config ,load $(srcdir)/cig/libcig.scm"; \
echo ",load-package cig-standalone"; \
echo ",in cig-standalone"; \
echo ",translate =scheme48/ $(LIB)/"; \
echo ",build cig-standalone-toplevel /tmp/cig") \
| ./$(VM) -i ./$(IMAGE)
$(srcdir)/cig/image2script $(LIB)/$(VM) </tmp/cig > $(CIG)
-chmod +x $(CIG)
mv /tmp/cig $(srcdir)/cig/cig_bootstrap
$(RM) /tmp/cig
$(CIG).image: $(IMAGE) $(VM) $(srcdir)/cig/cig.scm $(srcdir)/cig/libcig.scm
(echo ",batch"; \
echo ",translate =scheme48/ $(srcdir)/scheme/"; \
echo ",config ,load $(srcdir)/cig/cig.scm"; \
echo ",config ,load $(srcdir)/cig/libcig.scm"; \
echo ",load-package cig-aux"; \
echo ",open define-foreign-syntax"; \
echo ",translate =scheme48/ $(LIB)/"; \
echo ",dump /tmp/cig \"(CIG Preloaded -bri)\"") \
| ./$(VM) -o ./$(VM) -i ./$(IMAGE)
$(srcdir)/cig/image2script $(LIB)/$(VM) \
-o $(LIB)/$(VM) \
</tmp/cig > $(CIG).image
-chmod +x $(CIG).image
$(RM) /tmp/cig
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
# SCSH Specifics
#-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
scsh: scsh/scsh scsh/scsh.image
SCHEME =scsh/awk.scm \
scsh/defrec.scm \
scsh/endian.scm \
scsh/enumconst.scm \
scsh/event.scm \
scsh/low-interrupt.scm \
scsh/fdports.scm \
scsh/fileinfo.scm \
scsh/filemtch.scm \
scsh/filesys.scm \
scsh/flock.scm \
scsh/fname.scm \
scsh/fr.scm \
scsh/glob.scm \
scsh/dot-locking.scm \
scsh/here.scm \
scsh/libscsh.scm \
scsh/machine/bufpol.scm \
scsh/machine/errno.scm \
scsh/machine/fdflags.scm \
scsh/machine/netconst.scm \
scsh/machine/packages.scm \
scsh/machine/signals.scm \
scsh/machine/time_dep.scm \
scsh/machine/tty-consts.scm \
scsh/machine/waitcodes.scm \
scsh/md5.scm \
scsh/meta-arg.scm \
scsh/network.scm \
scsh/newports.scm \
scsh/procobj.scm \
scsh/pty.scm \
scsh/rdelim.scm \
scsh/rw.scm \
scsh/scsh-condition.scm \
scsh/scsh-interfaces.scm \
scsh/scsh-package.scm \
scsh/scsh-read.scm \
scsh/scsh-version.scm \
scsh/scsh.scm \
scsh/sighandlers.scm \
scsh/startup.scm \
scsh/stringcoll.scm \
scsh/syntax-helpers.scm \
scsh/syntax.scm \
scsh/syscalls.scm \
scsh/time.scm \
scsh/top.scm \
scsh/tty.scm \
scsh/utilities.scm \
scsh/weaktables.scm \
scsh/rx/packages.scm \
scsh/rx/re-match-syntax.scm \
scsh/rx/rx-lib.scm \
scsh/rx/parse.scm \
scsh/rx/re-subst.scm \
scsh/rx/simp.scm \
scsh/rx/posixstr.scm \
scsh/rx/re-syntax.scm \
scsh/rx/spencer.scm \
scsh/rx/oldfuns.scm \
scsh/rx/re-fold.scm \
scsh/rx/re.scm \
scsh/rx/test.scm \
scsh/rx/re-high.scm \
scsh/rx/regexp.scm \
scsh/rx/re-low.scm \
scsh/rx/regress.scm
# scsh/dbm.scm db.scm ndbm.scm
# jcontrol
# Bogus, but it makes the scm->c->o two-ply dependency work.
# Explicitly giving the .o/.c dependency also makes it go.
############################################################
cig/libcig.c: cig/libcig.scm
scsh/scsh: scsh/scsh-tramp.c
$(CC) -o $@ $(CPPFLAGS) $(CFLAGS) \
-DVM=\"$(LIB)/$(VM)\" \
-DIMAGE=\"$(LIB)/scsh.image\" \
scsh/scsh-tramp.c
bs: build/build-scsh-image
sh $(srcdir)/build/build-scsh-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \
"$(VM)" cig/cig.image
loads = $(srcdir)/scsh/let-opt.scm $(srcdir)/scsh/scsh-interfaces.scm \
$(srcdir)/scsh/machine/packages.scm \
$(srcdir)/scsh/rx/packages.scm \
$(srcdir)/scsh/scsh-package.scm \
$(srcdir)/scsh/lib/ccp-pack.scm \
$(srcdir)/scsh/lib/char-package.scm
opens = floatnums scsh ccp-lib scsh-top-package scsh-here-string-hax \
srfi-1 srfi-13 srfi-14 # srfi-14 is also exported by scsh
scsh/scsh.image: $(VM) $(SCHEME) $(IMAGE)
(echo ",translate =scheme48/ `pwd`/scheme/"; \
echo ",batch on"; \
echo ",config ,load $(loads)"; \
echo ",open $(opens)"; \
echo "(dump-scsh \"$@\")"; \
) \
| ./$(VM) -o ./$(VM) -i $(IMAGE) -h 10000000
# ,flush files => 0k
# ,flush names => -= 17k
# ,flush maps => -= 350K
# ,flush source => -= 1117k
# ,flush => 550k
scsh/stripped-scsh.image: $(VM) $(SCHEME) $(IMAGE)
(echo ",flush maps source";\
echo ",translate =scheme48/ `pwd`/scheme/"; \
echo ",batch on"; \
echo ",config ,load $(loads)"; \
echo ",open $(opens)"; \
echo ",flush"; \
echo "(dump-scsh \"$@\")";) \
| ./$(VM) -o ./$(VM) -i $(IMAGE) -h 10000000
install-scsh: scsh install-scsh-image install-stripped-scsh-image
$(RM) $(bindir)/$(RUNNABLE)
$(INSTALL_PROGRAM) $(srcdir)/scsh/scsh $(bindir)/$(RUNNABLE)
$(INSTALL_PROGRAM) $(srcdir)/$(LIBSCSHVM) $(libdir)/$(LIBSCSHVM)
$(INSTALL_PROGRAM) $(srcdir)/$(LIBSCSH) $(libdir)/$(LIBSCSH)
$(RANLIB) $(libdir)/$(LIBSCSH)
for f in $(srcdir)/scsh/*.scm $(srcdir)/scsh/*/*.scm; \
do $(INSTALL_DATA) $$f $(LIB)/scsh/; done
install-scsh-image: $(VM) scsh/scsh.image
( echo ',translate =scheme48 $(LIB)'; \
echo '(dump-scsh "$(LIB)/scsh.image")'; \
echo ',exit'; \
) | ./$(VM) -i scsh/scsh.image
install-stripped-scsh-image: $(VM) scsh/stripped-scsh.image
( echo ',translate =scheme48 $(LIB)'; \
echo '(dump-scsh "$(LIB)/stripped-scsh.image")'; \
echo ',exit'; \
) | ./$(VM) -i scsh/stripped-scsh.image
clean-scsh:
$(RM) scsh/*.o scsh/rx/*.o scsh/machine/*.o
$(RM) scsh/*.image
$(RM) $(LIBSCSHVM) $(LIBSCSH) scsh/scsh$(EXEEXT)

92
README
View File

@ -1,93 +1,19 @@
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
-*- Mode: Text; -*-
Please report bugs to scheme-48-bugs@martigny.ai.mit.edu, and include
Copyright (c) 1994 Brian D. Carlstrom
See file COPYING for copying information.
Please report bugs to scsh-bugs@zurich.ai.mit.edu, and include
the version number in your message.
Installation instructions in file INSTALL.
A user's guide is in file doc/user-guide.txt.
A scsh manual is in directory doc/scsh-manual/.
A scsh paper is in directory doc/scsh-paper/.
A scsh quick reference is in file doc/cheat.txt.
Recent changes are listed in file doc/news.txt.
Known bugs and things to do in the future are listed in doc/todo.txt.
Send mail to scheme-48-request@martigny.ai.mit.edu to be put on a
Send mail to scsh-request@zurich.ai.mit.edu to be put on a
mailing list for announcements, discussion, bug reports, and bug
fixes.
-----
When running "make", don't worry if the ".notify" target fails. Its
only purpose is to send an email message to
scheme-48-notifications@martigny.ai.mit.edu, so that we can get a
rough idea of how much Scheme 48 is being used and by whom. We
promise not to use your name or email address for any commercial
purpose. If you don't want us to know, just do "make -t .notify"
first (after running "configure").
-----
The Scheme 48 root directory is organized as follows (not all files are
listed here):
README this file
INSTALL installation instructions
COPYING copyright notice
configure configuration script
Makefile.in input to configure
doc/ some documentation
scheme48.man a Unix-style manual page
user-guide.txt general guide to using Scheme 48
todo.txt list of improvements we hope to make someday
news.txt list of improvements we have already made
module.ps description of Scheme 48's module system
big-scheme.txt extensions to Scheme
threads.txt multiprocessing
io.txt how the I/O system works
scheme/ scheme source files
packages.scm meta-module definitions
interfaces.scm system interface definitions
more-interfaces.scm system interface definitions
*-packages.scm module definitions
bcomp/ the byte-code compiler
vm/ virtual machine sources (written in Pre-Scheme)
rts/ run-time system sources
link/ static linker
env/ development environment modules (debugger, etc.)
big/ useful Scheme libraries and extensions ("Big Scheme")
alt/ portable implementations of some Scheme 48 features
opt/ optional code optimizer for the byte-code compiler
prescheme/ code for running the VM using Scheme 48
debug/ debugging utilities, tests, etc.
misc/ very miscellaneous things (e.g. AMB operator)
posix/ unfinished interface to POSIX system calls
ps-compiler/ Pre-Scheme -> C compiler
c/ c source files
sysdep.h.in input to configure
scheme48vm.c most of the VM (generated by Pre-Scheme compiler)
scheme48vm.h extern declarations for scheme48vm.c
scheme48heap.c storage management (generated by Pre-Scheme compiler)
scheme48heap.h extern declarations for scheme48heap.c
main.c entry point for the VM
prescheme.h part of the VM
extension.c default definition of vm_extension()
scheme48.h C declarations and macros for Scheme 48 data structures
old-scheme48.h old version, included for compatibility
c-mods.h minor additions to the C language
event.h header file for OS interface
io.h ditto
fd-io.h ditto
socket.c socket support
dynamo.c dynamic loading support
unix/ Unix-specific source files
posix/ C half of an unfinished interface to POSIX system calls
fake/ C files for insufficiently POSIX-compliant systems
build/ code for building the system
filenames.make included by Makefile, generated automatically
filenames.scm code for generating filenames.make
initial.image an image file containing a minimal Scheme system
initial.debug debugging database for same
initial.scm script for creating initial.image
build-usual-image script for creating scheme48.image
build-external-modules script for creating external-module initializer
emacs/ gnu emacs support

86
README.s48 Normal file
View File

@ -0,0 +1,86 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees.
; Copyright (c) 1994-2000 by Olin Shivers and Brian D. Carlstrom.
; Copyright (c) 1999-2000 by Martin Gasbichler.
See file COPYING.
Please report bugs to scsh-bugs@zurich.ai.mit.edu, and include
the version number in your message.
Installation instructions in file INSTALL.
A user's guide is in file doc/user-guide.txt.
Recent changes are listed in file doc/news.txt.
Known bugs and things to do in the future are listed in doc/todo.txt.
Send mail to scheme-48-request@martigny.ai.mit.edu to be put on a
mailing list for announcements, discussion, bug reports, and bug
fixes.
-----
The Scheme 48 root directory is organized as follows (not all files are
listed here):
README this file
INSTALL installation instructions
COPYING copyright notice
configure configuration script
Makefile.in input to configure
doc/ some documentation
scheme48.man a Unix-style manual page
user-guide.txt general guide to using Scheme 48
todo.txt list of improvements we hope to make someday
news.txt list of improvements we have already made
module.ps description of Scheme 48's module system
big-scheme.txt extensions to Scheme
threads.txt multiprocessing
io.txt how the I/O system works
scheme/ scheme source files
packages.scm meta-module definitions
interfaces.scm system interface definitions
more-interfaces.scm system interface definitions
*-packages.scm module definitions
bcomp/ the byte-code compiler
vm/ virtual machine sources (written in Pre-Scheme)
rts/ run-time system sources
link/ static linker
env/ development environment modules (debugger, etc.)
big/ useful Scheme libraries and extensions ("Big Scheme")
alt/ portable implementations of some Scheme 48 features
opt/ optional code optimizer for the byte-code compiler
prescheme/ code for running the VM using Scheme 48
debug/ debugging utilities, tests, etc.
misc/ very miscellaneous things (e.g. AMB operator)
posix/ unfinished interface to POSIX system calls
ps-compiler/ Pre-Scheme -> C compiler
c/ c source files
sysdep.h.in input to configure
scheme48vm.c most of the VM (generated by Pre-Scheme compiler)
scheme48vm.h extern declarations for scheme48vm.c
scheme48heap.c storage management (generated by Pre-Scheme compiler)
scheme48heap.h extern declarations for scheme48heap.c
main.c entry point for the VM
prescheme.h part of the VM
extension.c default definition of vm_extension()
scheme48.h C declarations and macros for Scheme 48 data structures
old-scheme48.h old version, included for compatibility
c-mods.h minor additions to the C language
event.h header file for OS interface
io.h ditto
fd-io.h ditto
socket.c socket support
dynamo.c dynamic loading support
unix/ Unix-specific source files
posix/ C half of an unfinished interface to POSIX system calls
fake/ C files for insufficiently POSIX-compliant systems
build/ code for building the system
filenames.make included by Makefile, generated automatically
filenames.scm code for generating filenames.make
initial.image an image file containing a minimal Scheme system
initial.debug debugging database for same
initial.scm script for creating initial.image
build-usual-image script for creating scheme48.image
build-external-modules script for creating external-module initializer
emacs/ gnu emacs support

389
RELEASE Normal file
View File

@ -0,0 +1,389 @@
Scsh 0.6.4 Release notes -*- outline -*-
We are pleased to release scsh version 0.6.4. The new version is
mainly a bug-fix release, the only new features are command-line
switches for loading exec scripts and support for some more SRFIs.
The text below gives a general description of scsh, instructions for obtaining
it, pointers to discussion forums, and a description of the new features in
release 0.6.3. (Emacs should display this document is in outline mode. Say
c-h m for instructions on how to move through it by sections (e.g., c-c c-n,
c-c c-p).)
* Contents
==========
What is scsh
Scsh as a scripting language
Scsh as a systems-programming language
Scsh is a portable programming environment
Obtaining and installing scsh
Getting in touch
The World-Wide What?
New in this release
Switches to load exec scripts
Bug fixes
API changes
New in 0.6.3
New in 0.6.2
New in 0.6.1
New in 0.6.0
Thanks
* What is scsh
==============
Scsh is a broad-spectrum systems-programming environment for Unix embedded
in R5RS Scheme. It has an open-source copyright, and runs on most major
Unix systems.
** Scsh as a scripting language
-------------------------------
Scsh has a high-level process notation for doing shell-script like tasks:
running programs, establishing pipelines and I/O redirection. For example, the
shell pipeline
gunzip < paper.tex.gz | detex | spell | lpr -Ppulp &
would be written in scsh as
(& (| (gunzip) (detex) (spell) (lpr -Ppulp)) ; Background a pipeline
(< paper.tex.gz)) ; with this redirection
Scsh embeds this process notation within a full Scheme implementation.
The process notation is realized as a set of macro definitions, and is
carefully designed to allow full integration with standard Scheme code.
Scsh isn't Scheme-like; it is Scheme.
At the scripting level, scsh also has an Awk design, also implemented
as a macro that can be embedded inside general Scheme code.
Scripts can be written as standalone Scheme source files, with a leading
#!/usr/local/bin/scsh -s
trigger line.
** Scsh as a systems-programming language
-----------------------------------------
Scsh additionally provides the low-level access to the operating system
normally associated with C. The current release provides full access to Posix,
plus important non-Posix extensions, such as complete sockets support.
"Complete Posix" means: fork, exec & wait, sockets, full read, write, open &
close, seek & tell, complete file-system access, including stat,
chmod/chgrp/chown, symlink, FIFO & directory access, tty & pty support, file
locking, pipes, select, file-name pattern-matching, time & date, environment
variables, signal handlers, and more.
In brief, you can now write Unix systems programs in Scheme instead of C.
For example, we have implemented an extensible HTTP server at MIT entirely
in scsh.
As important as full access to the OS is the manner in which it is provided.
Scsh integrates the OS support into Scheme in a manner which respects the
general structure of the language. The details of the design are discussed
in a joint MIT Lab for Computer Science/University of Hong Kong technical
report, "A Scheme Shell," also to appear in a revised format in the "Journal
syof Lisp and Symbolic Computation." This paper is also available by ftp:
ftp://ftp.scsh.net/pub/scsh/papers/scsh-paper.ps
** Scsh is a portable programming environment
---------------------------------------------
Scsh is designed for portability. It is implemented on top of Scheme 48,
a byte-code-interpreter Scheme implementation. The Scheme 48 virtual machine
can be compiled on any system with a C compiler; the rest of Scheme 48 is
machine-independent across 32-bit processors. Scsh's OS interface is
also quite portable, providing a consistent interface across different
Unix platforms. We currently have scsh implementations for:
AIX
BSD/OS
CXUX
FreeBSD
HP-UX
IRIX
Linux
NetBSD
OpenBSD
Solaris
SunOS
Ultrix
Win32
Darwin/Mac OS X
Scsh code should run without change across these systems.
Porting to new platforms is usually not difficult.
* Obtaining and installing scsh
===============================
You can get a copy of scsh via anonymous ftp, from
ftp://ftp.scsh.net/pub/scsh/scsh.tar.gz
The tar file includes a detailed manual and a paper describing
the design of the system.
For the lazily curious, we also have the manual separately available as
ftp://ftp.scsh.net/pub/scsh/0.6/scsh-manual.ps
Just click 'n view.
You *should* be able to build scsh on the standard platforms with exactly five
commands: gunzip, tar, cd, ./configure, and make. The configure script figures
out the special flags and switches needed to make the build work (thanks to
the GNU project for the autoconfig tool that makes this possible).
After doing the make, you can start up a Scheme shell and try it out
by saying
./go
See the manual for full details on the command-line switches.
If it's harder than this, and your system is standard, we'd like to know
about it.
* Getting in touch
==================
There are two main ways to join in scsh-related discussion: the mailing-list
scsh@zurich.ai.mit.edu
and the netnews group
comp.lang.scheme.scsh
These two forums should be equivalent, being bi-directionally gatewayed
at MIT, but due to technical problems it's better to read them both.
Bugs can be reported to
scsh-bugs@zurich.ai.mit.edu
or via the Scsh project's bugs section on SourceForge:
http://sourceforge.net/projects/scsh/
If you do not netnews hierarchy, or wish to join the mailing
list for other reasons, send mail to
scsh-request@zurich.ai.mit.edu
* The World-Wide What?
======================
We even have one of those dot-com cyberweb things:
http://www.scsh.net
We manage the project using SourceForge:
http://sourceforge.net/projects/scsh/
* New in this release
=====================
** Switches to load exec scripts
The new switch -le loads a file into the exec package, the new
switch -de loads the "-s" script into the exec package.
** Bug fixes
- Other select bug
- Timeout for select is in seconds, not milliseconds
- Load package md5 before dumping scsh.image
- Revised implementation of SRFI-19
- -sfd switch called bogus procedures
- Ooopsify write-string/partial
- Clean up get_groups
- Check for "." in file-name-{sans-}extension
- Bug fix for let-match: variables may be #f
- Fix some problems with WAIT-FOR-CHANNELS
- Fixes in the time zone code
- Fix a bug in SEND-MESSAGE: There is such a thing as an empty datagram
- Renamed string-filter to make-string-filter and char-filter to
make-char-port-filter
** API changes
pause-until-interrupt has been removed because it is not compatible
with the thread system
* New in 0.6.3
==============
** Shorter startup times
By a couple of small fixes we could diminish the startup
time by 10-30%.
** stripped-scsh.image
In addition to the standard heap image scsh.image, scsh now ships
with an additional image stripped-scsh.image. This image contains
the same code as the standard image but has almost all debugging
information removed. It is therefore much smaller (2.5 MB vs. 4.5
MB) which also allows shorter startup times. The image is intended
for use in scripts but not for interactive development. See the
manual for more information.
** MD5 support
The package md5 contains a bunch of procedures to compute MD5
checksums.
** New SRFIs
This release adds support for SRFI 25, 26, 27, 28 and 30.
** API changes
select and select! are supported again.
Note however, that we recommend to use the new select-ports and
select-port-channels procedures instead whenever possible.
New interface to the uname function.
New direct interface to the directory stream operations
New structure scheme-with-scsh which combines the exports of the
modules scsh and scheme, avoiding duplicates
New procdures to work directly on file-info records
The repl procedure has been removed
New procedures connect-socket-no-wait, connect-socket-successful?
Add lookup-external from recent S48
** Bugfixes
LET-MATCH, IF-MATCH, and COND-MATCH now behave according to the
documentation.
Many bug fixes for the SRE system, specifically for dynamic
submatches.
PORT->SOCKET uses dups both ports of the socket
Added missing process resource alignments
No reaping for stopped children
Initialize t.c_lflag before reading it.
Fix to allow single character here strings.
Add a whole bunch of S48_GC_PROTECT against s48_extract_integer.
Added MAP, FOR-EACH, MEMBER, ASSOC to SRFI 1 interface
Fixed a subtle bug in the macro for the << redirection
Use "compare" und "rename" to compare symbols in lots of macros
Fixed the close method for string-input-ports
... and many others.
* New in 0.6.2
==============
** SRFIs
In addition to SRFIs 1, 8, 13, 14 and 23 scsh now features SRFIs 2,
5, 6, 7, 9, 11, 16, 17 and 19. See http://srfi.schemers.org/ for a
detailed description. The SRFIs are available in packages srfi-N
where N is the number of the SRFI.
** port->socket
New procedure port->socket to turn a port into a socket object was
added to the network code.
** New forms in the module language
The module language supports the new forms modify, subset and
with-prefix from Scheme 48 version 0.57.
** API changes
Fork, fork/pipe, fork/pipe+ take an optional argument
continue-threads? to determine whether all threads should continue
to run in the child.
exec-path-list is now a preseved thread fluid
** PDF version of the manual
There is now a PDF version of the manual generated by pdflatex.
** Bugfixes
- Added default argument to tty-info as described in the manual
- Conversion to s48_value in tty1.c
- Fixed another hygiene problem in SRE
- Plugged space leak in bind-listen-accept-loop
- Aligned CWD and umask in various file operations
- Better releasing of port locks
- Corrected exception of time
- Set-cloexec to #t for unrevealed ports.
- Included scsh paper in the distribution.
- Fixed accept for AF_UNIX
- (setenv var #f) now deletes var from environment
- Quoted { and } within literal strings of regexps
* New in 0.6.1
==============
** API changes
For sre's, BOW, EOW, WORD, and WORD+ (which were already unsupported
in 0.6.0 on most platforms) are gone for good.
** Bugfixes
Most of the known bugs of version 0.6.0 have been fixed, many thanks for
the precise reports! See the project page on SourceForge for a list
of the remaining known bugs. Here is a brief overview of the fixes:
- GC_PROTECT'ed the necessary variables (specifically, where >1 arg to
a function 'may GC') (Thanks to Steven Jenkins for dealing with this)
- Fixed various race conditons in the signal handling and process reaping code
- Fixed bug in set-process-group
- If $HOME is unset, consult (user-info (user-uid)) for the value of
home-directory
- Fix external-call-from-callback problem leading to spurious
gc-protection-mismatch exceptions.
- Let s48-do-gc return 0 so the PreScheme compiler will emit the correct
signature of the function.
- scsh/linux/tty-consts.scm: num-ttychars seems to be 32 not 19.
- scsh/top.scm: Return 0 exit status for -c and -e.
- *.c: Replaced // comments.
- scsh/syslog1.c: Remove LOG_LPR from list of syslog levels.
- scsh/network1.c: Pass SYSCALL argument to ERRNO-ERROR.
- scsh/syscalls1.c: Disable timer interrupts before execve
- scsh/network.scm: Correct name extraction in bind-socket
- Added export for with-error-output-port
- Install HTML version of manual under $(libdir)
- ./configure is more rebost wrt $(srcdir)
- Fixed installation of the S48 manual
- Replaced several /tmp by /var/tmp
- Catch EISDIR in delete-filesys-object
- flush-all-ports is now non-blocking
* New in 0.6.0
==============
** Scsh is now based on Scheme 48 0.53
With the move from Scheme 48 version 0.36 to version 0.53 in this
release the underlying system received a massive update. The most
significant changes include:
User level threads
Advanced garbage collector
Improved foreign function interface to C
The most significant change for Scsh users is the addition of a
user-level thread system. Scsh provides various features to deal
with this new power in a system programming environment: An event
based interface to interrupts, thread local process state and
thread-safe system calls.
** A manual for Scheme 48 has been included
Richard Kelsey, the author of Scheme 48, has graciously allowed us
to retrofit the current Scheme 48 manual for inclusion in this scsh
release.
** Interfaces to dot-locking, crypt and syslog
Scsh now provides advisory file locking via the dot-locking scheme
and a direct binding to the crypt function. Furthermore we added
a complete, system-independent and thread-safe interface to syslog.
** API changes
Some features of the previous releases are currently not
supported as we did not have the time to implement them. Please tell
us, if you can't get along without them. Here is a listing of these
currently dereleased features:
select
select!
ODBC support
bufpol/line
The following procedures received new names in this release:
sleep (now process-sleep)
sleep-until (now process-sleep-until)
network-info, service-info and protocol-info now return #f on non-success.
The default directory for creating temporary files has changed: It's
now the value of $TMPDIR if set and /var/tmp otherwise.
The nth procedure is still there but is now officially obsolete. It
will go away in a future release.
** HTML version of the manual
There is now a HTML version of the scsh manual generated by tex2page
* Thanks
========
We would like to thank the members of local-resistance cells for the
Underground everywhere for bug reports, bug fixes, design review and comments
that were incorporated into this release. We really appreciate their help,
particularly in the task of porting scsh to new platforms.
Brought to you by the Scheme Underground. Go forth and write elegant systems
programs.
-Olin Shivers, Brian Carlstrom, Martin Gasbichler & Mike Sperber

66
TODO Normal file
View File

@ -0,0 +1,66 @@
0.6.1 release-critical:
=======================
Non-critical: [Martin]
=============
S48_EXTRACT_BOOLEAN is defined several times
create-file-thing should report a better error message.
/* Sorry, we only have a version with 5 arguments..*/.
s48_raise_os_error_5 (errno, sec, min, hour, mday, month);
how do i make the scheme48 heap larger? preferably without having to write
scripts that start like this:
#!/usr/local/lib/scsh/scshvm \
-o /usr/local/lib/scsh/scshvm -i /usr/local/lib/scsh/scsh.image -h <large-value>
-s
!#
Check whether we have remove the extern char *tzname[] declaration in time1.c
implement bufpol/line's flush on stdin
Move the code of time_plus_ticks to time1.c as it is not machine dependent
--->
The module system doesn't maintain a cwd of its own:
> ,config ,load ../sunet/xml/xml-packages.scm
../sunet/xml/xml-packages.scm
> (chdir "/tmp")
> ,open xml
Load structure xml (y/n)? y
[plt-compat
Error: exception
cannot-open-channel
(open-channel "../sunet/xml/plt.scm" 1)
<---
split up newports.scm (part that overwrites s48 defs, port-buffering, ...)
disallow cig to produce more than 12 arguments
libcig1.c : cig_string_body is probably extract_string
IsChar is used nowhere
Add .h.c rule to Makefile
--->
(define-syntax bla
(syntax-rules ()
((bla)
(rx any))))
> (bla)
Error: Illegal regular expression
#{Generated any 1276}
(Because "any" is imported from scsh-utilities in rx/parse.scm)
<---
Set port policy for input to bufpol/line via isatty

27
Thanks Normal file
View File

@ -0,0 +1,27 @@
Post-0.5.2-release bug reports:
Friedrich Dominicus
Jay Nietling
Tim Bradshaw
Robert Brown
Eric Marsden
Paul Emsley
Pawel Turnau
Hannu Koivisto
Andy Gaynor
Francisco Vides Fernandez
Tim Burgess
Brian Denheyer
Harvey Stein
Eric Hilsdale
Andreas Bernauer
Chris Beggy
Ed Kademan
Michal Maruska
Noel Hunt
David Reiss
Chad R Dougherty
Michel Schinz
Alan Bawden
Bengt Kleberg
RT Happe
Dorai Sitaram

32
acconfig.h
View File

@ -1,32 +0,0 @@
/*
* HAVE_SIGACTION is defined iff sigaction() is available.
*/
#undef HAVE_SIGACTION
/*
* HAVE_STRERROR is defined iff the standard libraries provide strerror().
*/
#undef HAVE_STRERROR
/*
* NLIST_HAS_N_NAME is defined iff a struct nlist has an n_name member.
* If it doesn't then we assume it has an n_un member which, in turn,
* has an n_name member.
*/
#undef NLIST_HAS_N_NAME
/*
* HAVE_SYS_SELECT_H is defined iff we have the include file sys/select.h.
*/
#undef HAVE_SYS_SELECT_H
/*
* USCORE is defined iff C externals are prepended with an underscore.
*/
#undef USCORE
@BOTTOM@
#include "fake/sigact.h"
#include "fake/strerror.h"
#include "fake/sys-select.h"

16
autogen.sh Executable file
View File

@ -0,0 +1,16 @@
#! /bin/sh
autoheader &&
autoconf &&
./configure &&
touch scsh/*.c &&
touch build/filenames.scm &&
rm -f scheme48.image cig/cig.image scsh/scsh.image &&
rm -f build/linker.image build/initial.image &&
rm -f c/scheme48.h &&
make build/filenames.make &&
make i-know-what-i-am-doing &&
make c/scheme48.h&&
make linker &&
make build/initial.image &&
make distclean

28
build/build-external-modules Executable file
View File

@ -0,0 +1,28 @@
#!/bin/sh
# Build external-modules.c.
target="$1"
shift
(
cat <<!
!
for i in "s48_initialize_external" "$@"; do
cat <<!
extern void $i(void);
!
done
cat <<!
void s48_initialize_external_modules (void) {
!
for i in "s48_initialize_external" "$@"; do
cat <<!
$i();
!
done
cat <<!
};
!
) >"$target"

2
build/build-usual-image
View File

@ -9,7 +9,7 @@ vm=$4
initial=$5
USER=${USER-`logname 2>/dev/null || echo '*GOK*'`}
$vm -i $initial -a batch <<EOF
./$vm -o ./$vm -i $initial batch <<EOF
,load $srcdir/scheme/env/init-defpackage.scm
((*structure-ref filenames 'set-translation!)
"=scheme48/" "$srcdir/scheme/")

7
build/filenames.make
View File

@ -1,7 +0,0 @@
#### This file was generated automatically. ####
initial-files = scheme/rts/low.scm scheme/rts/signal.scm scheme/rts/base.scm scheme/rts/util.scm scheme/rts/number.scm scheme/rts/lize.scm scheme/rts/record.scm scheme/rts/jar-defrecord.scm scheme/rts/method.scm scheme/rts/numio.scm scheme/rts/fluid.scm scheme/rts/defenum.scm scheme/vm/arch.scm scheme/big/queue.scm scheme/rts/condition.scm scheme/rts/session.scm scheme/rts/interrupt.scm scheme/rts/wind.scm scheme/rts/template.scm scheme/rts/continuation.scm scheme/rts/exception.scm scheme/rts/thread.scm scheme/rts/sleep.scm scheme/rts/lock.scm scheme/rts/port.scm scheme/rts/current-port.scm scheme/rts/write.scm scheme/rts/read.scm scheme/rts/channel.scm scheme/rts/channel-port.scm scheme/rts/channel-io.scm scheme/big/general-table.scm scheme/rts/population.scm scheme/bcomp/mtype.scm scheme/bcomp/interface.scm scheme/bcomp/binding.scm scheme/bcomp/name.scm scheme/bcomp/transform.scm scheme/bcomp/cenv.scm scheme/bcomp/thingie.scm scheme/bcomp/package.scm scheme/bcomp/package-undef.scm scheme/rts/env.scm scheme/big/filename.scm scheme/bcomp/read-form.scm scheme/bcomp/node.scm scheme/bcomp/schemify.scm scheme/bcomp/var-util.scm scheme/bcomp/syntax.scm scheme/bcomp/primop.scm scheme/bcomp/ddata.scm scheme/bcomp/stack-check.scm scheme/bcomp/state.scm scheme/bcomp/segment.scm scheme/bcomp/recon.scm scheme/bcomp/comp-exp.scm scheme/bcomp/comp-prim.scm scheme/bcomp/comp.scm scheme/rts/eval.scm scheme/env/dispcond.scm scheme/debug/mini-command.scm scheme/rts/scheduler.scm scheme/rts/root-scheduler.scm scheme/rts/init.scm scheme/env/start.scm scheme/bcomp/usual.scm scheme/bcomp/rules.scm scheme/bcomp/type.scm scheme/bcomp/module-language.scm scheme/bcomp/config.scm scheme/bcomp/scan-package.scm scheme/bcomp/optimize.scm scheme/bcomp/comp-package.scm scheme/env/load-package.scm scheme/big/strong.scm scheme/opt/usage.scm scheme/opt/sort.scm scheme/opt/inline.scm scheme/bcomp/for-reify.scm
usual-files = scheme/opt/analyze.scm scheme/env/disclosers.scm scheme/env/command-level.scm scheme/env/version-info.scm scheme/env/command.scm scheme/env/read-command.scm scheme/env/debuginfo.scm scheme/rts/xnum.scm scheme/rts/bignum.scm scheme/rts/ratnum.scm scheme/rts/recnum.scm scheme/rts/innum.scm scheme/env/basic-command.scm scheme/env/build.scm scheme/env/shadow.scm scheme/env/pedit.scm scheme/env/pacman.scm scheme/rts/time.scm scheme/env/debug.scm scheme/env/inspect.scm scheme/env/disasm.scm
linker-files = scheme/rts/util.scm scheme/alt/fluid.scm scheme/rts/defenum.scm scheme/vm/arch.scm scheme/alt/jar-defrecord.scm scheme/big/general-table.scm scheme/bcomp/mtype.scm scheme/alt/locations.scm scheme/bcomp/binding.scm scheme/bcomp/name.scm scheme/bcomp/transform.scm scheme/bcomp/node.scm scheme/bcomp/schemify.scm scheme/bcomp/var-util.scm scheme/bcomp/primop.scm scheme/alt/template.scm scheme/rts/template.scm scheme/bcomp/ddata.scm scheme/bcomp/thingie.scm scheme/bcomp/stack-check.scm scheme/bcomp/state.scm scheme/bcomp/segment.scm scheme/bcomp/recon.scm scheme/bcomp/comp-exp.scm scheme/bcomp/comp-prim.scm scheme/bcomp/comp.scm scheme/alt/closure.scm scheme/link/data.scm scheme/link/transport.scm scheme/link/write-image.scm scheme/alt/weak.scm scheme/rts/population.scm scheme/bcomp/interface.scm scheme/bcomp/cenv.scm scheme/bcomp/package.scm scheme/bcomp/package-undef.scm scheme/bcomp/syntax.scm scheme/env/debuginfo.scm scheme/big/filename.scm scheme/bcomp/read-form.scm scheme/bcomp/scan-package.scm scheme/bcomp/optimize.scm scheme/bcomp/usual.scm scheme/bcomp/rules.scm scheme/bcomp/comp-package.scm scheme/big/strong.scm scheme/opt/usage.scm scheme/opt/sort.scm scheme/opt/inline.scm scheme/link/reify.scm scheme/link/link.scm scheme/alt/loophole.scm scheme/bcomp/type.scm scheme/alt/low.scm scheme/bcomp/module-language.scm scheme/bcomp/config.scm scheme/opt/analyze.scm scheme/alt/environments.scm scheme/link/loadc.scm scheme/env/flatload.scm

1
build/filenames.scm
View File

@ -6,6 +6,7 @@
; Define DEFINE-STRUCTURE and friends
(for-each load
'("scheme/bcomp/module-language.scm"
"scheme/alt/dummy-interface.scm"
"scheme/alt/config.scm"
"scheme/env/flatload.scm"))

6351
build/initial.debug
View File

File diff suppressed because it is too large Load Diff

BIN
build/initial.image
View File

Binary file not shown.

4
build/initial.scm
View File

@ -1,4 +1,4 @@
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-2000 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Link script.
@ -30,7 +30,7 @@
(l '()))
(for-each (lambda (int)
(for-each-declaration
(lambda (name type)
(lambda (name package-name type)
(if (not (assq name l))
(let ((s (eval name env)))
(if (structure? s)

90
build/load-linker.exec Normal file
View File

@ -0,0 +1,90 @@
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Load the linker. -*- Mode: Scheme; -*-
; Run this script with ,exec ,load l.exec.
; After the script is loaded, you can, in principle, do whatever
; you might do in the usual linker image. For example, you might do
; (this is from the Makefile)
;
; ,in link-config
; (load-configuration "interfaces.scm")
; (load-configuration "packages.scm")
; (flatload initial-structures)
; (load "initial.scm")
; (link-initial-system)
;
; This is intended to be used to debug new versions of the compiler or
; static linker.
(config '(run (define :arguments :values))) ;temporary hack
(translate "=scheme48/" "./")
(load-package 'flatloading)
(open 'flatloading)
(define (r x) (config `(run ,x)))
(r '(define-structure source-file-names (export (%file-name% :syntax))
(open scheme-level-1
syntactic
fluids)
(begin (define-syntax %file-name%
(syntax-rules ()
((%file-name%) (fluid $source-file-name)))))))
(r '(define-structure enumerated enumerated-interface
(open scheme-level-1 signals)
(files (rts defenum scm))))
(r '(define-structure architecture architecture-interface
(open scheme-level-1 signals enumerated)
(files (rts arch))))
(config '(structure reflective-tower-maker
(export-reflective-tower-maker)))
; Make the new linker obtain its table, record, etc. structures from
; the currently running Scheme.
(config '(load "packages.scm"))
(config '(structure %run-time-structures run-time-structures-interface))
(config '(structure %features-structures features-structures-interface))
(r
'(define-structure %linker-structures
(make-linker-structures %run-time-structures
%features-structures
(make-compiler-structures %run-time-structures
%features-structures))))
; Load the linker's interface and structure definitions.
(config '(load "interfaces.scm" "more-interfaces.scm"))
(let ((z (config '(run %linker-structures)))
(env (config interaction-environment)))
(config (lambda () (flatload z env))))
; Load the linker.
(load-package 'link-config)
; Initialize
(in 'link-config
'(open scheme packages packages-internal
reflective-tower-maker))
(in 'linker '(run (set! *debug-linker?* #t)))
(in 'link-config '(open flatloading)) ; A different one.
; ,open debuginfo packages-internal compiler scan syntactic meta-types
; (in 'link-config '(dump "l.image"))
; ,exec (usual-stuff)
(define (usual-stuff)
(in 'link-config)
(run '(begin (load-configuration "interfaces.scm")
(load-configuration "packages.scm")
(flatload initial-structures)))
(load "initial.scm"))

82
build/lucid-script.lisp Normal file
View File

@ -0,0 +1,82 @@
; Script to load the Scheme 48 linker into Common Lisp.
; Requires Pseudoscheme 2.11.
(defvar pseudoscheme-directory "../pseudo/")
(load (concatenate 'string pseudoscheme-directory "loadit.lisp"))
; or perhaps (load (merge-pathnames "loadit.lisp" pseudoscheme-directory))
(load-pseudoscheme pseudoscheme-directory)
(progn (revised^4-scheme::define-sharp-macro #\.
#'(lambda (c port)
(read-char port)
(eval (let ((*readtable* ps::scheme-readtable))
(read port)))))
(values))
(ps:scheme)
;--------------------
; Scheme forms
(benchmark-mode)
(define config-env ; (interaction-environment) would also work here.
(#.'scheme-translator:make-program-env
'%config
(list #.'scheme-translator:revised^4-scheme-structure)))
(load "bcomp/module-language" config-env)
(load "alt/config" config-env)
(load "env/flatload" config-env)
(eval '(set! *load-file-type* #f) config-env)
(define load-config
(let ((load-config (eval 'load-configuration config-env)))
(lambda (filename)
(load-config filename config-env))))
(load-config "packages")
(define flatload-package (eval 'flatload config-env))
(flatload-package (eval 'linker-structures config-env) config-env)
(let ((#.'clever-load:*compile-if-necessary-p* #t))
(let ((#.'ps:*scheme-read* #.'#'ps::scheme-read-using-commonlisp-reader))
(load "alt/pseudoscheme-record")
(load "alt/pseudoscheme-features")))
(let ((#.'clever-load:*compile-if-necessary-p* #t))
(flatload-package (eval 'link-config config-env)))
(load "alt/init-defpackage.scm")
(define-syntax struct-list ;not in link.sbin
(syntax-rules ()
((struct-list ?name ...) (list (cons '?name ?name) ...))))
;--------------------
(quit)
#+Lucid
(defun disksave-restart-function ()
(format t "~&Scheme 48 linker.~2%")
;; (hax:init-interrupt-delivery) - for threads
(ps:scheme)
(terpri))
#+Lucid
(defun dump-linker ()
(lcl:disksave "link/linker-in-lucid" :gc t :full-gc t :verbose t
:restart-function #'disksave-restart-function))
;(dump-linker)
;(lcl:quit)
; Debugging hacks
;(defun enable-lisp-packages ()
; (setq *readtable* ps:scheme-readtable)
; (values))
;(defun disable-lisp-packages ()
; (setq *readtable* ps::roadblock-readtable)
; (values))

2
build/minor-version-number
View File

@ -1 +1 @@
53
6.4

2
c/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
sysdep.h
sysdep.h.in

6
c/c-mods.h
View File

@ -1,4 +1,10 @@
#ifndef TRUE
#define TRUE (0 == 0)
#endif
#ifndef FALSE
#define FALSE (0 == 1)
#endif
#define bool char /* boolean type */

6
c/event.h
View File

@ -1,5 +1,7 @@
enum event_enum { KEYBOARD_INTERRUPT_EVENT, IO_COMPLETION_EVENT, ALARM_EVENT,
OS_SIGNAL_EVENT, ERROR_EVENT, NO_EVENT };
enum event_enum { KEYBOARD_INTERRUPT_EVENT,
IO_READ_COMPLETION_EVENT, IO_WRITE_COMPLETION_EVENT,
ALARM_EVENT,
OS_SIGNAL_EVENT, ERROR_EVENT, NO_EVENT };
extern bool s48_add_pending_fd(int fd, bool is_input);
extern bool s48_remove_fd(int fd);

236
c/extension.c Normal file
View File

@ -0,0 +1,236 @@
/* Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees.
See file COPYING. */
/* Implementation of the vm-extension opcode. This is completely
optional; nothing in the standard system uses these features.
If you have ANSI C but not POSIX support, try compiling with -DPOSIX=0.
The vm-extension opcode is being phased out. New code should use the
external-call opcode to call C procedures.
floating point: POSIX.1, ANSI C (should we be linking with -lM or -lm?)
sprintf: POSIX.1, ANSI C
atof: POSIX.1, ANSI C
*/
#ifndef POSIX
# define POSIX 2
#endif
#include <stdio.h>
#include "sysdep.h"
#include "scheme48.h"
#include <string.h>
#include <stdlib.h>
#include <math.h>
#include <signal.h>
#include <unistd.h> /* setuid & setgid */
#include <errno.h>
#include <netdb.h> /* gethostbyname */ /* Kali code */
#include <sys/types.h>
#include <sys/wait.h>
#define GREATEST_FIXNUM_VALUE ((1 << 29) - 1)
#define LEAST_FIXNUM_VALUE (-1 << 29)
#define CHANNEL_INDEX(x) EXTRACT_FIXNUM(STOB_REF(x, 1))
#define FOR_INPUT 1
#define FOR_OUTPUT 2
typedef struct {
char b[sizeof(double)];
} unaligned_double;
typedef union {
double f;
unaligned_double b;
} float_or_bytes;
extern long s48_Sextension_valueS; /* how values are returned */
/* return status values */
#define EXT_ST_OKAY 0
#define EXT_ST_EXCEPTION 1
#define EXT_RETURN(value) {s48_Sextension_valueS = (value); return EXT_ST_OKAY; }
#define EXT_EXCEPTION return EXT_ST_EXCEPTION
/******************************************/
s48_value
s48_extended_vm (long key, s48_value value)
{
double x, y;
switch (key) {
/* Cases 0 through 19 are reserved for the mobot system. */
case 0: /* read jumpers on 68000 board */
EXT_RETURN(S48_UNSAFE_ENTER_FIXNUM(0));
/* Floating point */
#define FLOP 100
#define FLOP2(i) case FLOP+(i): \
if (!S48_STOB_P(value) || S48_STOB_DESCRIPTOR_LENGTH(value) != 2) \
EXT_EXCEPTION;
#define FLOP3(i) case FLOP+(i): \
if (!S48_STOB_P(value) || S48_STOB_DESCRIPTOR_LENGTH(value) != 3) \
EXT_EXCEPTION;
#define get_arg(args,i) S48_STOB_REF(args,(i))
#define get_string_arg(args,i) (S48_UNSAFE_EXTRACT_STRING(get_arg(args,i)))
#define get_float_arg(args, i, var) EXTRACT_FLOAT(get_arg(args, i), var)
#define set_float_arg(args, i, val) SET_FLOAT(get_arg(args, i), val)
#define EXTRACT_FLOAT(stob, var) \
{ s48_value temp_ = (stob); \
float_or_bytes loser_; \
if (!S48_STOB_P(temp_)) EXT_EXCEPTION; \
loser_.b = *(unaligned_double*)(&S48_STOB_REF(temp_, 0)); \
(var) = loser_.f; }
#define SET_FLOAT(stob, val) \
{ s48_value temp_ = (stob); \
float_or_bytes loser_; \
if (!S48_STOB_P(temp_)) EXT_EXCEPTION; \
loser_.f = (double)(val); \
*(unaligned_double*)(&S48_STOB_REF(temp_, 0)) = loser_.b; }
FLOP3(0) {
get_float_arg(value, 0, x);
get_float_arg(value, 1, y);
set_float_arg(value, 2, x + y);
EXT_RETURN(S48_UNSPECIFIC);}
FLOP3(1) {
get_float_arg(value, 0, x);
get_float_arg(value, 1, y);
set_float_arg(value, 2, x - y);
EXT_RETURN(S48_UNSPECIFIC);}
FLOP3(2) {
get_float_arg(value, 0, x);
get_float_arg(value, 1, y);
set_float_arg(value, 2, x * y);
EXT_RETURN(S48_UNSPECIFIC);}
FLOP3(3) {
get_float_arg(value, 0, x);
get_float_arg(value, 1, y);
if (y == 0.0) EXT_EXCEPTION;
set_float_arg(value, 2, x / y);
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(4) {
get_float_arg(value, 0, x);
get_float_arg(value, 1, y);
EXT_RETURN(S48_ENTER_BOOLEAN(x == y));}
FLOP2(5) {
get_float_arg(value, 0, x);
get_float_arg(value, 1, y);
EXT_RETURN(S48_ENTER_BOOLEAN(x < y));}
FLOP2(6) { /* fixnum->float */
s48_value arg = get_arg(value, 0);
if (!S48_FIXNUM_P(arg)) EXT_RETURN(S48_FALSE);
set_float_arg(value, 1, S48_UNSAFE_EXTRACT_FIXNUM(arg));
EXT_RETURN(S48_TRUE);}
FLOP2(7) { /* string->float */
char *str = get_string_arg(value, 0);
set_float_arg(value, 1, atof(str));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(8) { /* float->string */
size_t len;
char *str = get_string_arg(value,1);
get_float_arg(value, 0, x);
sprintf(str, "%g", x);
len = strlen(str);
if (len > S48_UNSAFE_STRING_LENGTH(get_arg(value,1)))
/* unlikely but catastrophic */
fprintf(stderr, "printing float: output too long: %s\n",
str);
EXT_RETURN(S48_UNSAFE_ENTER_FIXNUM(len));}
/* exp log sin cos tan asin acos atan sqrt */
FLOP2(9) {
get_float_arg(value, 0, x);
set_float_arg(value, 1, exp(x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(10) {
get_float_arg(value, 0, x);
set_float_arg(value, 1, log(x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(11) {
get_float_arg(value, 0, x);
set_float_arg(value, 1, sin(x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(12) {
get_float_arg(value, 0, x);
set_float_arg(value, 1, cos(x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(13) {
get_float_arg(value, 0, x);
set_float_arg(value, 1, tan(x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(14) {
get_float_arg(value, 0, x);
set_float_arg(value, 1, asin(x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(15) {
get_float_arg(value, 0, x);
set_float_arg(value, 1, acos(x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP3(16) { /* atan */
get_float_arg(value, 0, y);
get_float_arg(value, 1, x);
set_float_arg(value, 2, atan2(y, x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(17) {
get_float_arg(value, 0, x);
set_float_arg(value, 1, sqrt(x));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP2(18) { /* floor */
get_float_arg(value, 0, x);
set_float_arg(value, 1, floor(x));
EXT_RETURN(S48_UNSPECIFIC);}
case FLOP+19: { /* integer? */
EXTRACT_FLOAT(value, x);
EXT_RETURN(S48_ENTER_BOOLEAN(fmod(x, 1.0) == 0.0)); }
case FLOP+20: { /* float->fixnum */
EXTRACT_FLOAT(value, x);
if (x <= (double)GREATEST_FIXNUM_VALUE
&& x >= (double)LEAST_FIXNUM_VALUE)
{
EXT_RETURN(S48_UNSAFE_ENTER_FIXNUM((long)x)); }
else
EXT_RETURN(S48_FALSE);}
FLOP3(21) { /* quotient */
double z;
get_float_arg(value, 0, x);
get_float_arg(value, 1, y);
if (fmod(x, 1.0) != 0.0 || fmod(y, 1.0) != 0.0) EXT_EXCEPTION;
if (y == 0.0) EXT_EXCEPTION;
z = x / y;
set_float_arg(value, 2, z < 0.0 ? ceil(z) : floor(z));
EXT_RETURN(S48_UNSPECIFIC);}
FLOP3(22) { /* remainder */
get_float_arg(value, 0, x);
get_float_arg(value, 1, y);
if (fmod(x, 1.0) != 0.0 || fmod(y, 1.0) != 0.0) EXT_EXCEPTION;
if (y == 0.0) EXT_EXCEPTION;
/* "fmod(double x, double y) returns the floating-point remainder
(f) of the division of x by y, where f has the same sign as x,
such that x=iy+f for some integer i, and |f| < |y|." */
set_float_arg(value, 2, fmod(x, y));
EXT_RETURN(S48_UNSPECIFIC);}
default:
EXT_EXCEPTION;
}
}

404
c/external.c
View File

@ -127,6 +127,8 @@ s48_value
s48_external_call(s48_value sch_proc, s48_value proc_name,
long nargs, char *char_argv)
{
volatile char *gc_marker; /* volatile to survive longjumps */
char *gc_marker_temp; /* C wants it so */
volatile char *gc_roots_marker; /* volatile to survive longjumps */
volatile s48_value name = proc_name; /* volatile to survive longjumps */
@ -144,7 +146,8 @@ s48_external_call(s48_value sch_proc, s48_value proc_name,
S48_CHECK_VALUE(sch_proc);
S48_CHECK_STRING(name);
gc_roots_marker = s48_set_gc_roots_baseB();
gc_roots_marker = s48_set_gc_roots_baseB(&gc_marker_temp);
gc_marker = gc_marker_temp;
/* fprintf(stderr, "[external_call at depth %d]\n", depth); */
@ -209,7 +212,7 @@ s48_external_call(s48_value sch_proc, s48_value proc_name,
/* Raise an exception if the user neglected to pop off some gc roots. */
if (! s48_release_gc_roots_baseB((char *)gc_roots_marker)) {
if (! s48_release_gc_roots_baseB((char *)gc_roots_marker, (char *)gc_marker)) {
s48_raise_scheme_exception(S48_EXCEPTION_GC_PROTECTION_MISMATCH, 0);
}
@ -242,7 +245,7 @@ s48_external_call(s48_value sch_proc, s48_value proc_name,
depth,
callback_depth());
fprintf(stderr, "[throw unrolling to %ld]\n", gc_roots_marker); */
s48_release_gc_roots_baseB((char *)gc_roots_marker);
s48_release_gc_roots_baseB((char *)gc_roots_marker, (char *)gc_marker);
}
/* Check to see if a thread is waiting to return to the next block down. */
@ -301,7 +304,7 @@ s48_call_scheme(s48_value proc, long nargs, ...)
/* It would be nice to push a list of the arguments, but we have no way
of preserving them across a cons. */
if (nargs < 0 || 10 < nargs) { /* DO NOT INCREASE THIS NUMBER */
if (nargs < 0 || 12 < nargs) { /* DO NOT INCREASE THIS NUMBER */
s48_value sch_nargs = s48_enter_integer(nargs); /* `proc' is protected */
s48_raise_scheme_exception(S48_EXCEPTION_TOO_MANY_ARGUMENTS_IN_CALLBACK,
2, proc, sch_nargs);
@ -473,12 +476,12 @@ s48_raise_scheme_exception(long why, long nargs, ...)
/* Specific exceptions */
void
s48_raise_argtype_error(s48_value value) {
s48_raise_argument_type_error(s48_value value) {
s48_raise_scheme_exception(S48_EXCEPTION_WRONG_TYPE_ARGUMENT, 1, value);
}
void
s48_raise_argnumber_error(s48_value value, s48_value min, s48_value max) {
s48_raise_argument_number_error(s48_value value, s48_value min, s48_value max) {
s48_raise_scheme_exception(S48_EXCEPTION_WRONG_NUMBER_OF_ARGUMENTS,
3, value, min, max);
}
@ -501,6 +504,69 @@ s48_raise_os_error(int the_errno) {
s48_enter_string(strerror(the_errno)));
}
void
s48_raise_os_error_1(int the_errno, s48_value arg1) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 3,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1);
}
void
s48_raise_os_error_2(int the_errno, s48_value arg1, s48_value arg2) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 4,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2);
}
void
s48_raise_os_error_3(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 5,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3);
}
void
s48_raise_os_error_4(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 6,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3, arg4);
}
void
s48_raise_os_error_5(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4, s48_value arg5) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 7,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3, arg4, arg5);
}
void
s48_raise_os_error_6(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4, s48_value arg5,
s48_value arg6) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 8,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3, arg4, arg5, arg6);
}
void
s48_raise_os_error_7(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4, s48_value arg5,
s48_value arg6, s48_value arg7) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 9,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3, arg4, arg5, arg6, arg7);
}
void
s48_raise_string_os_error(char *reason) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 1,
@ -529,7 +595,7 @@ long
s48_stob_length(s48_value thing, int type)
{
if (!(S48_STOB_P(thing) && (S48_STOB_TYPE(thing) == type)))
s48_raise_argtype_error(thing);
s48_raise_argument_type_error(thing);
return S48_STOB_DESCRIPTOR_LENGTH(thing);
}
@ -538,7 +604,7 @@ long
s48_stob_byte_length(s48_value thing, int type)
{
if (!(S48_STOB_P(thing) && (S48_STOB_TYPE(thing) == type)))
s48_raise_argtype_error(thing);
s48_raise_argument_type_error(thing);
if (type == S48_STOBTYPE_STRING)
return S48_STOB_BYTE_LENGTH(thing) - 1;
@ -552,7 +618,7 @@ s48_stob_ref(s48_value thing, int type, long offset)
long length;
if (!(S48_STOB_P(thing) && (S48_STOB_TYPE(thing) == type)))
s48_raise_argtype_error(thing);
s48_raise_argument_type_error(thing);
length = S48_STOB_DESCRIPTOR_LENGTH(thing);
@ -572,7 +638,7 @@ s48_stob_set(s48_value thing, int type, long offset, s48_value value)
if (!(S48_STOB_P(thing) &&
(S48_STOB_TYPE(thing) == type) &&
!S48_STOB_IMMUTABLEP(thing)))
s48_raise_argtype_error(thing);
s48_raise_argument_type_error(thing);
length = S48_STOB_DESCRIPTOR_LENGTH(thing);
@ -585,12 +651,12 @@ s48_stob_set(s48_value thing, int type, long offset, s48_value value)
}
char
s48_byte_ref(s48_value thing, int type, long offset)
s48_stob_byte_ref(s48_value thing, int type, long offset)
{
long length;
if (!(S48_STOB_P(thing) && (S48_STOB_TYPE(thing) == type)))
s48_raise_argtype_error(thing);
s48_raise_argument_type_error(thing);
length = (type == S48_STOBTYPE_STRING) ?
S48_STOB_BYTE_LENGTH(thing) - 1 :
@ -605,12 +671,12 @@ s48_byte_ref(s48_value thing, int type, long offset)
}
void
s48_byte_set(s48_value thing, int type, long offset, char value)
s48_stob_byte_set(s48_value thing, int type, long offset, char value)
{
long length;
if (!(S48_STOB_P(thing) && (S48_STOB_TYPE(thing) == type)))
s48_raise_argtype_error(thing);
s48_raise_argument_type_error(thing);
length = (type == S48_STOBTYPE_STRING) ?
S48_STOB_BYTE_LENGTH(thing) - 1 :
@ -645,7 +711,7 @@ s48_value
s48_enter_fixnum(long value)
{
if (value < S48_MIN_FIXNUM_VALUE || S48_MAX_FIXNUM_VALUE < value)
s48_raise_argtype_error(s48_enter_integer(value));
s48_raise_argument_type_error(s48_enter_integer(value));
return S48_UNSAFE_ENTER_FIXNUM(value);
}
@ -654,7 +720,7 @@ long
s48_extract_fixnum(s48_value value)
{
if (! S48_FIXNUM_P(value))
s48_raise_argtype_error(value);
s48_raise_argument_type_error(value);
return S48_UNSAFE_EXTRACT_FIXNUM(value);
}
@ -689,6 +755,22 @@ s48_enter_integer(long value)
}
}
s48_value
s48_enter_unsigned_integer(unsigned long value)
{
if (value <= S48_MAX_FIXNUM_VALUE)
return S48_UNSAFE_ENTER_FIXNUM(value);
else {
S48_SHARED_BINDING_CHECK(long_to_bignum_binding);
return s48_call_scheme(S48_SHARED_BINDING_REF(long_to_bignum_binding),
3,
S48_FALSE, /* this is ok */
S48_UNSAFE_ENTER_FIXNUM(value >> 16),
S48_UNSAFE_ENTER_FIXNUM(value & 0xFFFF));
}
}
/*
* If we have a fixnum we just extract it. Bignums require a call back into
* Scheme 48. (BIGNUM-TO-LONG n) returns a vector containing the sign and the
@ -717,7 +799,7 @@ s48_extract_integer(s48_value value)
S48_GC_UNPROTECT();
if (stuff == S48_FALSE)
s48_raise_argtype_error(value);
s48_raise_argument_type_error(value);
/* The first VECTOR_REF does the type checking for the rest. */
{
@ -728,7 +810,7 @@ s48_extract_integer(s48_value value)
if ((! S48_FIXNUM_P(boxed_high)) ||
high > (pos_p ? 0x7FFF : 0x8000))
s48_raise_argtype_error(value);
s48_raise_argument_type_error(value);
{
long magnitude = ((- high) << 16) - low;
@ -738,6 +820,49 @@ s48_extract_integer(s48_value value)
}
}
unsigned long
s48_extract_unsigned_integer(s48_value value)
{
long temp;
if (S48_FIXNUM_P(value)){
temp = S48_UNSAFE_EXTRACT_FIXNUM(value);
if (temp < 0)
s48_raise_argument_type_error(value);
else return (unsigned long) temp;
}
else {
s48_value stuff;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(value);
S48_SHARED_BINDING_CHECK(bignum_to_long_binding);
stuff = s48_call_scheme(S48_SHARED_BINDING_REF(bignum_to_long_binding),
1,
value);
S48_GC_UNPROTECT();
if (stuff == S48_FALSE)
s48_raise_argument_type_error(value);
/* The first VECTOR_REF does the type checking for the rest. */
{
long low = S48_UNSAFE_EXTRACT_FIXNUM(S48_VECTOR_REF(stuff, 2));
s48_value boxed_high = S48_UNSAFE_VECTOR_REF(stuff, 1);
long high = S48_UNSAFE_EXTRACT_FIXNUM(boxed_high);
int pos_p = S48_EXTRACT_BOOLEAN(S48_UNSAFE_VECTOR_REF(stuff, 0));
if ((!pos_p) ||
(! S48_FIXNUM_P(boxed_high)) ||
(high > 0xFFFF))
s48_raise_argument_type_error(value);
else return ((((unsigned long) high) << 16) + low);
}
}
}
/*
* Doubles and characters are straightforward.
*/
@ -757,7 +882,7 @@ double
s48_extract_double(s48_value s48_double)
{
if (! S48_DOUBLE_P(s48_double))
s48_raise_argtype_error(s48_double);
s48_raise_argument_type_error(s48_double);
return S48_UNSAFE_EXTRACT_DOUBLE(s48_double);
}
@ -777,7 +902,7 @@ unsigned char
s48_extract_char(s48_value a_char)
{
if (! S48_CHAR_P(a_char))
s48_raise_argtype_error(a_char);
s48_raise_argument_type_error(a_char);
return S48_UNSAFE_EXTRACT_CHAR(a_char);
}
@ -812,6 +937,164 @@ s48_cons(s48_value v1, s48_value v2)
return obj;
}
s48_value
s48_list_1(s48_value v1)
{
return (s48_cons (v1, S48_NULL));
}
s48_value
s48_list_2(s48_value v1, s48_value v2)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_1 (v2);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_3(s48_value v1, s48_value v2, s48_value v3)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_2 (v2, v3);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_4(s48_value v1, s48_value v2, s48_value v3, s48_value v4)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_3 (v2, v3, v4);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_5(s48_value v1, s48_value v2, s48_value v3, s48_value v4, s48_value v5)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_4 (v2, v3, v4, v5);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_6(s48_value v1, s48_value v2, s48_value v3, s48_value v4, s48_value v5,
s48_value v6)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_5 (v2, v3, v4, v5, v6);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_7(s48_value v1, s48_value v2, s48_value v3, s48_value v4, s48_value v5,
s48_value v6, s48_value v7)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_6 (v2, v3, v4, v5, v6, v7);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_8(s48_value v1, s48_value v2, s48_value v3, s48_value v4, s48_value v5,
s48_value v6, s48_value v7, s48_value v8)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_7 (v2, v3, v4, v5, v6, v7, v8);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_9(s48_value v1, s48_value v2, s48_value v3, s48_value v4, s48_value v5,
s48_value v6, s48_value v7, s48_value v8, s48_value v9)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_8 (v2, v3, v4, v5, v6, v7, v8, v9);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_10(s48_value v1, s48_value v2, s48_value v3, s48_value v4, s48_value v5,
s48_value v6, s48_value v7, s48_value v8, s48_value v9, s48_value v10)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_9 (v2, v3, v4, v5, v6, v7, v8, v9, v10);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_11(s48_value v1, s48_value v2, s48_value v3, s48_value v4, s48_value v5,
s48_value v6, s48_value v7, s48_value v8, s48_value v9, s48_value v10,
s48_value v11)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_10 (v2, v3, v4, v5, v6, v7, v8, v9, v10, v11);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_list_12(s48_value v1, s48_value v2, s48_value v3, s48_value v4, s48_value v5,
s48_value v6, s48_value v7, s48_value v8, s48_value v9, s48_value v10,
s48_value v11, s48_value v12)
{
s48_value list = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(v1);
list = s48_list_11 (v2, v3, v4, v5, v6, v7, v8, v9, v10, v11, v12);
list = s48_cons (v1, list);
S48_GC_UNPROTECT();
return list;
}
s48_value
s48_make_weak_pointer(s48_value value)
{
@ -831,7 +1114,7 @@ s48_value
s48_enter_substring(char *str, int length)
{
s48_value obj = s48_allocate_stob(S48_STOBTYPE_STRING, length + 1);
strncpy(S48_UNSAFE_EXTRACT_STRING(obj), str, length);
memcpy(S48_UNSAFE_EXTRACT_STRING(obj), str, length);
*(S48_UNSAFE_EXTRACT_STRING(obj) + length) = '\0';
return obj;
}
@ -878,9 +1161,31 @@ s48_make_vector(int length, s48_value init)
}
s48_value
s48_make_byte_vector(int length)
s48_enter_byte_vector(char *bvec, int length)
{
return s48_allocate_stob(S48_STOBTYPE_BYTE_VECTOR, length);
s48_value obj = s48_allocate_stob(S48_STOBTYPE_BYTE_VECTOR, length);
memcpy(S48_UNSAFE_EXTRACT_BYTE_VECTOR(obj), bvec, length);
return obj;
}
char *
s48_extract_byte_vector(s48_value bvec)
{
S48_CHECK_BYTE_VECTOR(bvec);
return S48_UNSAFE_EXTRACT_BYTE_VECTOR(bvec);
}
s48_value
s48_make_byte_vector(int length, int init)
{
int i;
s48_value obj = s48_allocate_stob(S48_STOBTYPE_BYTE_VECTOR, length);
for (i = 0; i < length; i++)
S48_BYTE_VECTOR_SET(obj, i, init);
return obj;
}
s48_value
@ -929,7 +1234,7 @@ s48_check_record_type(s48_value record, s48_value type_binding)
if ((! S48_RECORD_P(record)) ||
(S48_UNSAFE_SHARED_BINDING_REF(type_binding) !=
S48_UNSAFE_RECORD_REF(record, -1)))
s48_raise_argtype_error(record);
s48_raise_argument_type_error(record);
}
long
@ -945,3 +1250,54 @@ s48_length(s48_value list)
return S48_UNSAFE_ENTER_FIXNUM(i);
}
/*
**
** Support for libscsh.a: add external initializers without the Makefile
**
*/
struct simple_list{
void (*init)(); /* pointer to init-function */
struct simple_list* next;
};
struct simple_list* additional_inits = 0;
/*
* This function is part of EXTERNAL_INITIALIZERS in the scsh Makefile.
* It calls the init-functions in additional_inits.
*/
void s48_init_additional_inits(){
struct simple_list* ptr = additional_inits;
struct simple_list* free_me;
while (ptr != 0){
ptr->init();
free_me = ptr;
ptr = ptr->next;
free (free_me);
}
}
/*
* Actual API function: argument is an init-function. You have to
* ensure, that all s48_add_external_inits are called before you call
* s48_main.
*/
int s48_add_external_init(void (*init)()){
struct simple_list *new_list;
new_list = (struct simple_list *) malloc(sizeof (struct simple_list));
if (new_list == 0) return 0;
new_list->init = init;
new_list->next = additional_inits;
additional_inits = new_list;
return 1;
}

4
c/fake/dlfcn.h
View File

@ -1,11 +1,7 @@
/*
* This include file is for systems which do not have dynamic loading.
*/
#if ! defined(HAVE_DLOPEN)
extern void *dlopen(char *filename, int flags);
extern char *dlerror(void);
extern void *dlsym(void *lib, char *name);
extern int dlclose(void *lib);
#endif

12
c/fake/libdl1.c
View File

@ -5,12 +5,18 @@
* (whose name is pointed to by object_file).
*/
#include "sysdep.h"
#include <stdlib.h>
#include <nlist.h>
#ifdef USCORE
#include <string.h>
#endif
#if defined(HAVE_DLOPEN)
#include <dlfcn.h>
#else
#include "../fake/dlfcn.h"
#endif
#if ! defined(NLIST_HAS_N_NAME)
#define n_name n_un.n_name
#endif
@ -64,7 +70,7 @@ dlsym(void *lib, char *name)
lasterror = "Bad library pointer passed to dlsym()";
return (NULL);
}
if (object_file == NULL) {
if (s48_object_file == NULL) {
lasterror = "I don't know the name of my executable";
return (NULL);
}
@ -87,7 +93,7 @@ dlsym(void *lib, char *name)
names[0].n_value = 0; /* for Linux */
names[0].n_type = 0; /* for Linux */
names[1].n_name = NULL;
status = nlist(object_file, names);
status = nlist(s48_object_file, names);
#ifdef USCORE
if (tmp != buff)
free((void *)tmp);

43
c/fake/libdl2.c Normal file
View File

@ -0,0 +1,43 @@
/*
* This is a fake version of the dynamic loading library for machines
* which don't have it, and don't even have an nlist.
* We fake it so that everything fails.
*/
#include "sysdep.h"
static char *lasterror;
char *
dlerror(void)
{
char *res;
res = lasterror;
lasterror = NULL;
return (res);
}
void *
dlopen(char *name, int flags)
{
lasterror = "Dynamic loading not supported on this machine";
return (NULL);
}
int
dlclose(void *lib)
{
return (0);
}
void *
dlsym(void *lib, char *name)
{
lasterror = "Dynamic loading not supported on this machine";
return (NULL);
}

15
c/fake/sigact.h Normal file
View File

@ -0,0 +1,15 @@
/*
* If we don't have sigaction, we fake it using signal.
*/
#if ! defined(HAVE_SIGACTION)
struct sigaction {
void (*sa_handler)();
int sa_mask;
int sa_flags;
};
#define sigaction(sig, act, oact) signal((sig), (act)->sa_handler)
#define sigemptyset(ign) 0
#endif

22
c/fake/strerror.c Normal file
View File

@ -0,0 +1,22 @@
/*
* If the system doesn't have a strerror procedure, we provide our own.
* Note, this depends on sys_nerr and sys_errlist being provided.
* If your system doesn't provide that either, you can replace this
* procedure with one that always returns "Unknown error".
*/
#include "sysdep.h"
extern int sys_nerr;
extern char *sys_errlist[];
char *
strerror(int errnum)
{
if ((0 <= errnum)
&& (errnum < sys_nerr))
return (sys_errlist[errnum]);
else
return ("Unknown error");
}

8
c/fake/strerror.h Normal file
View File

@ -0,0 +1,8 @@
/*
* If we don't have strerror(), we fake it using sys_nerr and sys_errlist.
*/
#if ! defined(HAVE_STRERROR)
extern char *strerror(int errnum);
#endif

9
c/fake/sys-select.h Normal file
View File

@ -0,0 +1,9 @@
/*
* If we have a sys/select.h, then include it.
*/
#if defined(HAVE_SYS_SELECT_H)
#include <sys/types.h>
#include <sys/select.h>
#endif

2
c/fd-io.h
View File

@ -7,6 +7,8 @@ extern int ps_open_fd(char *in_filename, bool is_input, long *status);
extern int ps_close_fd(long fd_as_long);
extern bool ps_check_fd(long fd_as_long, bool is_read, long *status);
extern long ps_read_fd(long fd_as_long, char *buf_as_long, long max, bool waitp,
bool *eofp, bool *pending, long *status);

117
c/init.c Normal file
View File

@ -0,0 +1,117 @@
/* Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees.
See file COPYING. */
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
#include "scheme48vm.h"
#include "scheme48heap.h"
extern void s48_sysdep_init(void);
extern void s48_initialize_external_modules(void);
/* JMG: s48_object_file is obsolete according to s48 manual */
char *s48_object_file; /* specified via a command line argument */
char *s48_reloc_file; /* dynamic loading will set this */
char *prog_name;
void *heap, *stack;
int s48_main (long heap_size, long stack_size,
char *image_name, int argc, char** argv)
{
int ret = internal_s48_main(heap_size, stack_size, "libscsh", "libscsh",
image_name, argc, argv);
free(heap);
free(stack);
return ret;
}
int
internal_s48_main(long heap_size, long stack_size, char * _prog_name,
char* object_file, char *image_name, int argc, char** argv)
{
long return_value;
long required_heap_size;
int warn_undefined_imported_bindings_p = 1;
#if defined(STATIC_AREAS)
extern long static_entry;
extern long static_symbol_table;
extern long static_imported_binding_table, static_exported_binding_table;
extern long p_count, *p_areas[], p_sizes[];
extern long i_count, *i_areas[], i_sizes[];
#endif
prog_name = _prog_name;
s48_object_file = object_file;
s48_reloc_file = NULL;
s48_sysdep_init();
s48_heap_init();
s48_init();
if (image_name == NULL)
required_heap_size = 0;
else {
/* check_image_header returns number of bytes; required_heap_size
is number of cells. */
required_heap_size =
s48_check_image_header((unsigned char *)image_name) >> 2;
if (-1 == required_heap_size) {
fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
return 1; }
}
/* two semi-spaces, plus we want some room to maneuver */
if (heap_size < 4 * required_heap_size) {
fprintf(stderr, "heap size %ld is too small, using %ld\n",
heap_size, 4 * required_heap_size);
heap_size = 4 * required_heap_size; }
heap = (void *) malloc(heap_size * sizeof(long));
stack = (void *) malloc(stack_size * sizeof(long));
if (!heap || !stack) {
fprintf(stderr, "system is out of memory\n");
return 1; }
s48_initialize_heap((long)heap, heap_size);
#if defined(STATIC_AREAS)
if (image_name == NULL) {
s48_register_static_areas(p_count, p_areas, p_sizes,
i_count, i_areas, i_sizes);
s48_set_image_valuesB(static_entry,
static_symbol_table,
static_imported_binding_table,
static_exported_binding_table);
} else if (s48_read_image() == -1) {
fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
return 1; }
#else
if (s48_read_image() == -1) {
fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
return 1; }
#endif
s48_initialize_vm(stack, stack_size);
s48_initialize_external_modules();
if (warn_undefined_imported_bindings_p)
s48_warn_about_undefined_imported_bindings();
return_value = s48_call_startup_procedure(argv, argc);
if (s48_reloc_file != NULL)
if (0 != unlink(s48_reloc_file))
fprintf(stderr, "unable to delete file %s\n", s48_reloc_file);
return(return_value);
}

12
c/io.h Normal file
View File

@ -0,0 +1,12 @@
extern FILE *ps_open_input_file(char *, long *);
extern FILE *ps_open_output_file(char *, long *);
extern long ps_close(FILE *);
extern char ps_read_char(FILE *, char *, long *, char);
extern long ps_read_integer(FILE *, char *, long *);
extern long ps_write_char(char, FILE *);
extern long ps_write_integer(long, FILE *);
extern long ps_write_string(char *, FILE *);
extern long ps_read_block(FILE *, char *, long, char *, long *);
extern long ps_write_block(FILE *, char *, long);
extern char *ps_error_string(long);
extern void ps_error(char *, long count, ...);

158
c/main.c
View File

@ -4,12 +4,13 @@
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
#include "scheme48vm.h"
#include "scheme48heap.h"
/* I bumped this up from 1.5 Mcell because the debugging info put us over
** the top. -Olin
*/
#if !defined(DEFAULT_HEAP_SIZE)
/* 1.5 megacell = 6 megabytes (3 meg per semispace) */
#define DEFAULT_HEAP_SIZE 1500000L
/* 5 megacell = 20 megabytes (10 meg per semispace) */
#define DEFAULT_HEAP_SIZE 5000000L
#endif
#if !defined(DEFAULT_STACK_SIZE)
@ -28,24 +29,29 @@
#endif /* STATIC_AREAS */
extern void s48_sysdep_init(void);
extern void s48_initialize_external_modules(void);
char *s48_object_file; /* specified via a command line argument */
char *s48_reloc_file; /* dynamic loading will set this */
char ** process_args(char **argv,
long *heap_size,
long *stack_size,
char **object_file,
char **image_name);
extern int
internal_s48_main(long heap_size, long stack_size,
char* prog_name, char* object_file, char* image_name,
int argc, char** argv);
int
main(argc, argv)
int argc; char **argv;
{
char **argp; /* JMG */
char *image_name = DEFAULT_IMAGE_NAME;
long heap_size = DEFAULT_HEAP_SIZE; /* in numbers of cells */
long stack_size = DEFAULT_STACK_SIZE; /* in numbers of cells */
int errors = 0;
long return_value;
void *heap, *stack;
long required_heap_size;
int warn_undefined_imported_bindings_p = 1;
char *object_file = NULL; /* specified via a command line argument */
char *prog_name;
#if defined(STATIC_AREAS)
extern long static_entry;
@ -57,125 +63,11 @@ main(argc, argv)
long vm_argc = 0;
char *me = *argv; /* Save program name. */
prog_name = *argv++;
s48_object_file = s48_reloc_file = NULL;
argv++; argc--; /* Skip program name. */
for (; argc > 0; argc--, argv++)
if (argv[0][0] == '-')
switch (argv[0][1]) {
case 'h':
argc--; argv++;
if (argc == 0) { errors++; break; }
heap_size = atoi(*argv);
if (heap_size <= 0) errors++;
break;
case 's':
argc--; argv++;
if (argc == 0) { errors++; break; }
stack_size = atoi(*argv);
if (stack_size <= 0) errors++;
break;
case 'i':
argc--; argv++;
if (argc == 0) { errors++; break; }
image_name = *argv;
break;
case 'a':
argc--;
vm_argc = argc; /* remaining args are passed to the VM */
argc = 0;
break;
case 'o':
argc--; argv++;
if (argc == 0) { errors++; break; }
s48_object_file = *argv;
break;
case 'u':
argc--; argv++;
warn_undefined_imported_bindings_p = 0;
break;
default:
fprintf(stderr, "Invalid argument: %s\n", *argv);
errors++;
}
else
if (argv[0][0] != '\0') {
fprintf(stderr, "Invalid argument: %s\n", *argv);
errors++; }
if (errors != 0) {
fprintf(stderr,
"Usage: %s [options] [-a arguments]\n\
Options: -h <total heap size in words>\n\
-s <stack buffer size in words>\n\
-i <image file name>\n\
-o <object file name>\n\
-u [don't warn on unbound external identifiers]",
me);
return 1;
}
s48_sysdep_init();
s48_heap_init();
s48_init();
if (image_name == NULL)
required_heap_size = 0;
else {
/* check_image_header returns number of bytes; required_heap_size
is number of cells. */
required_heap_size =
s48_check_image_header((unsigned char *)image_name) >> 2;
if (-1 == required_heap_size) {
fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
return 1; }
}
/* two semi-spaces, plus we want some room to maneuver */
if (heap_size < 4 * required_heap_size) {
fprintf(stderr, "heap size %ld is too small, using %ld\n",
heap_size, 4 * required_heap_size);
heap_size = 4 * required_heap_size; }
heap = (void *) malloc(heap_size * sizeof(long));
stack = (void *) malloc(stack_size * sizeof(long));
if (!heap || !stack) {
fprintf(stderr, "system is out of memory\n");
return 1; }
s48_initialize_heap((long)heap, heap_size);
#if defined(STATIC_AREAS)
if (image_name == NULL) {
s48_register_static_areas(p_count, p_areas, p_sizes,
i_count, i_areas, i_sizes);
s48_set_image_valuesB(static_entry,
static_symbol_table,
static_imported_binding_table,
static_exported_binding_table);
} else if (s48_read_image() == -1) {
fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
return 1; }
#else
if (s48_read_image() == -1) {
fprintf(stderr, "Image file \"%s\" is unusable.\n", image_name);
return 1; }
#endif
s48_initialize_vm(stack, stack_size);
s48_initialize_external_modules();
if (warn_undefined_imported_bindings_p)
s48_warn_about_undefined_imported_bindings();
return_value = s48_call_startup_procedure(argv, vm_argc);
if (s48_reloc_file != NULL)
if (0 != unlink(s48_reloc_file))
fprintf(stderr, "unable to delete file %s\n", s48_reloc_file);
return(return_value);
argv=process_args(argv,
&heap_size, &stack_size,
&object_file, &image_name);
for(argc=0, argp=argv; *argp; argc++, argp++); /* Recompute argc. */
return internal_s48_main(heap_size, stack_size, prog_name, object_file, image_name, argc, argv);
}

110
c/old-scheme48.h Normal file
View File

@ -0,0 +1,110 @@
typedef long scheme_value;
#define FIXNUM_TAG 0
#define FIXNUMP(x) (((long)(x) & 3L) == FIXNUM_TAG)
#define IMMEDIATE_TAG 1
#define IMMEDIATEP(x) (((long)(x) & 3L) == IMMEDIATE_TAG)
#define HEADER_TAG 2
#define HEADERP(x) (((long)(x) & 3L) == HEADER_TAG)
#define STOB_TAG 3
#define STOBP(x) (((long)(x) & 3L) == STOB_TAG)
#define ENTER_FIXNUM(n) ((scheme_value)((n) << 2))
#define EXTRACT_FIXNUM(x) ((long)(x) >> 2)
#define MISC_IMMEDIATE(n) (scheme_value)(IMMEDIATE_TAG | ((n) << 2))
#define SCHFALSE MISC_IMMEDIATE(0)
#define SCHTRUE MISC_IMMEDIATE(1)
#define SCHCHAR MISC_IMMEDIATE(2)
#define SCHUNSPECIFIC MISC_IMMEDIATE(3)
#define SCHUNDEFINED MISC_IMMEDIATE(4)
#define SCHEOF MISC_IMMEDIATE(5)
#define SCHNULL MISC_IMMEDIATE(6)
#define UNDEFINED SCHUNDEFINED
#define UNSPECIFIC SCHUNSPECIFIC
#define ENTER_BOOLEAN(n) ((n) ? SCHTRUE : SCHFALSE)
#define EXTRACT_BOOLEAN(x) ((x) != SCHFALSE)
#define ENTER_CHAR(c) (SCHCHAR | ((c) << 8))
#define EXTRACT_CHAR(x) ((x) >> 8)
#define CHARP(x) ((((long) (x)) & 0xff) == SCHCHAR)
#define ADDRESS_AFTER_HEADER(x, type) ((type *)((x) - STOB_TAG))
#define STOB_REF(x, i) ((ADDRESS_AFTER_HEADER(x, long))[i])
#define STOB_TYPE(x) ((STOB_HEADER(x)>>2)&31)
#define STOB_HEADER(x) (STOB_REF((x),-1))
#define STOB_BLENGTH(x) (STOB_HEADER(x) >> 8)
#define STOB_LLENGTH(x) (STOB_HEADER(x) >> 10)
#define STOBTYPE_PAIR 0
#define PAIRP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_PAIR))
#define STOBTYPE_SYMBOL 1
#define SYMBOLP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_SYMBOL))
#define STOBTYPE_VECTOR 2
#define VECTORP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_VECTOR))
#define STOBTYPE_CLOSURE 3
#define CLOSUREP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_CLOSURE))
#define STOBTYPE_LOCATION 4
#define LOCATIONP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_LOCATION))
#define STOBTYPE_CHANNEL 5
#define CHANNELP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_CHANNEL))
#define STOBTYPE_PORT 6
#define PORTP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_PORT))
#define STOBTYPE_RATNUM 7
#define RATNUMP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_RATNUM))
#define STOBTYPE_RECORD 8
#define RECORDP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_RECORD))
#define STOBTYPE_CONTINUATION 9
#define CONTINUATIONP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_CONTINUATION))
#define STOBTYPE_EXTENDED_NUMBER 10
#define EXTENDED_NUMBERP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_EXTENDED_NUMBER))
#define STOBTYPE_TEMPLATE 11
#define TEMPLATEP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_TEMPLATE))
#define STOBTYPE_WEAK_POINTER 12
#define WEAK_POINTERP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_WEAK_POINTER))
#define STOBTYPE_SHARED_BINDING 13
#define SHARED_BINDINGP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_SHARED_BINDING))
#define STOBTYPE_UNUSED_D_HEADER1 14
#define UNUSED_D_HEADER1P(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_UNUSED_D_HEADER1))
#define STOBTYPE_UNUSED_D_HEADER2 15
#define UNUSED_D_HEADER2P(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_UNUSED_D_HEADER2))
#define STOBTYPE_STRING 16
#define STRINGP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_STRING))
#define STOBTYPE_CODE_VECTOR 17
#define CODE_VECTORP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_CODE_VECTOR))
#define STOBTYPE_DOUBLE 18
#define DOUBLEP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_DOUBLE))
#define STOBTYPE_BIGNUM 19
#define BIGNUMP(x) (STOBP(x) && (STOB_TYPE(x) == STOBTYPE_BIGNUM))
#define CAR(x) STOB_REF(x, 0)
#define CDR(x) STOB_REF(x, 1)
#define SYMBOL_TO_STRING(x) STOB_REF(x, 0)
#define LOCATION_ID(x) STOB_REF(x, 0)
#define CONTENTS(x) STOB_REF(x, 1)
#define CLOSURE_TEMPLATE(x) STOB_REF(x, 0)
#define CLOSURE_ENV(x) STOB_REF(x, 1)
#define WEAK_POINTER_REF(x) STOB_REF(x, 0)
#define SHARED_BINDING_NAME(x) STOB_REF(x, 0)
#define SHARED_BINDING_IS_IMPORTP(x) STOB_REF(x, 1)
#define SHARED_BINDING_REF(x) STOB_REF(x, 2)
#define PORT_HANDLER(x) STOB_REF(x, 0)
#define PORT_STATUS(x) STOB_REF(x, 1)
#define PORT_LOCK(x) STOB_REF(x, 2)
#define PORT_LOCKEDP(x) STOB_REF(x, 3)
#define PORT_DATA(x) STOB_REF(x, 4)
#define PORT_BUFFER(x) STOB_REF(x, 5)
#define PORT_INDEX(x) STOB_REF(x, 6)
#define PORT_LIMIT(x) STOB_REF(x, 7)
#define PORT_PENDING_EOFP(x) STOB_REF(x, 8)
#define CHANNEL_STATUS(x) STOB_REF(x, 0)
#define CHANNEL_ID(x) STOB_REF(x, 1)
#define CHANNEL_OS_INDEX(x) STOB_REF(x, 2)
#define VECTOR_LENGTH(x) STOB_LLENGTH(x)
#define VECTOR_REF(x, i) STOB_REF(x, i)
#define CODE_VECTOR_LENGTH(x) STOB_BLENGTH(x)
#define CODE_VECTOR_REF(x, i) (ADDRESS_AFTER_HEADER(x, unsigned char)[i])
#define STRING_LENGTH(x) (STOB_BLENGTH(x)-1)
#define STRING_REF(x, i) (ADDRESS_AFTER_HEADER(x, char)[i])

59
c/prescheme.h Normal file
View File

@ -0,0 +1,59 @@
#include <errno.h>
#include "io.h"
#define PS_READ_CHAR(PORT,RESULT,EOFP,STATUS) \
{ \
FILE * TTport = PORT; \
int TTchar; \
if (EOF == (TTchar = getc(TTport))) \
RESULT = ps_read_char(TTport, &EOFP, &STATUS, 0==1);\
else { \
RESULT = TTchar; \
EOFP = 0; \
STATUS = 0; } \
}
#define PS_PEEK_CHAR(PORT,RESULT,EOFP,STATUS) \
{ \
FILE * TTport = PORT; \
int TTchar; \
if (EOF == (TTchar = getc(TTport))) \
RESULT = ps_read_char(TTport, &EOFP, &STATUS, 0==0);\
else { \
RESULT = TTchar; \
ungetc(RESULT, TTport); \
EOFP = 0; \
STATUS = 0; } \
}
#define PS_READ_INTEGER(PORT,RESULT,EOFP,STATUS) \
RESULT = ps_read_integer(PORT,&EOFP,&STATUS);
#define PS_WRITE_CHAR(CHAR,PORT,STATUS) \
{ \
FILE * TTport = PORT; \
char TTchar = CHAR; \
if (EOF == putc(TTchar,TTport)) \
STATUS = ps_write_char(TTchar,TTport); \
else { \
STATUS = 0; } \
}
/* C shifts may not work if the amount is greater than the machine word size */
/* Patched by JAR 6/6/93 */
#define PS_SHIFT_RIGHT(X,Y,RESULT) \
{ \
long TTx = X, TTy = Y; \
RESULT = TTy >= 32 ? (TTx < 0 ? -1 : 0) : TTx >> TTy; \
}
#define PS_SHIFT_LEFT(X,Y,RESULT) \
{ \
long TTy = Y; \
RESULT = TTy >= 32 ? 0 : X << TTy; \
}
extern long s48_return_value, s48_run_machine();

187
c/scheme48.h
View File

@ -13,9 +13,16 @@ typedef long s48_value;
#define NO_ERRORS 0 /* errno value */
extern int s48_main (long heap_size, long stack_size,
char *image_name, int argc, char** argv);
extern int s48_add_external_init(void (*init)());
/* Misc stuff */
#define S48_EQ(v1, v2) ((v1) == (v2))
#define S48_EQ_P(v1, v2) ((v1) == (v2))
/* Superceded name for the above definition, retained for compatibility. */
#define S48_EQ(v1, v2) ((v1) == (v2))
#define S48_MAX_FIXNUM_VALUE ((1 << 29) - 1)
#define S48_MIN_FIXNUM_VALUE (-1 << 29)
@ -39,15 +46,43 @@ extern s48_value s48_enter_fixnum(long);
extern long s48_extract_fixnum(s48_value);
extern s48_value s48_enter_integer(long);
extern long s48_extract_integer(s48_value);
extern s48_value s48_enter_unsigned_integer(unsigned long);
extern unsigned long s48_extract_unsigned_integer(s48_value);
extern s48_value s48_enter_double(double);
extern double s48_extract_double(s48_value);
extern s48_value s48_cons(s48_value, s48_value);
extern s48_value s48_list_1(s48_value);
extern s48_value s48_list_2(s48_value, s48_value);
extern s48_value s48_list_3(s48_value, s48_value, s48_value);
extern s48_value s48_list_4(s48_value, s48_value, s48_value, s48_value);
extern s48_value s48_list_5(s48_value, s48_value, s48_value, s48_value,
s48_value);
extern s48_value s48_list_6(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value);
extern s48_value s48_list_7(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value);
extern s48_value s48_list_8(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value);
extern s48_value s48_list_9(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value,
s48_value);
extern s48_value s48_list_10(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value);
extern s48_value s48_list_11(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value);
extern s48_value s48_list_12(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value);
extern s48_value s48_enter_string(char *);
extern char * s48_extract_string(s48_value);
extern s48_value s48_enter_substring(char *, int);
extern s48_value s48_make_string(int, char);
extern s48_value s48_make_vector(int, s48_value);
extern s48_value s48_make_byte_vector(int);
extern s48_value s48_enter_byte_vector(char *, int);
extern char * s48_extract_byte_vector(s48_value);
extern s48_value s48_make_byte_vector(int, int);
extern s48_value s48_make_record(s48_value);
extern s48_value s48_make_weak_pointer(s48_value);
extern void s48_check_record_type(s48_value, s48_value);
@ -64,7 +99,7 @@ extern s48_value s48_call_scheme(s48_value proc, long nargs, ...);
#define S48_EXPORT_FUNCTION(p) (s48_define_exported_binding(#p, s48_enter_pointer(p)))
#define S48_MAKE_VALUE(type) (s48_make_byte_vector(sizeof(type)))
#define S48_MAKE_VALUE(type) (s48_make_byte_vector(sizeof(type),0))
extern void * s48_value_pointer(s48_value);
#define S48_EXTRACT_VALUE_POINTER(x, type) ((type *) s48_value_pointer(x))
@ -177,28 +212,46 @@ extern void * s48_value_pointer(s48_value);
/* Exceptions */
extern void s48_raise_scheme_exception(long type, long nargs, ...);
extern void s48_raise_argtype_error(s48_value value);
extern void s48_raise_argnumber_error(s48_value value,
s48_value min, s48_value max);
extern void s48_raise_argument_type_error(s48_value value);
extern void s48_raise_argument_number_error(s48_value value,
s48_value min,
s48_value max);
extern void s48_raise_range_error(s48_value value,
s48_value min, s48_value max);
extern void s48_raise_closed_channel_error();
extern void s48_raise_os_error(int the_errno);
extern void s48_raise_os_error_1(int the_errno, s48_value arg1);
extern void s48_raise_os_error_2(int the_errno, s48_value arg1, s48_value arg2);
extern void s48_raise_os_error_3(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3);
extern void s48_raise_os_error_4(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4);
extern void s48_raise_os_error_5(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4, s48_value arg5);
extern void s48_raise_os_error_6(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4, s48_value arg5,
s48_value arg6);
extern void s48_raise_string_os_error(char *reason);
extern void s48_raise_out_of_memory_error();
/* Type checking */
#define S48_CHECK_PAIR(v) do { if (!S48_PAIR_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_FIXNUM(v) do { if (!S48_FIXNUM_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_STRING(v) do { if (!S48_STRING_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_CHANNEL(v) do { if (!S48_CHANNEL_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_RECORD(v) do { if (!S48_RECORD_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_VALUE(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_EXPORT_BINDING(v) do { if (!S48_EXPORT_BINDING_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_PAIR(v) do { if (!S48_PAIR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_FIXNUM(v) do { if (!S48_FIXNUM_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_STRING(v) do { if (!S48_STRING_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_BYTE_VECTOR(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_CHANNEL(v) do { if (!S48_CHANNEL_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_RECORD(v) do { if (!S48_RECORD_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_VALUE(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_EXPORT_BINDING(v) do { if (!S48_EXPORT_BINDING_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_VALUE_P(v) (S48_BYTE_VECTOR_P(v))
#define S48_TRUE_P(v) ((v) == S48_TRUE)
#define S48_FALSE_P(v) ((v) == S48_FALSE)
#define S48_EXTRACT_BOOLEAN(v) ((v) != S48_FALSE)
#define S48_ENTER_BOOLEAN(v) ((v) ? S48_TRUE : S48_FALSE)
extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_SHARED_BINDING_CHECK(binding) \
@ -207,6 +260,7 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
S48_SHARED_BINDING_NAME(binding)); \
} while(0)
#define S48_FIXNUM_TAG 0
#define S48_FIXNUM_P(x) (((long)(x) & 3L) == S48_FIXNUM_TAG)
#define S48_IMMEDIATE_TAG 1
@ -228,9 +282,6 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_EOF (S48_MISC_IMMEDIATE(5))
#define S48_NULL (S48_MISC_IMMEDIATE(6))
#define S48_ENTER_BOOLEAN(n) ((n) ? S48_TRUE : S48_FALSE)
#define S48_EXTRACT_BOOLEAN(x) ((x) != S48_FALSE)
#define S48_UNSAFE_ENTER_CHAR(c) (S48_CHAR | ((c) << 8))
#define S48_UNSAFE_EXTRACT_CHAR(x) ((x) >> 8)
#define S48_CHAR_P(x) ((((long) (x)) & 0xff) == S48_CHAR)
@ -238,8 +289,8 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_ADDRESS_AFTER_HEADER(x, type) ((type *)((x) - S48_STOB_TAG))
#define S48_STOB_REF(x, i) (S48_ADDRESS_AFTER_HEADER(x, s48_value)[i])
#define S48_STOB_BYTE_REF(x, i) (((char *)S48_ADDRESS_AFTER_HEADER(x, s48_value))[i])
#define S48_STOB_SET(x, i, v) do { s48_value __stob_set_x = (x); long __stob_set_i = (i); s48_value __stob_set_v = (v); if (S48_STOB_IMMUTABLEP(__stob_set_x)) s48_raise_argtype_error(__stob_set_x); else { S48_WRITE_BARRIER((__stob_set_x), (char *) (&S48_STOB_REF((__stob_set_x), (__stob_set_i))),(__stob_set_v)); *(&S48_STOB_REF((__stob_set_x), (__stob_set_i))) = (__stob_set_v); } } while (0)
#define S48_STOB_BYTE_SET(x, i, v) do { char __stob_set_x = (x); long __stob_set_i = (i); s48_value __stob_set_v = (v); if (S48_STOB_IMMUTABLEP(__stob_set_x)) s48_raise_argtype_error(__stob_set_x); else *(&S48_STOB_BYTE_REF((__stob_set_x), (__stob_set_i))) = (__stob_set_v); } while (0)
#define S48_STOB_SET(x, i, v) do { s48_value __stob_set_x = (x); long __stob_set_i = (i); s48_value __stob_set_v = (v); if (S48_STOB_IMMUTABLEP(__stob_set_x)) s48_raise_argument_type_error(__stob_set_x); else { S48_WRITE_BARRIER((__stob_set_x), (char *) (&S48_STOB_REF((__stob_set_x), (__stob_set_i))),(__stob_set_v)); *(&S48_STOB_REF((__stob_set_x), (__stob_set_i))) = (__stob_set_v); } } while (0)
#define S48_STOB_BYTE_SET(x, i, v) do { s48_value __stob_set_x = (x); long __stob_set_i = (i); char __stob_set_v = (v); if (S48_STOB_IMMUTABLEP(__stob_set_x)) s48_raise_argument_type_error(__stob_set_x); else *(&S48_STOB_BYTE_REF((__stob_set_x), (__stob_set_i))) = (__stob_set_v); } while (0)
#define S48_STOB_TYPE(x) ((S48_STOB_HEADER(x)>>2)&31)
#define S48_STOB_HEADER(x) (S48_STOB_REF((x),-1))
#define S48_STOB_ADDRESS(x) (&(S48_STOB_HEADER(x)))
@ -258,46 +309,48 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_CLOSURE_P(x) (s48_stob_has_type(x, 3))
#define S48_STOBTYPE_LOCATION 4
#define S48_LOCATION_P(x) (s48_stob_has_type(x, 4))
#define S48_STOBTYPE_CHANNEL 5
#define S48_CHANNEL_P(x) (s48_stob_has_type(x, 5))
#define S48_STOBTYPE_PORT 6
#define S48_PORT_P(x) (s48_stob_has_type(x, 6))
#define S48_STOBTYPE_RATNUM 7
#define S48_RATNUM_P(x) (s48_stob_has_type(x, 7))
#define S48_STOBTYPE_RECORD 8
#define S48_RECORD_P(x) (s48_stob_has_type(x, 8))
#define S48_STOBTYPE_CONTINUATION 9
#define S48_CONTINUATION_P(x) (s48_stob_has_type(x, 9))
#define S48_STOBTYPE_EXTENDED_NUMBER 10
#define S48_EXTENDED_NUMBER_P(x) (s48_stob_has_type(x, 10))
#define S48_STOBTYPE_TEMPLATE 11
#define S48_TEMPLATE_P(x) (s48_stob_has_type(x, 11))
#define S48_STOBTYPE_WEAK_POINTER 12
#define S48_WEAK_POINTER_P(x) (s48_stob_has_type(x, 12))
#define S48_STOBTYPE_SHARED_BINDING 13
#define S48_SHARED_BINDING_P(x) (s48_stob_has_type(x, 13))
#define S48_STOBTYPE_UNUSED_D_HEADER1 14
#define S48_UNUSED_D_HEADER1_P(x) (s48_stob_has_type(x, 14))
#define S48_STOBTYPE_UNUSED_D_HEADER2 15
#define S48_UNUSED_D_HEADER2_P(x) (s48_stob_has_type(x, 15))
#define S48_STOBTYPE_STRING 16
#define S48_STRING_P(x) (s48_stob_has_type(x, 16))
#define S48_STOBTYPE_BYTE_VECTOR 17
#define S48_BYTE_VECTOR_P(x) (s48_stob_has_type(x, 17))
#define S48_STOBTYPE_DOUBLE 18
#define S48_DOUBLE_P(x) (s48_stob_has_type(x, 18))
#define S48_STOBTYPE_BIGNUM 19
#define S48_BIGNUM_P(x) (s48_stob_has_type(x, 19))
#define S48_STOBTYPE_CELL 5
#define S48_CELL_P(x) (s48_stob_has_type(x, 5))
#define S48_STOBTYPE_CHANNEL 6
#define S48_CHANNEL_P(x) (s48_stob_has_type(x, 6))
#define S48_STOBTYPE_PORT 7
#define S48_PORT_P(x) (s48_stob_has_type(x, 7))
#define S48_STOBTYPE_RATNUM 8
#define S48_RATNUM_P(x) (s48_stob_has_type(x, 8))
#define S48_STOBTYPE_RECORD 9
#define S48_RECORD_P(x) (s48_stob_has_type(x, 9))
#define S48_STOBTYPE_CONTINUATION 10
#define S48_CONTINUATION_P(x) (s48_stob_has_type(x, 10))
#define S48_STOBTYPE_EXTENDED_NUMBER 11
#define S48_EXTENDED_NUMBER_P(x) (s48_stob_has_type(x, 11))
#define S48_STOBTYPE_TEMPLATE 12
#define S48_TEMPLATE_P(x) (s48_stob_has_type(x, 12))
#define S48_STOBTYPE_WEAK_POINTER 13
#define S48_WEAK_POINTER_P(x) (s48_stob_has_type(x, 13))
#define S48_STOBTYPE_SHARED_BINDING 14
#define S48_SHARED_BINDING_P(x) (s48_stob_has_type(x, 14))
#define S48_STOBTYPE_UNUSED_D_HEADER1 15
#define S48_UNUSED_D_HEADER1_P(x) (s48_stob_has_type(x, 15))
#define S48_STOBTYPE_UNUSED_D_HEADER2 16
#define S48_UNUSED_D_HEADER2_P(x) (s48_stob_has_type(x, 16))
#define S48_STOBTYPE_STRING 17
#define S48_STRING_P(x) (s48_stob_has_type(x, 17))
#define S48_STOBTYPE_BYTE_VECTOR 18
#define S48_BYTE_VECTOR_P(x) (s48_stob_has_type(x, 18))
#define S48_STOBTYPE_DOUBLE 19
#define S48_DOUBLE_P(x) (s48_stob_has_type(x, 19))
#define S48_STOBTYPE_BIGNUM 20
#define S48_BIGNUM_P(x) (s48_stob_has_type(x, 20))
#define S48_CAR_OFFSET 0
#define S48_CAR(x) (s48_stob_ref((x), S48_STOBTYPE_PAIR, 0))
#define S48_UNSAFE_CAR(x) (S48_STOB_REF((x), 0))
#define S48_SET_CAR(x, v) (s48_stob_ref((x), S48_STOBTYPE_PAIR, 0, (v)))
#define S48_SET_CAR(x, v) (s48_stob_set((x), S48_STOBTYPE_PAIR, 0, (v)))
#define S48_UNSAFE_SET_CAR(x, v) S48_STOB_SET((x), 0, (v))
#define S48_CDR_OFFSET 1
#define S48_CDR(x) (s48_stob_ref((x), S48_STOBTYPE_PAIR, 1))
#define S48_UNSAFE_CDR(x) (S48_STOB_REF((x), 1))
#define S48_SET_CDR(x, v) (s48_stob_ref((x), S48_STOBTYPE_PAIR, 1, (v)))
#define S48_SET_CDR(x, v) (s48_stob_set((x), S48_STOBTYPE_PAIR, 1, (v)))
#define S48_UNSAFE_SET_CDR(x, v) S48_STOB_SET((x), 1, (v))
#define S48_SYMBOL_TO_STRING_OFFSET 0
#define S48_SYMBOL_TO_STRING(x) (s48_stob_ref((x), S48_STOBTYPE_SYMBOL, 0))
@ -305,13 +358,18 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_LOCATION_ID_OFFSET 0
#define S48_LOCATION_ID(x) (s48_stob_ref((x), S48_STOBTYPE_LOCATION, 0))
#define S48_UNSAFE_LOCATION_ID(x) (S48_STOB_REF((x), 0))
#define S48_SET_LOCATION_ID(x, v) (s48_stob_ref((x), S48_STOBTYPE_LOCATION, 0, (v)))
#define S48_SET_LOCATION_ID(x, v) (s48_stob_set((x), S48_STOBTYPE_LOCATION, 0, (v)))
#define S48_UNSAFE_SET_LOCATION_ID(x, v) S48_STOB_SET((x), 0, (v))
#define S48_CONTENTS_OFFSET 1
#define S48_CONTENTS(x) (s48_stob_ref((x), S48_STOBTYPE_LOCATION, 1))
#define S48_UNSAFE_CONTENTS(x) (S48_STOB_REF((x), 1))
#define S48_SET_CONTENTS(x, v) (s48_stob_ref((x), S48_STOBTYPE_LOCATION, 1, (v)))
#define S48_SET_CONTENTS(x, v) (s48_stob_set((x), S48_STOBTYPE_LOCATION, 1, (v)))
#define S48_UNSAFE_SET_CONTENTS(x, v) S48_STOB_SET((x), 1, (v))
#define S48_CELL_REF_OFFSET 0
#define S48_CELL_REF(x) (s48_stob_ref((x), S48_STOBTYPE_CELL, 0))
#define S48_UNSAFE_CELL_REF(x) (S48_STOB_REF((x), 0))
#define S48_CELL_SET(x, v) (s48_stob_set((x), S48_STOBTYPE_CELL, 0, (v)))
#define S48_UNSAFE_CELL_SET(x, v) S48_STOB_SET((x), 0, (v))
#define S48_CLOSURE_TEMPLATE_OFFSET 0
#define S48_CLOSURE_TEMPLATE(x) (s48_stob_ref((x), S48_STOBTYPE_CLOSURE, 0))
#define S48_UNSAFE_CLOSURE_TEMPLATE(x) (S48_STOB_REF((x), 0))
@ -330,50 +388,52 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_SHARED_BINDING_REF_OFFSET 2
#define S48_SHARED_BINDING_REF(x) (s48_stob_ref((x), S48_STOBTYPE_SHARED_BINDING, 2))
#define S48_UNSAFE_SHARED_BINDING_REF(x) (S48_STOB_REF((x), 2))
#define S48_SHARED_BINDING_SET(x, v) (s48_stob_ref((x), S48_STOBTYPE_SHARED_BINDING, 2, (v)))
#define S48_SHARED_BINDING_SET(x, v) (s48_stob_set((x), S48_STOBTYPE_SHARED_BINDING, 2, (v)))
#define S48_UNSAFE_SHARED_BINDING_SET(x, v) S48_STOB_SET((x), 2, (v))
#define S48_PORT_HANDLER_OFFSET 0
#define S48_PORT_HANDLER(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 0))
#define S48_UNSAFE_PORT_HANDLER(x) (S48_STOB_REF((x), 0))
#define S48_SET_PORT_HANDLER(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 0, (v)))
#define S48_UNSAFE_SET_PORT_HANDLER(x, v) S48_STOB_SET((x), 0, (v))
#define S48_PORT_STATUS_OFFSET 1
#define S48_PORT_STATUS(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 1))
#define S48_UNSAFE_PORT_STATUS(x) (S48_STOB_REF((x), 1))
#define S48_SET_PORT_STATUS(x, v) (s48_stob_ref((x), S48_STOBTYPE_PORT, 1, (v)))
#define S48_SET_PORT_STATUS(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 1, (v)))
#define S48_UNSAFE_SET_PORT_STATUS(x, v) S48_STOB_SET((x), 1, (v))
#define S48_PORT_LOCK_OFFSET 2
#define S48_PORT_LOCK(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 2))
#define S48_UNSAFE_PORT_LOCK(x) (S48_STOB_REF((x), 2))
#define S48_SET_PORT_LOCK(x, v) (s48_stob_ref((x), S48_STOBTYPE_PORT, 2, (v)))
#define S48_SET_PORT_LOCK(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 2, (v)))
#define S48_UNSAFE_SET_PORT_LOCK(x, v) S48_STOB_SET((x), 2, (v))
#define S48_PORT_LOCKEDP_OFFSET 3
#define S48_PORT_LOCKEDP(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 3))
#define S48_UNSAFE_PORT_LOCKEDP(x) (S48_STOB_REF((x), 3))
#define S48_SET_PORT_LOCKEDP(x, v) (s48_stob_ref((x), S48_STOBTYPE_PORT, 3, (v)))
#define S48_SET_PORT_LOCKEDP(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 3, (v)))
#define S48_UNSAFE_SET_PORT_LOCKEDP(x, v) S48_STOB_SET((x), 3, (v))
#define S48_PORT_DATA_OFFSET 4
#define S48_PORT_DATA(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 4))
#define S48_UNSAFE_PORT_DATA(x) (S48_STOB_REF((x), 4))
#define S48_SET_PORT_DATA(x, v) (s48_stob_ref((x), S48_STOBTYPE_PORT, 4, (v)))
#define S48_SET_PORT_DATA(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 4, (v)))
#define S48_UNSAFE_SET_PORT_DATA(x, v) S48_STOB_SET((x), 4, (v))
#define S48_PORT_BUFFER_OFFSET 5
#define S48_PORT_BUFFER(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 5))
#define S48_UNSAFE_PORT_BUFFER(x) (S48_STOB_REF((x), 5))
#define S48_SET_PORT_BUFFER(x, v) (s48_stob_ref((x), S48_STOBTYPE_PORT, 5, (v)))
#define S48_SET_PORT_BUFFER(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 5, (v)))
#define S48_UNSAFE_SET_PORT_BUFFER(x, v) S48_STOB_SET((x), 5, (v))
#define S48_PORT_INDEX_OFFSET 6
#define S48_PORT_INDEX(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 6))
#define S48_UNSAFE_PORT_INDEX(x) (S48_STOB_REF((x), 6))
#define S48_SET_PORT_INDEX(x, v) (s48_stob_ref((x), S48_STOBTYPE_PORT, 6, (v)))
#define S48_SET_PORT_INDEX(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 6, (v)))
#define S48_UNSAFE_SET_PORT_INDEX(x, v) S48_STOB_SET((x), 6, (v))
#define S48_PORT_LIMIT_OFFSET 7
#define S48_PORT_LIMIT(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 7))
#define S48_UNSAFE_PORT_LIMIT(x) (S48_STOB_REF((x), 7))
#define S48_SET_PORT_LIMIT(x, v) (s48_stob_ref((x), S48_STOBTYPE_PORT, 7, (v)))
#define S48_SET_PORT_LIMIT(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 7, (v)))
#define S48_UNSAFE_SET_PORT_LIMIT(x, v) S48_STOB_SET((x), 7, (v))
#define S48_PORT_PENDING_EOFP_OFFSET 8
#define S48_PORT_PENDING_EOFP(x) (s48_stob_ref((x), S48_STOBTYPE_PORT, 8))
#define S48_UNSAFE_PORT_PENDING_EOFP(x) (S48_STOB_REF((x), 8))
#define S48_SET_PORT_PENDING_EOFP(x, v) (s48_stob_ref((x), S48_STOBTYPE_PORT, 8, (v)))
#define S48_SET_PORT_PENDING_EOFP(x, v) (s48_stob_set((x), S48_STOBTYPE_PORT, 8, (v)))
#define S48_UNSAFE_SET_PORT_PENDING_EOFP(x, v) S48_STOB_SET((x), 8, (v))
#define S48_CHANNEL_STATUS_OFFSET 0
#define S48_CHANNEL_STATUS(x) (s48_stob_ref((x), S48_STOBTYPE_CHANNEL, 0))
@ -403,15 +463,16 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_BYTE_VECTOR_REF(x, i) (s48_stob_byte_ref((x), S48_STOBTYPE_BYTE_VECTOR, (i)))
#define S48_BYTE_VECTOR_SET(x, i, v) (s48_stob_byte_set((x), S48_STOBTYPE_BYTE_VECTOR, (i), (v)))
#define S48_UNSAFE_BYTE_VECTOR_REF(x, i) (S48_STOB_BYTE_REF((x), (i)))
#define S48_UNSAFE_BYTE_VECTOR_SET(x, i, v) S48_BYTE_STOB_SET((x), (i), (v))
#define S48_UNSAFE_BYTE_VECTOR_SET(x, i, v) S48_STOB_BYTE_SET((x), (i), (v))
#define S48_STRING_LENGTH(x) (s48_stob_byte_length((x), S48_STOBTYPE_STRING))
#define S48_STRING_REF(x, i) (s48_stob_byte_ref((x), S48_STOBTYPE_STRING, (i)))
#define S48_STRING_SET(x, i, v) (s48_stob_byte_set((x), S48_STOBTYPE_STRING, (i), (v)))
#define S48_UNSAFE_STRING_REF(x, i) (S48_STOB_BYTE_REF((x), (i)))
#define S48_UNSAFE_STRING_SET(x, i, v) S48_BYTE_STOB_SET((x), (i), (v))
#define S48_UNSAFE_STRING_SET(x, i, v) S48_STOB_BYTE_SET((x), (i), (v))
#define S48_UNSAFE_BYTE_VECTOR_LENGTH(x) (S48_STOB_BYTE_LENGTH(x))
#define S48_UNSAFE_STRING_LENGTH(x) (S48_STOB_BYTE_LENGTH(x) - 1)
#define S48_UNSAFE_EXTRACT_STRING(x) (S48_ADDRESS_AFTER_HEADER((x), char))
#define S48_UNSAFE_EXTRACT_BYTE_VECTOR(x) (S48_ADDRESS_AFTER_HEADER((x), char))
#define S48_EXTRACT_EXTERNAL_OBJECT(x, type) ((type *)(S48_ADDRESS_AFTER_HEADER(x, long)+1))
#define S48_RECORD_TYPE_RESUMER(x) S48_RECORD_REF((x), 0)

80
c/scheme48.h.in
View File

@ -7,9 +7,16 @@ typedef long s48_value;
#define NO_ERRORS 0 /* errno value */
extern int s48_main (long heap_size, long stack_size,
char *image_name, int argc, char** argv);
extern int s48_add_external_init(void (*init)());
/* Misc stuff */
#define S48_EQ(v1, v2) ((v1) == (v2))
#define S48_EQ_P(v1, v2) ((v1) == (v2))
/* Superceded name for the above definition, retained for compatibility. */
#define S48_EQ(v1, v2) ((v1) == (v2))
#define S48_MAX_FIXNUM_VALUE ((1 << 29) - 1)
#define S48_MIN_FIXNUM_VALUE (-1 << 29)
@ -33,15 +40,43 @@ extern s48_value s48_enter_fixnum(long);
extern long s48_extract_fixnum(s48_value);
extern s48_value s48_enter_integer(long);
extern long s48_extract_integer(s48_value);
extern s48_value s48_enter_unsigned_integer(unsigned long);
extern unsigned long s48_extract_unsigned_integer(s48_value);
extern s48_value s48_enter_double(double);
extern double s48_extract_double(s48_value);
extern s48_value s48_cons(s48_value, s48_value);
extern s48_value s48_list_1(s48_value);
extern s48_value s48_list_2(s48_value, s48_value);
extern s48_value s48_list_3(s48_value, s48_value, s48_value);
extern s48_value s48_list_4(s48_value, s48_value, s48_value, s48_value);
extern s48_value s48_list_5(s48_value, s48_value, s48_value, s48_value,
s48_value);
extern s48_value s48_list_6(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value);
extern s48_value s48_list_7(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value);
extern s48_value s48_list_8(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value);
extern s48_value s48_list_9(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value,
s48_value);
extern s48_value s48_list_10(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value);
extern s48_value s48_list_11(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value);
extern s48_value s48_list_12(s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value,
s48_value, s48_value, s48_value, s48_value);
extern s48_value s48_enter_string(char *);
extern char * s48_extract_string(s48_value);
extern s48_value s48_enter_substring(char *, int);
extern s48_value s48_make_string(int, char);
extern s48_value s48_make_vector(int, s48_value);
extern s48_value s48_make_byte_vector(int);
extern s48_value s48_enter_byte_vector(char *, int);
extern char * s48_extract_byte_vector(s48_value);
extern s48_value s48_make_byte_vector(int, int);
extern s48_value s48_make_record(s48_value);
extern s48_value s48_make_weak_pointer(s48_value);
extern void s48_check_record_type(s48_value, s48_value);
@ -58,7 +93,7 @@ extern s48_value s48_call_scheme(s48_value proc, long nargs, ...);
#define S48_EXPORT_FUNCTION(p) (s48_define_exported_binding(#p, s48_enter_pointer(p)))
#define S48_MAKE_VALUE(type) (s48_make_byte_vector(sizeof(type)))
#define S48_MAKE_VALUE(type) (s48_make_byte_vector(sizeof(type),0))
extern void * s48_value_pointer(s48_value);
#define S48_EXTRACT_VALUE_POINTER(x, type) ((type *) s48_value_pointer(x))
@ -171,28 +206,46 @@ extern void * s48_value_pointer(s48_value);
/* Exceptions */
extern void s48_raise_scheme_exception(long type, long nargs, ...);
extern void s48_raise_argtype_error(s48_value value);
extern void s48_raise_argnumber_error(s48_value value,
s48_value min, s48_value max);
extern void s48_raise_argument_type_error(s48_value value);
extern void s48_raise_argument_number_error(s48_value value,
s48_value min,
s48_value max);
extern void s48_raise_range_error(s48_value value,
s48_value min, s48_value max);
extern void s48_raise_closed_channel_error();
extern void s48_raise_os_error(int the_errno);
extern void s48_raise_os_error_1(int the_errno, s48_value arg1);
extern void s48_raise_os_error_2(int the_errno, s48_value arg1, s48_value arg2);
extern void s48_raise_os_error_3(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3);
extern void s48_raise_os_error_4(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4);
extern void s48_raise_os_error_5(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4, s48_value arg5);
extern void s48_raise_os_error_6(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4, s48_value arg5,
s48_value arg6);
extern void s48_raise_string_os_error(char *reason);
extern void s48_raise_out_of_memory_error();
/* Type checking */
#define S48_CHECK_PAIR(v) do { if (!S48_PAIR_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_FIXNUM(v) do { if (!S48_FIXNUM_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_STRING(v) do { if (!S48_STRING_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_CHANNEL(v) do { if (!S48_CHANNEL_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_RECORD(v) do { if (!S48_RECORD_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_VALUE(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_EXPORT_BINDING(v) do { if (!S48_EXPORT_BINDING_P(v)) s48_raise_argtype_error(v); } while (0)
#define S48_CHECK_PAIR(v) do { if (!S48_PAIR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_FIXNUM(v) do { if (!S48_FIXNUM_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_STRING(v) do { if (!S48_STRING_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_BYTE_VECTOR(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_CHANNEL(v) do { if (!S48_CHANNEL_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_RECORD(v) do { if (!S48_RECORD_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_VALUE(v) do { if (!S48_BYTE_VECTOR_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_CHECK_EXPORT_BINDING(v) do { if (!S48_EXPORT_BINDING_P(v)) s48_raise_argument_type_error(v); } while (0)
#define S48_VALUE_P(v) (S48_BYTE_VECTOR_P(v))
#define S48_TRUE_P(v) ((v) == S48_TRUE)
#define S48_FALSE_P(v) ((v) == S48_FALSE)
#define S48_EXTRACT_BOOLEAN(v) ((v) != S48_FALSE)
#define S48_ENTER_BOOLEAN(v) ((v) ? S48_TRUE : S48_FALSE)
extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_SHARED_BINDING_CHECK(binding) \
@ -200,3 +253,4 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
s48_raise_scheme_exception(S48_EXCEPTION_UNBOUND_EXTERNAL_NAME, 1, \
S48_SHARED_BINDING_NAME(binding)); \
} while(0)

1056
c/scheme48heap.c
View File

File diff suppressed because it is too large Load Diff

53
c/scheme48heap.h Normal file
View File

@ -0,0 +1,53 @@
/*
* Externally visible objects defined in scheme48heap.c.
*/
/* initialize top-level variables */
extern void s48_heap_init(void);
/* heap-init interface */
extern void s48_initialize_heap(long, long);
extern void s48_register_static_areas(unsigned char, long *, long *,
unsigned char, long *, long *);
/* heap interface */
extern long s48_available(void);
extern long s48_heap_size(void);
extern long s48_find_all(long);
extern long s48_find_all_records(long);
extern char *s48_ShpS;
extern char *s48_SlimitS;
/* gc interface */
extern void s48_begin_collection(void);
extern long s48_trace_value(long);
extern long s48_trace_locationsB(char *, char *);
extern long s48_trace_stob_contentsB(long);
extern void s48_do_gc(void);
extern void s48_end_collection(void);
extern char s48_extantP(long);
extern long s48_gc_count(void);
/* allocation interface */
extern char s48_availableP(long);
extern long s48_preallocate_space(long);
extern char *s48_allocate_space(long, long, long);
extern void s48_write_barrier(long, char *, long);
/* images interface */
extern char s48_image_writing_okayP(void);
extern long s48_write_image(long, FILE *);
extern long s48_check_image_header(unsigned char *);
extern long s48_read_image();
extern long s48_startup_procedure(void);
extern long s48_initial_symbols(void);
extern long s48_initial_imported_bindings(void);
extern long s48_initial_exported_bindings(void);
extern long s48_resumer_records(void);
extern long s48_undumpable_records(long *);
extern void s48_initialization_completeB(void);
extern void s48_initializing_gc_root(void);
extern void s48_set_image_valuesB(long, long, long, long);

14374
c/scheme48vm.c
View File

File diff suppressed because it is too large Load Diff

6
c/scheme48vm.h
View File

@ -23,7 +23,7 @@ extern char s48_Spending_eventsPS;
extern char s48_Spending_interruptPS;
extern void s48_disable_interruptsB(void);
extern void s48_enable_interruptsB(void);
extern void s48_set_os_signal(s48_value type, s48_value argument);
extern void s48_set_os_signals(s48_value list);
/* imported and exported bindings */
extern void s48_define_exported_binding(char *, s48_value);
@ -56,6 +56,6 @@ extern s48_value s48_add_channel(s48_value, s48_value, long);
extern s48_value s48_allocate_stob(long type, long size);
extern void s48_push_gc_rootsB(char *, long);
extern char s48_pop_gc_rootsB(void);
extern char * s48_set_gc_roots_baseB(void);
extern char s48_release_gc_roots_baseB(char *);
extern char * s48_set_gc_roots_baseB(char **);
extern char s48_release_gc_roots_baseB(char *, char*);
extern void s48_register_gc_rootB(char *marker);

243
c/srfi/srfi-27.c Normal file
View File

@ -0,0 +1,243 @@
/* 54-BIT (double) IMPLEMENTATION IN C OF THE "MRG32K3A" GENERATOR
===============================================================
Sebastian.Egner@philips.com, Mar-2002, in ANSI-C and Scheme 48 0.57
This code is a C-implementation of Pierre L'Ecuyer's MRG32k3a generator.
The code uses (double)-arithmetics, assuming that it covers the range
{-2^53..2^53-1} exactly (!). The code of the generator is based on the
L'Ecuyer's own implementation of the generator. Please refer to the
file 'mrg32k3a.scm' for more information about the method.
The method provides the following functions via the C/Scheme
interface of Scheme 48 0.57 to 'mrg32k3a-b.scm':
s48_value mrg32k3a_pack_state1(s48_value state);
s48_value mrg32k3a_unpack_state1(s48_value state);
s48_value mrg32k3a_random_range();
s48_value mrg32k3a_random_integer(s48_value state, s48_value range);
s48_value mrg32k3a_random_real(s48_value state);
As Scheme48 FIXNUMs cannot cover the range {0..m1-1}, we break up
all values x in the state into x0+x1*w, where w = 2^16 = 65536.
The procedures in Scheme correct for that.
compile this file with:
gcc -c -I $SCHEME48 mrg32k3a-b.c
history of this file:
SE, 18-Mar-2002: initial version
SE, 22-Mar-2002: interface changed
SE, 25-Mar-2002: tested with Scheme 48 0.57 in c/srfi-27
SE, 27-Mar-2002: cleaned
SE, 13-May-2002: bug found by Shiro Kawai removed
*/
#include "scheme48.h" /* $SCHEME48/c/scheme48.h */
#include <sys/time.h>
#ifndef NULL
#define NULL 0
#endif
/* maximum value for random_integer: min(S48_MAX_FIXNUM_VALUE, m1) */
#define m_max (((long)1 << 29) - 1)
/* The Generator
=============
*/
/* moduli of the components */
#define m1 4294967087.0
#define m2 4294944443.0
/* representation of the state in C */
typedef struct {
double
x10, x11, x12,
x20, x21, x22;
} state_t;
/* recursion coefficients of the components */
#define a12 1403580.0
#define a13n 810728.0
#define a21 527612.0
#define a23n 1370589.0
/* normalization factor 1/(m1 + 1) */
#define norm 2.328306549295728e-10
/* the actual generator */
static double mrg32k3a(state_t *s) { /* (double), in {0..m1-1} */
double x10, x20, y;
long k10, k20;
/* #define debug 1 */
#if defined(debug)
printf(
"state = {%g %g %g %g %g %g};\n",
s->x10, s->x11, s->x12,
s->x20, s->x21, s->x22
);
#endif
/* component 1 */
x10 = a12*(s->x11) - a13n*(s->x12);
k10 = x10 / m1;
x10 -= k10 * m1;
if (x10 < 0.0)
x10 += m1;
s->x12 = s->x11;
s->x11 = s->x10;
s->x10 = x10;
/* component 2 */
x20 = a21*(s->x20) - a23n*(s->x22);
k20 = x20 / m2;
x20 -= k20 * m2;
if (x20 < 0.0)
x20 += m2;
s->x22 = s->x21;
s->x21 = s->x20;
s->x20 = x20;
/* combination of component */
y = x10 - x20;
if (y < 0.0)
y += m1;
return y;
}
/* Exported Interface
==================
*/
s48_value mrg32k3a_pack_state1(s48_value state) {
s48_value result;
state_t s;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(state); /* s48_extract_integer may GC */
result = S48_MAKE_VALUE(state_t);
#define REF(i) (double)s48_extract_integer(S48_VECTOR_REF(state, (long)(i)))
/* copy the numbers from state into s */
s.x10 = REF( 0) + 65536.0 * REF( 1);
s.x11 = REF( 2) + 65536.0 * REF( 3);
s.x12 = REF( 4) + 65536.0 * REF( 5);
s.x20 = REF( 6) + 65536.0 * REF( 7);
s.x21 = REF( 8) + 65536.0 * REF( 9);
s.x22 = REF(10) + 65536.0 * REF(11);
#undef REF
S48_GC_UNPROTECT();
/* box s into a Scheme object */
result = S48_MAKE_VALUE(state_t);
S48_SET_VALUE(result, state_t, s);
return result;
}
s48_value mrg32k3a_unpack_state1(s48_value state) {
s48_value result = S48_UNSPECIFIC;
state_t s;
S48_DECLARE_GC_PROTECT(1);
S48_GC_PROTECT_1(result);
/* unbox s from the Scheme object */
s = S48_EXTRACT_VALUE(state, state_t);
/* make and fill a Scheme vector with the numbers */
result = s48_make_vector((long)12, S48_FALSE);
#define SET(i, x) { \
long x1 = (long)((x) / 65536.0); \
long x0 = (long)((x) - 65536.0 * (double)x1); \
S48_VECTOR_SET(result, (long)(i+0), s48_enter_integer(x0)); \
S48_VECTOR_SET(result, (long)(i+1), s48_enter_integer(x1)); }
SET( 0, s.x10);
SET( 2, s.x11);
SET( 4, s.x12);
SET( 6, s.x20);
SET( 8, s.x21);
SET(10, s.x22);
#undef SET
S48_GC_UNPROTECT();
return result;
}
s48_value mrg32k3a_random_range(void) {
return s48_enter_fixnum(m_max);
}
s48_value mrg32k3a_random_integer(s48_value state, s48_value range) {
long result;
state_t s;
long n;
double x, q, qn, xq;
s = S48_EXTRACT_VALUE(state, state_t);
n = s48_extract_integer(range);
if (!( ((long)1 <= n) && (n <= m_max) ))
s48_raise_range_error(n, (long)1, m_max);
/* generate result in {0..n-1} using the rejection method */
q = (double)( (unsigned long)(m1 / (double)n) );
qn = q * n;
do {
x = mrg32k3a(&s);
} while (x >= qn);
xq = x / q;
/* check the range */
if (!( (0.0 <= xq) && (xq < (double)m_max) ))
s48_raise_range_error((long)xq, (long)0, m_max);
/* return result */
result = (long)xq;
S48_SET_VALUE(state, state_t, s);
return s48_enter_fixnum(result);
}
s48_value mrg32k3a_random_real(s48_value state) {
state_t s;
double x;
s = S48_EXTRACT_VALUE(state, state_t);
x = (mrg32k3a(&s) + 1.0) * norm;
S48_SET_VALUE(state, state_t, s);
return s48_enter_double(x);
}
/* Kludge for scsh */
static s48_value current_time(void){
struct timeval tv;
gettimeofday(&tv, NULL);
return s48_enter_integer(tv.tv_sec);
}
/* Exporting the C values to Scheme
================================
*/
void s48_init_srfi_27(void) {
S48_EXPORT_FUNCTION(mrg32k3a_pack_state1);
S48_EXPORT_FUNCTION(mrg32k3a_unpack_state1);
S48_EXPORT_FUNCTION(mrg32k3a_random_range);
S48_EXPORT_FUNCTION(mrg32k3a_random_integer);
S48_EXPORT_FUNCTION(mrg32k3a_random_real);
S48_EXPORT_FUNCTION(current_time);
}

99
c/sysdep.h.in
View File

@ -1,99 +0,0 @@
/* c/sysdep.h.in. Generated automatically from configure.in by autoheader. */
/* Define to empty if the keyword does not work. */
#undef const
/* Define if you need to in order for stat and other things to work. */
#undef _POSIX_SOURCE
/* Define as the return type of signal handlers (int or void). */
#undef RETSIGTYPE
/*
* HAVE_SIGACTION is defined iff sigaction() is available.
*/
#undef HAVE_SIGACTION
/*
* HAVE_STRERROR is defined iff the standard libraries provide strerror().
*/
#undef HAVE_STRERROR
/*
* NLIST_HAS_N_NAME is defined iff a struct nlist has an n_name member.
* If it doesn't then we assume it has an n_un member which, in turn,
* has an n_name member.
*/
#undef NLIST_HAS_N_NAME
/*
* USCORE is defined iff C externals are prepended with an underscore.
*/
#undef USCORE
/* Define if you have the chroot function. */
#undef HAVE_CHROOT
/* Define if you have the dlopen function. */
#undef HAVE_DLOPEN
/* Define if you have the ftime function. */
#undef HAVE_FTIME
/* Define if you have the gettimeofday function. */
#undef HAVE_GETTIMEOFDAY
/* Define if you have the nlist function. */
#undef HAVE_NLIST
/* Define if you have the select function. */
#undef HAVE_SELECT
/* Define if you have the setitimer function. */
#undef HAVE_SETITIMER
/* Define if you have the sigaction function. */
#undef HAVE_SIGACTION
/* Define if you have the socket function. */
#undef HAVE_SOCKET
/* Define if you have the <libgen.h> header file. */
#undef HAVE_LIBGEN_H
/* Define if you have the <posix/time.h> header file. */
#undef HAVE_POSIX_TIME_H
/* Define if you have the <sys/select.h> header file. */
#undef HAVE_SYS_SELECT_H
/* Define if you have the <sys/timeb.h> header file. */
#undef HAVE_SYS_TIMEB_H
/* Define if you have the dl library (-ldl). */
#undef HAVE_LIBDL
/* Define if you have the elf library (-lelf). */
#undef HAVE_LIBELF
/* Define if you have the gen library (-lgen). */
#undef HAVE_LIBGEN
/* Define if you have the m library (-lm). */
#undef HAVE_LIBM
/* Define if you have the mld library (-lmld). */
#undef HAVE_LIBMLD
/* Define if you have the nsl library (-lnsl). */
#undef HAVE_LIBNSL
/* Define if you have the socket library (-lsocket). */
#undef HAVE_LIBSOCKET
/* Define if you have the sun library (-lsun). */
#undef HAVE_LIBSUN
#include "fake/sigact.h"
#include "fake/strerror.h"
#include "fake/sys-select.h"

40
c/unix/dynamo-test.c Normal file
View File

@ -0,0 +1,40 @@
/*
* A simple test file for dynamic loading, dynamic name lookup, and
* old-style external calls.
*/
#include <stdio.h>
#include "scheme48.h"
/*
* These should only be called on characters or other immediates.
*/
s48_value
s48_dynamo_test(s48_value arg0, s48_value arg1, s48_value arg2)
{
int i;
s48_value vector = s48_make_vector(3, S48_FALSE);
S48_VECTOR_SET(vector, 0, arg0);
S48_VECTOR_SET(vector, 1, arg1);
S48_VECTOR_SET(vector, 2, arg2);
return vector;
}
s48_value
s48_old_dynamo_test(long nargs, s48_value args[])
{
int i;
s48_value vector = s48_make_vector(nargs, S48_FALSE);
for (i = 0; i < nargs; i++)
S48_VECTOR_SET(vector, i, args[i]);
return vector;
}

6
c/unix/dynamo.c
View File

@ -7,8 +7,12 @@
#include <unistd.h>
#include "sysdep.h"
#include "scheme48.h"
#include <dlfcn.h>
#if defined(HAVE_DLOPEN)
#include <dlfcn.h>
#else
#include "../fake/dlfcn.h"
#endif
#if defined(RTLD_NOW)
#define DLOPEN_MODE RTLD_NOW

218
c/unix/event.c
View File

@ -13,16 +13,31 @@
#include "c-mods.h"
#include "scheme48vm.h"
#include "event.h"
#include "../scsh/scsh_aux.h"
#include "../scsh/signals1.h"
/* turning interrupts and I/O readiness into events */
sigset_t full_sigset;
#define block_interrupts()
#define allow_interrupts()
#define block_interrupts(){sigprocmask (SIG_BLOCK, &full_sigset, 0);}
#define allow_interrupts(){sigprocmask (SIG_UNBLOCK, &full_sigset, 0);}
static void when_keyboard_interrupt();
static void when_alarm_interrupt();
static void when_sigpipe_interrupt();
/* JMG:*/
static void when_scsh_interrupt();
/* JMG: for scsh */
#define INTERRUPT_QUEUE_LENGTH 32
static int interrupt_queue [INTERRUPT_QUEUE_LENGTH];
static int next_interrupt = 0;
static int s48_os_signal_pending(void);
static bool s48_os_signal_happend(void);
bool s48_setcatcher(int signum, void (*catcher)(int));
void s48_start_alarm_interrupts(void);
@ -38,6 +53,47 @@ s48_sysdep_init(void)
errno);
exit(1);
}
sigfillset (&full_sigset);
/* JMG: for scsh */
s48_setcatcher(SIGCHLD, when_scsh_interrupt);
s48_setcatcher(SIGCONT, when_scsh_interrupt);
s48_setcatcher(SIGHUP, when_scsh_interrupt);
s48_setcatcher(SIGQUIT, when_scsh_interrupt);
s48_setcatcher(SIGTERM, when_scsh_interrupt);
s48_setcatcher(SIGTSTP, when_scsh_interrupt);
s48_setcatcher(SIGUSR1, when_scsh_interrupt);
s48_setcatcher(SIGUSR2, when_scsh_interrupt);
#ifdef SIGINFO
s48_setcatcher(SIGINFO, when_scsh_interrupt);
#endif
#ifdef SIGIO
s48_setcatcher(SIGIO, when_scsh_interrupt);
#endif
#if defined SIGPOLL && ((defined SIGIO && SIGPOLL != SIGIO) || \
!defined SIGIO)
s48_setcatcher(SIGPOLL, when_scsh_interrupt);
#endif
#ifdef SIGPROF
s48_setcatcher(SIGPROF, when_scsh_interrupt);
#endif
#ifdef SIGPWR
s48_setcatcher(SIGPWR, when_scsh_interrupt);
#endif
#ifdef SIGVTALRM
s48_setcatcher(SIGVTALRM, when_scsh_interrupt);
#endif
#ifdef SIGWINCH
s48_setcatcher(SIGWINCH, when_scsh_interrupt);
#endif
#ifdef SIGXCPU
s48_setcatcher(SIGXCPU, when_scsh_interrupt);
#endif
#ifdef SIGXFSZ
s48_setcatcher(SIGXFSZ, when_scsh_interrupt);
#endif
s48_start_alarm_interrupts();
}
@ -51,15 +107,21 @@ s48_setcatcher(int signum, void (*catcher)(int))
{
struct sigaction sa;
if (sigaction(signum, (struct sigaction *)NULL, &sa) != 0)
return (FALSE);
if (sa.sa_handler == SIG_IGN)
return (TRUE);
if (sigaction(signum, (struct sigaction *)NULL, &sa) != 0){
fprintf(stderr, "Failed to get sigaction for signal %d\n", signum);
exit(1);
}
/* JMG: what's the point of not setting the handler in this case?
if (sa.sa_handler == SIG_IGN)
return (TRUE);*/
sa.sa_handler = catcher;
sigemptyset(&sa.sa_mask);
sa.sa_flags = 0;
if (sigaction(signum, &sa, (struct sigaction *)NULL) != 0)
return (FALSE);
if (sigaction(signum, &sa, (struct sigaction *)NULL) != 0){
fprintf(stderr, "Failed to define handler for signal %d\n", signum);
exit(1);
}
return (TRUE);
}
@ -106,6 +168,8 @@ when_alarm_interrupt(int ign)
return;
}
#define USEC_PER_POLL (1000000 / POLLS_PER_SECOND)
/* delta is in ticks, 0 cancels current alarm */
@ -222,7 +286,7 @@ s48_stop_alarm_interrupts(void)
* (queue-ready-ports)
* (set! *poll-time* (+ *time* *poll-interval*))))
* (cond ((not (queue-empty? ready-ports))
* (values (enum event-type i/o-completion)
* (values (enum event-type i/o-{read/write}-completion)
* (dequeue! ready-ports)))
* ((>= *current_time* *alarm-time*)
* (set! *alarm-time* max-integer)
@ -237,9 +301,20 @@ s48_stop_alarm_interrupts(void)
* (values (enum event-type no-event) #f))))))
*/
static bool there_are_ready_ports(void);
static int next_ready_port(void);
static int queue_ready_ports(bool wait, long seconds, long ticks);
#define FD_QUIESCENT 0 /* idle */
#define FD_READY 1 /* I/O ready to be performed */
#define FD_PENDING 2 /* waiting */
typedef struct fd_struct {
int fd, /* file descriptor */
status; /* one of the FD_* constants */
bool is_input; /* iff input */
struct fd_struct *next; /* next on same queue */
} fd_struct;
static bool there_are_ready_ports(void);
static fd_struct *next_ready_fd_struct(void);
static int queue_ready_ports(bool wait, long seconds, long ticks);
int
s48_get_next_event(long *ready_fd, long *status)
@ -249,6 +324,8 @@ s48_get_next_event(long *ready_fd, long *status)
*/
int io_poll_status;
fd_struct *f;
/*
fprintf(stderr, "[poll at %d (waiting for %d)]\n", s48_current_time, alarm_time);
*/
@ -269,21 +346,25 @@ s48_get_next_event(long *ready_fd, long *status)
}
}
if (there_are_ready_ports()) {
*ready_fd = next_ready_port();
f = next_ready_fd_struct();
*ready_fd = f->fd;
*status = 0; /* chars read or written */
/* fprintf(stderr, "[i/o completion]\n"); */
return (IO_COMPLETION_EVENT);
if (f->is_input)
return (IO_READ_COMPLETION_EVENT);
else
return (IO_WRITE_COMPLETION_EVENT);
}
if (alarm_time != -1 && s48_current_time >= alarm_time) {
alarm_time = -1;
/* fprintf(stderr, "[alarm]\n"); */
return (ALARM_EVENT);
}
/*
block_interrupts();
/* JMG: scsh should handle this */
if (s48_os_signal_pending())
return (OS_SIGNAL_EVENT);
*/
block_interrupts();
if ((keyboard_interrupt_count == 0)
&& (alarm_time == -1 || s48_current_time < alarm_time)
&& (poll_time == -1 || s48_current_time < poll_time))
@ -299,17 +380,6 @@ s48_get_next_event(long *ready_fd, long *status)
* the pending ports and move any that are ready onto the other queue and
* signal an event.
*/
#define FD_QUIESCENT 0 /* idle */
#define FD_READY 1 /* I/O ready to be performed */
#define FD_PENDING 2 /* waiting */
typedef struct fd_struct {
int fd, /* file descriptor */
status; /* one of the FD_* constants */
bool is_input; /* iff input */
struct fd_struct *next; /* next on same queue */
} fd_struct;
/*
* A queue of fd_structs is empty iff the first field is NULL. In
@ -394,14 +464,14 @@ there_are_ready_ports(void)
}
static int
next_ready_port(void)
static fd_struct *
next_ready_fd_struct(void)
{
fd_struct *p;
p = rmque(&ready.first, &ready);
p->status = FD_QUIESCENT;
return (p->fd);
return (p);
}
@ -508,6 +578,8 @@ s48_wait_for_event(long max_wait, bool is_minutes)
}
if (keyboard_interrupt_count > 0)
status = NO_ERRORS;
else if (s48_os_signal_happend ())
status = NO_ERRORS;
else {
status = queue_ready_ports(TRUE, seconds, ticks);
if (there_are_ready_ports())
@ -552,8 +624,9 @@ queue_ready_ports(bool wait, long seconds, long ticks)
}
tvp = &tv;
if (wait)
if (seconds == -1)
if (seconds == -1){
tvp = NULL;
}
else {
tv.tv_sec = seconds;
tv.tv_usec = ticks * (1000000 / TICKS_PER_SECOND);
@ -561,6 +634,9 @@ queue_ready_ports(bool wait, long seconds, long ticks)
else
timerclear(&tv);
while(TRUE) {
if ((keyboard_interrupt_count > 0) || s48_os_signal_happend ())
return NO_ERRORS;
/* time gap */
left = select(limfd, &reads, &writes, &alls, tvp);
if (left > 0) {
fdpp = &pending.first;
@ -587,3 +663,81 @@ queue_ready_ports(bool wait, long seconds, long ticks)
return errno;
}
}
/*
* Adds `signum' to the queue of received signals.
*/
static void
queue_interrupt(int signum)
{
if (next_interrupt == INTERRUPT_QUEUE_LENGTH){
perror("Interrupt queue overflow -- report to Scheme 48 maintainers.");
exit(-1);
}
interrupt_queue[next_interrupt] = signum;
next_interrupt++;
}
/* JMG: for scsh */
static void when_scsh_interrupt(int signo)
{
queue_interrupt(sig2int[signo]);
NOTE_EVENT;
return;
}
/*
* This procedure is called periodically by the VM .
*
* s48_set_os_signal() is a VM procedure. The two arguments are the type
* of interrupt and one other value which can be used to return whatever
* associated information is desired. The two values, along with the
* current enabled-interrupts mask, are passed to the handler for os-signal
* interrupts.
*
* A handler can be installed by doing
(set-interrupt-handler! (enum interrupt os-signal)
(lambda (type arg enabled-interrupts)
(display type)
(newline)
(display arg)
(newline)
(display enabled-interrupts)
(newline)))
* The handler is called with all interrupts disabled. They are
* reenabled when the handler returns (or if done by hand).
*/
/*
* Returns TRUE if there is a signal to be delivered up to Scheme.
* Needs no be called with interrupts blocked.
*/
int
s48_os_signal_pending(void) {
int i;
s48_value interrupt_list = S48_NULL;
block_interrupts();
if (next_interrupt == 0) {
allow_interrupts();
return FALSE; }
else {
/* turn the queue into a scheme list and preserve the order */
for (i = next_interrupt; i > 0 ; i--)
interrupt_list = s48_cons (s48_enter_fixnum (interrupt_queue [i - 1]),
interrupt_list);
s48_set_os_signals(interrupt_list);
next_interrupt = 0;
allow_interrupts();
return TRUE; }
}
bool
s48_os_signal_happend(void) {
return (next_interrupt != 0);
}

41
c/unix/fd-io.c
View File

@ -82,6 +82,45 @@ ps_close_fd(long fd_as_long)
}
}
bool ps_check_fd(long fd_as_long, bool is_read, long *status)
{
int fd = (int)fd_as_long;
int ready;
struct timeval timeout;
fd_set fds;
FD_ZERO(&fds);
FD_SET(fd, &fds);
timerclear(&timeout);
*status = NO_ERRORS;
while(TRUE) {
ready = select(fd + 1,
is_read ? &fds : NULL,
is_read ? NULL : &fds,
&fds,
&timeout);
if (ready == 0)
return FALSE;
else if (ready == 1)
return TRUE;
else if (errno != EINTR) {
*status = errno;
return FALSE; } }
}
/*
* Return TRUE if successful, and FALSE otherwise.
*/
bool
ps_add_pending_fd(long fd_as_long, bool is_input)
{
return s48_add_pending_fd((int) fd_as_long, is_input);
}
long
ps_read_fd(long fd_as_long, char *buffer, long max, bool waitp,
bool *eofp, bool *pending, long *status)
@ -172,7 +211,7 @@ long
ps_abort_fd_op(long fd_as_long)
{
int fd = (int)fd_as_long;
fprintf(stderr, "aborting %d\n", fd);
if (!s48_remove_fd(fd))
fprintf(stderr, "Error: ps_abort_fd_op, no pending operation on fd %d\n",
fd);

129
c/unix/misc.c Normal file
View File

@ -0,0 +1,129 @@
/* Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees.
See file COPYING. */
#include <stdio.h>
#include <stdlib.h> /* for getenv(), etc. (POSIX?/ANSI) */
#include <string.h> /* for strncpy(), etc. (POSIX/ANSI) */
#include <pwd.h> /* for getpwnam() (POSIX.1) */
#include <unistd.h> /* for sysconf(), etc. (POSIX.1/.2)*/
#include <errno.h>
#include "sysdep.h"
#define TRUE (0 == 0)
#define FALSE (0 == 1)
/*
Expanding Unix filenames
Unix Sucks
Richard Kelsey Wed Jan 17 21:40:26 EST 1990
Later modified by others who wish to remain anonymous
Expands initial ~ and ~/ in string `name', leaving the result in `buffer'.
`buffer_len' is the length of `buffer'.
Note: strncpy(x, y, n) copies from y to x.
*/
char *s48_expand_file_name (name, buffer, buffer_len)
char *name, *buffer;
int buffer_len;
{
#define USER_NAME_SIZE 256
char *dir, *p, user_name[USER_NAME_SIZE];
struct passwd *user_data;
int dir_len, i;
extern char *getenv();
int name_len = strlen(name);
dir = 0;
if (name[0] == '~') {
name++; name_len--;
if (name[0] == '/' || name[0] == 0) {
dir = getenv("HOME"); }
else {
for (i = 0, p = name; i < name_len && *p != '/'; i++, p++)
if (i > (USER_NAME_SIZE - 2)) {
fprintf(stderr,
"\ns48_expand_file_name: user name longer than %d characters\n",
USER_NAME_SIZE - 3);
return(NULL); };
strncpy(user_name, name, i);
user_name[i] = 0;
user_data = getpwnam(user_name);
if (!user_data) {
fprintf(stderr, "\ns48_expand_file_name: unknown user \"%s\"\n",
user_name);
return(NULL); };
name_len -= i;
name = p;
dir = user_data->pw_dir; } }
else if (name[0] == '$') {
name++; name_len--;
for (i = 0, p = name; i < name_len && *p != '/'; i++, p++)
if (i > (USER_NAME_SIZE - 2)) {
fprintf(stderr,
"\ns48_expand_file_name: environment variable longer than %d characters\n",
USER_NAME_SIZE - 3);
return(NULL); };
strncpy(user_name, name, i);
user_name[i] = 0;
name_len -= i;
name = p;
dir = getenv(user_name); }
if (dir) {
dir_len = strlen(dir);
if ((name_len + dir_len + 1) > buffer_len) {
fprintf(stderr, "\ns48_expand_file_name: supplied buffer is too small\n");
return(NULL); };
strncpy(buffer, dir, dir_len);
strncpy(buffer + dir_len, name, name_len);
buffer[name_len + dir_len] = 0; }
else {
if ((name_len + 1) > buffer_len) {
fprintf(stderr, "\ns48_expand_file_name: supplied buffer is too small\n");
return(NULL); };
strncpy(buffer, name, name_len);
buffer[name_len] = 0; }
return(buffer);
}
/* test routine
main(argc, argv)
int argc;
char *argv[];
{
char buffer[32];
s48_expand_file_name(argv[1], buffer, 32);
printf("%s\n", buffer);
return(0);
}
*/
/* Driver loop for tail-recursive calls */
long s48_return_value;
long
s48_run_machine(long (*proc) (void))
{
while (proc != 0)
proc = (long (*) (void)) (*proc)();
return s48_return_value;
}
unsigned char *
ps_error_string(long the_errno)
{
return((unsigned char *)strerror(the_errno));
}

17
c/unix/socket.c
View File

@ -36,9 +36,23 @@ static s48_value s48_socket(s48_value server_p),
s48_value input_p),
s48_get_host_name(void);
s48_value s48_add_pending_channel (s48_value channel)
{
int socket_fd;
S48_CHECK_CHANNEL(channel);
socket_fd = S48_UNSAFE_EXTRACT_FIXNUM(S48_UNSAFE_CHANNEL_OS_INDEX(channel));
if (! s48_add_pending_fd(socket_fd, 1)) /* 1 for: yes, is input */
s48_raise_out_of_memory_error();
return S48_UNSPECIFIC;
}
/*
* Install all exported functions in Scheme48.
*/
void
s48_init_socket(void)
{
@ -50,6 +64,7 @@ s48_init_socket(void)
S48_EXPORT_FUNCTION(s48_connect);
S48_EXPORT_FUNCTION(s48_close_socket_half);
S48_EXPORT_FUNCTION(s48_get_host_name);
S48_EXPORT_FUNCTION(s48_add_pending_channel);
}
/*
@ -235,7 +250,7 @@ s48_accept(s48_value channel)
* and return #F to tell the Scheme procedure to wait.
*/
if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno == EAGAIN))
if ((errno != EWOULDBLOCK) && (errno != EINTR) && (errno != EAGAIN))
s48_raise_os_error(errno);
if (! s48_add_pending_fd(socket_fd, TRUE))

12
c/unix/test.c Normal file
View File

@ -0,0 +1,12 @@
#include "c/scheme48.h"
long
frog(long arg_count, long *args)
{
long i, res;
for (i = 0, res = s48_enter_integer(-100); i < arg_count; res += args[i], i++);
return res;
}

2
c/write-barrier.h Normal file
View File

@ -0,0 +1,2 @@
#define S48_WRITE_BARRIER(stob, address, value) ((void)0)

3
cig/.gitignore vendored Normal file
View File

@ -0,0 +1,3 @@
cig
cig.image

1171
cig/cig.scm Normal file
View File

File diff suppressed because it is too large Load Diff

48
cig/image2script Executable file
View File

@ -0,0 +1,48 @@
#!/bin/sh -
binary=$1
shift
if [ `echo $binary | wc -c` -gt 28 ] ; then
echo "#!/bin/sh -"
echo exec $binary $* -i '"$0"' '"$@"'
elif [ $# -gt 0 ] ; then
echo '#!'$binary \\
echo $* -i
else echo '#!'$binary -i
fi
exec cat
# This program reads an S48 image from stdin and turns it into
# an executable by prepending a #! prefix. The vm and its
# args are passed to this program on the command line.
#
# If the vm binary is 27 chars or less, then we can directly
# execute the vm with one of these scripts:
# No args:
# image2script /usr/local/bin/svm <image
# outputs this script:
# #!/usr/local/bin/svm -i
# ...image bits follow...
#
# Args:
# image2script /usr/bin/svm -h 4000000 -o /usr/bin/svm <image
# outputs this script:
# #!/usr/bin/svm \
# -h 4000000 -o /usr/bin/svm -i
# ...image bits follow...
#
# The exec system call won't handle the #! line if it contains more than
# 32 chars, so if the vm binary is over 28 chars, we have to use a /bin/sh
# trampoline.
# image2script /user1/lecturer/shivers/vc/scsh/s48/lib/svm -h 4000000 < ...
# outputs this script:
# #!/bin/sh -
# exec /user1/lecturer/shivers/vc/scsh/s48/lib/svm -h 4000000 -i $0 $*
# ...image bits follow...
#
# -Olin

117
cig/libcig.c Normal file
View File

@ -0,0 +1,117 @@
/* This is an Scheme48/C interface file,
** automatically generated by a hacked version of cig 3.0.
step 4
*/
#include <stdio.h>
#include <stdlib.h> /* For malloc. */
#include "libcig.h"
s48_value df_strlen_or_false(s48_value g1)
{
extern s48_value strlen_or_false(const char * );
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(1);
s48_value r1;
S48_GC_PROTECT_1(ret1);
r1 = strlen_or_false((const char * )AlienVal(g1));
ret1 = r1;
S48_GC_UNPROTECT();
return ret1;
}
s48_value df_cstring_nullp(s48_value g1)
{
extern int cstring_nullp(const char * );
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(1);
int r1;
S48_GC_PROTECT_1(ret1);
r1 = cstring_nullp((const char * )AlienVal(g1));
ret1 = ENTER_BOOLEAN(r1);
S48_GC_UNPROTECT();
return ret1;
}
s48_value df_c2scheme_strcpy_free(s48_value g1, s48_value g2)
{
extern int c2scheme_strcpy_free(s48_value , char* );
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(1);
int r1;
S48_GC_PROTECT_1(ret1);
r1 = c2scheme_strcpy_free(g1, (char* )AlienVal(g2));
ret1 = ENTER_BOOLEAN(r1);
S48_GC_UNPROTECT();
return ret1;
}
s48_value df_c2scheme_strcpy(s48_value g1, s48_value g2)
{
extern int c2scheme_strcpy(s48_value , char* );
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(1);
int r1;
S48_GC_PROTECT_1(ret1);
r1 = c2scheme_strcpy(g1, (char* )AlienVal(g2));
ret1 = ENTER_BOOLEAN(r1);
S48_GC_UNPROTECT();
return ret1;
}
s48_value df_c_veclen(s48_value g1)
{
extern s48_value c_veclen(long* );
s48_value ret1 = S48_FALSE;
S48_DECLARE_GC_PROTECT(1);
s48_value r1;
S48_GC_PROTECT_1(ret1);
r1 = c_veclen((long* )AlienVal(g1));
ret1 = r1;
S48_GC_UNPROTECT();
return ret1;
}
s48_value df_free(s48_value g1)
{
free((void* )AlienVal(g1));
return S48_FALSE;
}
s48_value df_set_strvec_carriers(s48_value g1, s48_value g2)
{
extern void set_strvec_carriers(s48_value , char** );
set_strvec_carriers(g1, (char** )AlienVal(g2));
return S48_FALSE;
}
void s48_init_cig(void)
{
S48_EXPORT_FUNCTION(df_strlen_or_false);
S48_EXPORT_FUNCTION(df_cstring_nullp);
S48_EXPORT_FUNCTION(df_c2scheme_strcpy_free);
S48_EXPORT_FUNCTION(df_c2scheme_strcpy);
S48_EXPORT_FUNCTION(df_c_veclen);
S48_EXPORT_FUNCTION(df_free);
S48_EXPORT_FUNCTION(df_set_strvec_carriers);
}

32
cig/libcig.h Normal file
View File

@ -0,0 +1,32 @@
#include "scheme48.h"
/* StobData is used by fdports.c. It should be changed over to STOB_REF
** by removing the extra indirection. */
#define StobData(x) (S48_ADDRESS_AFTER_HEADER(x, s48_value))
#define IsChar(x) ((((long) x) & 0xff) == S48_CHAR)
/* JMG: untested !! */
#define StrByte(x, i) ((i) + S48_ADDRESS_AFTER_HEADER((x), char))
#define cig_string_body(x) (S48_ADDRESS_AFTER_HEADER((x), char))
#define AlienVal(x) (S48_STOB_REF((x),0))
/* JMG: no () around this, because it's a do..while(0) */
#define SetAlienVal(x, v) S48_STOB_SET((x), 0, (v))
/* JMG: some hacks to leave to old sources untouched */
#define ENTER_BOOLEAN(x) (x ? S48_TRUE : S48_FALSE)
#define EXTRACT_BOOLEAN(x) ((x==S48_TRUE) ? 1 : 0)
/* #define ENTER_FIXNUM(x) (s48_enter_fixnum(x)) */
/* #define SCHFALSE S48_FALSE */
extern char *scheme2c_strcpy(s48_value sstr);
extern s48_value strlen_or_false(const char *s);
extern char *copystring_or_die(const char *);
extern char *copystring(char *, const char *);
extern s48_value strlen_or_false(const char *);
extern void cig_check_nargs(int arity, int nargs, const char *fn);

139
cig/libcig.scm Normal file
View File

@ -0,0 +1,139 @@
;;; (DEFINE-FOREIGN ...) forms are expanded by Cig into Scheme stubs.
;;; These stubs reference some support procedures to rep-convert the
;;; standard reps (e.g., string). This structure provides these support
;;; procedures.
;;;
;;; We export three kinds of things:
;;; - Type predicates that aren't in the R4RS env (e.g., FIXNUM?).
;;; - Carrier makers for making boxes to return things in.
;;; - Scheme-side rep-converters for return values.
(define-structure cig-aux
(export cstring-null?
C->scheme-string
C->scheme-string-w/len
C->scheme-string-w/len-no-free
C-string-vec->Scheme&free
C-string-vec->Scheme ; Bogus, because clients not reentrant.
string-carrier->string
string-carrier->string-no-free
fixnum?
make-string-carrier
make-alien
alien?
)
(open scheme code-vectors define-foreign-syntax)
(begin
(define min-fixnum (- (expt 2 29)))
(define max-fixnum (- (expt 2 29) 1))
(define (fixnum? x) (and (integer? x) (<= min-fixnum x max-fixnum)))
;; Internal utility.
(define (mapv! f v)
(let ((len (vector-length v)))
(do ((i 0 (+ i 1)))
((= i len) v)
(vector-set! v i (f (vector-ref v i))))))
;; Make a carrier for returning strings.
;; It holds a raw C string and a fixnum giving the length of the string.
(define (make-string-carrier) (cons (make-alien) 0))
(define (make-alien) (make-code-vector 4 0))
(define (alien? x) (and (code-vector? x) (= 4 (code-vector-length x)))) ; BOGUS
;;; C/Scheme string and vector conversion
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Generally speaking, in the following routines,
;;; a NULL C string param causes a function to return #f.
(foreign-init-name "cig")
(define-foreign %cstring-length-or-false
(strlen_or_false ((C "const char * ~a") cstr))
desc)
(define-foreign cstring-null?
(cstring_nullp ((C "const char * ~a") cstr))
bool)
(define-foreign %copy-c-string&free
(c2scheme_strcpy_free (string-desc sstr) ((C char*) cstr))
bool)
(define-foreign %copy-c-string
(c2scheme_strcpy (string-desc sstr) ((C char*) cstr))
bool)
(define (C->scheme-string cstr)
(cond ((%cstring-length-or-false cstr)
=> (lambda (strlen)
(let ((str (make-string strlen)))
(%copy-c-string&free str cstr)
str)))
(else #f)))
(define (C->scheme-string-w/len cstr len)
(and (integer? len)
(let ((str (make-string len)))
(%copy-c-string&free str cstr)
str)))
(define (C->scheme-string-w/len-no-free cstr len)
(and (integer? len)
(let ((str (make-string len)))
(%copy-c-string str cstr)
str)))
(define (string-carrier->string carrier)
(C->scheme-string-w/len (car carrier) (cdr carrier)))
(define (string-carrier->string-no-free carrier)
(C->scheme-string-w/len-no-free (car carrier) (cdr carrier)))
;;; Return the length of a null-terminated C word vector.
;;; Does not count the null word as part of the length.
;;; If vector is NULL, returns #f.
(define-foreign %c-veclen-or-false
(c_veclen ((C long*) c-vec))
desc) ; integer or #f if arg is NULL.
;;; CVEC is a C vector of char* strings, length VECLEN.
;;; This procedure converts a C vector of strings into a Scheme vector of
;;; strings. The C vector and its strings are all assumed to come from
;;; the malloc heap; they are returned to the heap when the rep-conversion
;;; is done.
;;;
;;; Hack: if VECLEN is #f, CVEC is assumed to be NULL terminated, and
;;; its length is calculated thusly.
(define (C-string-vec->Scheme&free cvec veclen)
(let ((vec (make-vector (or veclen (%c-veclen-or-false cvec) 0))))
(mapv! (lambda (ignore) (make-string-carrier)) vec)
(%set-string-vector-carriers! vec cvec)
(C-free cvec)
(mapv! string-carrier->string vec)))
(define (C-string-vec->Scheme cvec veclen) ; No free.
(let ((vec (make-vector (or veclen (%c-veclen-or-false cvec) 0))))
(mapv! (lambda (ignore) (make-string-carrier)) vec)
(%set-string-vector-carriers! vec cvec)
(mapv! string-carrier->string-no-free vec)))
(define-foreign C-free (free ((C void*) ptr)) no-declare ; for SunOS 4.x
ignore)
(define-foreign %set-string-vector-carriers!
(set_strvec_carriers (vector-desc svec) ((C char**) cvec))
ignore)
)) ; egakcap

163
cig/libcig1.c Normal file
View File

@ -0,0 +1,163 @@
/* Generic routines for Scheme48/C interfacing -- mostly for converting
** strings and null-terminated vectors back and forth.
** Copyright (c) 1993 by Olin Shivers.
*/
#include "libcig.h"
#include <string.h>
#include <stddef.h>
#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#define Malloc(type,n) ((type *) malloc(sizeof(type)*(n)))
#define Free(p) (free((char *)(p)))
/* (c2scheme_strcpy dest_scheme_string source_C_string)
** Copies C string's chars into Scheme string. Return #t.
** If C string is NULL, do nothing and return #f.
*/
int c2scheme_strcpy(s48_value sstr, const char *cstr)
{
if( cstr ) {
strncpy( (char*) StobData(sstr), cstr, S48_STRING_LENGTH(sstr) );
return 1;
}
else return 0;
}
/* Same as above, but free the C string when we are done. */
int c2scheme_strcpy_free(s48_value sstr, const char *cstr)
{
if( cstr ) {
strncpy( (char*) StobData(sstr), cstr, S48_STRING_LENGTH(sstr) );
Free(cstr);
return 1;
}
else return 0;
}
char *scheme2c_strcpy(s48_value sstr)
{
char *result;
int slen;
slen = S48_STRING_LENGTH(sstr);
result = Malloc(char, slen+1);
if( result == NULL ) {
fprintf(stderr,
"Fatal error: C stub tried to copy Scheme string,\n"
"but malloc failed on arg 0x%x, errno %d.\n",
sstr, errno);
exit(-1);
}
memcpy(result, cig_string_body(sstr), slen);
result[slen] = '\000';
return result;
}
/* One arg, a zero-terminated C word vec. Returns length.
** The terminating null is not counted. Returns #f on NULL.
*/
s48_value c_veclen(const long *vec)
{
const long *vptr = vec;
if( !vptr ) return S48_FALSE;
while( *vptr ) vptr++;
return s48_enter_fixnum(vptr - vec);
}
/* Copy string from into string to. If to is NULL, malloc a fresh string
** (if the malloc loses, return NULL).
** If from is NULL, then
** - if to is NULL, do nothing and return NULL.
** - Otherwise, deposit a single nul byte.
** Under normal conditions, this routine returns the destination string.
**
** The little boundary cases of this procedure are a study in obfuscation
** because C doesn't have a reasonable string data type. Give me a break.
*/
char *copystring(char *to, const char *from)
{
if( from ) {
int slen = strlen(from)+1;
if( !to && !(to = Malloc(char, slen)) ) return NULL;
else return memcpy(to, from, slen);
}
else
return to ? *to = '\000', to : NULL;
}
/* As in copystring, but if malloc loses, print out an error msg and croak. */
char *copystring_or_die(const char *str ) /* Note: NULL -> NULL. */
{
if( str ) {
int len = strlen(str)+1;
char *new_str = Malloc(char, len);
if( ! new_str ) {
fprintf(stderr, "copystring: Malloc failed.\n");
exit(-1);
}
return memcpy(new_str, str, len);
}
else return NULL;
}
int cstring_nullp( const char *s ) { return ! s; }
s48_value strlen_or_false(const char *s)
{ return s ? s48_enter_fixnum(strlen(s)) : S48_FALSE; }
/* svec is a Scheme vector of C string carriers. Scan over the C strings
** in cvec, and initialise the corresponding string carriers in svec.
*/
void set_strvec_carriers(s48_value svec, char const * const * cvec)
{
int svec_len = S48_VECTOR_LENGTH(svec);
char const * const * cv = cvec;
int i = 0;
/* JMG: now using normal array access, instead of pointer++ on a s48_value */
for(; svec_len > 0; i++, cv++, svec_len-- ) {
s48_value carrier, alien;
int strl;
/* *sv is a (cons (make-alien <c-string>) <string-length>). */
carrier = S48_VECTOR_REF(svec,i);
alien = S48_CAR(carrier);
strl = strlen(*cv);
S48_SET_CDR(carrier, s48_enter_fixnum(strl));
SetAlienVal(alien, (long) *cv);
}
}
/* Helper function for arg checking. Why bother, actually? */
void cig_check_nargs(int arity, int nargs, const char *fn)
{
if( arity != nargs ) {
fprintf(stderr,
"Cig fatal error (%s) -- C stub expected %d arg%s, "
"but got %d.\n",
fn, arity, (arity == 1) ? "" : "s", nargs);
exit(-1);
}
}
/* void ciginit(){ */
/* S48_EXPORT_FUNCTION (df_strlen_or_false); */
/* S48_EXPORT_FUNCTION (df_c_veclen); */
/* S48_EXPORT_FUNCTION (df_set_strvec_carriers); */
/* S48_EXPORT_FUNCTION (df_c2scheme_strcpy_free); */
/* S48_EXPORT_FUNCTION (df_cstring_nullp); */
/* S48_EXPORT_FUNCTION (df_free); */
/* S48_EXPORT_FUNCTION (df_c2scheme_strcpy); */
/* } */

1368
config.guess vendored Executable file
View File

File diff suppressed because it is too large Load Diff

1356
config.sub vendored Executable file
View File

File diff suppressed because it is too large Load Diff

1925
configure vendored
View File

File diff suppressed because it is too large Load Diff

330
configure.in
View File

@ -3,26 +3,7 @@ dnl
dnl We might want AC_WORDS_BIGENDIAN in the future.
dnl We might want AC_CHAR_UNSIGNED in the future.
dnl
dnl The -cckr (K&R) flag is for the IRIX C compiler. If this is left
dnl out, scheme48vm.c breaks because the rather pedantic SGI compiler
dnl decides that a char is not the same thing as an unsigned char.
dnl - Bryan O'Sullivan 3/94
dnl Note, this test didn't work correctly on Sun's which take -cckr as a
dnl synonym for -c. (HCC)
define(S48_CFLAG_CKR, [dnl
if test "z$GCC" = z; then
AC_MSG_CHECKING([-cckr])
oldCFLAGS="$CFLAGS"
CFLAGS="$CFLAGS -cckr"
AC_TRY_RUN([int main() { return 0;}],
[AC_MSG_RESULT(yes)],
[AC_MSG_RESULT(no)
CFLAGS="$oldCFLAGS"],
[AC_MSG_RESULT(no)
CFLAGS="$oldCFLAGS"])
fi
])dnl
dnl
define(S48_POSIX_LIBC, [dnl
echo checking for RISC/OS POSIX library lossage
if test -f /usr/posix/usr/lib/libc.a; then
@ -64,24 +45,254 @@ dnl
define(S48_USCORE, [dnl
AC_MSG_CHECKING([underscore before symbols])
echo 'main() { return 0; } fnord() {}' >conftest.c
if ${CC} ${CFLAGS} ${CPPFLAGS} ${LDFLAGS} conftest.c ${LIBS} &&
if ${CC} ${CFLAGS} ${CPPFLAGS} ${LDFLAGS} -o a.out conftest.c ${LIBS} &&
nm a.out | grep _fnord >/dev/null; then
AC_MSG_RESULT([yes])
AC_DEFINE(USCORE)
AC_DEFINE(USCORE, 1, [Define to 1 if symbols start with _])
else
AC_MSG_RESULT([no])
fi
rm -f conftest.c a.out
])dnl
dnl
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_TZNAME,[
AC_MSG_CHECKING(for tzname)
AC_CACHE_VAL(scsh_cv_tzname,[
AC_TRY_COMPILE([#include <time.h>],
[return (int) tzname;],
scsh_cv_tzname=yes,
scsh_cv_tzname=no)])
AC_MSG_RESULT($scsh_cv_tzname)
if test $scsh_cv_tzname = yes; then
AC_DEFINE(HAVE_TZNAME)
fi
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_ELF, [
AC_MSG_CHECKING(for ELF)
AC_CACHE_VAL(scsh_cv_elf,[
touch conftest.c
if ${CC} -v -o a.out conftest.c 2>&1 | grep -q __ELF__ ; then
scsh_cv_elf=yes
else
scsh_cv_elf=no
fi])
AC_MSG_RESULT($scsh_cv_elf)
if test $scsh_cv_elf = yes; then
LDFLAGS=-rdynamic
fi
rm -f conftest.c a.out
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_SIG_NRS, [
AC_MSG_RESULT([defining signal constants])
${CC} -o scsh_aux scsh/scsh_aux.c
AC_DEFINE_UNQUOTED(SIGNR_1, `./scsh_aux 1`, [scsh interrupt for signal 1])
AC_DEFINE_UNQUOTED(SIGNR_2, `./scsh_aux 2`, [scsh interrupt for signal 2])
AC_DEFINE_UNQUOTED(SIGNR_3, `./scsh_aux 3`, [scsh interrupt for signal 3])
AC_DEFINE_UNQUOTED(SIGNR_4, `./scsh_aux 4`, [scsh interrupt for signal 4])
AC_DEFINE_UNQUOTED(SIGNR_5, `./scsh_aux 5`, [scsh interrupt for signal 5])
AC_DEFINE_UNQUOTED(SIGNR_6, `./scsh_aux 6`, [scsh interrupt for signal 6])
AC_DEFINE_UNQUOTED(SIGNR_7, `./scsh_aux 7`, [scsh interrupt for signal 7])
AC_DEFINE_UNQUOTED(SIGNR_8, `./scsh_aux 8`, [scsh interrupt for signal 8])
AC_DEFINE_UNQUOTED(SIGNR_9, `./scsh_aux 9`, [scsh interrupt for signal 9])
AC_DEFINE_UNQUOTED(SIGNR_10, `./scsh_aux 10`, [scsh interrupt for signal 10])
AC_DEFINE_UNQUOTED(SIGNR_11, `./scsh_aux 11`, [scsh interrupt for signal 11])
AC_DEFINE_UNQUOTED(SIGNR_12, `./scsh_aux 12`, [scsh interrupt for signal 12])
AC_DEFINE_UNQUOTED(SIGNR_13, `./scsh_aux 13`, [scsh interrupt for signal 13])
AC_DEFINE_UNQUOTED(SIGNR_14, `./scsh_aux 14`, [scsh interrupt for signal 14])
AC_DEFINE_UNQUOTED(SIGNR_15, `./scsh_aux 15`, [scsh interrupt for signal 15])
AC_DEFINE_UNQUOTED(SIGNR_16, `./scsh_aux 16`, [scsh interrupt for signal 16])
AC_DEFINE_UNQUOTED(SIGNR_17, `./scsh_aux 17`, [scsh interrupt for signal 17])
AC_DEFINE_UNQUOTED(SIGNR_18, `./scsh_aux 18`, [scsh interrupt for signal 18])
AC_DEFINE_UNQUOTED(SIGNR_19, `./scsh_aux 19`, [scsh interrupt for signal 19])
AC_DEFINE_UNQUOTED(SIGNR_20, `./scsh_aux 20`, [scsh interrupt for signal 20])
AC_DEFINE_UNQUOTED(SIGNR_21, `./scsh_aux 21`, [scsh interrupt for signal 21])
AC_DEFINE_UNQUOTED(SIGNR_22, `./scsh_aux 22`, [scsh interrupt for signal 22])
AC_DEFINE_UNQUOTED(SIGNR_23, `./scsh_aux 23`, [scsh interrupt for signal 23])
AC_DEFINE_UNQUOTED(SIGNR_24, `./scsh_aux 24`, [scsh interrupt for signal 24])
AC_DEFINE_UNQUOTED(SIGNR_25, `./scsh_aux 25`, [scsh interrupt for signal 25])
AC_DEFINE_UNQUOTED(SIGNR_26, `./scsh_aux 26`, [scsh interrupt for signal 26])
AC_DEFINE_UNQUOTED(SIGNR_27, `./scsh_aux 27`, [scsh interrupt for signal 27])
AC_DEFINE_UNQUOTED(SIGNR_28, `./scsh_aux 28`, [scsh interrupt for signal 28])
AC_DEFINE_UNQUOTED(SIGNR_29, `./scsh_aux 29`, [scsh interrupt for signal 29])
AC_DEFINE_UNQUOTED(SIGNR_30, `./scsh_aux 30`, [scsh interrupt for signal 30])
AC_DEFINE_UNQUOTED(SIGNR_31, `./scsh_aux 31`, [scsh interrupt for signal 31])
rm -f scsh_aux scsh_aux.exe
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_LINUX_STATIC_DEBUG, [
case "$host" in
*-*-linux* )
AC_MSG_CHECKING(for broken Linux that needs -static with -g)
AC_CACHE_VAL(scsh_cv_linux_static_debug,[
AC_TRY_LINK([],
[],
scsh_cv_linux_static_debug=no,
scsh_cv_linux_static_debug=yes)])
AC_MSG_RESULT($scsh_cv_linux_static_debug)
if test $scsh_cv_linux_static_debug = yes; then
LDFLAGS="-static ${LDFLAGS}"
fi
;;
esac
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_CONST_SYS_ERRLIST,[
AC_MSG_CHECKING(for const sys_errlist)
AC_CACHE_VAL(scsh_cv_const_sys_errlist,[
AC_TRY_COMPILE([#include <errno.h>
#include <unistd.h>],
[const extern char *sys_errlist[];],
scsh_cv_const_sys_errlist=yes,
scsh_cv_const_sys_errlist=no)])
AC_MSG_RESULT($scsh_cv_const_sys_errlist)
if test $scsh_cv_const_sys_errlist = yes; then
AC_DEFINE(HAVE_CONST_SYS_ERRLIST, 1, [const char* sys_errlist])
fi
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_SOCKLEN_T,[
AC_MSG_CHECKING(for socklen_t)
AC_TRY_COMPILE([#include <sys/socket.h>
socklen_t x;
],[],[AC_MSG_RESULT(yes)],[
AC_TRY_COMPILE([#include <sys/socket.h>
int accept (int, struct sockaddr *, size_t *);
],[],[
AC_MSG_RESULT(size_t)
AC_DEFINE(socklen_t,
size_t, [Define to type of socklen_t])], [
AC_MSG_RESULT(int)
AC_DEFINE(socklen_t,int)])])
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_INIT(c/scheme48vm.c)
AC_CONFIG_HEADER(c/sysdep.h)
AC_CANONICAL_HOST
S48_PROG_CC
SCSH_SIG_NRS
AC_ISC_POSIX
SCSH_LINUX_STATIC_DEBUG
dnl set the cross-compile flag before we try anything.
AC_TRY_RUN([int main() { return 0;}], [], [], [true])
S48_CFLAG_CKR
AC_PROG_INSTALL
AC_PROG_RANLIB
AC_C_CONST
AC_C_BIGENDIAN
if test $ac_cv_c_bigendian = no ; then
ENDIAN=little
else
ENDIAN=big
fi
AR=${AR-"ar cq"}
TMPDIR=${TMPDIR-"/var/tmp"}
case "$host" in
## CX/UX
m88k-harris-cxux* )
dir=cxux
CC="cc -Xa"
CFLAGS="-O"
LDFLAGS="-O -Wl,-Bexport"
AC_DEFINE(HAVE_HARRIS, 1, [Define to 1 on m88k-harris-cxux])
;;
## DEC Ultrix
mips-dec-ultrix* )
dir=ultrix
if test ${CC} = cc; then
LDFLAGS=-N
fi
;;
## HP 9000 series 700 and 800, running HP/UX
hppa*-hp-hpux* )
dir=hpux
LDFLAGS="-Wl,-E"
if test ${CC} = cc; then
CFLAGS="-Ae -O +Obb1800"
fi
AC_DEFINE(_HPUX_SOURCE, 1, [Define to 1 to compile on HP/UX])
AC_DEFINE(hpux, 1, [Define to 1 on HP/UX])
AC_DEFINE(_XOPEN_SOURCE_EXTENDED, 1, [Define to 1 to compile on HP/UX])
;;
## IBM AIX
rs6000-ibm-aix*|powerpc-ibm-aix* )
dir=aix
LDFLAGS="-O"
if test ${CC} = gcc; then
LDFLAGS_AIX="-Xlinker -bexport:exportlist.aix"
else
LDFLAGS_AIX="-bexport:exportlist.aix"
fi
CFLAGS="-O"
AIX_P="exportlist.aix"
;;
## Linux
*-*-linux* )
dir=linux
# gross, but needed for some older a.out systems for 0.4.x
LIBS=-lc
SCSH_ELF
;;
## NetBSD and FreeBSD ( and maybe 386BSD also)
*-*-*bsd*|*-*-darwin* )
dir=bsd
SCSH_ELF
;;
## NeXT
*-next-* )
dir=next
CC="$CC -posix"
AC_DEFINE(HAVE_SIGACTION)
;;
## SGI IRIX
mips-sgi-irix* )
dir=irix
S48_CFLAG_CKR
INSTALL='$(srcdir)/install-sh'
;;
## SunOS
sparc*-sun-sunos* )
dir=sunos
;;
## Solaris - Sparc and i386
*-*-solaris* )
dir=solaris
AC_DEFINE(HAVE_NLIST)
;;
## NT - cygwin32
*-*-cygwin* )
AC_DEFINE(CYGWIN, 1, [Define to 1 on cygwin])
dir=cygwin32
EXEEXT=".exe"
;;
## Generic Configuration
* )
dir=generic
echo "WARNING: "
echo "WARNING: Using generic configuration."
echo "WARNING: See doc/porting.txt for more information."
echo "WARNING: "
;;
esac
(cd $srcdir/scsh && rm -rf machine && ln -s $dir machine)
AC_CHECK_LIB(m, main)
AC_CHECK_LIB(dl, main)
AC_CHECK_LIB(mld, main)
@ -89,27 +300,42 @@ AC_INIT(c/scheme48vm.c)
AC_CHECK_LIB(gen, main)
AC_CHECK_LIB(socket, main)
AC_CHECK_LIB(sun, getpwnam)
AC_CHECK_LIB(c, crypt, [true], AC_CHECK_LIB(crypt, crypt))
dnl Solaris 2.3 seems to need -lelf for nlist(). (tnx Bryan O'Sullivan)
AC_CHECK_LIB(elf, main)
S48_POSIX_LIBC
AC_CONST
AC_RETSIGTYPE
AC_CHECK_HEADERS(libgen.h sys/timeb.h posix/time.h)
AC_CHECK_HEADERS(sys/select.h)
AC_CHECK_FUNCS(gettimeofday ftime nlist select setitimer sigaction)
AC_CHECK_FUNC(dlopen, AC_DEFINE(HAVE_DLOPEN),
AC_CHECK_FUNC(nlist, [LIBOBJS="$LIBOBJS c/fake/libdl1.c],
[LIBOBJS="$LIBOBJS c/fake/libdl2.c]))
AC_CHECK_HEADERS(libgen.h sys/timeb.h posix/time.h sys/select.h nlist.h)
AC_CHECK_HEADERS(sys/un.h)
AC_CHECK_HEADERS(crypt.h)
AC_CHECK_FUNCS(gettimeofday ftime nlist select setitimer sigaction vasprintf)
SCSH_SOCKLEN_T
AC_CHECK_FUNC(dlopen, [AC_DEFINE(HAVE_DLOPEN,
1, [Define to 1 if the interface to the dynamic linker exists])],
[AC_CHECK_FUNC(nlist, [AC_LIBOBJ([c/fake/libdl1])],
[AC_LIBOBJ([c/fake/libdl2])])])
AC_CHECK_FUNCS(socket chroot)
AC_CHECK_FUNC(strerror, AC_DEFINE(HAVE_STRERROR),
[LIBOBJS="$LIBOBJS c/fake/strerror.o"])
AC_MSG_CHECKING([n_name])
AC_TRY_LINK([#include <nlist.h>],
[struct nlist name_list;
name_list.n_name = "foo";],
AC_DEFINE(NLIST_HAS_N_NAME)
AC_MSG_RESULT([yes]),
AC_MSG_RESULT([no]))
AC_CHECK_FUNC(strerror, AC_DEFINE(HAVE_STRERROR,
1, [Define to 1 if you have the strerror function]),
[AC_LIBOBJ([c/fake/strerror])])
AC_CHECK_FUNC(seteuid, [AC_DEFINE(HAVE_SETEUID,
1, [Define to 1 if you have the seteuid function])],
[AC_CHECK_FUNC(setreuid, [AC_DEFINE(HAVE_SETREUID,
1, [Define to 1 if you have the setreuid function])],
[AC_MSG_ERROR("Neither setegid nor setregid defined. Cannot continue.")])])
AC_CHECK_FUNC(setegid, [AC_DEFINE(HAVE_SETEGID,
1, [Define to 1 if you have the setegid function])],
[AC_CHECK_FUNC(setregid, [AC_DEFINE(HAVE_SETREGID,
1, [Define to 1 if you have the setregid function])],
[AC_MSG_ERROR("Neither setegid nor setregid defined. Cannot continue.")])])
AC_CHECK_MEMBER(struct nlist.n_name,
[AC_DEFINE(NLIST_HAS_N_NAME, 1, [Define to 1 if struct nlist.n_name exists])],,
[#include <nlist.h>])
AC_MSG_CHECKING([__NEXT__])
AC_TRY_LINK(,[
#ifdef __NeXT__
@ -124,7 +350,31 @@ fail
AC_MSG_RESULT([no]))
S48_USCORE
S48_RDYNAMIC
AC_STRUCT_TIMEZONE
AC_CHECK_MEMBER(struct tm.tm_gmtoff,
AC_DEFINE(HAVE_GMTOFF, 1, [Define to 1 if struct tm has member tm_gmtoff]))
SCSH_CONST_SYS_ERRLIST
CFLAGS1=${CFLAGS}
AC_SUBST(CFLAGS)
AC_SUBST(LIBOBJS)
AC_SUBST(LDFLAGS)
AC_OUTPUT(Makefile)
AC_SUBST(AIX_P)
AC_SUBST(AR)
AC_SUBST(CC)
AC_SUBST(CFLAGS)
AC_SUBST(CFLAGS1)
AC_SUBST(EXEEXT)
AC_SUBST(ENDIAN)
AC_SUBST(LDFLAGS)
AC_SUBST(LDFLAGS_AIX)
AC_SUBST(LIBS)
AC_SUBST(TMPDIR)
AC_CONFIG_FILES(Makefile scsh/endian.scm scsh-config)
AC_CONFIG_COMMANDS([scsh-config+x],[chmod +x scsh-config])
AC_OUTPUT

309
doc/big-scheme.txt
View File

@ -1,309 +0,0 @@
Documentation for Big Scheme
Big Scheme is a set of generally useful facilities.
Easiest way to access these things:
> ,open big-scheme
Load structure big-scheme (y/n)? y
...
A better way is to use the module system.
-----
Ascii conversions
(CHAR->ASCII <char>) => <integer>
(ASCII->CHAR <integer>) => <char>
These are identical to CHAR->INTEGER and INTEGER->CHAR except that
they use the ASCII encoding.
-----
Bitwise operations
(BITWISE-NOT <integer>) => <integer>
(BITWISE-AND <integer> <integer>) => <integer>
(BITWISE-IOR <integer> <integer>) => <integer>
(BITWISE-XOR <integer> <integer>) => <integer>
These perform various logical operations on integers on a bit-by-bit
basis, using a two's-complement representation.
(ARITHMETIC-SHIFT <integer> <bit-count>) => <integer>
Shift the integer by the given bit count, shifting left for positive
counts and right for negative ones. A two's complement
representation is used.
-----
Hash tables
(MAKE-TABLE) => <table>
(MAKE-STRING-TABLE) => <string-table>
Make a new, empty table. MAKE-TABLE returns a table that uses EQ?
for comparing keys and an ad-hoc hash function. String tables uses
strings for keys.
(MAKE-TABLE-MAKER <comparison-procedure> <hash-procedure>) => <procedure>
Returns a procedure of no arguments that makes tables that use the
given comparison and hash procedures.
(<comparison-procedure> <key1> <key2>) => <boolean>
(<hash-procedure> <key>) => <non-negative-integer>
(TABLE? <x>) => <boolean>
True if <x> is a table.
(TABLE-REF <table> <key>) => <x>
Return the value for <key> in <table>, or #F if there is none.
<key> should be of a type appropriate for <table>.
(TABLE-SET! <table> <key> <value>) => <undefined>
Make <value> be the value of <key> in <table>. <key> should be of a
type appropriate for <table>.
(TABLE-WALK <procedure> <table>) => <undefined>
Apply <procedure>, which must accept two arguments, to every
associated key and value in <table>.
-----
Enumerations
(DEFINE-ENUMERATION <type-name> (<name0> <name1> ...)) *SYNTAX*
Defines <type-name> to be an enumeration with components <name0>
<name1> .... Also defines <type-name>-COUNT to be the number of
components.
(ENUM <type-name> <component-name>) => <integer> *SYNTAX*
Evaluates to the value of <component-name> within the enumeration
<type-name>. For example, if (DEFINE-ENUMERATION COLOR (GREEN
RED)), then (ENUM COLOR GREEN) is zero and (ENUM COLOR RED) is one.
The mapping from name to integer is done at macro-expansion time, so
there is no run-time overhead.
(ENUMERAND->NAME <integer> <enumeration>) => <symbol>
Returns the name associated with <integer> within <enumeration>.
E.g. (ENUMERAND->NAME 1 COLOR) => 'RED.
(NAME->ENUMERAND <symbol> <enumeration>) => <integer>
Returns the integer associated with <symbol> within <enumeration>.
E.g. (ENUMERAND->NAME 'GREEN COLOR) => 0.
-----
Port extensions
(MAKE-TRACKING-INPUT-PORT <input-port>) => <input-port>
(MAKE-TRACKING-OUTPUT-PORT <output-port>) => <output-port>
These return ports that keep track of the current row and column and
are otherwise identical to their arguments.
(MAKE-STRING-INPUT-PORT <string>) => <input-port>
Returns a port that reads characters from the supplied string.
(CALL-WITH-STRING-OUTPUT-PORT <procedure>) => <string>
The procedure is called on a port. When it returns, CALL-WITH-STRING-
OUTPUT-PORT returns a string containing the characters written to the port.
(WRITE-ONE-LINE <output-port> <character-count> <procedure>) => <unspecified>
The procedure is called on an output port. Output written to that
port is copied to <output-port> until <character-count> characters
have been written, at which point WRITE-ONE-LINE returns.
(CURRENT-ROW <port>) => <integer> or #f
(CURRENT-COLUMN <port>) => <integer> or #f
These return the current read or write location of the port. #F is
returned if the port does not keep track of its location.
(FRESH-LINE <output-port>) => <undefined>
Write a newline character to <output-port> if its current column is not 0.
(INPUT-PORT? <any>) => <boolean>
(OUTPUT-PORT? <any>) => <boolean>
These are versions of the standard Scheme predicates that answer true for
extended ports.
-----
Queues
(MAKE-QUEUE) => <queue>
Returns a new, empty queue.
(ENQUEUE! <queue> <x>) => <undefined>
Puts <x> on the queue.
(DEQUEUE! <queue>) => <x>
Removes and returns the first element of the queue.
(QUEUE-EMPTY? <queue>) => <boolean>
True if the queue is empty.
(QUEUE? <x>) => <boolean>
True if <x> is a queue.
(QUEUE->LIST <queue>) => <list>
Returns a list of the elements of the queue, in order.
(QUEUE-LENGTH <queue>) => <integer>
The number of elements currently on the queue.
(DELETE-FROM-QUEUE! <queue> <x>) => <boolean>
Removes the first occurance of <x> from the queue, returning true if
it was found and false otherwise.
-----
Little utility procedures
(ATOM? <any>) => <boolean>
(ATOM? x) == (NOT (PAIR? x))
(NULL-LIST? <list>) => <boolean>
Returns #t for the empty list, #f for a pair, and signals an error
otherwise.
(NEQ? <any> <any>) => <boolean>
(NEQ? x y) is the same as (NOT (EQ? x y)).
(N= <number> <number>) => <boolean>
(N= x y) is the same as (NOT (= x y)).
(IDENTITY <any>) => <any>
(NO-OP <any>) => <any>
These both just return their argument. NO-OP is guaranteed not to
be compiled in-line, IDENTITY may be.
-----
List utilities
(MEMQ? <element> <list>) => <boolean>
Returns true if <element> is in <list>, false otherwise.
(ANY? <predicate> <list>) => <boolean>
Returns true if <predicate> is true for any element of <list>.
(EVERY? <predicate> <list>) => <boolean>
Returns true if <predicate> is true for every element of <list>.
(ANY <predicate> <list>)
(FIRST <predicate> <list>)
ANY returns some element of <list> for which <predicate> is true, or
#F if there are none. FIRST does the same except that it returns
the first element for which <predicate> is true.
(FILTER <predicate> <list>)
(FILTER! <predicate> <list>)
Returns a list containing all of the elements of <list> for which
<predicate> is true. The order of the elements is preserved.
FILTER! may reuse the storage of <list>.
(FILTER-MAP <procedure> <list>)
The same as FILTER except the returned list contains the results of
applying <procedure> instead of elements of <list>. (FILTER-MAP p
l) is the same as (FILTER IDENTITY (MAP p l)).
(PARTITION-LIST <predicate> <list>) => <list> <list>
(PARTITION-LIST! <predicate> <list>) => <list> <list>
The first return value contains those elements <list> for which
<predicate> is true, the second contains the remaining elements.
The order of the elements is preserved. PARTITION-LIST! may resuse
the storage of the <list>.
(REMOVE-DUPLICATES <list>) => <list>
Returns its argument with all duplicate elements removed. The first
instance of each element is preserved.
(DELQ <element> <list>) => <list>
(DELQ! <element> <list>) => <list>
(DELETE <predicate> <list>) => <list>
All three of these return <list> with some elements removed. DELQ
removes all elements EQ? to <element>. DELQ! does the same and may
modify the list argument. DELETE removes all elements for which
<predicate> is true. Both DELQ and DELETE may reuse some of the
storage in the list argument, but won't modify it.
(REVERSE! <list>) => <list>
Destructively reverses <list>.
(SORT-LIST <list> <a<b-procedure>) => <list>
(SORT-LIST! <list> <a<b-procedure>) => <list>
Returns a sorted copy of <list>. The sorting algorithm is stable.
(SORT-LIST '(6 5 1 3 2 4) <) => '(1 2 3 4 5 6)
-----
Additional syntax
(DESTRUCTURE ((<pattern> <init>) ...) <body> ...) *SYNTAX*
The <init>s are evaluated and their values are dissasembled
according to the corresponding patterns, with identifiers in the
patterns being bound to fresh locations holding the corresponding
part, and the body is evaluated in the extended environment.
Patterns may be any of the following:
#f Discard the corresponding part.
<identifier> Bind the <indentifier> to the part.
(<pattern> ...) The part must be a list at least as long as the
pattern.
(<pattern1> ... . <patternN>)
The same thing, except that the final CDR of the
part is dissasembled according to <patternN>.
#(<pattern> ...) The part must be a vector at least as long as the
pattern.
(RECEIVE <identifiers> <exp> <body> ...) *SYNTAX*
=> (CALL-WITH-VALUES (LAMBDA () <exp>) (LAMBDA <identifiers> <body> ...))
Bind <identifiers> to the values returned by <exp>, and evaluate the
body in the resulting environment.
-----
Printing and related procedures
(CONCATENATE-SYMBOL . <components>)
Returns the symbol whose name is produced by concatenating the DISPLAYed
representations of <components>.
(CONCATENATE-SYMBOL 'abc "-" 4) => 'abc-4
(FORMAT <port-spec> <format-string> . <arguments>) => <string> or <undefined>
Prints the arguments to the port as directed by the string. <port-spec>
should be either:
An output port. The output is written directly to the port. The result
of the call to FORMAT is undefined.
#T. The output is written to the current output port. The result of the
call to FORMAT is undefined.
#F. The output is written to a string, which is then the value returned
from the call to FORMAT.
Characters in <format-string> which are not preceded by a ~ are written
directly to the output. Characters preceded by a ~ have the following
meaning (case is irrelevant; ~a and ~A have the same meaning):
~~ prints a single ~
~A prints the next argument using DISPLAY
~D prints the next argument as a decimal number
~S prints the next argument using WRITE
~% prints a newline character
~& prints a NEWLINE character if the previous printed character was not one
(this is implemented using FRESH-LINE)
~? performs a recursive call to FORMAT using the next two arguments as the
string and the list of arguments
(ERROR <format-string> . <format-arguments>)
(BREAKPOINT <format-string> . <format-arguments>)
Signals an error or breakpoint condition, passing it the result of
applying FORMAT to the arguments.
(P <thing>)
(P <thing> <output-port>)
(PRETTY-PRINT <thing> <output-port> <position>)
Pretty-print <thing>. The current output port is used if no port is
specified. <position> is the starting offset. <thing> will be
pretty-printed to the right of this column.
Original by RK, 26 Jan 1993.
Minor changes by JAR, 5 Dec 1993.

740
doc/cheat.txt Normal file
View File

@ -0,0 +1,740 @@
Scsh cheat sheet
Olin Shivers
November 1996
This cheat sheet is intentionally kept brief and minimalist.
It is intended to function as an ASCII-format reminder for the
full manual, not as the definition. It can be read using GNU Emacs's
outline mode.
It is also not entirely up-to-date. I'd appreciate getting updates from users.
-------------------------------------------------------------------------------
* High-level forms
Extended process form:
(PF [REDIR1 ...])
Redirection:
(< [FDES] FILE-NAME)
(> [FDES] FILE-NAME)
(<< [FDES] OBJECT)
(= FDES FDES/PORT)
(- FDES/PORT)
stdports
Subforms are implicitly backquoted.
Process form:
(| PF1 ...) ; pipeline
(|+ CONNECT-LIST PF1 ...) ; complex pipeline
(begin . BODY) ; Scheme form
(epf . EPF) ; Embedded extended process form
(PROG ARG1 ... ARGn) ; Exec a program
Subforms are implicitly backquoted.
Using process forms in Scheme:
(exec-epf . EPF) ; Nuke the current process.
(& . EPF) ; Fork process in background. Return proc object.
(run . EPF) ; Run process. Return exit code.
(& . EPF) = (fork (lambda () (exec-epf . EPF)))
(run . EPF) = (wait (& . EPF))
Interfacing to subprocess I/O:
(run/port . EPF) -> port
(run/file . EPF) -> string
(run/string . EPF) -> string
(run/strings . EPF) -> string list
(run/sexp . EPF) -> object
(run/sexps . EPF) -> list
There are procedural equivalents for each of these, e.g., run/port* and
run/file*, that take thunk arguments for the subprocess.
(port->string PORT) -> string
Read until EOF on PORT, return data as a string.
(port->string-list PORT) -> string list
Repeatedly apply READ-LINE to PORT until EOF. Return list of lines read.
(port->sexp-list PORT) -> list
Repeatedly apply READ to PORT until EOF. Return list of items read.
(port->list READER PORT)
Repeatedly apply READER to PORT until EOF. Return list of items read.
(reduce-port PORT READER OP . SEEDS)
Evaluate (OP (READER PORT) . SEEDS) to get a new set of seeds
(OP must return as many values as there are SEEDS). When
a port read returns EOF, the current set of seed values are
returned as multiple values.
(run/port+proc . EPF) -> [port proc]
(run/port+proc* THUNK) -> [port proc]
(run/collecting FDS . EPF) -> [port ...]
(run/collecting* FDS THUNK) -> [port ...]
RUN/COLLECTING implicitly backquotes FDS.
(|| PF1 ... PFn)
(&& PF1 ... PFn)
Conditionally execute processes.
(char-filter filter) -> procedure
(string-filter filter [buflen]) -> procedure
* System calls
** Errors
(errno-error errno SYSCALL . DATA)
(with-errno-handler* HANDLER THUNK) -> value of thunk
HANDLER is called on two arguments: (HANDLER ERRNO PACKET)
where PACKET is a list of the form (ERRNO-MSG SYSCALL . DATA)
If HANDLER returns at all, the handler search continues upwards.
(with-errno-handler HANDLER-SPEC . BODY)
HANDLER-SPEC is of the form
((ERRNO PACKET) CLAUSE ...)
ERRNO and PACKET are variables bound to the errno error being raised.
There are two forms for handler clauses:
((ERRNO ...) . BODY)
(else . BODY)
ERRNO are expressions evaluating to errno integers.
** I/O
*** Port Manipulation
(close-after PORT CONSUMER) -> value(s) of consumer
(error-output-port) -> port
(with-current-input-port port . body) -> value(s) of body
(with-current-output-port port . body) -> value(s) of body
(with-error-output-port port . body) -> value(s) of body
(with-current-input-port* port thunk) -> value(s) of thunk
(with-current-output-port* port thunk) -> value(s) of thunk
(with-error-output-port* port thunk) -> value(s) of thunk
(close fd/port)
(stdports->stdio)
(stdio->stdports)
(with-stdio-ports* thunk) -> value(s) of thunk
(with-stdio-ports . body) -> value(s) of body
(make-string-input-port) -> port
(string-output-port-output port) -> port
(call-with-string-output-port proc) -> str
** Port and file descriptors
(fdes->inport fd) -> port
(fdes->outport fd) -> port
(port->fdes port) -> fixnum
Increment port's revealed count.
(port-revealed port) -> integer or #f
(release-port-handle port)
(call/fdes fd/port consumer) -> value(s) of consumer
(move->fdes fd/port target-fd) -> port or fdes
** Unix I/O
(dup fd/port [newfd]) -> fd/port
(dup->inport fd/port [newfd]) -> port
(dup->outport fd/port [newfd]) -> port
(dup->fdes fd/port [newfd]) -> fd
(file-seek fd/port offset whence)
(open-file fname flags [perms]) -> port
(open-input-file fname [flags]) -> port
(open-output-file fname [flags perms]) -> port
(open-fdes fname flags [perms]) -> integer
(fdes-flags fd/port)
(set-fdes-flags fd/port flags)
Only Posix flag defined is FDFLAGS/CLOSE-ON-EXEC, which you should
not ever have to use -- scsh manages this automatically.
(fdes-status fd/port)
(set-fdes-flags fd/port flags)
Operations allowed Flags
------------------ -----
Open+get+set open/append, open/non-blocking
open/async, open/fsync (non-Posix)
Open+get open/read, open/write, open/read+write
open/access-mask
Open only open/create, open/exclusive,
open/no-control-tty, open/truncate
(pipe) -> [rport wport]
(read-line [fd/port retain-newline?]) -> string or eof-object
(read-string nbytes [fd/port]) -> string or #f
(read-string! str [fd/port start end]) -> [nread or #f]
(read-string/partial nbytes [fd/port]) -> string or #f
(read-string!/partial str [fd/port start end]) -> [nread or #f]
(write-string string [fd/port start end])
(write-string/partial string [fd/port start end]) -> nwritten
(force-output [fd/port])
** File locking
(define-record lock-region
exclusive? ; write or read lock?
start ; integer: start, end & whence
end ; integer: define the region being locked.
whence ; The value of SEEK/SET, SEEK/DELTA, or SEEK/END.
proc) ; A proc object for the process locking the region.
(make-lock-region exclusive? start len [whence]) -> lock-region
WHENCE defaults to the value of SEEK/SET.
(lock-region fdes lock)
(lock-region/no-block fdes lock)
(get-lock-region fdes lock) -> lock-region or #f
(unlock-region fdes lock)
(with-region-lock* fdes lock thunk)
(with-region-lock fdes lock body ...) Syntax
** File system
(create-directory fname [perms override?])
(create-fifo fname [perms override?])
(create-hard-link oldname newname [override?])
OVERRIDE? one of {#f, QUERY, other true value}
(delete-directory fname)
(delete-file fname)
(delete-filesys-object fname)
(read-symlink fname) -> string
(rename-file old-fname new-fname [override?])
(set-file-mode fname/fd/port mode)
(set-file-owner fname/fd/port uid)
(set-file-group fname/fd/port gid)
(sync-file fd/port)
(sync-file-system)
(truncate-file fname/fd/port len)
(file-attributes fname/fd/port [chase?]) -> file-info
(define-record file-info
type ; {block-special, char-special, directory,
; fifo, regular, socket, symlink}
device ; Device file resides on.
inode ; File's inode.
mode ; File's permission bits.
nlinks ; Number of hard links to this file.
uid ; Owner of file.
gid ; File's group id.
size ; Size of file, in bytes.
atime ; Last access time.
mtime ; Last status-change time.
ctime) ; Creation time.
Derived procedures:
file-type type
file-inode inode
file-mode mode
file-nlinks nlinks
file-owner uid
file-group gid
file-size size
file-last-access atime
file-last-mod mtime
file-last-status-change ctime
(file-not-readable? fname) -> boolean
(file-not-writable? fname) -> boolean
(file-not-executable? fname) -> boolean
Returns one of
#f Access permitted
SEARCH-DENIED Can't stat---a protected directory
is blocking access.
PERMISSION Permission denied.
NO-DIRECTORY Some directory doesn't exist.
NONEXISTENT File doesn't exist.
(file-readable? fname) -> boolean
(file-writable? fname) -> boolean
(file-executable? fname) -> boolean
(file-not-exists? fname [chase?]) -> boolean
#f Exists.
SEARCH-DENIED Some protected directory
is blocking the search.
#t Doesn't exist.
(file-exists? fname [chase?]) -> boolean
(directory-files [dir dotfiles?]) -> string list
(glob pat1 ...) -> string list
(glob-quote string) -> string
(file-match root dot-files? pat1 ...) -> string list
(create-temp-file [prefix]) -> string
(temp-file-iterate maker [template]) -> [object ...]
TEMPLATE defaults to the value of *TEMP-FILE-TEMPLATE*.
(temp-file-channel) -> [inport outport]
** Processes
(exec prog arg1 ...)
(exec-path prog arg1 ...)
(exec/env prog env arg1 ...)
(exec-path/env prog env arg1 ...)
(%exec prog arglist env)
(exec-path-search fname pathlist) -> string
(exit [status])
(%exit [status])
(suspend)
(fork [thunk]) -> proc or #d
(%fork [thunk]) -> proc or #f
(fork/pipe [thunk]) -> proc or #f
(%fork/pipe [thunk]) -> proc or #f
(fork/pipe+ conns [thunk]) proc or #f
(%fork/pipe+ conns [thunk]) proc or #f
(wait proc/pid [flags]) -> status [proc]
(call-terminally thunk)
** Process state
(umask) -> fixnum
(set-umask perms)
(with-umask* perms thunk) -> values of thunk
(with-umask perms . body) -> values of body
(chdir [fname])
(cwd) -> string
(with-cwd* fname thunk) -> value(s) of thunk
(with-cwd fname . body) -> value(s) of body
(pid) -> fixnum
(parent-pid) -> fixnum
(process-group) -> fixnum
(set-process-group [proc/pid] pgrp)
(user-login-name) -> string
(user-uid) -> fixnum
(user-effective-uid) -> fixnum
(user-gid) -> fixnum
(user-effective-gid) -> fixnum
(user-supplementary-gids) -> fixnum list
(set-uid uid)
(set-gid gid)
(process-times) -> [ucpu scpu uchildren schildren]
** User and group db access
(user-info uid-or-name) -> user-info
(define-record user-info
name
uid
gid
home-dir
shell)
(->uid uid/name) -> fixnum
(->username uid/name) -> string
(group-info gid-or-name) -> record
(define-record group-info
name
gid
members) ; List of uids
(->gid gid/name) -> fixnum
(->group gid/name) -> string
** Accessing command-line arguments
command-line-arguments
Does not include program name
(command-line) -> string list
Includes program name in list.
(arg arglist n [default]) -> string
(arg* arglist n [default-thunk]) -> string
(argv n [default]) -> string
ARG is 1-based access to ARGLIST
ARGV is 0-based access to prog + args
** System parameters
(system-name) -> string
** Signal system
(signal-process proc/pid sig)
(signal-procgroup prgrp sig)
(pause-until-interrupt)
(sleep secs)
Non-signal S48 interrupts
-------------------------
interrupt/memory-shortage
Posix signals with S48 interrupts
------------------------------
signal/alrm interrupt/alrm (aka interrupt/alarm)
signal/int interrupt/int (aka interrupt/int)
signal/chld interrupt/chld
signal/cont interrupt/cont
signal/hup interrupt/hup
signal/quit interrupt/quit
signal/term interrupt/term
signal/tstp interrupt/tstp
signal/usr1 interrupt/usr1
signal/usr2 interrupt/usr2
signal/info interrupt/info Non-Posix
signal/io interrupt/io Non-Posix
signal/poll interrupt/poll Non-Posix
signal/prof interrupt/prof Non-Posix
signal/pwr interrupt/pwr Non-Posix
signal/urg interrupt/urg Non-Posix
signal/vtalrm interrupt/vtalrm Non-Posix
signal/winch interrupt/winch Non-Posix
signal/xcpu interrupt/xcpu Non-Posix
signal/xfsz interrupt/xfsz Non-Posix
Synchronous and uncatchable signals
-----------------------------------
signal/stop Uncatchable Posix
signal/kill Uncatchable Posix
signal/abrt Synchronous Posix
signal/fpe Synchronous Posix
signal/ill Synchronous Posix
signal/pipe Synchronous Posix
signal/segv Synchronous Posix
signal/ttin Synchronous Posix
signal/ttou Synchronous Posix
signal/bus Synchronous BSD + SVR4
signal/emt Synchronous BSD + SVR4
signal/iot Synchronous BSD + SVR4
signal/sys Synchronous BSD + SVR4
signal/trap Synchronous BSD + SVR4
** Interrupt handlers
(signal->interrupt sig) -> interrupt
(interrupt-set integer1 ...) -> integer
(enabled-interrupts) -> integer
(set-enabled-interrupts! integer) -> integer
(with-enabled-interrupts interrupt-set body ...) Syntax
(with-enabled-interrupts* interrupt-set thunk)
(set-interrupt-handler! interrupt handler) -> old-handler
(interrupt-handler interrupt) -> handler
HANDLER is #f (ignored), #t (default), or (lambda (enabled-ints) ...) proc.
** Time
(define-record date
seconds minute hour month-day month year
tz-name tz-secs summer?
week-day year-day)
(make-date sec min hour mday month year [tz-name tz-secs summer? wday yday])
(time+ticks)
(ticks/sec)
(date [time tz])
(time [date])
(date->string date)
(format-date fmt date)
** Environment variables
(setenv var val)
(getenv var) -> string
(env->alist) -> string->string alist
(alist->env alist)
(alist-delete key alist) -> alist
(alist-update key val alist) -> alist
(alist-compress alist) -> alist
(with-env* env-alist-delta thunk) -> value(s) of thunk
(with-total-env* env-alist thunk) -> value(s) of thunk
(with-env env-alist-delta . body) -> value(s) of body
(with-total-env env-alist . body) -> value(s) of body
(add-before elt before list) -> list
(add-after elt after list) -> list
** $USER $HOME, and $PATH
home-directory
exec-path-list
* Networking
** High Level Socket Routines
*** clients
(socket-connect protocol-family/internet socket-type name port) -> socket
(socket-connect protocol-family/unix socket-type pathname) -> socket
*** server
(bind-listen-accept-loop protocol-family/internet proc port) -> does-not-return
(bind-listen-accept-loop protocol-family/unix proc pathname) -> does-not-return
proc is a procedure of two arguments: a socket and a socket-address
** Sockets
(create-socket protocol-family type [protocol]) -> socket
(create-socket-pair type) -> [socket1 socket2]
(close-socket socket) -> undefined
protocol-family/unix
protocol-family/internet
socket-type/stream
socket-type/datagram
for protocol see protocol-info
(define-record socket family inport outport)
** Socket Addresses
(define-record socket-address family)
(unix-address->socket-address pathname) -> socket-address
(internet-address->socket-address host-address service-port)-> socket-address
internet-address/any
internet-address/loopback
internet-address/broadcast
(socket-address->unix-address socket-address) -> pathname
(socket-address->internet-address socket-address) ->
[host-address service-port]
** Low Level Socket Routines
(connect-socket socket socket-address) -> undefined
(bind-socket socket socket-address) -> undefined
(listen-socket socket backlog) -> undefined
(accept-connection socket) -> [new-socket socket-address]
(socket-local-address socket) -> socket-address
(socket-remote-address socket) -> socket-address
(shutdown-socket socket how-to) -> undefined
how-to:
shutdown/receives
shutdown/sends
shutdown/sends+receives
** Socket Specific I/O
see read-string/write-string for info on arguments
(receive-message socket length [flags]) ->
[string-or-#f socket-address]
(receive-message! socket string [start] [end] [flags]) ->
[count-or-#f socket-address]
(receive-message/partial socket length [flags]) ->
[string-or-#f socket-address]
(receive-message!/partial socket string [start] [end] [flags]) ->
[count-or-#f socket-address]
(send-message socket string [start] [end] [flags] [socket-address] ->
undefined
(send-message/partial socket string [start] [end] [flags] [socket-address]) ->
count
** Socket Options
(socket-option socket level option) -> value
(set-socket-option socket level option value) -> undefined
boolean:
socket/debug
socket/accept-connect
socket/reuse-address
socket/keep-alive
socket/dont-route
socket/broadcast
socket/use-loop-back
socket/oob-inline
socket/use-privileged
socket/cant-signal
tcp/no-delay
value:
socket/send-buffer
socket/receive-buffer
socket/send-low-water
socket/receive-low-water
socket/error
socket/type
ip/time-to-live
tcp/max-segment
socket/linger is #f or integer seconds
real number with microsecond resolution:
socket/send-timeout
socket/receive-timeout
** Database-information entries
(host-info name-or-socket-address) -> host-info
(network-info name-or-socket-address) -> network-info
(service-info name-or-number [protocol-name]) -> service-info
(protocol-info name-or-number) -> protocol-info
(define-record host-info name aliases addresses)
(define-record network-info name aliases net)
(define-record service-info name aliases port protocol)
(define-record protocol-info name aliases number)
* String manipulation
** Regular expressions
(string-match regexp string [start]) -> match or false
(regexp-match? obj) -> boolean
(match:start match [match-number]) -> fixnum
(match:end match [match-number]) -> fixnum
(match:substring match [match-number]) -> string
(make-regexp str) -> re
(regexp? obj) -> boolean
(regexp-exec regexp str [start]) -> match or false
(regexp-quote str) -> string
** Other string manipulation facilities
(index string char [start]) -> fixnum or false
(rindex string char [start]) -> fixnum or false
(substitute-env-vars fname) -> string
** Manipulating file-names
** Record I/O and field parsing
(read-delimited char-set [port]) -> string or eof
(read-delimited! char-set buf [port start end]) -> nchars or #f or eof
((record-reader [delims elide-delims? handle-delim]) [port]) -> string or eof
HANDLE-DELIM one of {trim, split, concat}
(read-paragraph [port delimiter?])
** Parsing fields
(field-splitter [regexp num-fields]) -> parser
(infix-splitter [delim num-fields handle-delim]) -> parser
(suffix-splitter [delim num-fields handle-delim]) -> parser
(sloppy-suffix-splitter [delim num-fields handle-delim]) -> parser
Where (parser string [start])
HANDLE-DELIM one of {trim, concat, split}
(join-strings strings [delimiter grammar])
GRAMMAR one of {infix, suffix}
** Field readers
(field-reader [field-parser record-reader])
* Awk
(awk <reader-exp> <rec&field-vars> [<rec-counter>] <state-var-inits>
<clause>
.
.
)
* Miscellaneous routines
** Integer bitwise ops
(arithmetic-shift i j) -> integer
(bitwise-and i j) -> integer
(bitwise-ior i j) -> integer
(bitwise-not i) -> integer
(bitwise-xor i j) -> integer
** ASCII encoding
(char->ascii \character) -> integer
(ascii->char \integer) -> character
** Top level
(repl)
* Running scsh
scsh [meta-arg] [switch1 ...] [end-option arg1 ...]
meta-arg: \ <script-file-name>
switch: -e <entry-point> Top-level entry point
-o <structure> Open structure in current package.
-m <structure> Switch to package.
-n <new-package> Switch to new package.
-lm <module> <file-name> Load module into config package.
-l <file-name> Load file into current package.
-dm Do script module.
-ds Do script.
end-option: -s <script> Specifies script to load.
-sfd <num> Script from file descriptor <num>.
-c <expression> Eval <expression> and exit.
--
scshvm [meta-arg] [vm-options] [end-option arg1 ...]
meta-arg: \ <fname>
vm-options: -h heap-size
-s stack-size
-o object-file
end-option: -i image-file
--
(dump-scsh-program main fname)
** File locations
/usr/local/bin/scsh
/usr/local/lib/scsh/
scshvm
scsh
scsh.image
doc/

4430
doc/external.ps
View File

File diff suppressed because it is too large Load Diff

290
doc/hacking.txt Normal file
View File

@ -0,0 +1,290 @@
,bench
,load-package linker
,new-package =link= linker debuginfo defpackage
,load scripts.scm
(link-initial-system)
To change between initial image starting in mini-command (MINI) and
command (MAXI):
1. Definition of initial system's command module in comp-packages.scm:
MINI: (make-mini-command scheme)
MAXI: (make-command scheme)
2. Location of (define-module (make-command ...)...):
MINI: more-packages.scm
MAXI: comp-packages.scm
3. Location of (define-interface command-interface ...):
MINI: more-interfaces.scm
MAXI: interfaces.scm
> ,new-package z architecture primitives packages table enumerated debug-data
z> (let ((i 0))
(table-walk (lambda (x y) (set! i (+ i 1)))
location-name-table)
i)
1385
z> (vector-length (find-all-xs (name->enumerand 'location stob)))
1259
(vector-length (find-all-xs (name->enumerand 'record stob)))
2150
(find-all-xs (name->enumerand 'record stob))
z> (do ((i 0 (+ i 1))
(j 0 (if (package? (vector-ref rs i)) (+ j 1) j))) ((= i (vector-length rs)) j))
72
z>
> ,new-package z architecture primitives compiler table
z> (vector-ref stob 10)
'template
z> stob
'#(pair symbol vector closure location port ratio record continuation extended-number template weak-pointer external unused-d-header1 unused-d-header2 string code-vector double bignum)
z> (vector-ref stob 7)
'record
z> (define rs (find-all-xs 7))
z> (vector-length rs)
2178
z> (define ls (find-all-xs 4))
z> (vector-length ls)
1266
z>
To get a fresh config package:
,in config (define-structures ((config1 (export)))
(open defpackage built-in-structures more-structures))
,config-package-is config1
To load a linker with a fresh new compiler:
x48 -i new-scheme48.image -h 10000000 <l.s48
Then ,load scripts.scm or whatever.
These are all files not belonging to any package description:
boot-packages.scm
comp-packages.scm
flatload.scm
more-packages.scm
more-interfaces.scm
rts-packages.scm
scripts.scm
interfaces.scm
infix/
debug/
alt/
link/p-features.scm
link/p-record.scm
link/t-features.scm
link/t-record.scm
misc/icon.scm
misc/mail.scm -- related to more-thread.scm
misc/more-thread.scm -- needs work
misc/sicp.scm -- add to more-packages
,load-package rk-extensions
,new-package rk-user rk-extensions
,user-package-is rk-user
# If initial images starts in mini-command instead of command, the
# rule for $(IMAGE) becomes something like this:
# (echo ,load more-interfaces.scm $(S48ROOT)/more-packages.scm; \
# echo "(ensure-loaded command)"; \
# echo ",go ((structure-ref command 'command-processor) batch)"; \
,in config (define-structures ((reification (export reify-structures)))
(open scheme-level-2 table
signals ;error
packages
features ;location-id location?
scan) ;find-free-names-in-syntax-rules
(files (link reify)))
,load-package reification
debug-config> ,in reification reify-structures
'#{Procedure 8447 reify-structures}
debug-config> (define reify-structures ##)
debug-config> make-simple-package
Error: undefined variable
make-simple-package
(package debug-config)
1 debug-config>
debug-config> (define-structures ((p (export start))) (open initial-system scheme-level-2 packages))
debug-config> (define go (in p `(start ,(reify-structures (desirable-packages) (lambda (loc) `',loc)))))
### Small images for exercising the linker and/or runtime system
debug/tiny.image: debug/tiny.scm $(LINKER_IMAGE)
($(START_LINKER_RUNNABLE) \
echo "(load \"debug/tiny-packages.scm\")"; \
echo "(link-simple-system '(debug tiny) 'start tiny-system)") \
| $(LINKER_RUNNABLE) -i $(LINKER_IMAGE)
debug/little.image: $(LINKER_IMAGE) $(CONFIG_FILES) $(little-files)
($(START_LINKER_RUNNABLE) \
echo "(load \"scripts.scm\")"; \
echo "(link-little-system)") \
| $(LINKER_RUNNABLE) -i $(LINKER_IMAGE) $(BIG_HEAP)
debug/medium.image: $(LINKER_IMAGE) $(CONFIG_FILES) $(medium-files)
($(START_LINKER_RUNNABLE) \
echo "(load \"scripts.scm\")"; \
echo "(link-medium-system)") \
| $(LINKER_RUNNABLE) -i $(LINKER_IMAGE) $(BIG_HEAP)
echo "(define l-f (package-all-filenames little-system))"; \
echo "(define m-f (package-all-filenames medium-system))"; \
'little-files l-f 'medium-files m-f \
[The following is from June 1992, and probably not quite compatible
with the current compiler internals.]
To eliminate use of the stack GC to implement tail recursion, change
comp.scm as follows:
(define (compile-unknown-call exp cenv depth cont)
(note-source-code
exp
(maybe-push-continuation (sequentially
(push-all (cdr exp) cenv 0)
(compile (car exp)
cenv
(length (cdr exp))
(fall-through-cont))
(instruction (if (return-cont? cont)
op/move-args-and-call
op/call)
(length (cdr exp))))
depth
cont)))
--------------------
Here's another cool thing. 6/28/93
(define-interface evaluation-interface
(export eval load eval-from-file))
(define-structure run evaluation-interface
(open scheme-level-2 syntactic packages scan
environments
signals
locations
features ;force-output
table
fluids)
(files (debug run)))
,load-package run
,in run
,in package-commands (environment-for-syntax-promise)
(define cool (make-simple-package (list scheme) eval ## 'cool))
,in command set-environment-for-commands!
(## cool)
cool> ,inspect (lambda (x) x)
'#{Procedure 6394}
[0: exp] '(lambda (x) x)
[1: env] '#{Package 286 cool}
inspect:
inspect: q
cool>
(define (z s)
(define (show-type name static)
(write name)
(display " : ")
(write (static-type static))
(newline))
(if (package? s)
(for-each-definition (lambda (name static loc)
(show-type name static))
s)
(interface-walk (lambda (name type)
(show-type name
(car (structure-lookup
s name #t))))
(structure-interface s))))
; ,open expander syntactic packages reconstruction
(define (e x)
(let ((p (interaction-environment)))
(let ((node (expand-form x p)))
(write (node-type node (package->environment p)))
(newline)
(eval node p))))
> (define hunk3 (lap hunk3
0 (check-nargs= 3)
2 (pop)
3 (make-stored-object 3 0)
6 (return)))
> (hunk3 1 2 3)
'(1 . 2)
> (define cxr (lap cxr
0 (check-nargs= 2)
2 (pop)
3 (stored-object-indexed-ref 0)
5 (return)))
> (cxr (hunk3 1 2 3) 2)
3
>
(define-syntax %cons
(lambda (e r c)
(let ((n (cadr e))
(kind (caddr e)))
`(,(r 'lap) (%cons ,n ,kind)
(check-nargs= ,n)
(pop)
(make-stored-object ,n ,kind)
(return)))))
(define (& x)
(or (node-ref x 'uid)
(begin (set! *n* (+ *n* 1))
(node-set! x 'uid *n*)
*n*))
x)
(define (uid n) (node-ref (& n) 'uid))
(define *n* 0)

690
doc/html/external.html
View File

@ -1,690 +0,0 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<!-- HTML file produced from file: external.tex --
-- using Hyperlatex v 2.3.1 (c) Otfried Cheong--
-- on Emacs 19.34.1, Tue Feb 23 18:21:44 1999 -->
<HEAD>
<TITLE>Mixing Scheme 48 and C</TITLE>
</HEAD><BODY>
<H1 ALIGN=CENTER>Using C code with Scheme 48</H1>
<H2 ALIGN=CENTER>Mike Sperber<BR><TT><FONT SIZE=-1>sperber@informatik.uni-tuebingen.de</FONT></TT><BR>Richard Kelsey<BR><TT><FONT SIZE=-1>kelsey@research.nj.nec.com</FONT></TT>
</H2>
<H3 ALIGN=CENTER>February 23, 1999</H3>
<H3 ALIGN=CENTER>Abstract</H3>
<BLOCKQUOTE>
This document describes an interface for calling C functions
from Scheme, calling Scheme functions from C, and allocating
storage in the Scheme heap.
These facilities are designed to link
existing C libraries into Scheme&nbsp;48 in order to use them from Scheme.
To this end, Scheme&nbsp;48 manages stub functions in C that
negotiate between the calling conventions of Scheme and C and the
memory allocation policies of both worlds.
No stub generator is available yet, but writing them is a straightforward task.
</BLOCKQUOTE>
<H1><A NAME="1">Available Facilities</A></H1>
<P>The following facilities are available for interfacing between
Scheme&nbsp;48 and C:
<UL><LI>Scheme code can call C functions.
<LI>The external interface provides full introspection for all
Scheme objects. External code may inspect, modify, and allocate
Scheme objects arbitrarily.
<LI>External code may raise exceptions back to Scheme&nbsp;48 to
signal errors.
<LI>External code may call back into Scheme. Scheme&nbsp;48
correctly unrolls the process stack on non-local exits.
<LI>External modules may register bindings of names to values with a
central registry accessible from
Scheme. Conversely, Scheme code can register shared
bindings for access by C code.
</UL>
This document has three parts: the first describes how bindings are
moved from Scheme to C and vice versa, the second tells how to call
C functions from Scheme, and the third covers the C interface
to Scheme objects, including calling Scheme procedures, using the
Scheme heap, and so forth.
<H2><A NAME="2">Scheme structures</A></H2>
<P>The structure <CODE>external-calls</CODE> has
most of the Scheme functions described here.
The others are in
<CODE>dynamic-externals</CODE>, which has the functions for dynamic loading and
name lookup from
the section on <A HREF="#dynamic-externals">Dynamic Loading</A>,
and <CODE>shared-bindings</CODE>, which has the additional shared-binding functions
described in
the section on the <A HREF="#more-shared-bindings">complete shared-binding interface</A>.
<H2><A NAME="3">C naming conventions</A></H2>
<P>The names of all of Scheme&nbsp;48's visible C bindings begin
with `<CODE>s48_</CODE>' (for procedures and variables) or
`<CODE>S48_</CODE>' (for macros).
Whenever a C name is derived from a Scheme identifier, we
replace `<CODE>-</CODE>' with `<CODE>_</CODE>' and convert letters to lowercase
for procedures and uppercase for macros.
A final `<CODE>?</CODE>' converted to `<CODE>_p</CODE>' (`<CODE>_P</CODE>' in C macro names).
A final `<CODE>!</CODE>' is dropped.
Thus the C macro for Scheme's <CODE>pair?</CODE> is <CODE>S48_PAIR_P</CODE> and
the one for <CODE>set-car!</CODE> is <CODE>S48_SET_CAR</CODE>.
Procedures and macros that do not check the types of their arguments
have `<CODE>unsafe</CODE>' in their names.
<P>All of the C functions and macros described have prototypes or definitions
in the file <CODE>c/scheme48.h</CODE>.
The C type for Scheme values is defined there to be <CODE>s48_value</CODE>.
<H1><A NAME="4">Shared bindings</A></H1>
<P>Shared bindings are the means by which named values are shared between Scheme
code and C code.
There are two separate tables of shared bindings, one for values defined in
Scheme and accessed from C and the other for values going the other way.
Shared bindings actually bind names to cells, to allow a name to be looked
up before it has been assigned.
This is necessary because C initialization code may be run before or after
the corresponding Scheme code, depending on whether the Scheme code is in
the resumed image or is run in the current session.
<H2><A NAME="5">Exporting Scheme values to C</A></H2>
<UL><LI><CODE>(define-exported-binding<I>&nbsp;name&nbsp;value</I>)&nbsp;-&gt;&nbsp;<I>shared-binding</I></CODE>
</UL>
<UL><LI><CODE>s48_value s48_get_imported_binding(char *name)</CODE>
<LI><CODE>s48_value S48_SHARED_BINDING_REF(s48_value shared_binding)</CODE>
</UL>
<P><CODE>Define-exported-binding</CODE> makes <CODE><I>value</I></CODE> available to C code
under as <CODE><I>name</I></CODE> which must be a <CODE><I>string</I></CODE>, creating a new shared
binding if necessary.
The C function <CODE>s48_get_imported_binding</CODE> returns the shared binding
defined for <CODE>name</CODE>, again creating it if necessary.
The C macro <CODE>S48_SHARED_BINDING_REF</CODE> dereferences a shared binding,
returning its current value.
<H2><A NAME="6">Exporting C values to Scheme</A></H2>
<UL><LI><CODE>void s48_define_exported_binding(char *name, s48_value value)</CODE>
</UL>
<UL><LI><CODE>(lookup-imported-binding<I>&nbsp;string</I>)&nbsp;-&gt;&nbsp;<I>shared-binding</I></CODE>
<LI><CODE>(shared-binding-ref<I>&nbsp;shared-binding</I>)&nbsp;-&gt;&nbsp;<I>value</I></CODE>
</UL>
<P>These are used to define shared bindings from C and to access them
from Scheme.
Again, if a name is looked up before it has been defined, a new binding is
created for it.
<P>The common case of exporting a C function to Scheme can be done using
the macro <CODE>S48_EXPORT_FUNCTION(<EM>name</EM>)</CODE>.
This expands into
<P><CODE>s48_define_exported_binding("<CODE><I>name</I></CODE>", s48_enter_pointer(<CODE><I>name</I></CODE>))</CODE>
<P>which boxes the function into a Scheme byte vector and then
exports it.
Note that <CODE>s48_enter_pointer</CODE> allocates space in the Scheme heap
and might trigger a
<A HREF="#gc">garbage collection</A>.
<UL><LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>(import-definition <CODE><I>name</I></CODE>)</CODE></td> <td align=right>syntax</td></tr></table>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>(import-definition <CODE><I>name&nbsp;c-name</I></CODE>)</CODE></td> <td align=right>syntax</td></tr></table>
</UL>
These macros simplify importing definitions from C to Scheme.
They expand into
<P><CODE>(define <CODE><I>name</I></CODE> (lookup-imported-binding <CODE><I>c-name</I></CODE>))</CODE>
<P>where <CODE><I>c-name</I></CODE> is as supplied for the second form.
For the first form <CODE><I>c-name</I></CODE> is derived from <CODE><I>name</I></CODE> by
replacing `<CODE>-</CODE>' with `<CODE>_</CODE>' and converting letters to lowercase.
For example, <CODE>(import-definition my-foo)</CODE> expands into
<P><CODE>(define my-foo (lookup-imported-binding "my_foo"))</CODE>
<H2><A NAME="more-shared-bindings">Complete shared binding interface</A></H2>
<P>There are a number of other Scheme functions related to shared bindings;
these are in the structure <CODE>shared-bindings</CODE>.
<UL><LI><CODE>(shared-binding?<I>&nbsp;x</I>)&nbsp;-&gt;&nbsp;<I>boolean</I></CODE>
<LI><CODE>(shared-binding-name<I>&nbsp;shared-binding</I>)&nbsp;-&gt;&nbsp;<I>string</I></CODE>
<LI><CODE>(shared-binding-is-import?<I>&nbsp;shared-binding</I>)&nbsp;-&gt;&nbsp;<I>boolean</I></CODE>
<LI><CODE>(shared-binding-set!<I>&nbsp;shared-binding&nbsp;value</I>)</CODE>
<LI><CODE>(define-imported-binding<I>&nbsp;string&nbsp;value</I>)</CODE>
<LI><CODE>(lookup-exported-binding<I>&nbsp;string</I>)</CODE>
<LI><CODE>(undefine-imported-binding<I>&nbsp;string</I>)</CODE>
<LI><CODE>(undefine-exported-binding<I>&nbsp;string</I>)</CODE>
</UL>
<P><CODE>Shared-binding?</CODE> is the predicate for shared-bindings.
<CODE>Shared-binding-name</CODE> returns the name of a binding.
<CODE>Shared-binding-is-import?</CODE> is true if the binding was defined from C.
<CODE>Shared-binding-set!</CODE> changes the value of a binding.
<CODE>Define-imported-binding</CODE> and <CODE>lookup-exported-binding</CODE> are
Scheme versions of <CODE>s48_define_exported_binding</CODE>
and <CODE>s48_lookup_imported_binding</CODE>.
The two <CODE>undefine-</CODE> procedures remove bindings from the two tables.
They do nothing if the name is not found in the table.
<P>The following C macros correspond to the Scheme functions above.
<UL><LI><CODE>int S48_SHARED_BINDING_P(x)</CODE>
<LI><CODE>int S48_SHARED_BINDING_IS_IMPORT_P(s48_value s_b)</CODE>
<LI><CODE>s48_value S48_SHARED_BINDING_NAME(s48_value s_b)</CODE>
<LI><CODE>void S48_SHARED_BINDING_SET(s48_value s_b, s48_value value)</CODE>
</UL>
<H1><A NAME="8">Calling C Functions from Scheme</A></H1>
<P>There are three different ways to call C functions from Scheme, depending on
how the C function was obtained.
<UL><LI><CODE>(call-imported-binding<I>&nbsp;binding&nbsp;arg<I><sub>0</sub></I>&nbsp;...</I>)&nbsp;-&gt;&nbsp;<I>value</I></CODE>
<LI><CODE>(call-external<I>&nbsp;external&nbsp;arg<I><sub>0</sub></I>&nbsp;...</I>)&nbsp;-&gt;&nbsp;<I>value</I></CODE>
<LI><CODE>(call-external-value<I>&nbsp;value&nbsp;name&nbsp;arg<I><sub>0</sub></I>&nbsp;...</I>)&nbsp;-&gt;&nbsp;<I>value</I></CODE>
</UL>
Each of these applies its first argument, a C function, to the rest of
the arguments.
For <CODE>call-imported-binding</CODE> the function argument must be an
imported binding.
For <CODE>call-external</CODE> the function argument must be an external
bound in the current process
(see
the section on <A HREF="#dynamic-externals">Dynamic Loading</A>).
For <CODE>call-external-value</CODE> <CODE><I>value</I></CODE> must be a byte vector
whose contents is a pointer to a C function and <CODE><I>name</I></CODE> should be
a string naming the function.
The <CODE><I>name</I></CODE> argument is used only for printing error messages.
<P>For all of these, the C function is passed the <CODE><I>arg<I><sub>i</sub></I></I></CODE> values
and the value returned is that returned by C procedure.
Up to twelve arguments may be passed.
There is no method supplied for returning multiple values to
Scheme from C (or vice versa) (mainly because C does not have multiple return
values).
<P>Keyboard interrupts that occur during a call to a C function are ignored
until the function returns to Scheme (this is clearly a
problem; we are working on a solution).
<UL><LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>(import-lambda-definition <CODE><I>name</I></CODE> (<CODE><I>formal</I></CODE> ...))</CODE></td> <td align=right>syntax</td></tr></table>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>(import-lambda-definition <CODE><I>name</I></CODE> (<CODE><I>formal</I></CODE> ...) <CODE><I>c-name</I></CODE>)</CODE></td> <td align=right>syntax</td></tr></table>
</UL>
These macros simplify importing functions from C.
They define <CODE><I>name</I></CODE> to be a function with the given formals that
applies those formals to the corresponding C binding.
<CODE><I>C-name</I></CODE>, if supplied, should be a string.
These expand into
<BLOCKQUOTE><PRE>
(define temp (lookup-imported-binding <CODE><I>c-name</I></CODE>))
(define <CODE><I>name</I></CODE>
(lambda (<CODE><I>formal</I></CODE> ...)
(external-apply temp <CODE><I>formal</I></CODE> ...)))
</PRE></BLOCKQUOTE>
<P>
If <CODE><I>c-name</I></CODE> is not supplied, it is derived from <CODE><I>name</I></CODE> by converting
all letters to lowercase and replacing `<CODE>-</CODE>' with `<CODE>_</CODE>'.
<H1><A NAME="9">Adding external modules to the <CODE>Makefile</CODE></A></H1>
<P>Getting access to C bindings from Scheme requires that the C code be
compiled an linked in with the Scheme&nbsp;48 virtual machine and that the
relevent shared-bindings be created.
The Scheme&nbsp;48 makefile has rules for compiling and linking external code
and for specifying initialization functions that should be called on
startup.
There are three Makefile variables that control which external modules are
included in the executable for the virutal machine (<CODE>scheme48vm</CODE>).
<CODE>EXTERNAL_OBJECTS</CODE> lists the object files to be included in
<CODE>scheme48vm</CODE>,
<CODE>EXTERNAL_FLAGS</CODE> is a list of <CODE>ld</CODE> flags to be used when
creating <CODE>scheme48vm</CODE>, and
<CODE>EXTERNAL_INITIALIZERS</CODE> is a list of C procedures to be called
on startup.
The procedures listed in <CODE>EXTERNAL_INITIALIZERS</CODE> should take no
arguments and have a return type of <CODE>void</CODE>.
After changing the definitions of any of these variables you should
do <CODE>make scheme48vm</CODE> to rebuild the virtual machine.
<H1><A NAME="dynamic-externals">Dynamic Loading</A></H1>
<P>External code can be loaded into a running Scheme&nbsp;48 process
and C object-file bindings can be dereferenced at runtime and
their values called
(although not all versions of Unix support all of this).
The required Scheme functions are in the structure <CODE>dynamic-externals</CODE>.
<UL><LI><CODE>(dynamic-load<I>&nbsp;string</I>)</CODE>
</UL>
<CODE>Dynamic-load</CODE> loads the named file into the current
process, raising an exception if the file cannot be found or if dynamic
loading is not supported by the operating system.
The file must have been compiled and linked appropriately.
For Linux, the following commands compile <CODE>foo.c</CODE> into a
file <CODE>foo.so</CODE> that can be loaded dynamically.
<BLOCKQUOTE><PRE>
% gcc -c -o foo.o foo.c
% ld -shared -o foo.so foo.o
</PRE></BLOCKQUOTE>
<UL><LI><CODE>(get-external<I>&nbsp;string</I>)&nbsp;-&gt;&nbsp;<I>external</I></CODE>
<LI><CODE>(external?<I>&nbsp;x</I>)&nbsp;-&gt;&nbsp;<I>boolean</I></CODE>
<LI><CODE>(external-name<I>&nbsp;external</I>)&nbsp;-&gt;&nbsp;<I>string</I></CODE>
<LI><CODE>(external-value<I>&nbsp;external</I>)&nbsp;-&gt;&nbsp;<I>byte-vector</I></CODE>
</UL>
These functions give access to values bound in the current process, and
are used for retrieving values from dynamically-loaded files.
<CODE>Get-external</CODE> returns an <I>external</I> object that contains the
value of <CODE><I>name</I></CODE>, raising an exception if there is no such
value in the current process.
<CODE>External?</CODE> is the predicate for externals, and
<CODE>external-name</CODE> and <CODE>external-value</CODE> return the name and
value of an external.
The value is returned as byte vector of length four (on 32-bit
architectures).
The value is that which was extant when <CODE>get-external</CODE> was
called.
The following two functions can be used to update the values of
externals.
<UL><LI><CODE>(lookup-external<I>&nbsp;external</I>)&nbsp;-&gt;&nbsp;<I>boolean</I></CODE>
<LI><CODE>(lookup-all-externals<I></I>)&nbsp;-&gt;&nbsp;<I>boolean</I></CODE>
</UL>
<CODE>Lookup-external</CODE> updates the value of <CODE><I>external</I></CODE> by looking its
name in the current process, returning <CODE>#t</CODE> if it is bound and <CODE>#f</CODE>
if it is not.
<CODE>Lookup-all-externals</CODE> calls <CODE>lookup-external</CODE> on all extant
externals, returning <CODE>#f</CODE> any are unbound.
<UL><LI><CODE>(call-external<I>&nbsp;external&nbsp;arg<I><sub>0</sub></I>&nbsp;...</I>)&nbsp;-&gt;&nbsp;<I>value</I></CODE>
</UL>
An external whose value is a C procedure can be called using
<CODE>call-external</CODE>.
See
the section on <A HREF="#8">calling C functions from Scheme</A>
for more information.
<P>In some versions of Unix retrieving a value from the current
process may require a non-trivial amount of computation.
We recommend that a dynamically-loaded file contain a single initialization
procedure that creates shared bindings for the values exported by the file.
<H1><A NAME="11">Compatibility</A></H1>
<P>Scheme&nbsp;48's old <CODE>external-call</CODE> function is still available in the structure
<CODE>externals</CODE>, which now also includes <CODE>external-name</CODE> and
<CODE>external-value</CODE>.
The old <CODE>scheme48.h</CODE> file has been renamed <CODE>old-scheme48.h</CODE>.
<H1><A NAME="12">Accessing Scheme data from C</A></H1>
<P>The C header file <CODE>scheme48.h</CODE> provides
access to Scheme&nbsp;48 data structures
(for compatibility, the old <CODE>scheme48.h</CODE> file is available
as <CODE>old-scheme48.h</CODE>).
The type <CODE>s48_value</CODE> is used for Scheme values.
When the type of a value is known, such as the integer returned
by <CODE>vector-length</CODE> or the boolean returned by <CODE>pair?</CODE>,
the corresponding C procedure returns a C value of the appropriate
type, and not a <CODE>s48_value</CODE>.
Predicates return <CODE>1</CODE> for true and <CODE>0</CODE> for false.
<H2><A NAME="13">Constants</A></H2>
<P>The following macros denote Scheme constants:
<DL><DT><B><CODE>S48_FALSE</CODE></B><DD> is <CODE>#f</CODE>.
<DT><B><CODE>S48_TRUE</CODE></B><DD> is <CODE>#t</CODE>.
<DT><B><CODE>S48_NULL</CODE></B><DD> is the empty list.
<DT><B><CODE>S48_UNSPECIFIC</CODE></B><DD> is a value used for functions which have no
meaningful return value
(in Scheme this value returned by the nullary procedure <CODE>unspecific</CODE>
in the structure <CODE>util</CODE>).
<DT><B><CODE>S48_EOF</CODE></B><DD> is the end-of-file object
(in Scheme this value is returned by the nullary procedure <CODE>eof-object</CODE>
in the structure <CODE>i/o-internal</CODE>).
</DL>
<H2><A NAME="14">Converting values</A></H2>
<P>The following functions convert values between Scheme and C
representations.
The `extract' ones convert from Scheme to C and the `enter's go the other
way.
<UL><LI><CODE>unsigned char s48_extract_char(s48_value)</CODE>
<LI><CODE>char * s48_extract_string(s48_value)</CODE>
<LI><CODE>long s48_extract_integer(s48_value)</CODE>
<LI><CODE>double s48_extract_double(s48_value)</CODE>
<LI><CODE>s48_value s48_enter_char(unsigned char)</CODE>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value s48_enter_string(char *)</CODE></td> <td align=right>(may GC)</td></tr></table>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value s48_enter_integer(long)</CODE></td> <td align=right>(may GC)</td></tr></table>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value s48_enter_double(double)</CODE></td> <td align=right>(may GC)</td></tr></table>
</UL>
<P>The value returned by <CODE>s48_extract_string</CODE> points to the actual
storage used by the string; it is valid only until the next
<A HREF="#gc">garbage collection</A>.
<P><CODE>s48_enter_integer()</CODE> needs to allocate storage when
its argument is too large to fit in a Scheme&nbsp;48 fixnum.
In cases where the number is known to fit within a fixnum (currently 30 bits
including the sign), the following procedures can be used.
These have the disadvantage of only having a limited range, but
the advantage of never causing a garbage collection.
<UL><LI><CODE>long s48_extract_fixnum(s48_value)</CODE>
<LI><CODE>s48_value s48_enter_fixnum(long)</CODE>
<LI><CODE>long S48_MAX_FIXNUM_VALUE</CODE>
<LI><CODE>long S48_MIN_FIXNUM_VALUE</CODE>
</UL>
<P>An error is signalled if <CODE>s48_extract_fixnum</CODE>'s argument
is not a fixnum or if the argument to <CODE>s48_enter_fixnum</CODE> is less than
<CODE>S48_MIN_FIXNUM_VALUE</CODE> or greater than <CODE>S48_MAX_FIXNUM_VALUE</CODE>
(<I>-2<sup>29</sup></I> and <I>2<sup>29</sup>-1</I> in the current system).
<H2><A NAME="15">C versions of Scheme procedures</A></H2>
<P>The following macros and procedures are C versions of Scheme procedures.
The names were derived by replacing `<CODE>-</CODE>' with `<CODE>_</CODE>',
`<CODE>?</CODE>' with `<CODE>p</CODE>', and dropping `<CODE>!</CODE>.
<UL><LI><CODE>int S48_EQ_P(s48_value)</CODE>
<LI><CODE>int S48_CHAR_P(s48_value)</CODE>
<LI><CODE>int S48_INTEGER_P(s48_value)</CODE>
</UL>
<UL><LI><CODE>int S48_PAIR_P(s48_value)</CODE>
<LI><CODE>s48_value S48_CAR(s48_value)</CODE>
<LI><CODE>s48_value S48_CDR(s48_value)</CODE>
<LI><CODE>void S48_SET_CAR(s48_value, s48_value)</CODE>
<LI><CODE>void S48_SET_CDR(s48_value, s48_value)</CODE>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value s48_cons(s48_value, s48_value)</CODE></td> <td align=right>(may GC)</td></tr></table>
<LI><CODE>long s48_length(s48_value)</CODE>
</UL>
<UL><LI><CODE>int S48_VECTOR_P(s48_value)</CODE>
<LI><CODE>long S48_VECTOR_LENGTH(s48_value)</CODE>
<LI><CODE>s48_value S48_VECTOR_REF(s48_value, long)</CODE>
<LI><CODE>void S48_VECTOR_SET(s48_value, long, s48_value)</CODE>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value s48_make_vector(long, s48_value)</CODE></td> <td align=right>(may GC)</td></tr></table>
</UL>
<UL><LI><CODE>int S48_STRING_P(s48_value)</CODE>
<LI><CODE>long S48_STRING_LENGTH(s48_value)</CODE>
<LI><CODE>char S48_STRING_REF(s48_value, long)</CODE>
<LI><CODE>void S48_STRING_SET(s48_value, long, char)</CODE>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value s48_make_string(long, char)</CODE></td> <td align=right>(may GC)</td></tr></table>
</UL>
<UL><LI><CODE>int S48_SYMBOL_P(s48_value)</CODE>
<LI><CODE>s48_value s48_SYMBOL_TO_STRING(s48_value)</CODE>
</UL>
<UL><LI><CODE>int S48_BYTE_VECTOR_P(s48_value)</CODE>
<LI><CODE>long S48_BYTE_VECTOR_LENGTH(s48_value)</CODE>
<LI><CODE>char S48_BYTE_VECTOR_REF(s48_value, long)</CODE>
<LI><CODE>void S48_BYTE_VECTOR_SET(s48_value, long, int)</CODE>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value s48_make_byte_vector(long, int)</CODE></td> <td align=right>(may GC)</td></tr></table>
</UL>
<H1><A NAME="16">Calling Scheme functions from C</A></H1>
<P>External code that has been called from Scheme can call back to Scheme
procedures using the following function.
<UL><LI><CODE>scheme_value s48_call_scheme(s48_value proc, long nargs, ...)</CODE>
</UL>
This calls the Scheme procedure <CODE>proc</CODE> on <CODE>nargs</CODE>
arguments, which are passed as additional arguments to <CODE>s48_call_scheme</CODE>.
There may be at most ten arguments.
The value returned by the Scheme procedure is returned by the C procedure.
Invoking any Scheme procedure may potentially cause a garbage collection.
<P>There are some complications that occur when mixing calls from C to Scheme
with continuations and threads.
C only supports downward continuations (via <CODE>longjmp()</CODE>).
Scheme continuations that capture a portion of the C stack have to follow the
same restriction.
For example, suppose Scheme procedure <CODE>s0</CODE> captures continuation <CODE>a</CODE>
and then calls C procedure <CODE>c0</CODE>, which in turn calls Scheme procedure
<CODE>s1</CODE>.
Procedure <CODE>s1</CODE> can safely call the continuation <CODE>a</CODE>, because that
is a downward use.
When <CODE>a</CODE> is called Scheme&nbsp;48 will remove the portion of the C stack used
by the call to <CODE>c0</CODE>.
On the other hand, if <CODE>s1</CODE> captures a continuation, that continuation
cannot be used from <CODE>s0</CODE>, because by the time control returns to
<CODE>s0</CODE> the C stack used by <CODE>c0</CODE> will no longer be valid.
An attempt to invoke an upward continuation that is closed over a portion
of the C stack will raise an exception.
<P>In Scheme&nbsp;48 threads are implemented using continuations, so the downward
restriction applies to them as well.
An attempt to return from Scheme to C at a time when the appropriate
C frame is not on top of the C stack will cause the current thread to
block until the frame is available.
For example, suppose thread <CODE>t0</CODE> calls a C procedure which calls back
to Scheme, at which point control switches to thread <CODE>t1</CODE>, which also
calls C and then back to Scheme.
At this point both <CODE>t0</CODE> and <CODE>t1</CODE> have active calls to C on the
C stack, with <CODE>t1</CODE>'s C frame above <CODE>t0</CODE>'s.
If thread <CODE>t0</CODE> attempts to return from Scheme to C it will block,
as its frame is not accessable.
Once <CODE>t1</CODE> has returned to C and from there to Scheme, <CODE>t0</CODE> will
be able to resume.
The return to Scheme is required because context switches can only occur while
C code is running.
<CODE>T0</CODE> will also be able to resume if <CODE>t1</CODE> uses a continuation to
throw past its call to C.
<H1><A NAME="gc">Interacting with the Scheme Heap</A></H1>
<P>Scheme&nbsp;48 uses a copying, precise garbage collector.
Any procedure that allocates objects within the Scheme&nbsp;48 heap may trigger
a garbage collection.
Variables bound to values in the Scheme&nbsp;48 heap need to be registered with
the garbage collector so that the value will be retained and so that the
variables will be updated if the garbage collector moves the object.
The garbage collector has no facility for updating pointers to the interiors
of objects, so such pointers, for example the ones returned by
<CODE>EXTRACT_STRING</CODE>, will likely become invalid when a garbage collection
occurs.
<H2><A NAME="18">Registering Objects with the GC</A></H2>
<P>A set of macros are used to manage the registration of local variables with the
garbage collector.
<UL><LI><CODE>S48_DECLARE_GC_PROTECT(<I>n</I>)</CODE>
<LI><CODE>void S48_GC_PROTECT_<I>n</I>(s48_value<I><sub>1</sub></I>, <I>...</I>, s48_value<I><sub>n</sub></I>)</CODE>
<LI><CODE>void S48_GC_UNPROTECT()</CODE>
</UL>
<P><CODE>S48_DECLARE_GC_PROTECT(<I>n</I>)</CODE>, where <I>1 &lt;= n &lt;= 9</I>, allocates
storage for registering <I>n</I> variables.
At most one use of <CODE>S48_DECLARE_GC_PROTECT</CODE> may occur in a block.
<CODE>S48_GC_PROTECT_<I>n</I>(<I>v<sub>1</sub></I>, <I>...</I>, <I>v<sub>n</sub></I>)</CODE> registers the
<I>n</I> variables (l-values) with the garbage collector.
It must be within scope of a <CODE>S48_DECLARE_GC_PROTECT(<I>n</I>)</CODE>
and be before any code which can cause a GC.
<CODE>S48_GC_UNPROTECT</CODE> removes the block's protected variables from
the garbage collectors list.
It must be called at the end of the block after
any code which may cause a garbage collection.
Omitting any of the three may cause serious and
hard-to-debug problems.
Notably, the garbage collector may relocate an object and
invalidate <CODE>s48_value</CODE> variables which are not protected.
<P>A <CODE>gc-protection-mismatch</CODE> exception is raised if, when a C
procedure returns to Scheme, the calls
to <CODE>S48_GC_PROTECT()</CODE> have not been matched by an equal number of
calls to <CODE>S48_GC_UNPROTECT()</CODE>.
<P>Global variables may also be registered with the garbage collector.
<UL><LI><CODE>void S48_GC_PROTECT_GLOBAL(<CODE><I>value</I></CODE>)</CODE>
</UL>
<P><CODE>S48_GC_PROTECT_GLOBAL</CODE> permanently registers the
variable <CODE><I>value</I></CODE> (an l-value) with the garbage collector.
There is no way to unregister the variable.
<H2><A NAME="19">Keeping C data structures in the Scheme heap</A></H2>
<P>C data structures can be kept in the Scheme heap by embedding them
inside byte vectors.
The following macros can be used to create and access embedded C objects.
<UL><LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value S48_MAKE_VALUE(type)</CODE></td> <td align=right>(may GC)</td></tr></table>
<LI><CODE>type S48_EXTRACT_VALUE(s48_value, type)</CODE>
<LI><CODE>type * S48_EXTRACT_VALUE_POINTER(s48_value, type)</CODE>
<LI><CODE>void S48_SET_VALUE(s48_value, type, value)</CODE>
</UL>
<P><CODE>S48_MAKE_VALUE</CODE> makes a byte vector large enough to hold an object
whose type is <CODE><I>type</I></CODE>.
<CODE>S48_EXTRACT_VALUE</CODE> returns the contents of a byte vector cast to
<CODE><I>type</I></CODE>, and <CODE>S48_EXTRACT_VALUE_POINTER</CODE> returns a pointer
to the contents of the byte vector.
The value returned by <CODE>S48_EXTRACT_VALUE_POINTER</CODE> is valid only until
the next <A HREF="#gc">garbage collection</A>.
<P><CODE>S48_SET_VALUE</CODE> stores <CODE>value</CODE> into the byte vector.
<H2><A NAME="20">C code and heap images</A></H2>
<P>Scheme&nbsp;48 uses dumped heap images to restore a previous system state.
The Scheme&nbsp;48 heap is written into a file in a machine-independent and
operating-system-independent format.
The procedures described above may be used to create objects in the
Scheme heap that contain information specific to the current
machine, operating system, or process.
A heap image containing such objects may not work correctly on
when resumed.
<P>To address this problem, a record type may be given a `resumer'
procedure.
On startup, the resumer procedure for a type is applied to each record of
that type in the image being restarted.
This procedure can update the record in a manner appropriate to
the machine, operating system, or process used to resume the
image.
<UL><LI><CODE>(define-record-resumer<I>&nbsp;record-type&nbsp;procedure</I>)</CODE>
</UL>
<P><CODE>Define-record-resumer</CODE> defines <CODE><I>procedure</I></CODE>,
which should accept one argument, to be the resumer for
<I>record-type</I>.
The order in which resumer procedures are called is not specified.
<P>The <CODE><I>procedure</I></CODE> argument to <CODE>define-record-resumer</CODE> may
be <CODE>#f</CODE>, in which case records of the given type are
not written out in heap images.
When writing a heap image any reference to such a record is replaced by
the value of the record's first field, and an exception is raised
after the image is written.
<H1><A NAME="21">Using Scheme records in C code</A></H1>
<P>External modules can create records and access their slots
positionally.
<UL><LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>s48_value S48_MAKE_RECORD(s48_value)</CODE></td> <td align=right>(may GC)</td></tr></table>
<LI><CODE>int S48_RECORD_P(s48_value)</CODE>
<LI><CODE>s48_value S48_RECORD_TYPE(s48_value)</CODE>
<LI><CODE>s48_value S48_RECORD_REF(s48_value, long)</CODE>
<LI><CODE>void S48_RECORD_SET(s48_value, long, s48_value)</CODE>
</UL>
The argument to <CODE>S48_MAKE_RECORD</CODE> should be a shared binding
whose value is a record type.
In C the fields of Scheme records are only accessible via offsets,
with the first field having offset zero, the second offset one, and
so forth.
If the order of the fields is changed in the Scheme definition of the
record type the C code must be updated as well.
<P>For example, given the following record-type definition
<BLOCKQUOTE><PRE>
(define-record-type thing :thing
(make-thing a b)
thing?
(a thing-a)
(b thing-b))
</PRE></BLOCKQUOTE>
the identifier <CODE>:thing</CODE> is bound to the record type and can
be exported to C:
<BLOCKQUOTE><PRE>
(define-exported-binding "thing-record-type" :thing)
</PRE></BLOCKQUOTE>
<CODE>Thing</CODE> records can then be made in C:
<BLOCKQUOTE><PRE>
static scheme_value thing_record_type_binding = SCHFALSE;
void initialize_things(void)
{
S48_GC_PROTECT_GLOBAL(thing_record_type_binding);
thing_record_type_binding =
s48_get_imported_binding("thing-record-type");
}
scheme_value make_thing(scheme_value a, scheme_value b)
{
s48_value thing;
s48_DECLARE_GC_PROTECT(2);
S48_GC_PROTECT_2(a, b);
thing = s48_make_record(thing_record_type_binding);
S48_RECORD_SET(thing, 0, a);
S48_RECORD_SET(thing, 1, b);
S48_GC_UNPROTECT();
return thing;
}
</PRE></BLOCKQUOTE>
Note that the variables <CODE>a</CODE> and <CODE>b</CODE> must be protected
against the possibility of a garbage collection occuring during
the call to <CODE>s48_make_record()</CODE>.
<H1><A NAME="22">Raising exceptions from external code</A></H1>
<P>The following macros explicitly raise certain errors, immediately
returning to Scheme&nbsp;48.
Raising an exception performs all
necessary clean-up actions to properly return to Scheme&nbsp;48, including
adjusting the stack of protected variables.
<UL><LI><CODE>s48_raise_scheme_exception(int type, int nargs, ...)</CODE>
</UL>
<P><CODE>s48_raise_scheme_exception</CODE> is the base procedure for
raising exceptions.
<CODE>type</CODE> is the type of exception, and should be one of the
<CODE>S48_EXCEPTION_</CODE>...constants defined in <CODE>scheme48arch.h</CODE>.
<CODE>nargs</CODE> is the number of additional values to be included in the
exception; these follow the <CODE>nargs</CODE> argument and should all have
type <CODE>s48_value</CODE>.
<CODE>s48_raise_scheme_exception</CODE> never returns.
<P>The following procedures are available for raising particular
types of exceptions.
Like <CODE>s48_raise_scheme_exception</CODE> these never return.
<UL><LI><CODE>s48_raise_argument_type_error(scheme_value)</CODE>
<LI><CODE>s48_raise_argument_number_error(int nargs, int min, int max)</CODE>
<LI><CODE>s48_raise_index_range_error(long value, long min, long max)</CODE>
<LI><CODE>s48_raise_closed_channel_error()</CODE>
<LI><CODE>s48_raise_os_error(int errno)</CODE>
<LI><CODE>s48_raise_out_of_memory_error()</CODE>
</UL>
<P>An argument type error indicates that the given value is of the wrong
type.
An argument number error is raised when the number of arguments, <CODE>nargs</CODE>,
should be, but isn't, between <CODE>min</CODE> and <CODE>max</CODE>, inclusive.
Similarly, and index range error is raised when <CODE>value</CODE> is not between
between <CODE>min</CODE> and <CODE>max</CODE>, inclusive.
<P>The following macros raise argument type errors if their argument does not
have the required type.
<UL><LI><CODE>void S48_CHECK_SYMBOL(s48_value)</CODE>
<LI><CODE>void S48_CHECK_PAIR(s48_value)</CODE>
<LI><CODE>void S48_CHECK_STRING(s48_value)</CODE>
<LI><CODE>void S48_CHECK_INTEGER(s48_value)</CODE>
<LI><CODE>void S48_CHECK_CHANNEL(s48_value)</CODE>
<LI><CODE>void S48_CHECK_BYTE_VECTOR(s48_value)</CODE>
<LI><CODE>void S48_CHECK_RECORD(s48_value)</CODE>
<LI><CODE>void S48_CHECK_SHARED_BINDING(s48_value)</CODE>
</UL>
<H1><A NAME="23">Unsafe functions and macros</A></H1>
<P>All of the C procedures and macros described above check that their
arguments have the appropriate types and that indexes are in range.
The following procedures and macros are identical to those described
above, except that they do not perform type and range checks.
They are provided for the purpose of writing more efficient code;
their general use is not recommended.
<UL><LI><CODE>char S48_UNSAFE_EXTRACT_CHAR(s48_value)</CODE>
<LI><CODE>char * S48_UNSAFE_EXTRACT_STRING(s48_value)</CODE>
<LI><CODE>long S48_UNSAFE_EXTRACT_INTEGER(s48_value)</CODE>
<LI><CODE>long S48_UNSAFE_EXTRACT_DOUBLE(s48_value)</CODE>
</UL>
<UL><LI><CODE>long S48_UNSAFE_EXTRACT_FIXNUM(s48_value)</CODE>
<LI><CODE>s48_value S48_UNSAFE_ENTER_FIXNUM(long)</CODE>
</UL>
<UL><LI><CODE>s48_value S48_UNSAFE_CAR(s48_value)</CODE>
<LI><CODE>s48_value S48_UNSAFE_CDR(s48_value)</CODE>
<LI><CODE>void S48_UNSAFE_SET_CAR(s48_value, s48_value)</CODE>
<LI><CODE>void S48_UNSAFE_SET_CDR(s48_value, s48_value)</CODE>
</UL>
<UL><LI><CODE>long S48_UNSAFE_VECTOR_LENGTH(s48_value)</CODE>
<LI><CODE>s48_value S48_UNSAFE_VECTOR_REF(s48_value, long)</CODE>
<LI><CODE>void S48_UNSAFE_VECTOR_SET(s48_value, long, s48_value)</CODE>
</UL>
<UL><LI><CODE>long S48_UNSAFE_STRING_LENGTH(s48_value)</CODE>
<LI><CODE>char S48_UNSAFE_STRING_REF(s48_value, long)</CODE>
<LI><CODE>void S48_UNSAFE_STRING_SET(s48_value, long, char)</CODE>
</UL>
<UL><LI><CODE>s48_value S48_UNSAFE_SYMBOL_TO_STRING(s48_value)</CODE>
</UL>
<UL><LI><CODE>long S48_UNSAFE_BYTE_VECTOR_LENGTH(s48_value)</CODE>
<LI><CODE>char S48_UNSAFE_BYTE_VECTOR_REF(s48_value, long)</CODE>
<LI><CODE>void S48_UNSAFE_BYTE_VECTOR_SET(s48_value, long, int)</CODE>
</UL>
<UL><LI><CODE>s48_value S48_UNSAFE_SHARED_BINDING_REF(s48_value s_b)</CODE>
<LI><CODE>int S48_UNSAFE_SHARED_BINDING_P(x)</CODE>
<LI><CODE>int S48_UNSAFE_SHARED_BINDING_IS_IMPORT_P(s48_value s_b)</CODE>
<LI><CODE>s48_value S48_UNSAFE_SHARED_BINDING_NAME(s48_value s_b)</CODE>
<LI><CODE>void S48_UNSAFE_SHARED_BINDING_SET(s48_value s_b, s48_value value)</CODE>
</UL>
<UL><LI><CODE>s48_value S48_UNSAFE_RECORD_TYPE(s48_value)</CODE>
<LI><CODE>s48_value S48_UNSAFE_RECORD_REF(s48_value, long)</CODE>
<LI><CODE>void S48_UNSAFE_RECORD_SET(s48_value, long, s48_value)</CODE>
</UL>
<UL><LI><CODE>type S48_UNSAFE_EXTRACT_VALUE(s48_value, type)</CODE>
<LI><CODE>type * S48_UNSAFE_EXTRACT_VALUE_POINTER(s48_value, type)</CODE>
<LI><CODE>void S48_UNSAFE_SET_VALUE(s48_value, type, value)</CODE>
</UL>
<HR ><ADDRESS><a href="http://www-pu.informatik.uni-tuebingen.de/users/sperber/">Mike
Sperber</a>, <a href="http://www.neci.nj.nec.com/homepages/kelsey/">Richard Kelsey</a></ADDRESS><BR>
</BODY></HTML>

315
doc/html/utilities.html
View File

@ -1,315 +0,0 @@
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<HTML>
<!-- HTML file produced from file: utilities.tex --
-- using Hyperlatex v 2.3.1 (c) Otfried Cheong--
-- on Emacs 19.34.1, Tue Feb 23 18:25:11 1999 -->
<HEAD>
<TITLE>Untitled</TITLE>
</HEAD><BODY>
<H1 ALIGN=CENTER>Scheme 48 User's Guide</H1>
<H2 ALIGN=CENTER>Richard A. Kelsey</H2>
<H3 ALIGN=CENTER>February 23, 1999</H3>
<H1><A NAME="1">ASCII character encoding</A></H1>
<P>These are in the structure <CODE>ascii</CODE>.
<UL><LI><CODE>(char-&gt;ascii<VAR> char</VAR>)&nbsp;-&gt;&nbsp;<VAR>integer</VAR></CODE>
<LI><CODE>(ascii-&gt;char<VAR> integer</VAR>)&nbsp;-&gt;&nbsp;<VAR>char</VAR></CODE>
</UL>
These are identical to <CODE>char-&gt;integer</CODE> and <CODE>integer-&gt;char</CODE> except that
they use the ASCII encoding.
<UL><LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>ascii-limit</CODE></td> <td align=right>integer</td></tr></table>
<LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE>ascii-whitespaces</CODE></td> <td align=right>list of integers</td></tr></table>
</UL>
<CODE>Ascii-limit</CODE> is one more than the largest value that <CODE>char-&gt;ascii</CODE>
may return.
<CODE>Ascii-whitespaces</CODE> is a list of the ASCII values of whitespace characters
(space, tab, line feed, form feed, and carriage return).
<H1><A NAME="2">Bitwise integer operations</A></H1>
<P>These functions use the two's-complement representation for integers.
There is no limit to the number of bits in an integer.
They are in the structures <CODE>bitwise</CODE> and <CODE>big-scheme</CODE>.
<UL><LI><CODE>(bitwise-and<VAR> integer integer</VAR>)&nbsp;-&gt;&nbsp;<VAR>integer</VAR></CODE>
<LI><CODE>(bitwise-ior<VAR> integer integer</VAR>)&nbsp;-&gt;&nbsp;<VAR>integer</VAR></CODE>
<LI><CODE>(bitwise-xor<VAR> integer integer</VAR>)&nbsp;-&gt;&nbsp;<VAR>integer</VAR></CODE>
<LI><CODE>(bitwise-not<VAR> integer</VAR>)&nbsp;-&gt;&nbsp;<VAR>integer</VAR></CODE>
</UL>
These perform various logical operations on integers on a bit-by-bit
basis. `<CODE>ior</CODE>' is inclusive OR and `<CODE>xor</CODE>' is exclusive OR.
<UL><LI><CODE>(arithmetic-shift<VAR> integer bit-count</VAR>)&nbsp;-&gt;&nbsp;<VAR>integer</VAR></CODE>
</UL>
Shifts the integer by the given bit count, which must be an integer,
shifting left for positive counts and right for negative ones.
Shifting preserves the integer's sign.
<H1><A NAME="3">Arrays</A></H1>
<P>These are N-dimensional, zero-based arrays and
are in the structure <CODE>arrays</CODE>.
<P>The array interface is derived from one written by Alan Bawden.
<UL><LI><CODE>(make-array<VAR> value dimension<I><sub>0</sub></I> ...</VAR>)&nbsp;-&gt;&nbsp;<VAR>array</VAR></CODE>
<LI><CODE>(array<VAR> dimensions element<I><sub>0</sub></I> ...</VAR>)&nbsp;-&gt;&nbsp;<VAR>array</VAR></CODE>
<LI><CODE>(copy-array<VAR> array</VAR>)&nbsp;-&gt;&nbsp;<VAR>array</VAR></CODE>
</UL>
<CODE>Make-array</CODE> makes a new array with the given dimensions, each of which
must be a non-negative integer.
Every element is initially set to <CODE><VAR>value</VAR></CODE>.
<CODE>Array</CODE> Returns a new array with the given dimensions and elements.
<CODE><VAR>Dimensions</VAR></CODE> must be a list of non-negative integers,
The number of elements should be the equal to the product of the
dimensions.
The elements are stored in row-major order.
<BLOCKQUOTE><PRE>
(make-array 'a 2 3) <CODE>-&gt;</CODE> {Array 2 3}
(array '(2 3) 'a 'b 'c 'd 'e 'f)
<CODE>-&gt;</CODE> {Array 2 3}
</PRE></BLOCKQUOTE>
<P><CODE>Copy-array</CODE> returns a copy of <CODE><VAR>array</VAR></CODE>.
The copy is identical to the <CODE><VAR>array</VAR></CODE> but does not share storage with it.
<UL><LI><CODE>(array?<VAR> value</VAR>)&nbsp;-&gt;&nbsp;<VAR>boolean</VAR></CODE>
</UL>
Returns <CODE>#t</CODE> if <CODE><VAR>value</VAR></CODE> is an array.
<UL><LI><CODE>(array-ref<VAR> array index<I><sub>0</sub></I> ...</VAR>)&nbsp;-&gt;&nbsp;<VAR>value</VAR></CODE>
<LI><CODE>(array-set!<VAR> array value index<I><sub>0</sub></I> ...</VAR>)</CODE>
<LI><CODE>(array-&gt;vector<VAR> array</VAR>)&nbsp;-&gt;&nbsp;<VAR>vector</VAR></CODE>
<LI><CODE>(array-dimensions<VAR> array</VAR>)&nbsp;-&gt;&nbsp;<VAR>list</VAR></CODE>
</UL>
<CODE>Array-ref</CODE> returns the specified array element and <CODE>array-set!</CODE>
replaces the element with <CODE><VAR>value</VAR></CODE>.
<BLOCKQUOTE><PRE>
(let ((a (array '(2 3) 'a 'b 'c 'd 'e 'f)))
(let ((x (array-ref a 0 1)))
(array-set! a 'g 0 1)
(list x (array-ref a 0 1))))
<CODE>-&gt;</CODE> '(b g)
</PRE></BLOCKQUOTE>
<P><CODE>Array-&gt;vector</CODE> returns a vector containing the elements of <CODE><VAR>array</VAR></CODE>
in row-major order.
<CODE>Array-dimensions</CODE> returns the dimensions of
the array as a list.
<UL><LI><CODE>(make-shared-array<VAR> array linear-map dimension<I><sub>0</sub></I> ...</VAR>)&nbsp;-&gt;&nbsp;<VAR>array</VAR></CODE>
</UL>
<CODE>Make-shared-array</CODE> makes a new array that shares storage with <CODE><VAR>array</VAR></CODE>
and uses <CODE><VAR>linear-map</VAR></CODE> to map indicies to elements.
<CODE><VAR>Linear-map</VAR></CODE> must accept as many arguments as the number of
<CODE><VAR>dimension</VAR></CODE>s given and must return a list of non-negative integers
that are valid indicies into <CODE><VAR>array</VAR></CODE>.
<BLOCKQUOTE><PRE>
(array-ref (make-shared-array a f i0 i1 ...)
j0 j1 ...)
</PRE></BLOCKQUOTE>
is equivalent to
<BLOCKQUOTE><PRE>
(apply array-ref a (f j0 j1 ...))
</PRE></BLOCKQUOTE>
<P>As an example, the following function makes the transpose of a two-dimensional
array:
<BLOCKQUOTE><PRE>
(define (transpose array)
(let ((dimensions (array-dimensions array)))
(make-shared-array array
(lambda (x y)
(list y x))
(cadr dimensions)
(car dimensions))))
(array-&gt;vector
(transpose
(array '(2 3) 'a 'b 'c 'd 'e 'f)))
<CODE>-&gt;</CODE> '(a d b e c f)
</PRE></BLOCKQUOTE>
<H1><A NAME="4">Records</A></H1>
<P>New types can be constructed using the <CODE>define-record-type</CODE> macro
from the <CODE>define-record-types</CODE> structure
The general syntax is:
<BLOCKQUOTE><PRE>
(define-record-type <CODE><VAR>tag</VAR></CODE> <CODE><VAR>type-name</VAR></CODE>
(<CODE><VAR>constructor-name</VAR></CODE> <CODE><VAR>field-tag</VAR></CODE> ...)
<CODE><VAR>predicate-name</VAR></CODE>
(<CODE><VAR>field-tag</VAR></CODE> <CODE><VAR>accessor-name</VAR></CODE> [<CODE><VAR>modifier-name</VAR></CODE>])
...)
</PRE></BLOCKQUOTE>
This makes the following definitions:
<UL><LI><table border=0 cellspacing=0 cellpadding=0 width=80%>
<tr> <td><CODE><CODE><VAR>type-name</VAR></CODE></CODE></td> <td align=right>type</td></tr></table>
<LI><CODE>(<CODE><VAR>constructor-name</VAR></CODE><VAR> field-init ...</VAR>)&nbsp;-&gt;&nbsp;<VAR>type-name</VAR></CODE>
<LI><CODE>(<CODE><VAR>predicate-name</VAR></CODE><VAR> value</VAR>)&nbsp;-&gt;&nbsp;<VAR>boolean</VAR></CODE>
<LI><CODE>(<CODE><VAR>accessor-name</VAR></CODE><VAR> type-name</VAR>)&nbsp;-&gt;&nbsp;<VAR>value</VAR></CODE>
<LI><CODE>(<CODE><VAR>modifier-name</VAR></CODE><VAR> type-name value</VAR>)</CODE>
</UL>
<CODE><VAR>Type-name</VAR></CODE> is the record type itself, and can be used to
specify a print method (see below).
<CODE><VAR>Constructor-name</VAR></CODE> is a constructor that accepts values
for the fields whose tags are specified.
<CODE><VAR>Predicate-name</VAR></CODE> to a predicate that can returns <CODE>#t</CODE> for
elements of the type and <CODE>#f</CODE> for everything else.
The <CODE><VAR>accessor-name</VAR></CODE>s retrieve the values of fields,
and the <CODE><VAR>modifier-name</VAR></CODE>'s update them.
The <CODE><VAR>tag</VAR></CODE> is used in printing instances of the record type and
the field tags are used in the inspector and to match
constructor arguments with fields.
<UL><LI><CODE>(define-record-discloser<VAR> type discloser</VAR>)</CODE>
</UL>
<CODE>Define-record-discloser</CODE> determines how
records of type <CODE><VAR>type</VAR></CODE> are printed.
<CODE><VAR>Discloser</VAR></CODE> should be procedure which takes a single
record of type <CODE><VAR>type</VAR></CODE> and returns a list whose car is
a symbol.
The record will be printed as the value returned by <CODE><VAR>discloser</VAR></CODE>
with curly braces used instead of the usual parenthesis.
<P>For example
<BLOCKQUOTE><PRE>
(define-record-type pare :pare
(kons x y)
pare?
(x kar set-kar!)
(y kdr))
</PRE></BLOCKQUOTE>
defines <CODE>kons</CODE> to be a constructor, <CODE>kar</CODE> and <CODE>kdr</CODE> to be
accessors, <CODE>set-kar!</CODE> to be a modifier, and <CODE>pare?</CODE> to be a predicate
for a new type of object.
The type itself is named <CODE>:pare</CODE>.
<CODE>Pare</CODE> is a tag used in printing the new objects.
<P>By default, the new objects print as <CODE>#Pare</CODE>.
The print method can be modified using DEFINE-RECORD-DISCLOSER:
<BLOCKQUOTE><PRE>
(define-record-discloser :pare
(lambda (p) `(pare ,(kar p) ,(kdr p))))
</PRE></BLOCKQUOTE>
will cause the result of <CODE>(kons 1 2)</CODE> to print as
<CODE>#{pare 1 2}</CODE>.
<H1><A NAME="5">Finite record types</A></H1>
<P>The structure <CODE>finite-types</CODE> has
two macros for defining `finite' record types.
These are record types for which there are a fixed number of instances,
which are created when the record type is defined.
The syntax for the defining a finite type is:
<BLOCKQUOTE><PRE>
(define-finite-type <CODE><VAR>tag</VAR></CODE> <CODE><VAR>type-name</VAR></CODE>
(<CODE><VAR>field-tag</VAR></CODE> ...)
<CODE><VAR>predicate-name</VAR></CODE>
<CODE><VAR>vector-of-elements-name</VAR></CODE>
<CODE><VAR>name-accessor</VAR></CODE>
<CODE><VAR>index-accessor</VAR></CODE>
(<CODE><VAR>field-tag</VAR></CODE> <CODE><VAR>accessor-name</VAR></CODE> [<CODE><VAR>modifier-name</VAR></CODE>])
...
((<CODE><VAR>element-name</VAR></CODE> <CODE><VAR>field-value</VAR></CODE> ...)
...))
</PRE></BLOCKQUOTE>
This differs from <CODE>define-record-type</CODE> in the following ways:
<UL><LI>No name is specified for the constructor, but the field arguments
to the constructor are listed.
<LI>The <CODE><VAR>vector-of-elements-name</VAR></CODE> is added; it will be bound
to a vector containing all of the elements of the type.
These are constructed by applying the (unnamed) constructor to the
initial field values at the end of the form.
<LI>There are names for accessors for two required fields, name
and index.
These fields are not settable, and are not to be included
in the argument list for the constructor.
<LI>The form ends with the names and the initial field values for
the elements of the type.
The name must be first.
The remaining values must match the <CODE><VAR>field-tag</VAR></CODE>s in the constructor's
argument list.
<LI><CODE><VAR>Tag</VAR></CODE> is bound to a macro that maps <CODE><VAR>element-name</VAR></CODE>s to the
the corresponding element of the vector.
The name lookup is done at macro-expansion time.
</UL>
<BLOCKQUOTE><PRE>
(define-finite-type color :color
(red green blue)
color?
colors
color-name
color-index
(red color-red)
(green color-green)
(blue color-blue)
((white 255 255 255)
(black 0 0 0)
(yellow 255 255 0)
(maroon 176 48 96)))
(color-name (vector-ref colors 0)) <CODE>-&gt;</CODE> white
(color-name (color black)) <CODE>-&gt;</CODE> black
(color-index (color yellow)) <CODE>-&gt;</CODE> 2
(color-red (color maroon)) <CODE>-&gt;</CODE> 176
</PRE></BLOCKQUOTE>
<P>Enumerated types are finite types whose only fields are the name
and the index.
The syntax for defining an enumerated type is:
<BLOCKQUOTE><PRE>
(define-enumerated-type <CODE><VAR>tag</VAR></CODE> <CODE><VAR>type-name</VAR></CODE>
<CODE><VAR>predicate-name</VAR></CODE>
<CODE><VAR>vector-of-elements-name</VAR></CODE>
<CODE><VAR>name-accessor</VAR></CODE>
<CODE><VAR>index-accessor</VAR></CODE>
(<CODE><VAR>element-name</VAR></CODE> ...))
</PRE></BLOCKQUOTE>
In the absence of any additional fields, both the constructor argument
list and the initial field values are not required.
<P>The above example of a finite type can be pared down to the following
enumerated type:
<BLOCKQUOTE><PRE>
(define-enumerated-type color :color
color?
colors
color-name
color-index
(white black yellow maroon))
(color-name (vector-ref colors 0)) <CODE>-&gt;</CODE> white
(color-name (color black)) <CODE>-&gt;</CODE> black
(color-index (color yellow)) <CODE>-&gt;</CODE> 2
</PRE></BLOCKQUOTE>
<H1><A NAME="6">Hash tables</A></H1>
<P>These are generic hash tables, and are in the structure <CODE>tables</CODE>.
Strictly speaking they are more maps than tables, as every table has a
value for every possible key (for that type of table).
All but a finite number of those values are <CODE>#f</CODE>.
<UL><LI><CODE>(make-table<VAR></VAR>)&nbsp;-&gt;&nbsp;<VAR>table</VAR></CODE>
<LI><CODE>(make-symbol-table<VAR></VAR>)&nbsp;-&gt;&nbsp;<VAR>symbol-table</VAR></CODE>
<LI><CODE>(make-string-table<VAR></VAR>)&nbsp;-&gt;&nbsp;<VAR>string-table</VAR></CODE>
<LI><CODE>(make-integer-table<VAR></VAR>)&nbsp;-&gt;&nbsp;<VAR>integer-table</VAR></CODE>
<LI><CODE>(make-table-maker<VAR> compare-proc hash-proc</VAR>)&nbsp;-&gt;&nbsp;<VAR>procedure</VAR></CODE>
<LI><CODE>(make-table-immutable!<VAR> table</VAR>)</CODE>
</UL>
The first four functions listed make various kinds of tables.
<CODE>Make-table</CODE> returns a table whose keys may be symbols, integer,
characters, booleans, or the empty list (these are also the values
that may be used in <CODE>case</CODE> expressions).
As with <CODE>case</CODE>, comparison is done using <CODE>eqv?</CODE>.
The comparison procedures used in symbol, string, and integer tables are
<CODE>eq?</CODE>, <CODE>string=?</CODE>, and <CODE>=</CODE>.
<P><CODE>Make-table-maker</CODE> takes two procedures as arguments and returns
a nullary table-making procedure.
<CODE><VAR>Compare-proc</VAR></CODE> should be a two-argument equality predicate.
<CODE><VAR>Hash-proc</VAR></CODE> should be a one argument procedure that takes a key
and returns a non-negative integer hash value.
If <CODE>(<CODE><VAR>compare-proc</VAR></CODE> <CODE><VAR>x</VAR></CODE> <CODE><VAR>y</VAR></CODE>)</CODE> returns true,
then <CODE>(= (<CODE><VAR>hash-proc</VAR></CODE> <CODE><VAR>x</VAR></CODE>) (<CODE><VAR>hash-proc</VAR></CODE> <CODE><VAR>y</VAR></CODE>))</CODE>
must also return true.
For example, <CODE>make-integer-table</CODE> could be defined
as <CODE>(make-table-maker = abs)</CODE>.
<P><CODE>Make-table-immutable!</CODE> prohibits future modification to its argument.
<UL><LI><CODE>(table?<VAR> value</VAR>)&nbsp;-&gt;&nbsp;<VAR>boolean</VAR></CODE>
<LI><CODE>(table-ref<VAR> table key</VAR>)&nbsp;-&gt;&nbsp;<VAR>value or <CODE>#f</CODE></VAR></CODE>
<LI><CODE>(table-set!<VAR> table key value</VAR>)</CODE>
<LI><CODE>(table-walk<VAR> procedure table</VAR>)</CODE>
</UL>
<CODE>Table?</CODE> is the predicate for tables.
<CODE>Table-ref</CODE> and <CODE>table-set!</CODE> access and modify the value of <CODE><VAR>key</VAR></CODE>
in <CODE><VAR>table</VAR></CODE>.
<CODE>Table-walk</CODE> applies <CODE><VAR>procedure</VAR></CODE>, which must accept two arguments,
to every associated key and non-<CODE>#f</CODE> value in <CODE>table</CODE>.
<UL><LI><CODE>(default-hash-function<VAR> value</VAR>)&nbsp;-&gt;&nbsp;<VAR>integer</VAR></CODE>
<LI><CODE>(string-hash<VAR> string</VAR>)&nbsp;-&gt;&nbsp;<VAR>integer</VAR></CODE>
</UL>
<CODE>default-hash-function</CODE> is the hash function used in the tables
returned by <CODE>make-table</CODE>, and <CODE>string-hash</CODE> it the one used
by <CODE>make-string-table</CODE>.
<HR >
</BODY></HTML>

159
doc/install.txt Normal file
View File

@ -0,0 +1,159 @@
-*- Mode: Indented-text; -*-
Here are some remarks to complement what's in the INSTALL file.
-----
When running "make", don't worry if the ".notify" target fails. Its
only purpose is to send an email message to
scheme-48-notifications@martigny.ai.mit.edu, so that we can get a
rough idea of how much Scheme 48 is being used and by whom. We
promise not to use your name or email address for any commercial
purpose. If you don't want us to know, just do "make -t .notify"
first.
-----
Customizing the installation
1. If you don't believe in configure scripts, or don't have a
/bin/sh that can handle the configure script, you can make
sysdep.h and Makefile manually from sysdep.h.in and Makefile.in.
The technique is fairly obvious. For Makefile, just give
reasonable values for all of the variables at the top that are
defined as "foo = @foo@", e.g. srcdir=., CC=cc, LIBS=-lm,
INSTALL=cp, etc. For sysdep.h, read the comments. If your OS is
Posix compliant, you should be able to copy sysdep.h.in to
sysdep.h unmodified and everything should work.
2. If you definitely won't be installing Scheme 48, you should set
libdir to the distribution directory (e.g. "make libdir=`pwd`").
This will make the ,open and ,load-package commands work for the
library packages defined in more-packages.scm.
3. If desired, customize the contents of the development environment
heap image by editing the definitions of USUAL-COMMANDS and/or
USUAL-FEATURES in more-packages.scm; see below.
4. If you're using a DEC MIPS, and want to use the foreign function
interface, specify LDFLAGS=-N (with e.g. "make LDFLAGS=-N").
-----
Customizing scheme48.image
By default, the image consists of a core Scheme system (Revised^5
Scheme plus a very minimal read-eval-print loop) together with a
standard set of "options" (command processor, debugging commands,
inspector, disassembler, generic arithmetic). The set of options is
controlled by the definitions of USUAL-COMMANDS and USUAL-FEATURES in
more-packages.scm. If you make the (open ...) clause empty, then
"make scheme48.image" will create a Scheme system without any extras
(such as error recovery), and the image will be smaller. The files
are listed in approximate order of decreasing desirability; you'll
probably want at least these:
package-commands, build
- necessary for the scheme48.image script to work
debuginfo, disclosers
- necessary if you want error messages to be at all helpful
debugging
- defines important debugging commands such as ,preview and ,trace
After editing the definition of usual-features, simply
make scheme48.image
to rebuild the image.
-----
Deeper changes to the system -- for example, edits to most of the
files in the rts/ directory -- will require using the static linker to
make a new initial.image. After you have a working scheme48.image
(perhaps a previous version of Scheme 48), you can create a linker
image with
make linker
after which you can say
make image
to get the linker to build a new initial.image and initial.debug.
scheme48.image will then be built from those.
You might think that "make scheme48.image" ought to do this, but the
circular dependencies
scheme48.image on initial.image
initial.image on link/linker.image
link/linker.image on scheme48.image
needs to be broken somewhere, or else make will (justifiably) barf. I
chose to break the cycle by making scheme48.image not depend on
initial.image, since this is most robust for installation purposes.
-----
Editor support
We recommend interacting with the Scheme 48 command processor using the
emacs/scheme interface written by Olin Shivers at CMU. Copies of the
relevant .el files, together with a "cmuscheme48.el", are in the
emacs/ subdirectory of the release. Usage information is in
doc/user-guide.txt.
You will probably want to byte-compile the .el files to get .elc
files. Use M-x byte-compile-file to do this.
-----
Performance
If you don't have a C compiler that optimizes as well as gcc does,
then performance may suffer. Take a look at the automatically
generated code in scheme48vm.c to find out why. With a good register
allocator, all those variables (including some of the virtual
machine's virtual registers) get allocated to hardware registers, and
it really flies. Without one, performance can be pretty bad.
The configure script automatically sets the Makefile variable CFLAGS
to -O2 -g if gcc is available, or to -O if it isn't. This can be
overriden by specifying a different CFLAGS, e.g. "make CFLAGS=-g" for
no optimization.
Even if you do have a good compiler, you should be able to improve
overall performance even more, maybe about 6-10%, by removing the
range check from the interpreter's instruction dispatch. To do this,
use the -S flag to get assembly code for scheme48vm.c, then find the
instructions in scheme48vm.s corresponding to the big dispatch in
restart():
L19173: {
code_pointer_83X = arg1K0;
switch ((*((unsigned char *) code_pointer_83X))) {
... }
There will be one or two comparison instructions to see whether the
opcode is in range; just remove them. For the 68000 I use a "sed"
script
/cmpl #137,d0/ N
/cmpl #137,d0\n jhi L/ d
but of course the constant will probably have to change when a new
release comes along.
See the user's guide for information on the ,bench command, which
makes programs run faster.
-----
filenames.make is "include"d by the Makefile, but is automatically
generated from the module dependencies laid out in the various
configuration files (*-packages.scm). If you edit any of these .scm
files, you may want to do a "make filenames.make" before you do any
further "make"s in order to update the depedencies. This step isn't
necessary if you're using Gnu make, because Gnu make will make
included files automatically.

201
doc/io.txt Normal file
View File

@ -0,0 +1,201 @@
There are two types of I/O objects in Scheme 48, channels and ports.
Channels are the raw, unbuffered ports of the operating system. The
only I/O operations the VM supports for channels are block reads and
writes. Ports are the actual Scheme ports and are implemented in Scheme,
with some support from the VM for READ-CHAR, PEEK-CHAR, and WRITE-CHAR
for efficiency. The run-time system provides ports that are buffered
versions of channels. Other sorts of ports are in big/more-port.scm.
Source files:
rts/port.scm port operations and port handlers
rts/current-port.scm current-input-port, etc.
rts/channel.scm blocking on channels and handling i/o interrupts
rts/channel-port.scm ports that read and write to channels
rts/low.scm CHANNEL-READ and CHANNEL-WRITE
big/more-port.scm additional kinds of ports
vm/arch.scm fields of ports and channels
vm/prim-io.scm VM i/o opcodes
vm/vmio.scm implementation of channels
----------------------------------------------------------------
CHANNELS
The VM instructions that deal with channels are:
(OPEN-CHANNEL <spec> <mode>) -> channel
<mode> is a from the enumeration OPEN-CHANNEL-OPTION in arch.scm.
<spec> is either a filename (as a string) or an OS port (as a one-word
code-vector), depending on the mode.
(CLOSE-CHANNEL <channel>) -> unspecific
(CHANNEL-MAYBE-READ <string-or-code-vector> <start-index> <count> <wait?>
<channel>)
-> number of bytes read or the eof-object
(CHANNEL-MAYBE-WRITE <string-or-code-vector> <start-index> <count> <channel>)
-> number of bytes written
These read or write up to the specified number of characters or bytes
from or to the string or code-vector, with the first character or byte
going at <start-index>.
(CHANNEL-ABORT <channel>) -> number of bytes read or written or
the eof-object
This aborts any pending read or write operation on the channel. The return
value reflects any partial completion.
CHANNEL-MAYBE-READ and CHANNEL-MAYBE-WRITE do not block. If the read or
write cannot be completed immediately a PENDING-CHANNEL-I/O exception is
raised. It is then up to the run-time system to either wait or run some
other thread. The VM raises an I/O-COMPLETION interrupt whenever an i/o
operation completes.
Because CHANNEL-MAYBE-READ and CHANNEL-MAYBE-WRITE are awkward to use,
the RTS defines somewhat simpler versions:
(CHANNEL-READ <buffer> <start> <needed> <channel>)
-> number of bytes read or the eof-object
(CHANNEL-WRITE <buffer> <start> <count> <channel>)
-> unspecified
<Buffer> is either a string or code vector and <start> is the index of the
first character read or written. <Needed> is one of:
N > 0 : the call returns when this many characters has been read or
an EOF is reached.
'IMMEDIATE : the call reads as many characters as are available and
returns immediately.
'ANY : the call returns as soon as at least one character has been read
or an EOF is reached.
<Count> is the number of characters to be written. CHANNEL-READ will read
the requested number of characters unless an EOF is reached. CHANNEL-WRITE
will write the requested number of characters.
----------------------------------------------------------------
PORTS
Ports are actual Scheme port and are (usually) buffered. They are fully
exposed to the run-time system. The VM instructions on ports could be
implemented in Scheme; they are in the VM for efficiency. Buffers are
code-vectors (this is a micro-hack; strings have a slightly higher overhead
because of the null terminating byte for C compatibility) (code-vectors are
just vectors of bytes).
The fields of a port are:
PORT-STATUS: a bit set represented as a fixnum.
Indices into this bit set are from the PORT-STATUS-OPTIONS
enumeration in arch.scm. The current bits are: input, output,
open-for-input, open-for-output (the last two are for things like
sockets, on which you need to block but which do not support
normal reading or writing).
PORT-HANDLER: a record containing three procedures. These handle
printing the port, closing the port, and filling (for input ports)
or emptying (for output ports) buffers.
PORT-DATA: ?
Whatever stuff the handler needs.
PORT-LOCKED?, PORT-LOCK: used by the system to guarentee the atomicity
of i/o operations.
PORT-BUFFER: a code-vector. The input or output buffer of the port.
PORT-INDEX: a fixnum. The index of the next byte to read or written.
PORT-LIMIT: a fixnum. One past the end of the valid/available buffer space.
PORT-PENDING-EOF?: true if the next read to this port should return EOF.
Additional operations on ports:
(READ-BLOCK string-or-code-vector start count input-port)
Read COUNT bytes into STRING-OR-CODE-VECTOR starting at index START.
Returns the number of bytes read. Only an end-of-file will prevent
the requested number of bytes from being read.
(WRITE-STRING string output-port)
Write the characters in the string to the port.
(WRITE-BLOCK string-or-code-vector start count output-port)
The output counterpart to READ-BLOCK. This always writes out the
requested number of bytes. Its return value is unspecified.
(FORCE_OUTPUT output-port)
Causes any buffered characters to be written out.
(CURRENT-ERROR-PORT)
The current error port, analogous to Scheme's CURRENT-INPUT-PORT
and CURRENT-OUTPUT-PORT.
The system maintains a list of output ports whose buffers should be
periodically flushed. The default output port and ports made by
OPEN-OUTPUT-FILE are on this list. (PERIODICALLY-FORCE-OUTPUT! <output-port>)
may be used to add others.
----------------------------------------------------------------
PORT HANDLERS
Every port has a handler with three procedures. The first two are used
for printing and closing ports and have the same type for all ports:
(DISCLOSE port-data) -> disclose list
(CLOSE port-data) -> unspecific
For CLOSE, The system takes care of modifying the port's status.
The third procedure is used to fill and empty buffers. Its arguments
and return values depend on the kind of port:
Buffered output ports:
(BUFFER-PROC port-data buffer start-index byte-count) -> unspecific
BYTE-COUNT bytes should be copied from the buffer beginning at
START-INDEX. The buffer may be either a string or a code-vector.
Unbuffered output ports:
(BUFFER-PROC port-data char) -> unspecific
Write out the given character. The system uses this for the default
error port.
Input ports:
(BUFFER-PROC data buffer start-index needed-bytes)
-> EOF or number of bytes read (before an EOF)
Bytes should be copied into the buffer starting at START-INDEX. The
buffer may be either a string or a code-vector. NEEDED-BYTES is one of:
'IMMEDIATE
The call should return immediately after transfering whatever number
of bytes are currently available, possibly none (this is used for
CHAR-READY?). The maximum number of characters is determined by the
length of BUFFER.
'ANY
The call should wait until at least one byte is available or an EOF
occurs (used for READ-CHAR and PEEK-CHAR). The maximum number of
characters is determined by the length of BUFFER.
N > 0
The call should wait until N bytes have been copied into the buffer
or an EOF occurs. If the return value is less than NEEDED-BYTES the
port code inserts an EOF after the last byte.
----------------------------------------------------------------
Ports and the Virtual Machine
Ports could be implemented entirely in Scheme, with no support from
the VM. For efficiency reasons VM instructions are supplied for
three port operations:
(READ-CHAR <port>)
(PEEK-CHAR <port>)
(WRITE-CHAR <char> <port>)
For each of these, if there is sufficient data or space in the
appropriate buffer the VM performs the operation. Otherwise a
buffer-full/empty exception is raised and the exception handler
uses the buffer procedure from the port's handler to fill or
empty the buffer.

1090
doc/meeting.ps Normal file
View File

File diff suppressed because it is too large Load Diff

1417
doc/module.ps
View File

File diff suppressed because it is too large Load Diff

700
doc/news.txt Normal file
View File

@ -0,0 +1,700 @@
-*- Mode: Indented-text; -*-
Recent changes to Scheme 48.
2/24/99 (version 0.53)
Additions:
DEFINE-FINITE-TYPE and DEFINE-ENUMERATED-TYPE (in structure
FINITE-TYPES; documented in doc/utilities.ps and
doc/html/utilities.html.
Added CHAR-SOURCE->INPUT-PORT, CHAR-SINK->OUTPUT-PORT,
MAKE-STRING-OUTPUT-PORT, STRING-OUTPUT-SOURCE-OUTPUT to
the extended-ports structure.
The structure BYTE-VECTORS is the same as CODE-VECTORS with `byte'
replacing `code' in all the names. The underlying datatype is the
same for both, and uses `byte' when printing.
There is a new and much improved interface to C code, thanks to
Mike Sperber. It is documented in in doc/external.ps and
doc/html/external.html.
Bug fixes:
Session-data and user-context records are no longer in the fluid env.
Lexical environments can now be nested up to 65k deep.
,expand no longer prints `definition in expression context' warnings.
Added ARRAY? and SEARCH-TREE? to the array and search tree structures.
Flat environments work again.
Templates of the form `var ... ...' now work in syntax rules.
Reinstated caching of SCHEMIFY results to greatly reduce the space
used by debugging info.
Added argument checking to STRING->NUMBER and NUMBER->STRING.
Fixed space blow-up in LOAD.
Unused ports are closed more reliably.
Changes:
The heap, gc, and image code is now in three separate modules.
The symbol table is now held in a VM register.
Inlined SHOWING-FOCUS-VALUES into the main command loop and moved
the sentinal call to reduce the noise at the base of ,preview output.
The tables returned by MAKE-TABLE now use EQV? for comparison (instead
of EQ?). This makes these tables about 50% slower when numbers are
used as keys, but significantly more accurate.
Floating-point numbers are no longer double boxed.
The channels structure has been split into channels and low-channels.
7/22/98 (version 0.52)
Bug fixes:
Fixed problems with unbound variables in SET! and the inliner.
Made macro expansion a bit less eager; this should reduce the amount
of heap space needed for compilation.
6/29/98 (version 0.51)
Incompatible changes:
BIG-SCHEME no longer exports its version of DEFINE-RECORD-TYPE (but
it is available from the structure DEFRECORD). I am slowly removing
all uses of this version of DEFINE-RECORD-TYPE from the sources.
The version of DEFINE-RECORD-TYPE exported by DEFINE-RECORD-TYPES
checks that every constructor argument corresponds to a field.
Uses of LAP must list their free variables (see env/assem.scm).
Changes:
The functions exported by BIG-SCHEME that were not available elsewhere
are now exported by BIG-UTIL as well.
MAKE-RANDOM now checks its argument (but is still a fairly poor
source of pseudo-randomness).
SIGPIPE no longer kills the S48 process (this was done earlier but
not listed here).
The macro/module/compiler code has been reorganized. Hopefully
the only noticable difference is in the babble written when loading
files and packages.
Added CODE-QUOTE (in its own structure of the same name) for use
in writing hygienic macro-generating macros. CODE-QUOTE is the
same as QUOTE except that it does not strip off any of the macro
system's name annotations.
The FLOATNUMS package now exports FLOATNUM?.
Bug fixes:
Fixed phony stack-overflow bug.
Fixed a bug in thread time-debit mechanism.
Made floating point numbers always print as inexact.
Got rid of bogus type-error warnings when using floatnums.
Fixed declaration of call_startup_procedure in c/main.c.
2/11/98 (version 0.50)
Fixed bug in closed-compiled version of READ-CHAR.
Fixed negative-key bug in integer tables.
11/18/97 (version 0.49)
Removed some non-portable Kali code that had been accidentally
included in c/extension.c.
10/29/97 (version 0.48)
The VM's calling convention now has the caller doing protocol checking,
instead of the callee. The *NARGS* register no longer exists.
Scheme's variable-arity procedures (APPLY, MAKE-VECTOR, +, -, etc.)
are usually handled without raising an exception. Calls with an
`atypical' number of arguments are now much faster.
Opcodes were added for >, <=, and >=.
Procedures can take up to about 8k arguments. The limit is determined
by the value of AVAILABLE-STACK-SPACE in scheme/vm/arch.scm.
Compiler detects wrong number of arguments in ((lambda ...) ...).
Removed the dynamic point from the dynamic environment to make
DYNAMIC-WIND behave reasonably with threads.
KILL-THREAD! should work more reliably.
The I/O primitives now pass OS error messages to the exception handlers.
I/O errors when flushing buffers no longer crash the system.
The Pre-Scheme compiler's hack for shadowing global variables with
local copies is no longer used.
Incompatible changes:
The internal thread interface was simplified.
There are some architecture changes; .image files will have to
be rebuilt.
ACCESS-SCHEME-48 and scheme/misc/slib-init.scm have been removed
(thanks to Mike Sperber's updating of slib).
1/27/97 (version 0.47)
Fixed ,exit and added ,exit-when-done.
CASE now uses EQV? exclusively.
11/5/96 (version 0.46)
Fixed a few minor thread problems.
opt/analyze.scm now writes to current-noise-port.
DELQ and DELETE now delete every instance, as the documentation claims.
There should be no more spurious heap-overflow interrupts.
Fixed bugs that caused the system to die if stdout blocked.
Template offsets have been increased to two bytes.
Disassembly of flat-lambda now works (fix from Michael Sperber).
8/23/96 (version 0.45)
Fixed various problems with thread termination and nested schedulers.
Changed thread-internal interface to make schedulers easier to write.
BITWISE-{AND,IOR,XOR} now take an arbitrary number of arguments.
Output ports have their buffers flushed when Scheme 48 terminates.
In keeping with RnRS, CLOSE-{IN,OUT}PUT-PORT are now idempotent.
MODULO now handles negative arguments properly.
6/20/96 (version 0.44)
The VM's byte-code interpreter and storage management code are
now compiled to separate C files.
The socket code works again.
5/10/96 (version 0.42-0.43)
Various fixes to the thread and I/O systems.
The Unix interface code is more portable.
EOF (control-D) now resumes running all non-broken threads on
resumed command level. Thus EOF after a keyboard interrupt
(control-C) resumes running the interrupted thread.
11/30/95 (version 0.41)
The distribution has been reorganized to reduce the number of files
in the top-level directory.
The threads implementation has been replaced with one based on engines
to allow for nested schedulers.
Threads are now included in the initial image.
The I/O system has been fixed and automatic periodic output buffer
flushing has been reinstalled.
Command levels have been integrated with the threads system to ensure
that at most one REPL is active at any time.
CONDVAR has been changed to PLACEHOLDER (condition variables being
something quite different).
,profile no longer works, it will be fixed in a later version.
MIN and MAX now do inexact contagion.
4/13/95 (version 0.40)
Renamed error-output-port to current-error-port.
Reinstated ".gdbinit"...
segment->template now takes parent templates debug data as an
argument.
Automatic periodic output buffer flushing has been
temporarily disabled. A future version of the I/O system
will fix it.
Fixed expansion of named LET.
The bummed-define-record-types structure is now gone; use
define-record-types instead.
There is somewhat better syntax checking now.
8/12/94 (versions 0.38-0.39)
,profile <command> prints out profiling information
An interrupt is raised after ever GC; the default handler checks
to see if some reasonable amount of storage was reclaimed.
Some of the standard Scheme procedures, including LENGTH, FOR-EACH,
VECTOR, and ASSQ, are now significantly faster.
Making, accessing, and setting records is faster.
tar file now includes the top-level directory
The "scheme-level-2-internal" structure has been renamed to
"usual-resumer".
` ( . ' is now illegal (as required by the R4RS grammar).
Made DELAY and FORCE comply with R4RS.
The EXPAND optimizer does a topological sort on definitions.
(optimize flat-environments) causes the compiler to produce
flat (instead of nested) lexical environments.
The I/O system has been rewritten to do its own buffering. There
are significant changes to unix.c to support this. See doc/io.txt.
(ERROR-OUTPUT) is now available from the structure i/o.
jar-defrecord has been replaced with a modified bummed-jar-defrecord
Files load about 25% faster, for a number of reasons.
Removed the copy of vm/arch.scm from the rts directory.
Threads and sockets work together; SOCKET-ACCEPT no longer blocks.
The compiler no longer prints out .'s as it compiles definitions.
7/5/94 (version 0.37)
I/O opcodes now raise an interrupt instead of blocking (they still
block if no corresponding interrupt handler has been installed).
The threads code has been rewritten; threads that block on I/O
do not busy wait and THREAD-READ-CHAR and THREAD-PEEK-CHAR have
been removed.
Attempting to obtain a lock twice or to release an unowned lock
now signal errors.
READ-CHAR-WITH-TIMEOUT returns #F if the timeout occurs.
The socket structure is back in more-packages.scm.
Renamed .gdbinit to gdbinit
tar file now contains a top-level directory
3/22/94 (version 0.36)
Removed doc/lsc.ps for copyright reasons.
Fixed (* 47123 46039) multiply bug.
Modified vm/README to make it easier to run the VM.
3/16/94 (version 0.35)
Fixed (exact->inexact 0.1) -> 0..1. bug.
Fixed VM bug that permitted the creation of stored objects with
negative sizes.
3/8/94 (version 0.34)
"make check" target tests out various features.
Fixes for SGI IRIX 4.0.5 and MIPS RISC/OS 4.51, courtesy
Bryan O'Sullivan.
debug/run.scm and the "medium system" work again now.
misc/static.scm should work on the 68000.
Command processor no longer fluid-binds (interaction-environment)
on recursive entry.
2/24/94 (version 0.33)
Fixed bug in VM's interrupt system.
Made non-local srcdir work in Makefile.
Added (load-package 'bigbit) to vm/README.
2/23/94 (version 0.32)
Some incompatible changes to the VM; .image files will have
to be rebuilt.
Improvements to configuration script and to unix.c to support
a wider variety of Unixes. The system should now work
under any Posix-compliant Unix (except maybe for
char-ready?; see comments in unix.c).
Upped the default heap size from 4 meg (2 per semispace) to 6
meg (3 per semispace).
New command line argument -s <size> for specifying size of
stack buffer. Default is 2500 (words).
$@ -> "$@" in script (thanks to Paul Stodghill for this fix).
Obscure interrupt/exception VM bug fixed.
It is now possible to put an initial heap image into static
memory (effectively allocated by OS process creation).
Immutable initial objects go into static read-only memory,
and mutable initial objects go into static read-write
memory. Initial objects not copied by the GC. There is no
documentation yet, but look at the rules for little and
debug/little.o in the Makefile if you're interested.
2/13/94 (version 0.31)
Incompatible changes:
In interfaces, all exported syntactic keywords must be
given type :syntax. For example,
(define-interface my-macros
(export (my-macro :syntax) ...))
Image entry procedures for the ,build command are now
passed a list of strings, not just a single string, for
the command line arguments following -a.
The names of the macros defined in scheme48.h
(pairp, car, string_length, etc.) are now all upper case.
New "configure" script generates Makefile from Makefile.in
and sysdep.h from sysdep.h.in (thanks to Gnu autoconf).
See INSTALL and doc/install.txt.
Bug fixes:
Can now make vectors (strings, etc.) as big as the amount
of heap space available (but you're still screwed if you
try to make one bigger than 2^23-1 bytes - don't do it).
Non-ANSI-ness fixed in scheme48vm.c (jump out of, then
back into, a block expected block-local variables to be
unchanged).
Fixed big/external.scm (had VECTOR-POSQ instead of ENUM).
In (define-syntax foo bar) you got an error if bar was a
variable reference.
Plugged a storage leak (file-environments table in
env/debug.scm). Images made with ,build were too large.
Flushed extraneous delay from make-reflective-tower.
Renamed variables in Makefile to resemble Gnu standards.
Fixed definition of LINKER_RUNNABLE in Makefile.
Added doc/call-back.txt.
Fixed define-enumerated documentation (doc/big-scheme.txt).
Environment maps no longer retained for things in initial.image
and scheme48.image. This makes scheme48.image about 170K
smaller.
2/3/94 (version 0.30)
Faster EXPT.
FLOATNUMS improvement: (inexact->exact <float>) should now
work, e.g.
(inexact->exact (/ 1. 3.)) => 6004799503160661/18014398509481984
Reinstated ACCESS-SCHEME-48 for the benefit of PSD (portable
scheme debugger) and a certain other software package that
shall remain nameless. It only knows about a small number of
procedures, including things like ERROR and FORCE-OUTPUT.
Various changes to support the Pre-Scheme compiler, notably
SET-REFLECTIVE-TOWER-MAKER!.
Incompatible change to the ENUMERATED structure: the names
foo/bar no longer become defined. Write (enum foo bar)
instead. This will macro expand into the correct small
integer.
1/30/94 (version 0.29)
Fixed ps_run_time() to call sysconf() to find out how many
ticks there are per second. It used to assume 60. This
affects the output of the ,time command, so don't try
comparing numbers from this version with numbers from older
versions.
,time command will now accept a command, e.g.
,time ,load foo.scm.
It appears that if multiple arguments follow -a on the
argument line, they are concatenated together with spaces
separating them and passed to the startup procedure. I
don't know how long this has worked. This will change in
the future so that the startup procedure gets a list of
strings.
Installed what used to be called the GENERAL-TABLES structure
as the TABLES structure used by the system. This allows
the use of other comparison predicates besides EQ?, and
eliminates some code that had a restrictive copyright
notice.
ENUM, NAME->ENUMERAND, and ENUMERAND->NAME are all macros.
Enumerated types themselves are now macros as well.
1/23/94 Fixed bad multiplication bug in VM: (* 214760876 10) was
returning 125112.
Moved RECORD-TYPE? and RECORD-TYPE-FIELD-NAMES from the
RECORDS-INTERNAL interface to the RECORDS interface, for
a somewhat closer approximation to MIT Scheme.
Various type system improvements.
Still no documentation for the ,exec package, but see
link/load-linker.exec for an example.
New generic function feature, exported by the METHODS
interface (see interfaces.scm), almost like in a certain
dynamic object-oriented language.
1/11/94 (version 0.27)
Change:
The isomorphism used by CHAR->INTEGER and INTEGER->CHAR is
no longer ASCII. This change was introduced in order to
assist the development of portable programs. If you need
ASCII encoding, you should open the ASCII structure and
use the procedures CHAR->ASCII and ASCII->CHAR.
Features:
The help system is somewhat improved.
New form DEFINE-STRUCTURE defines a single structure.
Incompatible changes to package system:
Renamed DEFINE-PACKAGE to DEFINE-STRUCTURES
Renamed DEFINE-STRUCTURE to DEFINE
Renamed all the base types from FOO to :FOO. E.g.
:SYNTAX, :VALUE, :PAIR, etc.
Other:
Removed socket support due to restrictive copyright on some
of the C code that was in extension.c.
12/21/93 ,take has been flushed in favor of ,exec ,load. Commands are
now accessed via a distinguished package instead of a table.
Documentation pending.
Postscript (.ps) files now included in doc/ subdirectory. (I
thought they had been there all along, but apparently I was
wrong.)
Enhanced, but still kludgey, floating point support. Use
,open floatnum.
12/12/93 (version 0.26)
NetBSD port.
Hacked write-level and write-depth for inspecting circular
structure.
Recursive FORCEs signal errors, e.g.
(force (letrec ((loser (delay (force loser)))) loser))
12/7/93 (version 0.25)
Bug fix:
filenames.make can now be remade using initial.image. This
means that you can snarf a distribution and then edit
USUAL-FEATURES before making scheme48.image.
12/6/93 Incompatible changes:
Change of terminology: "signature" --> "interface".
This means that DEFINE-SIGNATURE is now called
DEFINE-INTERFACE, etc.
Some structures have been renamed:
condition -> conditions
continuation -> continuations
exception -> exceptions
queue -> queues
port -> ports
record -> records, record-internal -> records-internal
table -> tables
template -> templates
The ,load-into command has been removed. Use ,in ... ,load
instead (see below), e.g.
,in mumble ,load myfile.scm
The heap size for -h is specified in words, not bytes. As
before, the size must account for both semispaces; -h 2n
means n words per semispace. This change was actually
made a while ago, but I was confused as to what it meant.
Bug fixes:
#e1.7 reads as 17/10, (exact? 1+1.0i) => #f, and 1.0+i prints.
Features:
Things like ((structure-ref scheme if) 1 2 3) work.
The following commands now take arbitrary commands to execute
in the specified package, not just forms:
,config ,user ,for-syntax ,in <package>
For example, you can say
,in mumble ,trace foo
This subsumes the functionality of the ,load-into and
,load-config commands.
Dynamic loading of shared libraries for System V systems
(untested).
Documentation:
Somewhat improved. user-guide.txt now lists most of the
interesting built-in packages. lsc.ps is a draft of "A
Tractable Scheme Implementation," a paper submitted to Lisp
and Symbolic Computation. See also doc/big-scheme.txt,
doc/thread.txt, and doc/external.txt.
10/30/93 LET-SYNTAX and LETREC-SYNTAX.
Arrays (see big/array.scm).
Lots of internal changes.
7/20/93 Features:
Type system. See doc/types.txt.
7/4/93 Features:
New define-package clause (for-syntax <clause>*).
E.g. (define-package ((my-package ...))
(open ...)
(for-syntax (open scheme my-utilities)
(files more-crud-for-syntax))
...)
A file name to package map is now used by the emacs
interface. Whenever you load a file, or zap from a file that
hasn't been previously loaded or zapped, the package in
which forms are being evaluated is remembered in a table.
The next time you zap some forms from the same file, they
will be evaluated in that package.
Sometimes you may get an association you don't want. In that
situation, you can use the ,forget command to delete an
entry in the table.
A new ,push command goes to a deeper command level.
Experimental "command preferred" command processor mode: if
you give the command ",form-preferred off", commands will
be "preferred" to forms, meaning that you don't need to
type a comma before giving a command. To see the value
of a variable FOO you have to say (begin foo).
Experimental "no levels" command processor mode: if you
give the command ",levels off", then an error will not
push a new command level. If you want to ignore an
error, you don't need to take any action - further
evaluations will happen at top level. If you want to
enter the inspector or get a preview, you can issue these
commands or a ,push command immediately after the error
occurs (more precisely, any time until the focus object
is set by some other command).
All of the mode-control commands (batch, bench,
break-on-warnings, form-preferred, and levels) take
an optional argument. When no argument is given, they
will toggle the corresponding mode. With an argument of
ON or OFF, they turn the mode on or off.
The ,flush and ,keep commands have been made more flexible
and verbose.
6/18/93 Incompatible changes:
The access-scheme48 procedure has gone away. Use ,open
or the module system instead.
The user, configuration, and for-syntax packages no longer
have variables bound to them in the configuration package.
Where previously you said: Now you should say:
,in user <form> ,user <form>
,in config <form> ,config <form>
,in for-syntax <form> ,for-syntax <form>
,load-into config <file> ,load-config <file>
,load-into for-syntax <file> ,for-syntax (load "file")
Features:
There is an ,expand <form> command for debugging macros.
The ,open command takes any number of structure names, and opens
them all (like ,new-package).
New procedure DEFINE-INDENTATION exported by the PP structure.
E.g. (define-indentation 'let-fluid 1) is like Gnu emacs's
(put 'let-fluid 'scheme-indent-hook 1).
The inspector simplifies generated names in continuation
source code display. E.g. when formerly it said
"Waiting for (#{Generated lambda} () (x->node (car exps)))"
now it says
"Waiting for (lambda () (x->node (car exps)))"
Macros can signal syntax errors by returning input expression
unchanged. (Comparison uses EQ?.)
Documentation:
The doc/ directory contains a draft of a "Scheme 48
Progress Report."
Cleanup:
Procedure NULL-TERMINATE added to structure EXTERNALS's
signature.
"Vulgar Scheme" renamed to "Big Scheme".
Two new subdirectories, env/ (for programming environment)
and big/ (for Big Scheme), now contain most of what was
in the misc/ directory.
Several source files that were in the top level and link/
directories have moved to the env/ and alt/ directories.
5/6/93 Bug fixes:
Fixed -h command line switch. The size was being improperly
divided by 4, so if you asked for an N megabyte heap, you'd
actually only get an N/4 megabyte heap.
Nested backquotes were broken for a while; should be fixed
now.
Features:
Quoted structure is read-only: e.g. (set-car! '(a b) 3) will
produce an exception.
,config [<form>] and ,user [<form>] are like ,in <struct> <form>.
Unix socket support; see misc/socket.scm.
Now using gzip instead of compress for distributions.
,open command offers to load packages.
A .gdbinit file sets a breakpoint at CM's exception raising
code, and defines a handy "preview" command.
1/18/93 Feature:
Scheme 48 distributions now have version numbers. The
version number is printed in the image startup message.
Please include it in bug reports.
The module system is now documented. See doc/module.tex.
12/17/92 Bug fixes:
Macro templates of the form (x ... y) are supported.
Macro templates are now less fussy about meta-variable
rank: you can do "(x y) ..." even when the rank of either
x or y (but not both) is too low; the low-ranking text
will be copied as many times as necessary. (A
meta-variable's "rank" is the number of ...'s it sits
under in the left-hand side of the rewrite rule.)
SYNTAX-RULES is now itself hygienic. This means you can
have a meta-variable named CAR, for instance.
New development environment features:
Commands now start with comma (",") instead of colon
(":"). (Easier to type since it's not shifted.)
values, call-with-values, dynamic-wind, eval,
interaction-environment, and scheme-report-environment
added per upcoming Revised^5 Scheme report. See
doc/meeting.tex.
Modifications to quoted structure will now be detected and
reported as errors.
An interrupt will occur if an insufficient amount of memory
is reclaimed by a garbage collection.
Inspector now accepts arbitrary command processor commands
(with or without leading comma)
,keep command controls retention of debugging information.
Features removed:
#\page and #\tab. These aren't in the Scheme report.
Their absence in Scheme 48 will encourage portability.
access-scheme48 works with fewer names than before. Use the
package system instead.
Complex numbers not in the system, by default. Get them
back by changing usual-features in more-packages.scm.
Features changed:
Many changes to package system. See doc/module.tex.
The :identify-image command is gone. Instead, supply a
second argument (optional) to the ,dump command.
The inspector's TEM command has been shortened to T.
Internal changes and features:
Stored objects types are now part of the virtual machine
architecture, i.e. known to the byte-code compiler.
Run-time system is split up into many little modules.
File names are retained in debug database. (But not used for
anything yet...)
Tweaks to table package reduce standard image size by 50K
and increase compiler speed by 7%.
Immutability bit in object headers.
Weak pointers.
7/18/92 Features removed:
Table package's default hash function no longer supports
string, pairs, or vectors.
7/9/92 Bug fixes:
(- 0 -536870912)
Inspector now uses command i/o ports instead of current ones
Inexact integers print as N. instead of #iN
Throwing back into a call-with-....put-port now produces a
warning instead of an error
Feature fixes:
In DEFINE-PACKAGE, OPEN no longer implies ACCESS.
misc/receive.scm renamed to rts/values.scm, made to conform
with Revised^5 Report, and installed internally.
Features:
New :load-package command. Uses file names in (file ...) clause
of a define-package. These are interpreted relative to the
directory in which the file containing the define-package
was found.
#\tab and #\page now print this way.
6/17/92 Bug fixes:
Fixed bug in modulo.
Flushed LAST-PAIR (which disappeared between R^3 and R^4).
DEFINE-SYNTAX and SYNTAX-RULES now exist.
CEILING, FLOOR, and ROUND now exist.
GCD and LCM are now n-ary.
STRING-CI=? and STRING-COPY fixed.
STRING->SYMBOL now copies its argument before handing it to
INTERN.
=, <, etc. now work with more than two arguments.
CHAR-READY? exists.
Calls via APPLY are now tail-recursive.
DISPLAY of vectors and lists works (ugh).
Development environment improvements:
Type ? at inspector to get list of inspector commands.
Inspector D command goes to next continuation.
Inspector M command shows more of a long menu.
Inspector TEM command goes to a continuation's or closure's
template.
For closures and continuations, inspector displays local
variables with their names.
For continuations, inspector displays source code for
expression into which control will return.
Multiple command loop levels. EOF (control-D) now only pops
out a single level. :reset pops all the way out. :level n
goes out to level n.
Can disable benchmark mode.
Procedures made with (let ((f (lambda ...))) ...) now print
with names.
Features:
Package system: special forms define-package and package-ref;
command processor commands :set-package, :load-into,
:clear-package, :new-package, :export, :open-package, etc.
In misc directory: threads, queues, extended ports, format, etc.
Changes to system environment:
user-initial-environment -> user-package
record-updator -> record-modifier
primitive-throw superseded by with-continuation
ash -> arithmetic-shift
New bootstrap regime.
Support for threads: alarm clock interrupt, etc.
Etc.:
Liberal COPYRIGHT file, and a little notice in each source file.
INSTALL and NEWS split off from README.
doc.txt renamed to user-guide.txt.
The Makefile now provides two ways to make "s48" for
installation. One depends on the exec #! script execution
feature and the other doesn't.
"make" targets for testsys.image and little.image.
Runs Jaffer's test suite and library.
Flushed s48.el. Use cmuscheme instead.
9/5/90 Command processor argument parser revamped.
:load, :trace, and :untrace commands take arbitrary number
of arguments. Argument to :proceed is optional.
New (but undocumented) :identify-image command.
Better error messages: wrong number of arguments, undefined
variable.
+, *, min, max, apply are now n-ary; -, /, make-string,
make-vector, read-char, peek-char, write-char have
appropriate argument optionality.
Better internal support for macros; not yet ready for release.
Added STRING as per R^3.99RS.
More testing of Scheme version of bytecode interpreter.
Better scoping of ##; files can't see command processor context.
OR and CASE don't cons closures.
VM checks for non-existent heap image file, gives error
message instead of "bus error".
Numerous internal changes in compiler and exception system.
Fixed char<?.
Fixed -.5 bug in string->number.
8/26/90 Tested (link-system) inside of T; seems to work.
Benchmark mode available via :BENCH command.
System is 15K bigger due to new fatter global environment
representations.
Inspector abbreviation improved.
Disassembler now works on continuations, sort of.
7/26/90 ((lambda ...) ...) no longer makes a closure
Features now in default system:
:inspect
:dis[assemble]
Generic arithmetic: bignums, rationals, complexes
rationalize
:time command is more verbose
MOREFILES variable in Makefile for loading extra stuff
Default heap size increased to 2 megabytes per semispace

175
doc/no-leaf-env.txt Normal file
View File

@ -0,0 +1,175 @@
Return-Path: <kelsey@ccs.neu.edu>
Date: Mon, 14 Jun 93 14:34:40 -0400
To: jar@cs.cornell.edu
Subject: environments for leaf procedures
From: kelsey@flora.ccs.neu.edu
Sender: kelsey@ccs.neu.edu
I merged the no-leaf-environments code back into the system, and this
time it may be worth it. Loading pp.scm sped up by 2%, even though
the compiler is doing more work. Benchmark times (in seconds):
old new speedup
quicksort 1.48 1.39 6%
towers 1.05 1.05 0%
matrix-multiply 3.32 3.10 7%
matrix-multiply2 1.94 1.80 7%
Local variable names are screwed up:
> (define (f x) (let ((y 4)) (+ x y)))
> (f 'a)
Error: exception
(+ 'a 4)
1> ,debug
'#{Continuation (pc 13) f}
[0] 4
[1: y] 'a
inspect:
There is probably a simple fix for this.
Here is the diff:
% diff comp.scm comp.scm.save
26d25
< (define $compiling-leaf (make-fluid 'no))
28,33d26
< (define (note-not-leaf!)
< (set-fluid! $compiling-leaf 'no))
<
< (define (compiling-leaf?)
< (eq? 'yes (fluid $compiling-leaf)))
<
63,82c56,66
< (deliver-value (if (env-ref? den)
< (local-variable den cenv depth #f)
< (instruction-with-variable op/global exp den #f))
< cont)))
<
< (define (local-variable den cenv depth set?)
< (let ((back (env-ref-back den cenv))
< (over (env-ref-over den)))
< (if (and (compiling-leaf?)
< (= back 0))
< (instruction (if set? op/stack-set! op/stack-ref)
< (+ (- over 1) depth))
< (let ((back (if (compiling-leaf?) (- back 1) back)))
< (if set?
< (instruction op/set-local! back over)
< (case back
< ((0) (instruction op/local0 over)) ;+++
< ((1) (instruction op/local1 over)) ;+++
< ((2) (instruction op/local2 over)) ;+++
< (else (instruction op/local back over))))))))
---
> (if (env-ref? den)
> (let ((back (env-ref-back den cenv))
> (over (env-ref-over den)))
> (deliver-value (case back
> ((0) (instruction op/local0 over)) ;+++
> ((1) (instruction op/local1 over)) ;+++
> ((2) (instruction op/local2 over)) ;+++
> (else (instruction op/local back over)))
> cont))
> (deliver-value (instruction-with-variable op/global exp den #f)
> cont))))
143,145c127,132
< (if (env-ref? den)
< (local-variable den cenv depth #t)
< (instruction-with-variable op/set-global! name den #t)))
---
> (cond ((env-ref? den)
> (instruction op/set-local!
> (env-ref-back den cenv)
> (env-ref-over den)))
> (else
> (instruction-with-variable op/set-global! name den #t))))
203d189
< (note-not-leaf!) ; this isn't strictly necessary, but it keeps things simpler
222,231c208,215
< (cond ((return-cont? cont)
< code)
< (else
< (note-not-leaf!) ; this isn't strictly necessary, but it keeps things simpler
< (sequentially (instruction-with-offset&byte op/make-cont
< (segment-size code)
< depth)
< (note-source-code (cont-source-info cont)
< code)
< (cont-segment cont)))))
---
> (if (return-cont? cont)
> code
> (sequentially (instruction-with-offset&byte op/make-cont
> (segment-size code)
> depth)
> (note-source-code (cont-source-info cont)
> code)
> (cont-segment cont))))
264d247
< (note-not-leaf!)
280,315c263,284
< (let-fluids $compiling-leaf 'maybe
< (lambda ()
< (let ((code (really-compile-lambda-code formals body cenv name)))
< (if (eq? (fluid $compiling-leaf) 'maybe)
< (let-fluids $compiling-leaf 'yes
< (lambda ()
< (really-compile-lambda-code formals body cenv name)))
< code)))))
<
< (define (really-compile-lambda-code formals body cenv name)
< (let* ((nargs (number-of-required-args formals))
< (vars (normalize-formals formals))
< (cenv (if (null? formals)
< cenv ;+++
< (bind-vars vars cenv))))
< (sequentially
< (cond ((n-ary? formals)
< (sequentially
< (instruction op/make-rest-list nargs)
< (instruction op/push)
< (if (compiling-leaf?)
< empty-segment
< (instruction op/make-env (+ nargs 1)))))
< ((null? formals)
< (note-not-leaf!) ; no point if no variables
< empty-segment)
< ((compiling-leaf?)
< empty-segment)
< (else
< (instruction op/make-env nargs)))
< (note-environment
< vars
< (compile-body body
< cenv
< 0
< (return-cont name))))))
---
> (if (null? formals)
> (compile-body body ;+++ Don't make null environment
> cenv
> 0
> (return-cont name))
> (sequentially
> (let ((nargs (number-of-required-args formals)))
> (if (n-ary? formals)
> (sequentially
> (instruction op/make-rest-list nargs)
> (instruction op/push)
> (instruction op/make-env (+ nargs 1)))
> (instruction op/make-env nargs)))
> (let* ((vars (normalize-formals formals))
> (cenv (bind-vars vars cenv)))
> (note-environment
> vars
> (compile-body body
> cenv
> 0
> (return-cont name)))))))
>

81
doc/package.txt
View File

@ -1,81 +0,0 @@
-- this file is probably obsolete --
The package system interface. Much too complicated.
Signatures
make-simple-signature
make-compound-signature
signature?
signature-ref
signature-walk
Structures
make-structure
structure?
structure-signature
structure-package
structure-name
Packages
make-package
make-simple-package ;start.scm
Lookup and definition operations
package-lookup
package-lookup-type ;comp.scm
package-find-location ;rts/env.scm
package-lookup-location ;segment.scm
probe-package
package-check-assigned
package-check-variable
package-define!
package-define-type! ;hmm.
package-ensure-defined!
Things needed by the form/file/package scanner
for-each-definition ;for integrate-all-primitives!
package-accesses ;for scan-package
package-clauses ;for scan-package
package-file-name ;for scan-package
package-opens ;for scan-package
package-evaluator ;for define-syntax
package-for-syntax ;for define-syntax
Miscellaneous
$note-undefined ;eval.scm
noting-undefined-variables ;eval.scm, etc.
package-uid ;eval.scm
set-shadow-action! ;eval.scm
verify-later! ;for the define-structures macro
reset-packages-state! ;Makefile - for linker
initialize-reified-package! ;for reification
transform-for-structure-ref ;for reification ?
Inessential (for package mutation, programming environment)
check-structure
package-integrate? ;env/debug.scm
set-package-integrate?! ;env/debug.scm
package-loaded? ;env/load-package.scm
set-package-loaded?! ;env/load-package.scm
package-name ;env/command.scm
package-name-table ;env/debuginfo.scm
package-open! ;env/debug.scm
package-system-sentinel ;env/command.scm
package-unstable? ;env/pacman.scm
package? ;env/command.scm
undefined-variables ;env/debug.scm
Location names (also inessential)
flush-location-names
location-name
location-name-table
location-package-name

44
doc/porting.txt Normal file
View File

@ -0,0 +1,44 @@
What to do when your system isn't supported
First of all: DON'T PANIC. It's easy to get scsh to work on a new
system. Besides, you'll be a hero to the masses waiting for the Scheme
Shell on your platform. There is a sample "generic" system in
scsh/generic which you can copy as a base to modify. The modifications
mainly involve pulling some constants in from C header files and hacking
a few lines of C based on your standard I/O internals. I know, its C and
all, together we can survive. If you need some hand holding, feel free
to write to the scsh mailing list at scsh@zurich.ai.mit.edu.
stdio_dep.c:
This is the one C file you have to actually deal with. The code in here
defines two or three simple operations on stdio FILE*'s that are not
part of the stdio.h interface. The main things it needs to be able
to do is see if there is input ready, how much is ready, and to change
the file descriptor associated with a FILE*. Usually how to do this
is fairly obvious from <stdio.h>. Check out the other platforms for ideas.
errno.scm:
Scheme defines for C header values found in <errno.h>.
fdflags.scm:
Scheme defines for C header values found in <fcntl.h>.
netconst.scm:
Scheme defines for C header values found in socket and network includes.
signals.scm:
Scheme defines for C header values found in <sys/signal.h>.
waitcodes.scm:
Scheme defines for C header values and macros found in <sys/wait.h>.
packages.scm:
Scheme48 module definitions for the values in the above scheme files.
load-scsh.scm:
The script of commands and expressions used to build scsh.
After you've hacked these files together, it'd be nice to also hack
config.scsh to support your new machine. Run config.guess to see what it
thinks your machine is. Then, send us the info, and we'll make sure it
gets in a future release. (That means you, Jonathan.)

81
doc/scheme48.man Normal file
View File

@ -0,0 +1,81 @@
.TH LS48 1
.\" File scheme48.man: Manual page template for Scheme 48.
.\" Replace LS48 with the name of your default image and LLIB with the
.\" directory containing scheme48vm and default image.
.SH NAME
LS48 \- a Scheme interpreter
.SH SYNOPSIS
.B LS48
[-i image] [-h heapsize] [-a argument]
.SH DESCRIPTION
.B LS48
is an implementation of the Scheme programming language as described in
the
.I "Revised^4 Report on the Algorithmic Language Scheme."
A runnable system requires two parts, an executable program that implements
the Scheme 48 virtual machine, and an image that is used to initialize
the store of the virtual machine.
.B LS48
is a shell script that starts the virtual machine with an image that runs
in a Scheme command loop.
.PP
The
.B LS48
command loop reads Scheme expressions,
evaluates them, and prints their results.
It also executes commands, which are identified by an initial comma character.
Type the command
.I ,help
to receive a list of available commands.
.PP
The
.B \-h
option causes
.IR heapsize
words to be allocated for both semispaces of the copying garbage
collector. One word is four bytes. Cons cells are currently 3 words,
so if you want to make sure you can allocate, say, a million cons
cells, you should specify
.B \-h
6000000 (actually a little more, to account for the initial heap
image and breathing room).
.PP
The
.I ,dump
and
.I ,build
commands put heap images in files.
The
.B \-i
option causes the initial heap image to be taken from file
.IR image .
The
.B \-a
option causes a list of strings to be passed as the argument
to an image generated using the
.I ,build
command. The first argument to
.I ,build
is a procedure that is passed
the arguments following
.B \-a
and which should return an integer (which is the
return value of the Scheme 48 process).
.PP
.nf
> ,build (lambda (a) (display a) (newline) 0) foo.image
> ,exit
$ LS48 -i foo.image -a mumble
mumble
$
.PP
.fi
.SH FILES
.TP 40
.B LLIB/scheme48vm
the virtual machine.
.TP
.B LLIB/LS48.image
the default image.
.SH BUGS
Procedure calls with more than 63 explicit arguments might not work.

6
doc/scsh-manual/.gitignore vendored Normal file
View File

@ -0,0 +1,6 @@
*.aux *.log *.out
*.idx *.ilg *.ind *.dvi
.,*
*.toc
thumb*.png
man.ps man.pdf

1
doc/scsh-manual/.tex2page.hdir Normal file
View File

@ -0,0 +1 @@
html

44
doc/scsh-manual/Makefile Normal file
View File

@ -0,0 +1,44 @@
.SUFFIXES: .tex .dvi .ps .pdf $(.SUFFIXES)
TEX= front.tex intro.tex procnotation.tex syscalls.tex network.tex \
strings.tex awk.tex miscprocs.tex running.tex
TEX2PAGE=tex2page
man.dvi: $(TEX)
man.pdf: $(TEX)
.dvi.ps:
dvips -j0 -o $@ $<
.tex.dvi:
latex $< && latex $<
makeindex $(<:.tex=.idx)
rm $*.log
.tex.pdf:
pdflatex $< && thumbpdf $@ && pdflatex $<
makeindex $(<:.tex=.idx)
rm $*.log
clean:
-rm -f *.log *.png man.out man.dvi man.ps man.pdf thumb*.png
rm -rf html
INSTALL_DATA= install -c -m 644
tar:
tar cf - *.tex sty | gzip > man.tar.gz
html: $(TEX)
$(TEX2PAGE) man && $(TEX2PAGE) man
install: man.ps
@echo WARNING:
@echo WARNING: this depends on /u/su/scsh/scsh
@echo WARNING: pointing to the current release
@echo WARNING:
$(INSTALL_DATA) cheat.txt /u/su/scsh/scsh/doc/
$(INSTALL_DATA) man.ps /u/su/scsh/scsh/doc/scsh-manual.ps
$(INSTALL_DATA) $(TEX) /u/su/scsh/scsh/doc/scsh-manual/
$(INSTALL_DATA) sty/* /u/su/scsh/scsh/doc/scsh-manual/sty/

35
doc/scsh-manual/THANKS Normal file
View File

@ -0,0 +1,35 @@
Michel.Schinz@studi.epfl.ch
Documentation error in STRING-OUTPUT-PORT-OUTPUT.
Reported 12/19.
Victor Zandy
character-gobbling in (record-reader) caused by 'trim / 'peek
default misunderstanding in delimited readers. Fixed 4/5/96
Michael Becker
reap-policy = early can still lose if you loop and fork.
fork now reaps & retries if it loses and the policy is early reap.
This is a kludge until I have sigchld handlers.
Fixed 4/5/96
Tod Olson
Reported painfully slow delimited-reader I/O in November.
Michel.Schinz@studi.epfl.ch
Reported some picky little typos in the manual.
Shriram
Doc bugs in defrec.scm
euler@lavielle.COM (Lutz Euler) 2/24/97
Manual bugs and a bug in stdio->stdports.
Alan Bawden 4/97
Lots of good bug reports and fixes.
Jim Blandy 4/97
Fixes for meta.scm
Kevin Esler 4/97
Updated Irix port

32
doc/scsh-manual/ack.txt Normal file
View File

@ -0,0 +1,32 @@
Acknowledgements
Who should I thank? My so-called "colleagues," who laugh at me behind my
back, all the while becoming famous on *my* work? My worthless graduate
students, whose computer skills appear to be limited to downloading bitmaps
off of netnews? My parents, who are still waiting for me to quit "fooling
around with computers," go to med school, and become a radiologist? My
department chairman, a manager who gives one new insight into and sympathy for
disgruntled postal workers?
My God, no one could blame me--no one!--if I went off the edge and just lost
it completely one day. I couldn't get through the day as it is without the
Prozac and Jack Daniels I keep on the shelf, behind my Tops-20 JSYS manuals.
I start getting the shakes real bad around 10am, right before my advisor
meetings. A 10 oz. Jack 'n Zac helps me get through the meetings without one
of my students winding up with his severed head in a bowling-ball bag. They
look at me funny; they think I twitch a lot. I'm not twitching. I'm
controlling my impulse to snag my 9mm Sig-Sauer out from my day-pack and make
a few strong points about the quality of undergraduate education in Amerika.
If I thought anyone cared, if I thought anyone would even be reading this, I'd
probably make an effort to keep up appearances until the last possible
moment. But no one does, and no one will. So I can pretty much say exactly
what I think.
Oh, yes, the *acknowledgements.* I think not. I did it. I did it all,
by myself.
Olin Shivers
Cambridge
September 4, 1994

252
doc/scsh-manual/array.sty Normal file
View File

@ -0,0 +1,252 @@
%%
%% This is file `/usr2/distrib/latex209/nfss/array.sty' generated
%% on <1991/11/22> with the docstrip utility (v1.1k).
%%
%% The original source files were:
%%
%% /usr2/users/latex3/source/array/array.doc
%%
%% Copyright (C) 1989,1990,1991 by Frank Mittelbach, Rainer Schoepf.
%% All rights reserved.
%%
%% This file is part of the NFSS (New Font Selection Scheme) package.
%%
%% IMPORTANT NOTICE:
%%
%% You are not allowed to change this file. You may however copy this file
%% to a file with a different name and then change the copy if you obey
%% the restrictions on file changes described in readme.mz.
%%
%% You are allowed to distribute this file under the condition that it is
%% distributed together with all files mentioned in readme.mz3. If you
%% receive only some of these files from someone, complain!
%%
%% You are NOT ALLOWED to distribute this file alone. You are NOT ALLOWED
%% to take money for the distribution or use of either this file or a
%% changed version, except for a nominal charge for copying etc.
%%
%% For error reports in case of UNCHANGED versions see readme files.
%%
%% Please do not request updates from us directly. Distribution is done
%% through Mail-Servers and TeX organizations.
%%
\def\fileversion{v2.0e}
\def\filedate{91/02/07}
\def\docdate {90/08/20}
%% \CheckSum{681}
%% \CharacterTable
%% {Upper-case \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
%% Lower-case \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
%% Digits \0\1\2\3\4\5\6\7\8\9
%% Exclamation \! Double quote \" Hash (number) \#
%% Dollar \$ Percent \% Ampersand \&
%% Acute accent \' Left paren \( Right paren \)
%% Asterisk \* Plus \+ Comma \,
%% Minus \- Point \. Solidus \/
%% Colon \: Semicolon \; Less than \<
%% Equals \= Greater than \> Question mark \?
%% Commercial at \@ Left bracket \[ Backslash \\
%% Right bracket \] Circumflex \^ Underscore \_
%% Grave accent \` Left brace \{ Vertical bar \|
%% Right brace \} Tilde \~}
%%
\@ifundefined{d@llar}{}{\endinput}
\typeout{Style-Option: `array' \fileversion
\space\space <\filedate> (F.M.)}
\typeout{English documentation dated \space <\docdate> (F.M.)}
\def\@addtopreamble#1{\xdef\@preamble{\@preamble #1}}
\def\@testpach#1{\@chclass
\ifnum \@lastchclass=6 \@ne \@chnum \@ne \else
\ifnum \@lastchclass=7 5 \else
\ifnum \@lastchclass=8 \tw@ \else
\ifnum \@lastchclass=9 \thr@@
\else \z@
\ifnum \@lastchclass = 10 \else
\@chnum
\if #1c\z@ \else
\if #1l\@ne \else
\if #1r\tw@ \else
\z@ \@chclass
\if#1|\@ne \else
\if #1!6 \else
\if #1@7 \else
\if #1<8 \else
\if #1>9 \else
10
\@chnum
\if #1m\thr@@\else
\if #1p4 \else
\if #1b5 \else
\z@ \@chclass \z@ \@preamerr \z@ \fi \fi \fi \fi
\fi \fi \fi \fi \fi \fi \fi \fi \fi \fi \fi \fi}
\def\@xexpast#1*#2#3#4\@@{%
\@tempcnta #2
\toks@={#1}\@temptokena={#3}%
\let\the@toksz\relax \let\the@toks\relax
\def\@tempa{\the@toksz}%
\ifnum\@tempcnta >0 \@whilenum\@tempcnta >0\do
{\edef\@tempa{\@tempa\the@toks}\advance \@tempcnta \m@ne}%
\let \@tempb \@xexpast \else
\let \@tempb \@xexnoop \fi
\def\the@toksz{\the\toks@}\def\the@toks{\the\@temptokena}%
\edef\@tempa{\@tempa}%
\expandafter \@tempb \@tempa #4\@@}
\def\prepnext@tok{\advance \count@ \@ne
\toks\count@={}}
\def\save@decl{\toks\count@ \expandafter{\@nextchar}}
\def\insert@column{%
\the@toks \the \@tempcnta
{\ignorespaces \@sharp \unskip}%
\the@toks \the \count@ \relax}
\newdimen\col@sep
\def\@acol{\@addtopreamble{\hskip\col@sep}}
\def\@mkpream#1{\gdef\@preamble{}\@lastchclass 4 \@firstamptrue
\let\@sharp\relax \let\@startpbox\relax \let\@endpbox\relax
\@xexpast #1*0x\@@
\count@\m@ne
\let\the@toks\relax
\prepnext@tok
\expandafter \@tfor \expandafter \@nextchar
\expandafter :\expandafter =\@tempa \do
{\@testpach\@nextchar
\ifcase \@chclass \@classz \or \@classi \or \@classii
\or \save@decl \or \or \@classv \or \@classvi
\or \@classvii \or \@classviii \or \@classix
\or \@classx \fi
\@lastchclass\@chclass}%
\ifcase\@lastchclass
\@acol \or
\or
\@acol \or
\@preamerr \thr@@ \or
\@preamerr \tw@ \@addtopreamble\@sharp \or
\or
\else \@preamerr \@ne \fi
\def\the@toks{\the\toks}}
\def\@classx{%
\ifcase \@lastchclass
\@acolampacol \or
\@addamp \@acol \or
\@acolampacol \or
\or
\@acol \@firstampfalse \or
\@addamp
\fi}
\def\@classz{\@classx
\@tempcnta \count@
\prepnext@tok
\@addtopreamble{\ifcase \@chnum
\hfil
\d@llar
\insert@column
\d@llar \hfil \or
\d@llar \insert@column \d@llar \hfil \or
\hfil\kern\z@ \d@llar \insert@column \d@llar \or
$\vcenter
\@startpbox{\@nextchar}\insert@column \@endpbox $\or
\vtop \@startpbox{\@nextchar}\insert@column \@endpbox \or
\vbox \@startpbox{\@nextchar}\insert@column \@endpbox
\fi}\prepnext@tok}
\def\@classix{\ifnum \@lastchclass = \thr@@
\@preamerr \thr@@ \fi
\@classx}
\def\@classviii{\ifnum \@lastchclass >\z@
\@preamerr 4\@chclass 6 \@classvi \fi}
\def\@arrayrule{\@addtopreamble \vline}
\def\@classvii{\ifnum \@lastchclass = \thr@@
\@preamerr \thr@@ \fi}
\def\@classvi{\ifcase \@lastchclass
\@acol \or
\@addtopreamble{\hskip \doublerulesep}\or
\@acol \or
\@classvii
\fi}
\def\@classii{\advance \count@ \m@ne
\save@decl\prepnext@tok}
\def\@classv{\save@decl
\@addtopreamble{\d@llar\the@toks\the\count@\relax\d@llar}%
\prepnext@tok}
\def\@classi{\@classvi
\ifcase \@chnum \@arrayrule \or
\@classv \fi}
\def\@startpbox#1{\bgroup
\hsize #1 \@arrayparboxrestore
\vrule \@height \ht\@arstrutbox \@width \z@}
\def\@endpbox{\vrule \@width \z@ \@depth \dp \@arstrutbox \egroup}
\def\@array[#1]#2{%
\@tempdima \ht \strutbox
\advance \@tempdima by\extrarowheight
\setbox \@arstrutbox \hbox{\vrule
\@height \arraystretch \@tempdima
\@depth \arraystretch \dp \strutbox
\@width \z@}%
\begingroup
\@mkpream{#2}%
\xdef\@preamble{\ialign \@halignto
\bgroup \@arstrut \@preamble
\tabskip \z@ \cr}%
\endgroup
\if #1t\vtop \else \if#1b\vbox \else \vcenter \fi \fi
\bgroup
\let \@sharp ##\let \protect \relax
\lineskip \z@
\baselineskip \z@
\m@th
\let\\ \@arraycr \let\par\@empty \@preamble}
\newdimen \extrarowheight
\extrarowheight=0pt
\def\@arstrut{\unhcopy\@arstrutbox}
\def\@arraycr{{\ifnum 0=`}\fi
\@ifstar \@xarraycr \@xarraycr}
\def\@xarraycr{\@ifnextchar [%
\@argarraycr {\ifnum 0=`{\fi}\cr}}
\def\@argarraycr[#1]{\ifnum0=`{\fi}\ifdim #1>\z@
\@xargarraycr{#1}\else \@yargarraycr{#1}\fi}
\def\@xargarraycr#1{\unskip
\@tempdima #1\advance\@tempdima \dp\@arstrutbox
\vrule \@depth\@tempdima \@width\z@ \cr}
\def\@yargarraycr#1{\cr\noalign{\vskip #1}}
\def\multicolumn#1#2#3{%
\multispan{#1}\begingroup
\def\@addamp{\if@firstamp \@firstampfalse \else
\@preamerr 5\fi}%
\@mkpream{#2}\@addtopreamble\@empty
\endgroup
\def\@sharp{#3}%
\@arstrut \@preamble \ignorespaces}
\def\array{\col@sep\arraycolsep
\def\d@llar{$}\gdef\@halignto{}%
\@tabarray}
\def\@tabarray{\@ifnextchar[{\@array}{\@array[c]}}
\def\tabular{\gdef\@halignto{}\@tabular}
\expandafter\def\csname tabular*\endcsname#1{%
\gdef\@halignto{to#1}\@tabular}
\def\@tabular{%
\leavevmode
\hbox \bgroup $\col@sep\tabcolsep \let\d@llar\@empty
\@tabarray}
\def\endarray{\crcr \egroup \egroup \gdef\@preamble{}}
\def\endtabular{\endarray $\egroup}
\expandafter\let\csname endtabular*\endcsname=\endtabular
\let\@ampacol=\relax \let\@expast=\relax
\let\@arrayclassiv=\relax \let\@arrayclassz=\relax
\let\@tabclassiv=\relax \let\@tabclassz=\relax
\let\@arrayacol=\relax \let\@tabacol=\relax
\let\@tabularcr=\relax \let\@@endpbox=\relax
\let\@argtabularcr=\relax \let\@xtabularcr=\relax
\def\@preamerr#1{\def\@tempd{{..} at wrong position: }%
\@latexerr{%
\ifcase #1 Illegal pream-token (\@nextchar): `c' used\or %0
Missing arg: token ignored\or %1
Empty preamble: `l' used\or %2
>\@tempd token ignored\or %3
<\@tempd changed to !{..}\or %4
Only one colum-spec. allowed.\fi}\@ehc} %5
\def\@tfor#1:=#2\do#3{\def\@fortmp{#2}\ifx\@fortmp\@empty
\else\@tforloop#2\@nil\@nil\@@#1{#3}\fi}
\endinput
%%
%% End of file `/usr2/distrib/latex209/nfss/array.sty'.

672
doc/scsh-manual/awk.tex Normal file
View File

@ -0,0 +1,672 @@
%&latex -*- latex -*-
\chapter{Awk, record I/O, and field parsing}
\label{chapt:fr-awk}
{\Unix} programs frequently process streams of records,
where each record is delimited by a newline,
and records are broken into fields with other delimiters
(for example, the colon character in \ex{/etc/passwd}).
Scsh has procedures that allow the programmer to easily
do this kind of processing.
Scsh's field parsers can also be used to parse other kinds
of delimited strings, such as colon-separated \verb|$PATH| lists.
These routines can be used with scsh's \ex{awk} loop construct
to conveniently perform pattern-directed computation over streams
of records.
\section{Record I/O and field parsing}
\label{sec:field-reader}
The procedures in this section are used to read records from
I/O streams and parse them into fields.
A record is defined as text terminated by some delimiter (usually a newline).
A record can be split into fields by using regular expressions in
one of several ways: to \emph{match} fields, to \emph{separate} fields,
or to \emph{terminate} fields.
The field parsers can be applied to arbitrary strings (one common use is
splitting environment variables such as \ex{\$PATH} at colons into its
component elements).
The general delimited-input procedures described in
chapter~\ref{chapt:rdelim} are also useful for reading simple records,
such as single lines, paragraphs of text, or strings terminated by specific
characters.
\subsection{Reading records}
\defun{record-reader} {[delims elide-delims? handle-delim]} {\proc}
\begin{desc}
Returns a procedure that reads records from a port. The
procedure is invoked as follows:
%
\codex{(\var{reader} \var{[port]}) $\longrightarrow$
\textrm{\textit{{\str} or eof}}}
%
A record is a sequence of characters terminated by one of the characters
in \var{delims} or eof. If \var{elide-delims?} is true, then a contiguous
sequence of delimiter chars are taken as a single record delimiter. If
\var{elide-delims?} is false, then a delimiter char coming immediately
after a delimiter char produces an empty-string record. The reader
consumes the delimiting char(s) before returning from a read.
The \var{delims} set defaults to the set $\{\mbox{newline}\}$.
It may be a charset, string, character, or character predicate,
and is coerced to a charset.
The \var{elide-delims?} flag defaults to \ex{\#f}.
The \var{handle-delim} argument controls what is done with the record's
terminating delimiter.
\begin{inset}
\begin{tabular}{lp{0.6\linewidth}}
\ex{'trim} & Delimiters are trimmed. (The default)\\
\ex{'split}& Reader returns delimiter string as a second argument.
If record is terminated by EOF, then the eof object is
returned as this second argument. \\
\ex{'concat} & The record and its delimiter are returned as
a single string.
\end{tabular}
\end{inset}
The reader procedure returned takes one optional argument, the port
from which to read, which defaults to the current input port. It returns
a string or eof.
\end{desc}
\subsection{Parsing fields}
\label{sec:field-splitter}
\defun {field-splitter} {[field num-fields]} \proc
\defunx {infix-splitter} {[delim num-fields handle-delim]} \proc
\defunx {suffix-splitter} {[delim num-fields handle-delim]} \proc
\defunx {sloppy-suffix-splitter} {[delim num-fields handle-delim]} \proc
\begin{desc}
These functions return a parser function that can be used as follows:
\codex{(\var{parser} \var{string} \var{[start]}) $\longrightarrow$
\var{string-list}}
The returned parsers split strings into fields defined
by regular expressions. You can parse by specifying a pattern that
\emph{separates} fields, a pattern that \emph{terminates} fields, or
a pattern that \emph{matches} fields:
\begin{inset}
\begin{tabular}{l@{\qquad}l}
Procedure & Pattern \\ \hline
\ex{field-splitter} & matches fields \\
\ex{infix-splitter} & separates fields \\
\ex{suffix-splitter}& terminates fields \\
\ex{sloppy-suffix-splitter} & terminates fields
\end{tabular}
\end{inset}
These parser generators are controlled by a range of options, so that you
can precisely specify what kind of parsing you want. However, these
options default to reasonable values for general use.
Defaults:
\begin{tightinset}
\begin{tabular}{l@{\quad=\quad }ll}
\var{delim} & \ex{(rx (| (+ white) eos))} & (suffix delimiter: white space or eos) \\
\multicolumn{1}{l}{} & \ex{(rx (+ white))} & (infix delimiter: white space) \\
\var{field} & \verb|(rx (+ (~ white)))| & (non-white-space) \\
\var{num-fields} & \verb|#f| & (as many fields as possible) \\
\var{handle-delim} & \verb|'trim| & (discard delimiter chars)
\end{tabular}
\end{tightinset}
{\ldots}which means: break the string at white space, discarding the
white space, and parse as many fields as possible.
The \var{delim} parameter is a regular expression matching the text
that occurs between fields.
See chapter~\ref{chapt:sre} for information on regular expressions,
and the \ex{rx} form used to specify them.
In the separator case,
it defaults to a pattern matching white space;
in the terminator case,
it defaults to white space or end-of-string.
The \var{field} parameter is a regular expression used
to match fields. It defaults to non-white-space.
The \var{delim} patterns may also be given as a string,
character, or char-set, which are coerced to regular expressions.
So the following expressions are all equivalent,
each producing a function that splits strings apart at colons:
\begin{inset}
\begin{verbatim}
(infix-splitter (rx ":"))
(infix-splitter ":")
(infix-splitter #\:)
(infix-splitter (char-set #\:))\end{verbatim}
\end{inset}
The boolean \var{handle-delim} determines what to do with delimiters.
\begin{tightinset}\begin{tabular}{ll}
\ex{'trim} & Delimiters are thrown away after parsing. (default) \\
\ex{'concat} & Delimiters are appended to the field preceding them. \\
\ex{'split} & Delimiters are returned as separate elements in
the field list.
\end{tabular}
\end{tightinset}
The \var{num-fields} argument used to create the parser specifies how many
fields to parse. If \ex{\#f} (the default), the procedure parses them all.
If a positive integer $n$, exactly that many fields are parsed; it is an
error if there are more or fewer than $n$ fields in the record. If
\var{num-fields} is a negative integer or zero, then $|n|$ fields
are parsed, and the remainder of the string is returned in the last
element of the field list; it is an error if fewer than $|n|$ fields
can be parsed.
The field parser produced is a procedure that can be employed as
follows:
\codex{(\var{parse} \var{string} \var{[start]}) \evalto \var{string-list}}
The optional \var{start} argument (default 0) specifies where in the string
to begin the parse. It is an error if
$\var{start} > \ex{(string-length \var{string})}$.
The parsers returned by the four parser generators implement different
kinds of field parsing:
\begin{description}
\item[\ex{field-splitter}]
The regular expression specifies the actual field.
\item[\ex{suffix-splitter}]
Delimiters are interpreted as element \emph{terminators}.
If vertical-bar is the the delimiter, then the string \ex{""}
is the empty record \ex{()}, \ex{"foo|"} produces a one-field record
\ex{("foo")}, and \ex{"foo"} is an error.
The syntax of suffix-delimited records is:
\begin{inset}
\begin{tabular}{lcll}
\synvar{record} & ::= & \ex{""} \qquad (Empty record) \\
& $|$ & \synvar{element} \synvar{delim}
\synvar{record}
\end{tabular}
\end{inset}
It is an error if a non-empty record does not end with a delimiter.
To make the last delimiter optional, make sure the delimiter regexp
matches the end-of-string (sre \ex{eos}).
\item [\ex{infix-splitter}]
Delimiters are interpreted as element \emph{separators}. If comma is the
delimiter, then the string \ex{"foo,"} produces a two-field
record \ex{("foo" "")}.
The syntax of infix-delimited records is:
\begin{inset}
\begin{tabular}{lcll}
\synvar{record} & ::= & \ex{""} \qquad (Forced to be empty record) \\
& $|$ & \synvar{real-infix-record} \\
\\
\synvar{real-infix-record} & ::= & \synvar{element} \synvar{delim}
\synvar{real-infix-record} \\
& $|$ & \synvar{element}
\end{tabular}
\end{inset}
Note that separator semantics doesn't really allow for empty
records---the straightforward grammar (\ie, \synvar{real-infix-record})
parses an empty string as a singleton list whose one field is the empty
string, \ex{("")}, not as the empty record \ex{()}. This is unfortunate,
since it means that infix string parsing doesn't make \ex{string-append}
and \ex{append} isomorphic. For example,
\codex{((infix-splitter ":") (string-append \var{x} ":" \var{y}))}
doesn't always equal
\begin{code}
(append ((infix-splitter ":") \var{x})
((infix-splitter ":") \var{y}))\end{code}
It fails when \var{x} or \var{y} are the empty string.
Terminator semantics \emph{does} preserve a similar isomorphism.
However, separator semantics is frequently what other Unix software
uses, so to parse their strings, we need to use it. For example,
Unix \verb|$PATH| lists have separator semantics. The path list
\ex{"/bin:"} is broken up into \ex{("/bin" "")}, not \ex{("/bin")}.
Comma-separated lists should also be parsed this way.
\item[\ex{sloppy-suffix}]
The same as the \ex{suffix} case, except that the parser will skip an
initial delimiter string if the string begins with one instead of parsing
an initial empty field. This can be used, for example, to field-split a
sequence of English text at white-space boundaries, where the string may
begin or end with white space, by using regex
\begin{code}{(rx (| (+ white) eos))}\end{code}
(But you would be better off using \ex{field-splitter} in this case.)
\end{description}
\end{desc}
Figure~\ref{fig:splitters} shows how the different parser grammars
split apart the same strings.
%
\begin{boxedfigure}{tbp}
\begin{center}\small
\begin{tabular}{lllll}
Record & : suffix & \verb!:|$! suffix & : infix & non-: field \\
\hline
\ex{""} & \ex{()} & \ex{()} & \ex{()} & \ex{()} \\
\ex{":"} & \ex{("")} & \ex{("")} & \ex{("" "")} & \ex{()} \\
\ex{"foo:"} & \ex{("foo")} & \ex{("foo")} & \ex{("foo" "")} & \ex{("foo")} \\
\ex{":foo"}& \emph{error} & \ex{("" "foo")}& \ex{("" "foo")}& \ex{("foo")} \\
\ex{"foo:bar"} & \emph{error} & \ex{("foo" "bar")} & \ex{("foo" "bar")} & \ex{("foo" "bar")}
\end{tabular}
\end{center}
\caption{Using different grammars to split records into fields.}
\label{fig:splitters}
\end{boxedfigure}
%
Having to choose between the different grammars requires you to decide
what you want, but at least you can be precise about what you are parsing.
Take fifteen seconds and think it out. Say what you mean; mean what you
say.
\defun{join-strings} {string-list [delimiter grammar]} \str
\begin{desc}
This procedure is a simple unparser---it pastes strings together using
the delimiter string.
The \var{grammar} argument is one of the symbols \ex{infix} (the default)
or \ex{suffix}; it determines whether the
delimiter string is used as a separator or as a terminator.
The delimiter is the string used to delimit elements; it defaults to
a single space \ex{" "}.
Example:
\begin{code}
(join-strings '("foo" "bar" "baz") ":")
\qquad{\evalto} "foo:bar:baz"\end{code}
\end{desc}
\subsection{Field readers}
\defun{field-reader} {[field-parser rec-reader]} \proc
\begin{desc}
This utility returns a procedure that reads records with field structure
from a port.
The reader's interface is designed to make it useful in the \ex{awk}
loop macro (section~\ref{sec:awk}).
The reader is used as follows:
\codex{(\var{reader} \var{[port]}) {\evalto} \var{[raw-record parsed-record]} or \var{[eof ()]}}
When the reader is applied to an input port (default: the current
input port), it reads a record using \var{rec-reader}. If this record isn't
the eof object, it is parsed with \var{field-parser}. These two
values---the record, and its parsed representation---are returned
as multiple values from the reader.
When called at eof, the reader returns [eof-object \ex{()}].
Although the record reader typically returns a string, and
the field-parser typically takes a string argument, this is not
required. The record reader can produce, and the field-parser consume,
values of any type. However, the empty list returned as the
parsed value on eof is hardwired into the field reader.
For example, if port \ex{p} is open on \ex{/etc/passwd}, then
\codex{((field-reader (infix-splitter ":" 7)) p)}
returns two values:
{\small
\begin{widecode}
"dalbertz:mx3Uaqq0:107:22:David Albertz:/users/dalbertz:/bin/csh"
("dalbertz" "mx3Uaqq0" "107" "22" "David Albertz" "/users/dalbertz"
"/bin/csh")\end{widecode}}
The \var{field-parser} defaults to the value of \ex{(field-splitter)},
a parser that picks out sequences of non-white-space strings.
The \var{rec-reader} defaults to \ex{read-line}.
Figure~\ref{fig:field-readers} shows \ex{field-reader} being
used to read different kinds of Unix records.
\begin{boxedfigure}{tbhp}
\begin{centercode}
;;; /etc/passwd reader
(field-reader (infix-splitter ":" 7))
; wandy:3xuncWdpKhR.:73:22:Wandy Saetan:/usr/wandy:/bin/csh
;;; Two ls -l output readers
(field-reader (infix-splitter (rx (+ white)) 8))
(field-reader (infix-splitter (rx (+ white)) -7))
; -rw-r--r-- 1 shivers 22880 Sep 24 12:45 scsh.scm
;;; Internet hostname reader
(field-reader (field-splitter (rx (+ (~ ".")))))
; stat.sinica.edu.tw
;;; Internet IP address reader
(field-reader (field-splitter (rx (+ (~ "."))) 4))
; 18.24.0.241
;;; Line of integers
(let ((parser (field-splitter (rx (? ("+-")) (+ digit)))))
(field-reader (\l{s} (map string->number (parser s))))
; 18 24 0 241
;;; Same as above.
(let ((reader (field-reader (field-splitter (rx (? ("+-"))
(+ digit))))))
(\lx{maybe-port} (map string->number (apply reader maybe-port))))
; Yale beat harvard 26 to 7.\end{centercode}
\caption{Some examples of \protect\ex{field-reader}}
\label{fig:field-readers}
\end{boxedfigure}
\end{desc}
\subsection{Forward-progress guarantees and empty-string matches}
A loop that pulls text off a string by repeatedly matching a regexp
against that string can conceivably get stuck in an infinite loop if
the regexp matches the empty string. For example, the SREs
\ex{bos}, \ex{eos}, \ex{(* any)}, and \ex{(| "foo" (* (~ "f")))}
can all match the empty string.
The routines in this package that iterate through strings with regular
expressions are careful to handle this empty-string case.
If a regexp matches the empty string, the next search starts, not from
the end of the match (which in the empty string case is also the
beginning---that's the problem), but from the next character over.
This is the correct behaviour. Regexps match the longest possible
string at a given location, so if the regexp matched the empty string
at location $i$, then it is guaranteed it could not have matched
a longer pattern starting with character $i$. So we can safely begin
our search for the next match at char $i+1$.
With this provision, every iteration through the loop makes some forward
progress, and the loop is guaranteed to terminate.
This has the effect you want with field parsing. For example, if you split
a string with the empty pattern, you will explode the string into its
individual characters:
\codex{((suffix-splitter (rx)) "foo") {\evalto} ("" "f" "o" "o")}
However, even though this boundary case is handled correctly, we don't
recommend using it. Say what you mean---just use a field splitter:
\codex{((field-splitter (rx any)) "foo") {\evalto} ("f" "o" "o")}
Or, more efficiently,
\codex{((\l{s} (map string (string->list s))) "foo")}
\subsection{Reader limitations}
Since all of the readers in this package require the ability to peek
ahead one char in the input stream, they cannot be applied to raw
integer file descriptors, only Scheme input ports. This is because
Unix doesn't support peeking ahead into input streams.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Awk}
\label{sec:awk}
Scsh provides a loop macro and a set of field parsers that can
be used to perform text processing very similar to the Awk programming
language.
The basic functionality of Awk is factored in scsh into its component
parts.
The control structure is provided by the \ex{awk} loop macro;
the text I/O and parsers are provided by the field-reader subroutine library
(section~\ref{sec:field-reader}).
This factoring allows the programmer to compose the basic loop structure
with any parser or input mechanism at all.
If the parsers provided by the field-reader package are insufficient,
the programmer can write a custom parser in Scheme and use it with
equal ease in the awk framework.
Awk-in-scheme is given by a loop macro called \ex{awk}. It looks like
this:
\begin{code}\cdmath
(awk \synvar{next-record} \synvar{record\&field-vars}
{\rm[\synvar{counter}]} \synvar{state-var-decls}
\synvar{clause$_1$} \ldots)\index{awk}\end{code}
The body of the loop is a series of clauses, each one representing
a kind of condition/action pair. The loop repeatedly reads a record,
and then executes each clause whose condition is satisfied by the record.
Here's an example that reads lines from port \ex{p}
and prints the line number and line of every line containing the
string ``\ex{Church-Rosser}'':
\begin{code}
(awk (read-line) (ln) lineno ()
("Church-Rosser" (format #t "~d: ~s~%" lineno ln)))\end{code}
This example has just one clause in the loop body, the one that
tests for matches against the regular expression ``\ex{Church-Rosser}''.
The \synvar{next-record} form is an expression that is evaluated each time
through the loop to produce a record to process.
This expression can return multiple values;
these values are bound to the variables given in the
\synvar{record\&field-vars} list of variables.
The first value returned is assumed to be the record;
when it is the end-of-file object, the loop terminates.
For example, let's suppose we want to read items from \ex{/etc/password},
and we use the \ex{field-reader} procedure to define a record parser for
\ex{/etc/passwd} entries:
\codex{(define read-passwd (field-reader (infix-splitter ":" 7)))}
binds \ex{read-passwd} to a procedure that reads in a line of text when
it is called, and splits the text at colons. It returns two values:
the entire line read, and a seven-element list of the split-out fields.
(See section~\ref{sec:field-reader} for more on \ex{field-reader} and
\ex{infix-splitter}.)
So if the \synvar{next-record} form in an \ex{awk} expression is
\ex{(read-passwd)}, then \synvar{record\&field-vars} must be a list of
two variables, \eg,
\codex{(record field-vec)}
since \ex{read-passwd} returns two values.
Note that \ex{awk} allows us to use \emph{any} record reader we want in the
loop, returning whatever number of values we like. These values
don't have to be strings or string lists. The only requirement
is that the record reader return the eof object as its first value
when the loop should terminate.
The \ex{awk} loop allows the programmer to have loop variables. These are
declared and initialised by the \synvar{state-var-decls} form, a
\codex{((\var{var} \var{init-exp}) (\var{var} \var{init-exp}) \ldots)}
list rather like the \ex{let} form. Whenever a clause in the loop body
executes, it evaluates to as many values as there are state variables,
updating them.
The optional \synvar{counter} variable is an iteration counter.
It is bound to 0 when the loop starts.
The counter is incremented each time a non-eof record is read.
There are several kinds of loop clause. When evaluating the body of the
loop, \ex{awk} evaluates \emph{all} the clauses sequentially.
Unlike \ex{cond}, it does not stop after the first clause is satisfied;
it checks them all.
\begin{itemize}
\itum{\ex{(\var{test} \vari{body}1 \vari{body}2 \ldots)}}
If \var{test} is true, execute the body forms. The last body form
is the value of the clause. The test and body forms are evaluated
in the scope of the record and state variables.
The \var{test} form can be one of:
\begin{inset}
\begin{tabular}{lp{0.6\linewidth}}
\var{integer}: & The test is true for that iteration of the loop.
The first iteration is \#1. \\
\var{sre}: & A regular expression, in SRE notation
(see chapter~\ref{chapt:sre}) can be used as
a test. The test is successful if the pattern
matches the record.
In particular, note that any string is an SRE. \\
\ex{(when \var{expr})}: &
The body of a \ex{when} test is evaluated as a
Scheme boolean expression in the inner scope of the
\ex{awk} form. \\
\var{expr}: & If the form is none of the above, it is treated as
a Scheme expression---in practice, the \ex{when}
keyword is only needed in cases where SRE/Scheme
expression ambiguity might occur.
\end{tabular}
\end{inset}
\itum{\begin{tabular}[t]{l}
\ex{(range\ \ \ \var{start-test} \var{stop-test} \vari{body}1 \ldots)} \\
\ex{(:range\ \ \var{start-test} \var{stop-test} \vari{body}1 \ldots)} \\
\ex{(range:\ \ \var{start-test} \var{stop-test} \vari{body}1 \ldots)} \\
\ex{(:range:\ \var{start-test} \var{stop-test} \vari{body}1 \ldots)}
\end{tabular}}
%
These clauses become activated when \var{start-test} is true;
they stay active on all further iterations until \var{stop-test}
is true.
So, to print out the first ten lines of a file, we use the clause:
\codex{(:range: 1 10 (display record))}
The colons control whether or not the start and stop lines
are processed by the clause. For example:
\begin{inset}\begin{tabular}{l@{\qquad}l}
\ex{(range\ \ \ 1 5\ \ \ldots)} & Lines \phantom{1} 2 3 4 \\
\ex{(:range\ \ 1 5\ \ \ldots)} & Lines 1 2 3 4 \\
\ex{(range:\ \ 1 5\ \ \ldots)} & Lines \phantom{1} 2 3 4 5 \\
\ex{(:range: 1 5\ \ \ldots)} & Lines 1 2 3 4 5
\end{tabular}
\end{inset}
A line can trigger both tests, either simultaneously starting and
stopping an active region, or simultaneously stopping one and starting
a new one, so ranges can abut seamlessly.
\itum{\ex{(else \vari{body}1 \vari{body}2 \ldots)}}
If no other clause has executed since the top of the loop, or
since the last \ex{else} clause, this clause executes.
\itum{\ex{(\var{test} => \var{exp})}}
If evaluating \ex{test} produces a true value,
apply \var{exp} to that value.
If \var{test} is a regular expression, then \var{exp} is applied
to the match data structure returned by the regexp match routine.
\itum{\ex{(after \vari{body}1 \ldots)}}
This clause executes when the loop encounters EOF. The body forms
execute in the scope of the state vars and the record-count var,
if there are any. The value of the last body form is the value
of the entire awk form.
If there is no \ex{after} clause, \ex{awk} returns the loop's state
variables as multiple values.
\end{itemize}
\subsection{Examples}
Here are some examples of \ex{awk} being used to process various types
of input stream.
\begin{code}
(define $ nth) ; Saves typing.
;;; Print out the name and home-directory of everyone in /etc/passwd:
(let ((read-passwd (field-reader (infix-splitter ":" 7))))
(call-with-input-file "/etc/passwd"
(lambda (port)
(awk (read-passwd port) (record fields) ()
(#t (format #t "~a's home directory is ~a~%"
($ fields 0)
($ fields 5)))))))\end{code}
\begin{code}
;;; Print out the user-name and home-directory of everyone whose
;;; name begins with "S"
(let ((read-passwd (field-reader (infix-splitter ":" 7))))
(call-with-input-file "/etc/passwd"
(lambda (port)
(awk (read-passwd port) (record fields) ()
((: bos "S")
(format #t "~a's home directory is ~a~%"
($ fields 0)
($ fields 5)))))))\end{code}
\begin{code}
;;; Read a series of integers from stdin. This expression evaluates
;;; to the number of positive numbers that were read. Note our
;;; "record-reader" is the standard Scheme READ procedure.
(awk (read) (i) ((npos 0))
((> i 0) (+ npos 1)))\end{code}
\begin{code}
;;; Filter -- pass only lines containing my name.
(awk (read-line) (line) ()
("Olin" (display line) (newline)))\end{code}
\begin{code}
;;; Count the number of non-comment lines of code in my Scheme source.
(awk (read-line) (line) ((nlines 0))
((: bos (* white) ";") nlines) ; A comment line.
(else (+ nlines 1))) ; Not a comment line.\end{code}
\begin{code}
;;; Read numbers, counting the evens and odds.
(awk (read) (val) ((evens 0) (odds 0))
((> val 0) (display "pos ") (values evens odds)) ; Tell me about
((< val 0) (display "neg ") (values evens odds)) ; sign, too.
(else (display "zero ") (values evens odds))
((even? val) (values (+ evens 1) odds))
(else (values evens (+ odds 1))))\end{code}
\begin{code}
;;; Determine the max length of all the lines in the file.
(awk (read-line) (line) ((max-len 0))
(#t (max max-len (string-length line))))\end{code}
\begin{code}
;;; (This could also be done with PORT-FOLD:)
(port-fold (current-input-port) read-line
(lambda (line maxlen) (max (string-length line) maxlen))
0)\end{code}
\begin{code}
;;; Print every line longer than 80 chars.
;;; Prefix each line with its line #.
(awk (read-line) (line) lineno ()
((> (string-length line) 80)
(format #t "~d: ~s~%" lineno line)))\end{code}
\begin{code}
;;; Strip blank lines from input.
(awk (read-line) (line) ()
((~ white) (display line) (newline)))\end{code}
\begin{code}
;;; Sort the entries in /etc/passwd by login name.
(for-each (lambda (entry) (display (cdr entry)) (newline)) ; Out
(sort (lambda (x y) (string<? (car x) (car y))) ; Sort
(let ((read (field-reader (infix-splitter ":" 7)))) ; In
(awk (read) (line fields) ((ans '()))
(#t (cons (cons ($ fields 0) line) ans))))))\end{code}
\begin{code}
;;; Prefix line numbers to the input stream.
(awk (read-line) (line) lineno ()
(#t (format #t "~d:\\t~a~%" lineno line)))\end{code}
\section{Backwards compatibility}
Previous scsh releases provided an \ex{awk} form with a different syntax,
designed around regular expressions written in Posix notation as strings,
rather than SREs.
This form is still available in a separate module for old code.
It'll be documented in the next release of this manual. Dig around
in the sources for it.

45
doc/scsh-manual/boxedminipage.sty Normal file
View File

@ -0,0 +1,45 @@
% boxedminipage.sty
%
% adds the boxedminipage environment---just like minipage, but has a
% box round it!
%
% The thickneess of the rules around the box is controlled by
% \fboxrule, and the distance between the rules and the edges of the
% inner box is governed by \fboxsep.
%
% This code is based on Lamport's minipage code.
\def\boxedminipage{\@ifnextchar [{\@iboxedminipage}{\@iboxedminipage[c]}}
\def\@iboxedminipage[#1]#2{\leavevmode \@pboxswfalse
\if #1b\vbox
\else \if #1t\vtop
\else \ifmmode \vcenter
\else \@pboxswtrue $\vcenter
\fi
\fi
\fi\bgroup % start of outermost vbox/vtop/vcenter
\hsize #2
\hrule\@height\fboxrule
\hbox\bgroup % inner hbox
\vrule\@width\fboxrule \hskip\fboxsep \vbox\bgroup % innermost vbox
\advance\hsize -2\fboxrule \advance\hsize-2\fboxsep
\textwidth\hsize \columnwidth\hsize
\@parboxrestore
\def\@mpfn{mpfootnote}\def\thempfn{\thempfootnote}\c@mpfootnote\z@
\let\@footnotetext\@mpfootnotetext
\let\@listdepth\@mplistdepth \@mplistdepth\z@
\@minipagerestore\@minipagetrue
\everypar{\global\@minipagefalse\everypar{}}}
\def\endboxedminipage{%
\par\vskip-\lastskip
\ifvoid\@mpfootins\else
\vskip\skip\@mpfootins\footnoterule\unvbox\@mpfootins\fi
\egroup % ends the innermost \vbox
\hskip\fboxsep \vrule\@width\fboxrule
\egroup % ends the \hbox
\hrule\@height\fboxrule
\egroup% ends the vbox/vtop/vcenter
\if@pboxsw $\fi}

296
doc/scsh-manual/code.sty Normal file
View File

@ -0,0 +1,296 @@
% code.sty: -*- latex -*-
% Latex macros for a "weak" verbatim mode.
% -- like verbatim, except \, {, and } have their usual meanings.
% Environments: code, tightcode, codeaux, codebox, centercode
% Commands: \dcd, \cddollar, \cdmath, \cd, \codeallowbreaks, \codeskip, \^
% Already defined in LaTeX, but of some relevance: \#, \$, \%, \&, \_, \{, \}
% Changelog at the end of the file.
% These commands give you an environment, code, that is like verbatim
% except that you can still insert commands in the middle of the environment:
% \begin{code}
% for(x=1; x<loop_bound; x++)
% y += x^3; /* {\em Add in {\tt x} cubed} */
% \end{code}
%
% All characters are ordinary except \{}. To get \{} in your text,
% you use the commands \\, \{, and \}.
% These macros mess with the definition of the special chars (e.g., ^_~%).
% The characters \{} are left alone, so you can still have embedded commands:
% \begin{code} f(a,b,\ldots,y,z) \end{code}
% However, if your embedded commands use the formerly-special chars, as in
% \begin{code} x := x+1 /* \mbox{\em This is $y^3$} */ \end{code}
% then you lose. The $ and ^ chars are scanned in as non-specials,
% so they don't work. If the chars are scanned *outside* the code env,
% then you have no problem:
% \def\ycube{$y^3$}
% \begin{code} x := x+1 /* {\em This is \ycube} */ \end{code}
% If you must put special chars inside the code env, you do it by
% prefixing them with the special \dcd ("decode") command, that
% reverts the chars to back to special status:
% \begin{code} x := x+1 /* {\dcd\em This is $y^3$} */ \end{code}
% \dcd's scope is bounded by its enclosing braces. It is only defined within
% the code env. You can also turn on just $ with the \cddollar command;
% you can turn on just $^_ with the \cdmath command. See below.
%
% Alternatively, just use \(...\) for $...$, \sp for ^, and \sb for _.
% WARNING:
% Like \verb, you cannot put a \cd{...} inside an argument to a macro
% or a command. If you try, for example,
% \mbox{\cd{$x^y$}}
% you will lose. That is because the text "\cd{$x^y$}" gets read in
% as \mbox's argument before the \cd executes. But the \cd has to
% have a chance to run before LaTeX ever reads the $x^y$ so it can
% turn off the specialness of $ and ^. So, \cd has to appear at
% top level, not inside an argument. Similarly, you can't have
% a \cd or a \code inside a macro (Although you could use \gdef to
% define a macro *inside* a \cd, which you could then use outside.
% Don't worry about this if you don't understand it.)
% BUG: In the codebox env, the effect of a \dcd, \cddollar, or \cdmath
% command is reset at the end of each line. This can be hacked by
% messing with the \halign's preamble, if you feel up to it.
% Useage note: the initial newline after the \begin{code} or
% \begin{codebox} is eaten, but the last newline is not.
% So,
% \begin{code}
% foo
% bar
% \end{code}
% leaves one more blank line after bar than does
% \begin{code}
% foo
% bar\end{code}
% Moral: get in the habit of terminating code envs without a newline
% (as in the second example).
%
% All this stuff tweaks the meaning of space, tab, and newline.
%===============================================================================
% \cd@obeyspaces
% Turns all spaces into non-breakable spaces.
% Note: this is like \@vobeyspaces except without spurious space in defn.
% @xobeysp is basically a space; it's defined in latex.tex.
%
{\catcode`\ =\active\gdef\cd@obeyspaces{\catcode`\ =\active\let =\@xobeysp}}
% \cd@obeytabs
% Turns all tabs into 8 non-breakable spaces (which is bogus).
%
{\catcode`\^^I=\active %
\gdef\cd@obeytabs{\catcode`\^^I=\active\let^^I=\cd@tab}}
\def\cd@tab{\@xobeysp\@xobeysp\@xobeysp\@xobeysp\@xobeysp\@xobeysp\@xobeysp\@xobeysp}
% \cd@obeylines
% Turns all cr's into linebreaks. Pagebreaks are not permitted between lines.
% This is copied from lplain.tex's \obeylines, with the cr def'n changed.
%
{\catcode`\^^M=\active % these lines must end with %
\gdef\cd@obeylines{\catcode`\^^M=\active\let^^M=\cd@cr}}
% What ^M turns into. This def'n keeps blank lines from being compressed out.
\def\cd@cr{\par\penalty10000\leavevmode} % TeX magicness
%\def\cd@cr{\par\penalty10000\mbox{}} % LaTeX
% \codeallowbreaks
% Same as \cd@obeylines, except pagebreaks are allowed.
% Put this command inside a code env to allow pagebreaks.
{\catcode`\^^M=\active % these lines must end with %
\gdef\codeallowbreaks{\catcode`\^^M\active\let^^M\cd@crbr}}
%\def\cd@crbr{\leavevmode\endgraf} % What ^M turns into.
\def\cd@crbr{\par\leavevmode} % What ^M turns into.
% \cd@obeycrsp
% Turns cr's into non-breakable spaces. Used by \cd.
{\catcode`\^^M=\active % these lines must end with %
\gdef\cd@obeycrsp{\catcode`\^^M=\active\let^^M=\@xobeysp}}
% =============================================================================
% Set up code environment, in which most of the common special characters
% appearing in code are treated verbatim, namely: $&#^_~%
% \ { } are still enabled so that macros can be called in this
% environment. Use \\, \{, and \} to use these characters verbatim
% in this environment.
%
% Inside a group, you can make
% all the hacked chars special with the \dcd command
% $ special with the \cddollar command
% $^_ special with the \cdmath command.
% If you have a bunch of math $..$'s in your code env, then a global \cddollar
% or \cdmath at the beginning of the env can save a lot of trouble.
% When chars are special (e.g., after a \dcd), you can still get #$%&_{} with
% \#, \$, \%, \&, \_, \{, and \} -- this is standard LaTeX.
% Additionally, \\ gives \ inside the code env, and when \cdmath
% makes ^ special, it also defines \^ to give ^.
%The hacked characters can be made special again
% within a group by using the \dcd command.
% Note: this environment allows no breaking of lines whatsoever; not
% at spaces or hypens. To arrange for a break use the standard \- command,
% or a \discretionary{}{}{} which breaks, but inserts nothing. This is useful,
% for example for allowing hypenated identifiers to be broken, e.g.
% \def\={\discretionary{}{}{}} %optional break
% FOO-\=BAR.
\def\setupcode{\parsep=0pt\parindent=0pt%
\normalfont\ttfamily\frenchspacing\catcode``=13\@noligs%
\def\\{\char`\\}%
\let\dcd=\cd@dcd\let\cddollar=\cd@dollarspecial\let\cdmath=\cd@mathspecial%
\@makeother\$\@makeother\&\@makeother\#%
\@makeother\^\@makeother\_\@makeother\~%
\@makeother\%\cd@obeytabs\cd@obeyspaces}
% other: $&#^_~%
% left special: \{}
% unnecessary: @`'"
%% codebox, centercode
%%=============================================================================
%% The codebox env makes a box exactly as wide as it needs to be
%% (i.e., as wide as the longest line of code is). This is useful
%% if you want to center a chunk of code, or flush it right, or
%% something like that. The optional argument to the environment,
%% [t], [c], or [b], specifies how to vertically align the codebox,
%% just as with arrays or other boxes. Default is [c].
%% Must be a newline immediately after "\begin{codebox}[t]"!
{\catcode`\^^M=\active % these lines must end with %
\gdef\cd@obeycr{\catcode`\^^M=\active\let^^M=\cr}}
% If there is a [<letter>] option, then the following newline will
% be read *after* ^M is bound to \cr, so we're cool. If there isn't
% an option given (i.e., default to [c]), then the @\ifnextchar will
% gobble up the newline as it gobbles whitespace. So we insert the
% \cr explicitly. Isn't TeX fun?
\def\codebox{\leavevmode\@ifnextchar[{\@codebox}{\@codebox[c]\cr}} %]
\def\@codebox[#1]%
{\hbox\bgroup$\if #1t\vtop \else \if#1b\vbox \else \vcenter \fi\fi\bgroup%
\tabskip\z@\setupcode\cd@obeycr% just before cd@obey
\halign\bgroup##\hfil\span}
\def\endcodebox{\crcr\egroup\egroup\m@th$\egroup}
% Center the box on the page:
\newenvironment{centercode}%
{\begin{center}\begin{codebox}[c]}%
{\end{codebox}\end{center}}
%% code, codeaux, tightcode
%%=============================================================================
%% Code environment as described above. Lines are kept on one page.
%% This actually works by setting a huge penalty for breaking
%% between lines of code. Code is indented same as other displayed paras.
%% Note: to increase left margin, use \begin{codeaux}{\leftmargin=1in}.
% To allow pagebreaks, say \codeallowbreaks immediately inside the env.
% You can allow breaks at specific lines with a \pagebreak form.
%% N.B.: The \global\@ignoretrue command must be performed just inside
%% the *last* \end{...} before the following text. If not, you will
%% get an extra space on the following line. Blech.
%% This environment takes two arguments.
%% The second, required argument is the \list parameters to override the
%% \@listi... defaults.
%% - Usefully set by clients: \topsep \leftmargin
%% - Possible, but less useful: \partopsep
%% The first, optional argument is the extra \parskip glue that you get around
%% \list environments. It defaults to the value of \parskip.
\def\codeaux{\@ifnextchar[{\@codeaux}{\@codeaux[\parskip]}} %]
\def\@codeaux[#1]#2{%
\bgroup\parskip#1%
\begin{list}{}%
{\parsep\z@\rightskip\z@\listparindent\z@\itemindent\z@#2}%
\item[]\setupcode\cd@obeylines}%
\def\endcodeaux{\end{list}\leavevmode\egroup\ignorespaces\global\@ignoretrue}
%% Code env is codeaux with the default margin and spacing \list params:
\def\code{\codeaux{}} \let\endcode=\endcodeaux
%% Like code, but with no extra vertical space above and below.
\def\tightcode{\codeaux[=0pt]{\topsep\z@}}%
\let\endtightcode\endcodeaux
% {\vspace{-1\parskip}\begin{codeaux}{\partopsep\z@\topsep\z@}}%
% {\end{codeaux}\vspace{-1\parskip}}
% Reasonable separation between lines of code
\newcommand{\codeskip}{\penalty0\vspace{2ex}}
% \cd is used to build a code environment in the middle of text.
% Note: only difference from display code is that cr's are taken
% as unbreakable spaces instead of linebreaks.
\def\cd{\leavevmode\begingroup\ifmmode\let\startcode=\startmcode\else%
\let\startcode\starttcode\fi%
\setupcode\cd@obeycrsp\startcode}
\def\starttcode#1{#1\endgroup}
\def\startmcode#1{\hbox{#1}\endgroup}
% Restore $&#^_~% to their normal catcodes
% Define \^ to give the ^ char.
% \dcd points to this guy inside a code env.
\def\cd@dcd{\catcode`\$=3\catcode`\&=4\catcode`\#=6\catcode`\^=7%
\catcode`\_=8\catcode`\~=13\catcode`\%=14\def\^{\char`\^}}
% Selectively enable $, and $^_ as special.
% \cd@mathspecial also defines \^ give the ^ char.
% \cddollar and \cdmath point to these guys inside a code env.
\def\cd@dollarspecial{\catcode`\$=3}
\def\cd@mathspecial{\catcode`\$=3\catcode`\^=7\catcode`\_=8%
\def\^{\char`\^}}
% Change log:
% Started off as some macros found in C. Rich's library.
% Olin 1/90:
% Removed \makeatletter, \makeatother's -- they shouldn't be there,
% because style option files are read with makeatletter. The terminal
% makeatother screwed things up for the following style options.
% Olin 3/91:
% Rewritten.
% - Changed things so blank lines don't get compressed out (the \leavevmove
% in \cd@cr and \cd@crwb).
% - Changed names to somewhat less horrible choices.
% - Added lots of doc, so casual hackers can more easily mess with all this.
% - Removed `'"@ from the set of hacked chars, since they are already
% non-special.
% - Removed the bigcode env, which effect can be had with the \codeallowbreaks
% command.
% - Removed the \@noligs command, since it's already defined in latex.tex.
% - Win big with the new \dcd, \cddollar, and \cdmath commands.
% - Now, *only* the chars \{} are special inside the code env. If you need
% more, use the \dcd command inside a group.
% - \cd now works inside math mode. (But if you use it in a superscript,
% it still comes out full size. You must explicitly put a \scriptsize\tt
% inside the \cd: $x^{\cd{\scriptsize\tt...}}$. A \leavevmode was added
% so that if you begin a paragraph with a \cd{...}, TeX realises you
% are starting a paragraph.
% - Added the codebox env. Tricky bit involving the first line hacked
% with help from David Long.
% Olin 8/94
% Changed the font commands for LaTeX2e.

114
doc/scsh-manual/css.t2p Normal file
View File

@ -0,0 +1,114 @@
% css.t2p
% Dorai Sitaram
% 19 Jan 2001
% A basic style for HTML documents generated
% with tex2page.
\ifx\shipout\UNDEFINED
\cssblock
body {
color: black;
/* background-color: #e5e5e5;*/
background-color: #ffffff;
/*background-color: beige;*/
margin-top: 2em;
margin-left: 8%;
margin-right: 8%;
}
h1,h2,h3,h4,h5,h6 {
margin-top: .5em;
}
.partheading {
font-size: 100%;
}
.chapterheading {
font-size: 100%;
}
pre {
margin-left: 2em;
}
ol {
list-style-type: decimal;
}
ol ol {
list-style-type: lower-alpha;
}
ol ol ol {
list-style-type: lower-roman;
}
ol ol ol ol {
list-style-type: upper-alpha;
}
.scheme {
color: brown;
}
.scheme .keyword {
color: #990000;
font-weight: bold;
}
.scheme .builtin {
color: #990000;
}
.scheme .variable {
color: navy;
}
.scheme .global {
color: purple;
}
.scheme .selfeval {
color: green;
}
.scheme .comment {
color: teal;
}
.schemeresponse {
color: green;
}
.navigation {
color: red;
text-align: right;
font-style: italic;
}
.disable {
/* color: #e5e5e5; */
color: gray;
}
.smallcaps {
font-size: 75%;
}
.smallprint {
color: gray;
font-size: 75%;
text-align: right;
}
.smallprint hr {
text-align: left;
width: 40%;
}
\endcssblock
\fi
% ex:ft=css

6
doc/scsh-manual/ct.sty Normal file
View File

@ -0,0 +1,6 @@
% Loads cmtt fonts in on \tt. -*- latex -*-
% I prefer these to the Courier fonts that latex gives you w/postscript styles.
% Courier is too spidery and too wide -- it's hard to get 80 chars on a line.
% -Olin
\renewcommand{\ttdefault}{cmtt}

278
doc/scsh-manual/decls.tex Normal file
View File

@ -0,0 +1,278 @@
\makeatletter
\def\ie{\mbox{\emph{i.e.}}} % \mbox keeps the last period from
\def\Ie{\mbox{\emph{I.e.}}} % looking like an end-of-sentence.
\def\eg{\mbox{\emph{e.g.}}}
\def\Eg{\mbox{\emph{E.g.}}}
\def\etc{{\em etc.}}
\def\Lisp{\textsc{Lisp}}
\def\CommonLisp{\textsc{Common Lisp}}
\def\Ascii{\textsc{Ascii}}
\def\Ansi{\textsc{Ansi}}
\def\Unix{{Unix}} % Not smallcaps, according to Bart.
\def\Scheme{{Scheme}}
\def\scm{{Scheme 48}}
\def\RnRS{R5RS}
\def\Posix{\textsc{Posix}}
\def\sharpf{\textnormal{\texttt{\#f}}}
\def\sharpt{\textnormal{\texttt{\#t}}}
\newcommand{\synteq}{\textnormal{::=}}
\def\maketildeother{\catcode`\~=12}
\def\maketildeactive{\catcode`\~=13}
\def\~{\char`\~}
\newcommand{\evalsto}{\ensuremath{\Rightarrow}}
% One-line code examples
%\newcommand{\codex}[1]% One line, centred. Tight spacing.
% {$$\abovedisplayskip=.75ex plus 1ex minus .5ex%
% \belowdisplayskip=\abovedisplayskip%
% \abovedisplayshortskip=0ex plus .5ex%
% \belowdisplayshortskip=\abovedisplayshortskip%
% \hbox{\ttt #1}$$}
%\newcommand{\codex}[1]{\begin{tightinset}\ex{#1}\end{tightinset}\ignorespaces}
\newcommand{\codex}[1]{\begin{leftinset}\ex{#1}\end{leftinset}\ignorespaces}
\def\widecode{\codeaux{\leftmargin=0pt\topsep=0pt}}
\def\endwidecode{\endcodeaux}
% For multiletter vars in math mode:
\newcommand{\var}[1]{\mbox{\frenchspacing\it{#1}}}
\newcommand{\vari}[2]{\ensuremath{\mbox{\it{#1}}_{#2}}}
%% What you frequently want when you say \tt:
\def\ttchars{\catcode``=13\@noligs\frenchspacing}
\def\ttt{\normalfont\ttfamily\ttchars}
% Works in math mode; all special chars remain special; cheaper than \cd.
% Will not be correct size in super and subscripts, though.
\newcommand{\ex}[1]{{\normalfont\texttt{\ttchars #1}}}
\newenvironment{inset}
{\bgroup\parskip=1ex plus 1ex\begin{list}{}%
{\topsep=0pt\rightmargin\leftmargin}%
\item[]}%
{\end{list}\leavevmode\egroup\global\@ignoretrue}
\newenvironment{leftinset}
{\bgroup\parskip=1ex plus 1ex\begin{list}{}%
{\topsep=0pt}%
\item[]}%
{\end{list}\leavevmode\egroup\global\@ignoretrue}
\newenvironment{tightinset}
{\bgroup\parskip=0pt\begin{list}{}%
{\topsep=0pt\rightmargin\leftmargin}%
\item[]}%
{\end{list}\leavevmode\egroup\global\@ignoretrue}
\newenvironment{tightleftinset}
{\bgroup\parskip=0pt\begin{list}{}%
{\topsep=0pt}%
\item[]}%
{\end{list}\leavevmode\egroup\global\@ignoretrue}
\long\def\remark#1{\bgroup\small\begin{quote}\textsl{Remark: } #1\end{quote}\egroup}
\newenvironment{remarkenv}{\bgroup\small\begin{quote}\textsl{Remark: }}%
{\end{quote}\egroup}
\newcommand{\oops}[1]{\bgroup\small\begin{quote}\textsl{Oops: } #1\end{quote}\egroup}
\newcommand{\note}[1]{\{Note #1\}}
\newcommand{\itum}[1]{\item{\bf #1}\\*}
% For use in code. The \llap magicness makes the lambda exactly as wide as
% the other chars in \tt; the \hskip shifts it right a bit so it doesn't
% crowd the left paren -- which is necessary if \tt is cmtt.
% Note that (\l{x y} (+ x y)) uses the same number of columns in TeX form
% as it produces when typeset. This makes it easy to line up the columns
% in your input. \l is bound to some useless command in LaTeX, so we have to
% define it w/renewcommand.
\let\oldl\l %Save the old \l on \oldl
\renewcommand{\l}[1]{\ \llap{$\lambda$\hskip-.05em}\ (#1)}
% This one is for the rare (lambda x ...) case -- it doesn't have the
% column-invariant property. Oh, well.
\newcommand{\lx}[1]{\ \llap{$\lambda$\hskip-.05em}\ {#1}}
% For subcaptions
\newcommand{\subcaption}[1]
{\unskip\vspace{-2mm}\begin{center}\unskip\em#1\end{center}}
%%% T release notes stuff
\newlength{\notewidth}
\setlength{\notewidth}{\textwidth}
\addtolength{\notewidth}{-1.25in}
%\newcommand{\remark} [1]
% {\par\vspace{\parskip}
% \parbox[t]{.75in}{\sc Remark:}
% \parbox[t]{\notewidth}{\em #1}
% \vspace{\parskip}
% }
\newenvironment{optiontable}%
{\begin{tightinset}\renewcommand{\arraystretch}{1.5}%
\begin{tabular}{@{}>{\ttt}ll@{}}}%
{\end{tabular}\end{tightinset}}%
\newenvironment{desctable}[1]%
{\begin{inset}\renewcommand{\arraystretch}{1.5}%
\begin{tabular}{lp{#1}}}%
{\end{tabular}\end{inset}}
\def\*{{\ttt *}}
% Names of things
\newcommand{\keyword} [1]{\index{#1}{\normalfont\textsf{#1}}}
% \ex{#1} and also generates an index entry.
\newcommand{\exi}[1]{\index{#1@\texttt{#1}}\ex{#1}}
\newcommand{\indextt}[1]{\index{#1@\texttt{#1}}}
\newcommand{\evalto}{$\Longrightarrow$\ }
\renewcommand{\star}{$^*$\/}
\newcommand{\+}{$^+$}
% Semantic domains, used to indicate the type of a value
\newcommand{\sem}{\normalfont\itshape} %semantic font
\newcommand{\semvar}[1]{\textit{#1}} %semantic font
\newcommand{\synvar}[1]{\textrm{\textit{$\left<\right.$#1$\left.\right>$}}} %syntactic font
\newcommand{\type}{\sem}
\newcommand{\zeroormore}[1]{{\sem #1$_1$ \ldots #1$_n$}}
\newcommand{\oneormore}[1]{{\sem #1$_1$ #1$_2$ \ldots #1$_n$}}
\newcommand{\proc} {{\sem procedure}}
\newcommand{\boolean} {{\sem boolean}}
\newcommand{\true} {{\sem true}}
\newcommand{\false} {{\sem false}}
\newcommand{\num} {{\sem number}}
\newcommand{\fixnum} {{\sem fixnum}}
\newcommand{\integer} {{\sem integer}}
\newcommand{\real} {{\sem real}}
\newcommand{\character} {{\sem character}}
\newcommand{\str} {{\sem string}}
\newcommand{\sym} {{\sem symbol}}
\newcommand{\location} {{\sem location}}
\newcommand{\object} {{\sem object}}
\newcommand{\error} {{\sem error}}
\newcommand{\syntaxerror} {{\sem syntax error}}
\newcommand{\readerror} {{\sem read error}}
\newcommand{\undefined} {{\sem undefined}}
\newcommand{\noreturn} {{\sem no return value}}
\newcommand{\port} {{\sem port}}
% semantic variables
\newcommand{\identifier} {{\sem identifier}}
\newcommand{\identifiers} {\zeroormore{\<ident>}}
\newcommand{\expr} {{\sem expression}}
\newcommand{\body} {{\sem body}}
\newcommand{\valueofbody} {{\sem value~of~body}}
\newcommand{\emptylist} {{\sem empty~list}}
\newcommand{\car} {\keyword{car}}
\newcommand{\cdr} {\keyword{cdr}}
\newcommand{\TMPDIR}{\texttt{\$TMPDIR}}
% generally useful things
% For line-breaking \tt stuff.
\renewcommand{\=}{\discretionary{-}{}{-}}
\newcommand{\ob}{\discretionary{}{}{}} % Optional break.
\newcommand{\indx}[1]{#1 \index{ #1 }}
%\newcommand{\gloss}[1]{#1 \glossary{ #1 }}
% This lossage produces #2 if #1 is zero length, otw #3.
% We use it to conditionally add a space between the procedure and
% the args in procedure prototypes, but only if there are any args--
% we want to produce "(read)", not "(read )".
\newlength{\voidlen}
\newcommand{\testvoid}[3]{\settowidth\voidlen{#1}\ifdim\voidlen>0in{#3}\else{#2}\fi}
% Typeset a definition prototype line, e.g.:
% (cons <arg1> <arg2>) -> pair procedure
%
% Five args are: proc-name args ret-value(s) type index-entry
\newcommand{\dfnix}[5]
{\hbox to \linewidth{\ttchars%
{\ttt(#1\testvoid{#2}{}{\ }{\sem{#2}}\testvoid{#2}{}{\/})\hskip 1em minus
0.5em$\longrightarrow$\hskip 1em minus 0.5em{\sem{#3}}\hfill\quad\textnormal{#4}}}\index{#5}}
\newcommand{\dfnx}[4] {\dfnix{#1}{#2}{#3}{#4}{#1@\texttt{#1}}}
\newcommand{\dfn} {\par\medskip\dfnx} % Takes 4 args, actually.
\newcommand{\dfni} {\par\medskip\dfnix} % Takes 5 args, actually.
\newcommand{\defvar} {\par\medskip\defvarx} % Takes 4 args, actually.
\newcommand{\defvarx}[2]%
{\index{#1}
\hbox to \linewidth{\ttchars{{\ttt{#1}} \hfill #2}}}%
% Typeset the protocol line, then do the following descriptive text indented.
% If you want to group two procs together, do the first one with a \dfn,
% then the second one, and the documentation, with a \defndescx.
% This one doesn't put whitespace above. Use it immediately after a \dfn
% to group two prototype lines together.
\newenvironment{dfndescx}[4]%
{\dfnx{#1}{#2}{#3}{#4}\begin{desc}}{\end{desc}}
\newenvironment{dfndesc}[4] % This one puts whitespace above.
{\par\medskip\begin{dfndescx}{#1}{#2}{#3}{#4}}
{\end{dfndescx}}
\newenvironment{desc}%
{\nopagebreak[2]%
\smallskip
\bgroup\begin{list}{}{\topsep=0pt\parskip=0pt}\item[]}
{\end{list}\leavevmode\egroup\global\@ignoretrue}
\def\defun#1#2#3{\dfn{#1}{#2}{#3}{procedure}} % preskip
\newcommand{\defunx}[3]{\dfnx{#1}{#2}{#3}{procedure}} % no skip
\newenvironment{defundescx}[3]%
{\begin{dfndescx}{#1}{#2}{#3}{procedure}}
{\end{dfndescx}}
\newenvironment{defundesc}[3]%
{\begin{dfndesc}{#1}{#2}{#3}{procedure}}
{\end{dfndesc}}
\newenvironment{column}{\begin{tabular}[t]{@{}l@{}}}{\end{tabular}}
\newenvironment{exampletable}%
{\begin{leftinset}%
\newcommand{\header}[1]{\multicolumn{2}{@{}l@{}}{##1}\\}%
\newcommand{\splitline}[2]%
{\multicolumn{2}{@{}l@{}}{##1}\\\multicolumn{2}{@{}l@{}}{\qquad\evalto\quad{##2}}}
\begin{tabular}{@{}l@{\quad\evalto\quad}l@{}}}%
{\end{tabular}\end{leftinset}}
% Put on blank lines in a code env to allow a pagebreak.
\newcommand{\cb}{\pagebreak[0]}
\newenvironment{boxedcode}
{\begin{inset}\tabular{|l|}\hline}
{\\ \hline \end{tabular}\end{inset}}
% A ragged-right decl that doesn't redefine \\ -- for use in tables.
\newcommand{\raggedrightparbox}{\let\temp=\\\raggedright\let\\=\temp}
\newenvironment{boxedfigure}[1]%
{\begin{figure}[#1]\begin{boxedminipage}{\linewidth}\vskip 1.5ex}
{\end{boxedminipage}\end{figure}}
\makeatother

76
doc/scsh-manual/draftfooters.sty Normal file
View File

@ -0,0 +1,76 @@
% Document style option "draftfooter"
% -- usage: \documentstyle[...,draftfooter,...]{...}
% -- puts "DRAFT" with date and time in page footer
%
% Olin Shivers 1/17/94
% - Hacked from code I used in my dissertation and from code in a
% drafthead.sty package written by Stephen Page sdpage@uk.ac.oxford.prg.
%----------------------------------------------------------------------------
%
% compute the time in hours and minutes; make new variables \timehh and \timemm
%
\newcount\timehh\newcount\timemm
\timehh=\time
\divide\timehh by 60 \timemm=\time
\count255=\timehh\multiply\count255 by -60 \advance\timemm by \count255
%
\def\draftbox{{\protect\small\bf \fbox{DRAFT}}}
\def\drafttime{%
{\protect\small\sl\today\ -- \ifnum\timehh<10 0\fi%
\number\timehh\,:\,\ifnum\timemm<10 0\fi\number\timemm}}
\def\drafttimer{\protect\makebox[0pt][r]{\drafttime}}
\def\drafttimel{\protect\makebox[0pt][l]{\drafttime}}
\def\thepagel{\protect\makebox[0pt][l]{\rm\thepage}}
\def\thepager{\protect\makebox[0pt][r]{\rm\thepage}}
% Header is empty.
% Footer is "date DRAFT pageno"
\def\ps@plain{
\let\@mkboth\@gobbletwo
\let\@oddhead\@empty \let\@evenhead\@empty
\def\@oddfoot{\reset@font\rm\drafttimel\hfil\draftbox\hfil\thepager}
\if@twoside
\def\@evenfoot{\reset@font\rm\thepagel\hfil\draftbox\hfil\drafttimer}
\else \let\@evenfoot\@oddfoot
\fi
}
% Aux macro -- sets footer to be "date DRAFT".
\def\@draftfooters{
\def\@oddfoot{\reset@font\rm\drafttimel\hfil\draftbox}
\if@twoside
\def\@evenfoot{\reset@font\rm\draftbox\hfil\drafttimer}
\else \let\@evenfoot\@oddfoot
\fi
}
% Header is empty.
% Footer is "date DRAFT".
\def\ps@empty{
\let\@mkboth\@gobbletwo
\let\@oddhead\@empty \let\@evenhead\@empty
\@draftfooters
}
% Header is defined by the document style (article, book, etc.).
% Footer is "date DRAFT".
\let\@draftoldhead\ps@headings
\def\ps@headings{
\@draftoldhead % Do the default \pagestyle{headings} stuff.
\@draftfooters % Then define the draft footers:
}
% Header is defined by the document style (article, book, etc.),
% and filled in by user's \markboth and \markright commands.
% Footer is "date DRAFT".
\let\@draftoldmyhead\ps@myheadings
\def\ps@myheadings{
\@draftoldmyhead % Do the default \pagestyle{myheadings} stuff.
\@draftfooters % Then define the draft footers:
}
\ps@plain

56
doc/scsh-manual/front.tex Normal file
View File

@ -0,0 +1,56 @@
%&latex -*- latex -*-
\title{Scsh Reference Manual}
\subtitle{For scsh release 0.6.4}
\author{Olin Shivers, Brian D.~Carlstrom, Martin Gasbichler, and Mike Sperber}
\date{April 2003}
\maketitle
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Some code-changes for tex2page and latex output. NF
\texonly
\chapter*{Acknowledgements}
\endtexonly
\htmlonly
\\ \ex{Acknowledgements} \\ \\
\endhtmlonly
Who should I thank?
My so-called ``colleagues,'' who laugh at me behind my back,
all the while becoming famous on {\em my\/} work?
My worthless graduate students, whose computer skills appear to
be limited to downloading bitmaps off of netnews?
My parents, who are still waiting for me to quit ``fooling around with
computers,'' go to med school, and become a radiologist?
My department chairman, a manager who gives one new insight into
and sympathy for disgruntled postal workers?
My God, no one could blame me---no one!---if I went off the edge and just
lost it completely one day.
I couldn't get through the day as it is without the Prozac and Jack Daniels
I keep on the shelf, behind my Tops-20 JSYS manuals.
I start getting the shakes real bad around 10am, right before my
advisor meetings. A 10 oz.\ Jack 'n Zac helps me get through the
meetings without one of my students winding up with his severed head
in a bowling-ball bag. They look at me funny; they think I twitch a
lot. I'm not twitching. I'm controlling my impulse to snag my 9mm
Sig-Sauer out from my day-pack and make a few strong points about
the quality of undergraduate education in Amerika.
If I thought anyone cared, if I thought anyone would even be reading this,
I'd probably make an effort to keep up appearances until the last possible
moment. But no one does, and no one will. So I can pretty much say exactly
what I think.
Oh, yes, the {\em acknowledgements.}
I think not. I did it. I did it all, by myself.
\begin{flushright}
\begin{tabular}{l}
Olin Shivers \\
Cambridge \\
September 4, 1994
\end{tabular}
\end{flushright}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\tableofcontents

16
doc/scsh-manual/headings.sty Normal file
View File

@ -0,0 +1,16 @@
% headings.tex -*- latex -*-
% Quieter headings that the ones used in article.sty.
% This is not a style option. Don't say [headings].
% Instead, say \input{headings} after the \documentstyle.
% -Olin 7/91
\makeatletter
\def\section{\@startsection {section}{1}{\z@}{-3.5ex plus -1ex minus
-.2ex}{2.3ex plus .2ex}{\large\normalfont\bfseries}}
\def\subsection{\@startsection{subsection}{2}{\z@}{-3.25ex plus -1ex minus
-.2ex}{1.5ex plus .2ex}{\normalsize\normalfont\bfseries}}
\def\subsubsection{\@startsection{subsubsection}{3}{\z@}{-3.25ex plus
-1ex minus -.2ex}{1.5ex plus .2ex}{\normalsize\normalfont\bfseries}}
\makeatother

435
doc/scsh-manual/intro.tex Normal file
View File

@ -0,0 +1,435 @@
%&latex -*- latex -*-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\chapter{Introduction}
This is the reference manual for scsh,
a {\Unix} shell that is embedded within {\Scheme}.
Scsh is a Scheme system designed for writing useful standalone Unix
programs and shell scripts---it spans a wide range of application,
from ``script'' applications usually handled with perl or sh,
to more standard systems applications usually written in C.
Scsh comes built on top of {\scm}, and has two components:
a process notation for running programs and setting up pipelines
and redirections,
and a complete syscall library for low-level access to the operating system.
This manual gives a complete description of scsh.
A general discussion of the design principles behind scsh can be found
in a companion paper, ``A Scheme Shell.''
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Copyright \& source-code license}
Scsh is open source. The complete sources come with the standard
distribution, which can be downloaded off the net.
Scsh has an ideologically hip, BSD-style license.
We note that the code is a rich source for other Scheme implementations
to mine. Not only the \emph{code}, but the \emph{APIs} are available
for implementors working on Scheme environments for systems programming.
These APIs represent years of work, and should provide a big head-start
on any related effort. (Just don't call it ``scsh,'' unless it's
\emph{exactly} compliant with the scsh interfaces.)
Take all the code you like; we'll just write more.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Obtaining scsh}
Scsh is distributed via net publication.
We place new releases at well-known network sites,
and allow them to propagate from there.
We currently release scsh to the following Internet sites:
\begin{inset}\begin{flushleft}
\ex{\urlh{ftp://ftp.scsh.net/pub/scsh}{ftp://ftp.scsh.net/pub/scsh}} \\
\ex{\urlh{http://prdownloads.sourceforge.net/scsh/}{http://prdownloads.sourceforge.net/scsh/}} \\
\end{flushleft}
\end{inset}
%
Each should have a compressed tar file of the entire scsh release,
which includes all the source code and the manual,
and a separate file containing just this manual in Postscript form,
for those who simply wish to read about the system.
However, nothing is certain for long on the Net.
Probably the best way to get a copy of scsh is to use a network
resource-discovery tool, such as archie,
to find ftp servers storing scsh tar files.
Take the set of sites storing the most recent release of scsh,
choose one close to your site, and download the tar file.
\section{Building scsh}
Scsh currently runs on a fairly large set of Unix systems, including
Linux, FreeBSD, OpenBSD, NetBSD, MacOS X, SunOS, Solaris, AIX, NeXTSTEP, Irix, and HP-UX.
We use the Gnu project's autoconfig tool to generate self-configuring
shell scripts that customise the scsh Makefile for different OS variants.
This means that if you use one of the common Unix implementations,
building scsh should require exactly the following steps:
\begin{inset}
\begin{tabular}{l@{\qquad}l}
\ex{gunzip scsh.tar.gz} & \emph{Uncompress the release tar file.} \\
\ex{untar xfv scsh.tar} & \emph{Unpack the source code.} \\
\ex{cd scsh-0.6.x} & \emph{Move to the source directory.} \\
\ex{./configure} & \emph{Examine host; build Makefile.} \\
\ex{make} & \emph{Build system.}
\end{tabular}
\end{inset}
When you are done, you should have a virtual machine compiled in
file \ex{scshvm}, and a heap image in file \ex{scsh/scsh.image}.
Typing
\begin{code}
make install
\end{code}
will install these programs in your installation directory
(by default, \ex{/usr/local}), along with a small stub startup
binary, \ex{scsh}.
If you don't have the patience to do this, you can start up
a Scheme shell immediately after the initial make by simply
saying
\codex{./scshvm -o ./scshvm -i scsh/scsh.image}
See chapter~\ref{chapt:running} for full details on installation
locations and startup options.
It is not too difficult to port scsh to another Unix platform if your
OS is not supported by the current release.
See the release notes for more details on how to do this.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Caveats}
It is important to note what scsh is \emph{not}, as well as what it is.
Scsh, in the current release, is primarily designed for the writing of
shell scripts---programming.
It is not a very comfortable system for interactive command use:
the current release lacks job control, command-line editing, a terse,
convenient command syntax, and it does not read in an initialisation
file analogous to \ex{.login} or \ex{.profile}.
We hope to address all of these issues in future releases;
we even have designs for several of these features;
but the system as-released does not currently provide these features.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Naming conventions}
Scsh follows a general naming scheme that consistently employs a set of
abbreviations.
This is intended to make it easier to remember the names of things.
Some of the common ones are:
\begin{description}
\item [\ex{fdes}]
Means ``file descriptor,'' a small integer used in {\Unix}
to represent I/O channels.
\item [\ex{\ldots*}]
A given bit of functionality sometimes comes in two related forms,
the first being a \emph{special form} that contains a body of
{\Scheme} code to be executed in some context,
and the other being a \emph{procedure} that takes a procedural
argument (a ``thunk'') to be called in the same context.
The procedure variant is named by taking the name of the special form,
and appending an asterisk. For example:
\begin{code}
;;; Special form:
(with-cwd "/etc"
(for-each print-file (directory-files))
(display "All done"))
;;; Procedure:
(with-cwd* "/etc"
(lambda ()
(for-each print-file (directory-files))
(display "All done")))\end{code}
\item [\ex{\var{action}/\var{modifier}}]
The infix ``\ex{/}'' is pronounced ``with,'' as in
\ex{exec/env}---``exec with environment.''
\item [\ex{call/\ldots}]
Procedures that call their argument on some computed value
are usually named ``\ex{call/\ldots},'' \eg,
\ex{(call/fdes \var{port} \var{proc})}, which calls \var{proc}
on \var{port}'s file descriptor, returning whatever \var{proc}
returns. The abbreviated name means ``call with file descriptor.''
\item [\ex{with-\ldots}]
Procedures that call their argument, and special forms that execute
their bodies in some special dynamic context frequently have
names of the form \ex{with-\ldots}. For example,
\ex{(with-env \var{env} \vari{body}1 \ldots)} and
\ex{(with-env* \var{env} \var{thunk})}. These forms set
the process environment body, execute their body or thunk,
and then return after resetting the environment to its original
state.
\item[\ex{create-}]
Procedures that create objects in the file system (files, directories,
temp files, fifos, \etc), begin with \ex{create-\ldots}.
\item [\ex{delete-}]
Procedures that delete objects from the file system (files,
directories, temp files, fifos, \etc), begin with \ex{delete-\ldots}.
\item[ \ex{\var{record}:\var{field}} ]
Procedures that access fields of a record are usually written
with a colon between the name of the record and the name of the
field, as in \ex{user-info:home-dir}.
\item[\ex{\%\ldots}]
A percent sign is used to prefix lower-level scsh primitives
that are not commonly used.
\item[\ex{-info}]
Data structures packaging up information about various OS
entities frequently end in \ldots\ex{-info}. Examples:
\ex{user-info}, \ex{file-info}, \ex{group-info}, and \ex{host-info}.
\end{description}
%
Enumerated constants from some set \var{s} are usually named
\ex{\var{s}/\vari{const}1}, \ex{\var{s}/\vari{const}2}, \ldots.
For example, the various {\Unix} signal integers have the names
\ex{signal/cont}, \ex{signal/kill}, \ex{signal/int}, \ex{signal/hup},
and so forth.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Lexical issues}
Scsh's lexical syntax is just {\RnRS} {\Scheme}, with the following
exceptions.
\subsection{Extended symbol syntax}
Scsh's symbol syntax differs from {\RnRS} {\Scheme} in the following ways:
\begin{itemize}
\item In scsh, symbol case is preserved by \ex{read} and is significant on
symbol comparison. This means
\codex{(run (less Readme))}
displays the right file.
\item ``\ex{-}'' and ``\ex{+}'' are allowed to begin symbols.
So the following are legitimate symbols:
\codex{-O2 -geometry +Wn}
\item ``\ex{|}'' and ``\ex{.}'' are symbol constituents.
This allows \ex{|} for the pipe symbol, and \ex{..} for the parent-directory
symbol. (Of course, ``\ex{.}'' alone is not a symbol, but a
dotted-pair marker.)
\item A symbol may begin with a digit.
So the following are legitimate symbols:
\codex{9x15 80x36-3+440}
\end{itemize}
\subsection{Extended string syntax}
Scsh strings are allowed to contain the {\Ansi} C escape sequences
such as \verb|\n| and \verb|\161|.
\subsection{Block comments and executable interpreter-triggers}
Scsh allows source files to begin with a header of the form
\codex{\#!/usr/local/bin/scsh -s}
The Unix operating system treats source files beginning with the headers
of this form specially;
they can be directly executed by the operating system
(see chapter~\ref{chapt:running} for information on how to use this feature).
The scsh interpreter ignores this special header by treating \ex{\#!} as a
comment marker similar to \ex{;}.
When the scsh reader encounters \ex{\#!}, it skips characters until it finds
the closing sequence
new\-line/{\ob}ex\-cla\-ma\-tion-{\ob}point/{\ob}sharp-{\ob}sign/{\ob}new\-line.
Although the form of the \ex{\#!} read-macro was chosen to support
interpreter-triggers for executable Unix scripts,
it is a general block-comment sequence and can be used as such
anywhere in a scsh program.
\subsection{Here-strings}
The read macro \ex{\#<} is used to introduce ``here-strings''
in programs, similar to the \ex{<<} ``here document'' redirections
provided by sh and csh.
There are two kinds of here-string, character-delimited and line-delimited;
they are both introduced by the \ex{\#<} sequence.
\subsubsection{Character-delimited here-strings}
A \emph{character-delimited} here-string has the form
\codex{\#<\emph{x}...stuff...\emph{x}}
where \emph{x} is any single character
(except \ex{<}, see below),
which is used to delimit the string bounds.
Some examples:
\begin{inset}
\begin{tabular}{ll}
Here-string syntax & Ordinary string syntax \\ \hline
\verb:#<|Hello, world.|: & \verb:"Hello, world.": \\
\verb:#<!"Ouch," he said.!: & \verb:"\"Ouch,\" he said.":
\end{tabular}
\end{inset}
%
There is no interpretation of characters within the here-string;
the characters are all copied verbatim.
\subsubsection{Line-delimited here-strings}
If the sequence begins "\ex{\#<<}" then it introduces a \emph{line-delimited}
here-string.
These are similar to the ``here documents'' of sh and csh.
Line-delimited here-strings are delimited by the rest of the text line that
follows the "\ex{\#<<}" sequence.
For example:
\begin{code}
#<<FOO
Hello, there.
This is read by Scheme as a string,
terminated by the first occurrence
of newline-F-O-O-newline or newline-F-O-O-eof.
FOO\end{code}
%
Thus,
\begin{code}
#<<foo
Hello, world.
foo\end{code}
%
is the same thing as
\codex{"Hello, world."}
Line-delimited here-strings are useful for writing down long, constant
strings---such as long, multi-line \ex{format} strings,
or arguments to Unix programs, \eg,
\begin{code}
;; Free up some disk space for my netnews files.
(run (csh -c #<<EOF
cd /urops
rm -rf *
echo All done.
EOF
))\end{code}
The advantage they have over the double-quote syntax
(\eg, \ex{"Hello, world."})
is that there is no need to backslash-quote special characters internal
to the string, such as the double-quote or backslash characters.
The detailed syntax of line-delimited here-strings is as follows.
The characters "\ex{\#<<}" begin the here-string.
The characters between the "\ex{\#<<}" and the next newline are the
\emph{delimiter line}.
All characters between the "\ex{\#<<}" and the next newline comprise the
delimiter line---including any white space.
The body of the string begins on the following line,
and is terminated by a line of text which exactly matches the
delimiter line.
This terminating line can be ended by either a newline or end-of-file.
Absolutely no interpretation is done on the input string.
Control characters, white space, quotes, backslash---everything
is copied as-is.
The newline immediately preceding the terminating delimiter line is
not included in the result string
(leave an extra blank line if you need to put a final
newline in the here-string---see the example above).
If EOF is encountered before reading the end of the here-string,
an error is signalled.
\subsection{Dot}
It is unfortunate that the single-dot token, ``\ex{.}'', is both
a fundamental {\Unix} file name and a deep, primitive syntactic token
in {\Scheme}---it means the following will not parse correctly in scsh:
\codex{(run/strings (find . -name *.c -print))}
You must instead quote the dot:
\codex{(run/strings (find "." -name *.c -print))}
When you write shell scripts that manipulate the file system,
keep in mind the special status of the dot token.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Record types and the \texttt{define-record} form}
\label{sec:defrec}
\index{define-record@\texttt{define-record}}
Scsh's interfaces occasionally provide data in structured record types;
an example is the \ex{file-info} record whose various fields describe the size,
protection, last date of modification, and other pertinent data for a
particular file.
These record types are described in this manual using the \ex{define-record}
notation, which looks like the following:
%
\begin{code}
(define-record ship
x
y
(size 100))\end{code}
%
This form defines a \var{ship} record, with three fields:
its x and y coordinates, and its size.
The values of the \var{x} and \var{y} fields are specified as parameters
to the ship-building procedure, \ex{(make-ship \var{x} \var{y})},
and the \var{size} field is initialised to 100.
All told, the \ex{define-record} form above defines the following procedures:
%
\begin{center}
\begin{tabular}{|ll|}
\multicolumn{1}{l}{Procedure} & \multicolumn{1}{l}{Definition} \\
\hline
(make-ship \var{x} \var{y}) & Create a new \var{ship} record. \\
\hline
(ship:x \var{ship}) & Retrieve the \var{x} field. \\
(ship:y \var{ship}) & Retrieve the \var{y} field. \\
(ship:size \var{ship}) & Retrieve the \var{size} field. \\
\hline
(set-ship:x \var{ship} \var{new-x}) & Assign the \var{x} field. \\
(set-ship:y \var{ship} \var{new-y}) & Assign the \var{y} field. \\
(set-ship:size \var{ship} \var{new-size}) & Assign the \var{size} field. \\
\hline
(modify-ship:x \var{ship} \var{xfun}) & Modify \var{x} field with \var{xfun}. \\
(modify-ship:y \var{ship} \var{yfun}) & Modify \var{y} field with \var{yfun}. \\
(modify-ship:size \var{ship} \var{sizefun}) & Modify \var{size} field with \var{sizefun}. \\
\hline
(ship? \var{object}) & Type predicate. \\
\hline
(copy-ship \var{ship}) & Shallow-copy of the record. \\
\hline
\end{tabular}
\end{center}
%
An implementation of \ex{define-record} is available as a macro for Scheme
programmers to define their own record types;
the syntax is accessed by opening the package \ex{defrec-package}, which
exports the single syntax form \ex{define-record}.
See the source code for the \ex{defrec-package} module
for further details of the macro.
You must open this package to access the form.
Scsh does not export a record-definition package by default as there are
several from which to choose.
Besides the \ex{define-record} macro, which Shivers prefers\footnote{He wrote
it.}, you might instead wish to employ the notationally-distinct
\ex{define-record-type} macro that Jonathan Rees
prefers\footnote{He wrote it.}.
It can be found in the
\ex{define-record-types} structure.
Alternatively, you may define your own, of course.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{A word about {\Unix} standards}
``The wonderful thing about {\Unix} standards is that there are so many
to choose from.''
You may be totally bewildered about the multitude of various standards that
exist.
Rest assured that nowhere in this manual will you encounter an attempt
to spell it all out for you;
you could not read and internalise such a twisted account without
bleeding from the nose and ears.
However, you might keep in mind the following simple fact: of all the
standards, {\Posix} is the least common denominator.
So when this manual repeatedly refers to {\Posix}, the point is ``the
thing we are describing should be portable just about anywhere.''
Scsh sticks to {\Posix} when at all possible; its major departure is
symbolic links, which aren't in {\Posix} (see---it
really \emph{is} a least common denominator).
%%% Local Variables:
%%% mode: latex
%%% TeX-master: "man"
%%% End:

133
doc/scsh-manual/man.t2p Normal file
View File

@ -0,0 +1,133 @@
% man.t2p
% Dorai Sitaram
% Feb 6, 2000
% This file contains the tex2page macros needed to process
% the scsh LaTeX document scsh-n.n.n/doc/scsh-manual/man.tex.
% Copy (or link) this file alongside man.tex and run
%
% tex2page man
\input css.t2p
\htmlmathstyle{no-image}
\let\pagebreak\relax
\let\small\relax
%\let\PRIMtableofcontents\tableofcontents
%\def\tableofcontents{\chapter*{Contents}\PRIMtableofcontents}
\def\subtitle#1{\def\savesubtitle{#1}}
\def\maketitle{
\subject{\TIIPtitle}
{\bf \hr}
\rightline{\savesubtitle}
\bigskip\bigskip
\bigskip\bigskip
{\bf\TIIPauthor}
{\bf\hr}
}
\let\PRIMdocument\document
\def\document{\PRIMdocument
\let\ttchars\relax
\let\ttt\tt
%\def\~{\rawhtml~\endrawhtml}
\def\~{\char`\~}
\def\cd#1{{\tt\def\\{\char`\\}\defcsactive\${\char`\$}\defcsactive\~{\char`\~}\defcsactive\&{\char`\&}#1}}
\def\cddollar{\undefcsactive\$}
\def\cdmath{\undefcsactive\$}
\def\codeallowbreaks{\relax}
\def\defvarx#1#2{\index{#1}\leftline{{\tt #1} \qquad #2}}
\let\PRIMflushright\flushright
\def\flushright{\PRIMflushright\TIIPtabularborder=0 }
\let\PRIMfigure\figure
\let\PRIMendfigure\endfigure
\def\figure{\par\hrule\PRIMfigure}
\def\endfigure{\PRIMendfigure\hrule\par}
\let\PRIMtable\table
\let\PRIMendtable\endtable
\def\table{\par\hrule\PRIMtable}
\def\endtable{\PRIMendtable\hrule\par}
\imgdef\vdots{\bf.\par.\par.}
%\evalh{
%
%(define all-blanks?
% (lambda (s)
% (andmap
% char-whitespace?
% (string->list s))))
%
%}
%
%
%\def\spaceifnotempty{\evalh{
%
%(let ((x (ungroup (get-token))))
% (unless (all-blanks? x)
% (emit #\space)))
%
%}}
\def\spaceifnotempty#1{%
\def\TEMP{#1}%
\ifx\TEMP\empty\else\ \fi}
\def\dfnix#1#2#3#4#5{\index{#5}\leftline{{\tt(#1\spaceifnotempty{#2}{\it#2})} \quad $\longrightarrow$ \quad {\it #3} \qquad (#4)}}
%\def\ex#1{{\tt #1}}
%\let\ex\texttt
\def\l#1{lambda (#1)}
\def\lx#1{lambda {#1}}
%\def\notenum#1{}
%\def\project#1{}
%\def\var#1{{\it #1\/}}
%\let\var\textit
%\def\vari#1#2{\mbox{{\it #1\/}\undefcsactive\$$_{#2}$}}
%\def\vari#1#2{\textit{#1}$_{#2}$}
\renewenvironment{boxedfigure}{\def\srecomment#1{\\#1\\}%
\begin{figure}\pagestyle}{\end{figure}}
\newenvironment{centercode}{\begin{code}}{\end{code}}
\def\setupcode{\tt%
\def\\{\char`\\}%
\defcsactive\${\$}%
\def\evalto{==> }%
\defcsactive\%{\%}\obeywhitespace}
\newenvironment{code}{\begin{quote}\setupcode\GOBBLEOPTARG}
{\end{quote}}
\newenvironment{codebox}{\begin{tableplain}\bgroup\setupcode\GOBBLEOPTARG}
{\egroup\end{tableplain}}
\renewenvironment{desc}{\begin{quote}}{\end{quote}}
\renewenvironment{exampletable}{%
\def\header#1{\\\leftline{#1}\\}%
\def\splitline#1#2{\\\leftline{#1}\\\leftline{#2}}%
\begin{tabular}{}}{\end{tabular}}
\newenvironment{tightcode}{\begin{code}}{\end{code}}
\renewenvironment{widecode}{\begin{code}}{\end{code}}
\renewenvironment{inset}{\begin{quote}}{\end{quote}}
\renewenvironment{leftinset}{\begin{quote}}{\end{quote}}
\renewenvironment{tightinset}{\begin{quote}}{\end{quote}}
\renewenvironment{tightleftinset}{\begin{quote}}{\end{quote}}
}

82
doc/scsh-manual/man.tex Normal file
View File

@ -0,0 +1,82 @@
% -*- latex -*-
% This is the reference manual for the Scheme Shell.
\documentclass[twoside]{report}
\usepackage{code,boxedminipage,makeidx,palatino,ct,
headings,mantitle,array,matter,mysize10,tex2page}
\texonly
% tex2page defines \url and hyperref loads the package url
% but setting \url to \relax satisfies \newcommand
\let\url\relax
\input{pdfcond}
\ifpdf
\usepackage[pdftex,hyperindex,
pdftitle={scsh manual, release 0.6.4},
pdfauthor={Olin Shivers, Brian D.~Carlstrom, Martin Gasbichler,
and Mike Sperber}
colorlinks=true,linkcolor=blue,pagecolor=blue,urlcolor=blue,
pdfstartview=FitH,pdfview=FitH]{hyperref}
\usepackage{thumbpdf}
\usepackage{tocbibind}
\else
\usepackage[dvipdfm,hyperindex,hypertex,
pdftitle={scsh manual, release 0.6.4},
pdfauthor={Olin Shivers, Brian D.~Carlstrom, Martin Gasbichler,
and Mike Sperber}
colorlinks=true,linkcolor=blue,pagecolor=blue,urlcolor=blue,
pdfstartview=FitH,pdfview=FitH]{hyperref}
\fi
\endtexonly
% These fonts are good choices for screen-readable pdf, but the man needs
% a pass over the layout, since the this tt font will blow out the width
% of some examples, making them wrap and generally screwing them up. Maybe this
% should also be a LaTeX option, so we can get palatino on the hardcopy
% runs and these fonts on pdf runs...
%\renewcommand{\rmdefault}{phv}
%\renewcommand{\sfdefault}{phv}
%\renewcommand{\ttdefault}{pcr}
% Style issues
\parskip = 3pt plus 3pt
\sloppy
%\includeonly{miscprocs}
\input{decls}
\makeindex
%%% End preamble
\begin{document}
\frontmatter
\include{front}
\mainmatter
\include{intro}
\include{procnotation}
\include{syscalls}
\include{network}
\include{strings}
\include{sre}
\include{rdelim}
\include{awk}
\include{threads}
\include{miscprocs}
\include{running}
\backmatter
\printindex
\end{document}
% General things to do when converting ASCII text to LaTeX:
% Build a set of \breakondash, \breakondot, \breakonslash commands
% that will enable breaking in \tt. This is better than \=, etc.
%
% Check for ..., quote char, double-dashes --
% Double-word check
% lambda -> \l

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