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

Compare commits

base: scsh-conservatory:main
Branches Tags
scsh-conservatory:main
scsh-conservatory:r0-6-stable
scsh-conservatory:r0-6-stable_bp
scsh-conservatory:release-0-6-4
scsh-conservatory:release-0-6-3
scsh-conservatory:release-0-6-2
scsh-conservatory:release-0-6-1
scsh-conservatory:import-1.1.1
..
compare: scsh-conservatory:release-0-6-1
Branches Tags
scsh-conservatory:main
scsh-conservatory:r0-6-stable
scsh-conservatory:r0-6-stable_bp
scsh-conservatory:release-0-6-4
scsh-conservatory:release-0-6-3
scsh-conservatory:release-0-6-2
scsh-conservatory:release-0-6-1
scsh-conservatory:import-1.1.1

1 Commits
main ... release-0-

Author SHA1 Message Date
cvs-fast-export ab17ff4b49 Synthetic commit for incomplete tag release-0-6-1 2002-02-25 09:01:39 +00:00
357 changed files with 29901 additions and 41665 deletions
Show Stats Expand all files Collapse all files

11
.gitignore vendored
View File

@ -27,13 +27,10 @@ _$*
core
# CVS default ignores end
Makefile
autom4te.cache
cig
cig/
config.cache
config.log
config.status
configure
go
config.log
config.cache
config.status
scsh.image
scshvm
go

8
COPYING
View File

@ -1,7 +1,7 @@
Copyright (c) 1993-2003 Richard Kelsey and Jonathan Rees
Copyright (c) 1994-2003 by Olin Shivers and Brian D. Carlstrom.
Copyright (c) 1999-2003 by Martin Gasbichler.
Copyright (c) 2001-2003 by Michael Sperber.
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.

7
CVS_README
View File

@ -25,7 +25,7 @@ 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 the value of the variable BUILD_RUNNABLE in Makefile.in
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
@ -35,10 +35,7 @@ To build Scsh, proceed as follows:
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.
on. Furthermore the configure file will be generated.
3.) Configure the system:

453
Makefile.in
View File

@ -14,7 +14,7 @@ INSTALL = @INSTALL@
INSTALL_PROGRAM = @INSTALL_PROGRAM@
INSTALL_DATA = @INSTALL_DATA@
LDFLAGS = @LDFLAGS@
LDFLAGS = -g @LDFLAGS@
LIBOBJS = @LIBOBJS@
RM = rm -f
@ -29,12 +29,7 @@ libdir = @libdir@
incdir = @includedir@
manext = 1
mandir = @mandir@/man$(manext)
lib_dirs_list = @lib_dirs_list@
host = @host@
### End of `configure' section###
### @machine@ will be substituted below ###
htmldir = $(libdir)/scsh/doc/scsh-manual/html
@ -46,16 +41,13 @@ htmldir = $(libdir)/scsh/doc/scsh-manual/html
# Ultrix
# LDFLAGS = -N
.SUFFIXES:
.SUFFIXES: .c .o
.c.o:
$(CC) -g -c $(DEFS) -I ./c -I$(srcdir)/c $(CPPFLAGS) $(CFLAGS) -o $@ $<
$(CC) -g -c $(CPPFLAGS) $(DEFS) -I$(srcdir)/c -I$(srcdir)/cig $(CFLAGS) -o $@ $<
# BUILD_RUNNABLE has to be Scheme 48 0.53. This is used for builds directly
# 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 = /Users/jao/Library/Scheme/s48/bin/scheme48
BUILD_RUNNABLE = /afs/wsi/i386_fbsd32/bin/scheme48
RUNNABLE = scsh
MANPAGE = $(RUNNABLE).$(manext)
LIB = $(libdir)/$(RUNNABLE)
@ -89,7 +81,7 @@ include $(srcdir)/build/filenames.make
# requires you to have squirreled away a previous working version
# of scsh.
BIG_HEAP = -h 5500000
BIG_HEAP = -h 5000000
# 1. is broken if you build from CVS
# LINKER_VM = ./$(VM) $(BIG_HEAP)
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
@ -109,23 +101,27 @@ START_LINKER = echo ',batch' && echo ',bench on'
# Targets:
IMAGE = scheme48.image
INITIAL = $(srcdir)/build/initial.image
INITIAL = build/initial.image
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/machine/libansi.o \
scsh/network1.o \
scsh/putenv.o \
scsh/rx/regexp1.o \
@ -135,25 +131,20 @@ SCSHOBJS = \
scsh/time1.o \
scsh/tty1.o \
scsh/userinfo1.o \
scsh/sighandlers1.o \
scsh/libscsh.o \
scsh/md5.o
scsh/sighandlers1.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_libscsh s48_init_md5
s48_init_cig
UNIX_OBJS = c/unix/misc.o c/unix/io.o c/unix/fd-io.o c/unix/event.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) $(SCSHOBJS) \
$(SCSHVMHACKS) $(SRFI_OBJS)
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)
FAKEHS = c/fake/dlfcn.h c/fake/sigact.h c/fake/strerror.h \
c/fake/sys-select.h
@ -167,14 +158,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 scsh $(LIBSCSH) $(LIBSCSHVM)
# Run unit tests
test: enough
@echo "Running test suite..."
@(($(srcdir)/go -lm $(srcdir)/scsh/test/test-packages.scm \
-o test-all -c "(test-all)" | grep -v 'OK$$') \
|| (echo "All tests passed"))
enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH) $(LIBSCSHVM)
# --------------------
# External code to include in the VM
@ -184,7 +168,8 @@ EXTERNAL_OBJECTS = $(SOCKET_OBJECTS) $(LOOKUP_OBJECTS)
EXTERNAL_FLAGS = $(SOCKET_FLAGS)
EXTERNAL_INITIALIZERS = $(ADDITIONAL_INITIALIZER) $(SOCKET_INITIALIZERS) \
$(LOOKUP_INITIALIZERS) \
$(SCSH_INITIALIZERS) $(SRFI_INITIALIZERS) \
$(SCSH_INITIALIZERS) \
s48_init_cig
# Rules for any external code.
@ -220,11 +205,16 @@ ADDITIONAL_INITIALIZER = s48_init_additional_inits
touch .notify
-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
| 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
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.
@ -234,6 +224,7 @@ scsh/network1o: scsh/network1.h
scsh/flock1.o: scsh/flock1.h
scsh/fdports1.o scsh/fdports.o: scsh/fdports1.h
#scsh/select1.o scsh/select.o: scsh/select1.h
scsh/rx/regexp1.o: c/scheme48.h
@ -241,13 +232,13 @@ scsh/sighandlers1.o: scsh/sighandlers1.h
scsh/syslog1.o: c/scheme48.h
include $(srcdir)/scsh/@machine@/Makefile.inc
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"
#.include "$(srcdir)/scsh/machine/Makefile.inc"
$(VM): c/main.o $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)
rm -f /tmp/s48_external_$$$$.c && \
$(srcdir)/build/build-external-modules /tmp/s48_external_$$$$.c \
build/build-external-modules /tmp/s48_external_$$$$.c \
$(EXTERNAL_INITIALIZERS) && \
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ c/main.o $(OBJS) $(UNIX_OBJS) \
/tmp/s48_external_$$$$.c \
@ -258,6 +249,13 @@ $(VM): c/main.o $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)
#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)
@ -266,24 +264,24 @@ $(LIBSCSHVM): c/smain.o $(OBJS)
$(LIBSCSH): $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)
$(RM) $@ \
rm -f /tmp/s48_external_$$$$.c && \
$(srcdir)/build/build-external-modules /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) \
$(AR) $@ $(OBJS) $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS) \
/tmp/s48_external_$$$$.o && \
$(RANLIB) $@ && \
rm -f /tmp/s48_external_$$$$.c /tmp/s48_external_$$$$.o
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) $(srcdir)/c/main.c
$(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) $(srcdir)/c/init.c
$(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
@ -310,8 +308,8 @@ c/fake/strerror.o: c/fake/strerror.h
$(IMAGE): $(VM) scheme/env/init-defpackage.scm scheme/more-interfaces.scm \
scheme/link-packages.scm scheme/more-packages.scm \
$(usual-files) build/initial.debug build/build-usual-image
$(srcdir)/build/build-usual-image $(srcdir) "$(srcdir)/scheme" '$(IMAGE)' './$(VM)' \
'$(srcdir)/$(INITIAL)'
build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \
'$(INITIAL)'
### Fake targets: all clean install man dist
@ -319,14 +317,14 @@ install: enough dirs inst-script inst-vm inst-misc inst-man inst-inc \
inst-doc install-scsh
inst-vm: $(VM)
$(INSTALL_PROGRAM) $(VM) $(DESTDIR)$(LIB)
$(INSTALL_PROGRAM) $(VM) $(LIB)
inst-man:
if [ -d $(DESTDIR)$(mandir) -a -w $(DESTDIR)$(mandir) ]; then \
if [ -d $(mandir) -a -w $(mandir) ]; then \
sed 's=LBIN=$(bindir)=g' doc/scsh.man | \
sed 's=LLIB=$(LIB)=g' | \
sed 's=LSCSH=$(RUNNABLE)=g' >$(MANPAGE) && \
$(INSTALL_DATA) $(MANPAGE) $(DESTDIR)$(mandir) && \
$(INSTALL_DATA) $(MANPAGE) $(mandir) && \
$(RM) $(MANPAGE); \
else \
echo "$(mandir) not writable dir, not installing man page" \
@ -334,61 +332,54 @@ inst-man:
fi
inst-inc:
$(INSTALL_DATA) $(srcdir)/c/scheme48.h $(DESTDIR)$(incdir)
$(INSTALL_DATA) $(srcdir)/c/write-barrier.h $(DESTDIR)$(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 srfi; do \
for f in $(srcdir)/scheme/$$stub/*.scm; do \
$(INSTALL_DATA) $$f $(DESTDIR)$(LIB)/$$stub || exit 1; \
for stub in env big opt misc link; do \
for f in scheme/$$stub/*.scm; do \
$(INSTALL_DATA) $$f $(LIB)/$$stub || exit 1; \
done; \
done && \
for f in $(srcdir)/scheme/rts/*num.scm $(srcdir)/scheme/rts/jar-defrecord.scm; do \
$(INSTALL_DATA) $$f $(DESTDIR)$(LIB)/rts || exit 1; \
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 $(DESTDIR)$(LIB)/doc/; \
$(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 $(DESTDIR)$(LIB)/doc/s48-manual/; \
do $(INSTALL_DATA) $$f $(LIB)/doc/s48-manual/; \
done && \
for f in $(srcdir)/doc/src/manual/*.html; \
do $(INSTALL_DATA) $$f $(DESTDIR)$(LIB)/doc/s48-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 $(DESTDIR)$(LIB)/doc/scsh-manual/; \
$(srcdir)/doc/scsh-manual/*.ps; \
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 $(DESTDIR)$(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 $(DESTDIR)$(LIB)/doc/scsh-paper/; \
done && \
for f in $(srcdir)/doc/scsh-paper/html/*.html \
$(srcdir)/doc/scsh-paper/html/*.css; \
do $(INSTALL_DATA) $$f $(DESTDIR)$(LIB)/doc/scsh-paper/html; \
do $(INSTALL_DATA) $$f $(htmldir)/; \
done
inst-script:
script=$(DESTDIR)$(bindir)/$(RUNNABLE) && \
script=$(bindir)/$(RUNNABLE) && \
echo '#!/bin/sh' >$$script && \
echo >>$$script && \
echo 'lib=$(LIB)' >>$$script && \
echo 'exec $$lib/$(VM) -i $$lib/$(IMAGE) "$$@"' \
echo 'exec $$lib/$(VM) -o $$lib/$(VM) -i $$lib/$(IMAGE) "$$@"' \
>>$$script && \
chmod +x $$script
@ -397,22 +388,22 @@ go:
echo '#!/bin/sh' >$@ && \
echo >>$@ && \
echo "lib=`pwd`" >>$@ && \
echo 'exec $$lib/$(VM) -i $$lib/scsh/scsh.image "$$@"' \
echo 'exec $$lib/$(VM) -o $$lib/$(VM) -i $$lib/scsh/scsh.image "$$@"' \
>>$@ && \
chmod +x $@
dirs:
for dir in $(libdir) $(bindir) $(incdir) $(LIB) $(mandir) $(htmldir); do\
{ mkdir -p $(DESTDIR)$$dir && [ -w $(DESTDIR)$$dir ]; } || { \
echo "$(DESTDIR)$$dir not a writable directory" >&2; \
{ 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 $(DESTDIR)$(LIB)/$$dir && [ -w $(DESTDIR)$(LIB)/$$dir ]; } || { \
echo "$(DESTDIR)$(LIB)/$$dir not a writable directory" >&2; \
rts env big opt misc link scsh doc/scsh-manual \
doc/s48-manual/html cig; do \
{ mkdir -p $(LIB)/$$dir && [ -w $(LIB)/$$dir ]; } || { \
echo "$(LIB)/$$dir not a writable directory" >&2; \
exit 1; \
}; \
done
@ -420,27 +411,27 @@ dirs:
configure: configure.in
autoheader && autoconf
clean: clean-scsh
$(RM) $(VM) *.o c/*/*.o c/*.o \
clean: clean-cig clean-scsh
-rm -f $(VM) *.o c/unix/*.o c/*.o c/fake/*.o \
$(IMAGE) \
build/*.tmp $(MANPAGE) build/linker.image \
scheme/debug/*.image scheme/debug/*.debug \
scheme/debug/*.image scheme/debug/*.debug \
scheme/vm/scheme48vm.c scheme/vm/scheme48heap.c \
go $(distname)
distclean: clean
$(RM) Makefile config.log config.status c/sysdep.h config.cache \
scsh/endian.scm \
exportlist.aix scsh-config
rmdir scsh/machine
$(RM) a.exe $(VM).base $(VM).def $(VM).exp
-find . -name '*~' -o -name '#*' -o -name core -exec rm {} \;
clean-cig:
-rm -f cig/*.o $(CIG) $(CIG).image $(LIBCIG)
maintainer-clean: distclean
@echo 'This command is intended for maintainers to use; it'
@echo 'deletes files that may need special tools to rebuild.'
$(RM) $(srcdir)/c/{scheme48vm.c,scheme48heap.c,scheme48.h}
$(RM) $(srcdir)/build/{linker.image,initial.image}
clean-scm2c:
rm -f #scsh/select.c
distclean: clean
rm -f Makefile config.log config.status c/sysdep.h config.cache \
scsh/machine \
scsh/endian.scm scsh/static.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
( \
@ -471,7 +462,7 @@ tags:
# DISTFILES should include all sources.
DISTFILES = README COPYING INSTALL RELEASE configure config.sub config.guess \
scsh-config.in configure.in Makefile.in install-sh \
acconfig.h configure.in Makefile.in install-sh \
doc/*.ps doc/*.txt \
doc/src/*.tex doc/src/*.sty doc/src/manual.dvi \
doc/src/manual.ps \
@ -483,39 +474,27 @@ DISTFILES = README COPYING INSTALL RELEASE configure config.sub config.guess \
c/*.[ch] c/*/*.[ch] c/scheme48.h.in \
emacs/*.el gdbinit \
scheme/*.scm scheme/*/*.scm \
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 \
ps-compiler \
c/sysdep.h.in \
scsh/*.scm scsh/*/*.scm \
scsh/*.[ch] scsh/*/*.[ch] \
scsh/*.scm.in \
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/*.tex doc/scsh-manual/man.ps \
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
doc/src/manual/*.html
distname = $(RUNNABLE)-0.`cat $(srcdir)/build/minor-version-number`
distname = $(RUNNABLE)-0.`cat build/minor-version-number`
dist: build/initial.image distclean
(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) && \
dist: build/initial.image
(cd doc/src && hyperlatex manual.tex) && \
(cd doc/scsh-manual && makeindex man && make man.ps && make html) && \
distname=$(distname) && \
distfile=$(distdir)/$$distname.tar.gz && \
distfile=$(distdir)/$$distname.tgz && \
if [ -d $(distdir) ] && \
[ -w $$distfile -o -w $(distdir) ]; then \
rm -f $$distname && \
@ -532,8 +511,7 @@ dist: build/initial.image distclean
else \
echo "Can't write $$distfile" >&2; \
exit 1; \
fi && \
echo "Hope you already called ./autogen..."
fi
# Increment the minor version number
inc:
@ -610,7 +588,7 @@ link/linker-in-lucid: build/lucid-script.lisp $(linker-files) \
# no debugging environment to speak of.
$(INITIAL): $(LINKER_IMAGE) $(CONFIG_FILES) build/initial.scm $(initial-files) \
scsh/here.scm # gross and Olin hates it -bri
scsh/here.scm # gross and Olin hates it -bri
($(START_LINKER); \
echo '(load-configuration "scheme/interfaces.scm")'; \
echo '(load-configuration "scheme/packages.scm")'; \
@ -688,7 +666,7 @@ c/scheme48.h: c/scheme48.h.in scheme/vm/arch.scm scheme/vm/data.scm \
echo ',batch'; \
echo ',load-package big-scheme'; \
echo ',open big-scheme'; \
echo ',load $(srcdir)/scheme/link/generate-c-header.scm'; \
echo ',load scheme/link/generate-c-header.scm'; \
echo "(make-c-header-file \"$@\" \
\"$(srcdir)/c/scheme48.h.in\" \
\"$(srcdir)/scheme/vm/arch.scm\" \
@ -726,88 +704,106 @@ i-know-what-i-am-doing:
) | $(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/command-line.scm \
scsh/continuation.scm \
scsh/crypt.scm \
scsh/configure.scm \
SCHEME =scsh/awk.scm \
scsh/char-set.scm \
scsh/defrec.scm \
scsh/directory.scm \
scsh/dot-locking.scm \
scsh/endian.scm \
scsh/enumconst.scm \
scsh/environment.scm \
scsh/event.scm \
scsh/fcntl.scm \
scsh/fd-syscalls.scm \
scsh/low-interrupt.scm \
scsh/fdports.scm \
scsh/file.scm \
scsh/fileinfo.scm \
scsh/filemtch.scm \
scsh/filesys.scm \
scsh/flock.scm \
scsh/fname.scm \
scsh/fname-system.scm \
scsh/fr.scm \
scsh/glob.scm \
scsh/dot-locking.scm \
scsh/here.scm \
scsh/import-os-error-syscall.scm \
scsh/lib-dirs.scm \
scsh/libscsh.scm \
scsh/low-interrupt.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/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/meta-arg.scm \
scsh/network.scm \
scsh/newports.scm \
scsh/port-collect.scm \
scsh/process-high-level.scm \
scsh/process-state.scm \
scsh/process.scm \
scsh/procobj.scm \
scsh/pty.scm \
scsh/rdelim.scm \
scsh/resource.scm \
scsh/rw.scm \
scsh/rx/packages.scm \
scsh/rx/cond-package.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/signal.scm \
scsh/startup.scm \
scsh/stdio.scm \
scsh/stringcoll.scm \
scsh/syntax-helpers.scm \
scsh/syntax.scm \
scsh/system.scm \
scsh/temp-file.scm \
scsh/syscalls.scm \
scsh/time.scm \
scsh/top.scm \
scsh/tty.scm \
scsh/user-group.scm \
scsh/utilities.scm \
scsh/weaktables.scm \
scsh/rx/cond-package.scm \
scsh/rx/packages.scm \
scsh/rx/re-match-syntax.scm \
scsh/rx/rx-lib.scm \
scsh/rx/loadem.scm \
scsh/rx/parse.scm \
scsh/rx/re-subst.scm \
scsh/rx/simp.scm \
scsh/rx/modules.scm \
scsh/rx/posixstr.scm \
scsh/rx/re-syntax.scm \
scsh/rx/spencer.scm \
@ -820,102 +816,79 @@ SCHEME = \
scsh/rx/re-low.scm \
scsh/rx/regress.scm
# scsh/dbm.scm db.scm ndbm.scm
# static.scm static-heap.scm static1.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/select.c: scsh/select.scm
scsh/scsh: scsh/scsh-tramp.c
$(CC) -o $@ $(CPPFLAGS) $(CFLAGS) \
-DVM=\"$(LIB)/$(VM)\" \
-DIMAGE=\"$(LIB)/scsh.image\" \
$<
scsh/scsh-tramp.c
loads = $(srcdir)/scsh/let-opt.scm $(srcdir)/scsh/scsh-interfaces.scm \
$(srcdir)/scsh/@machine@/packages.scm \
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/rx/cond-package.scm \
$(srcdir)/scsh/scsh-package.scm \
$(srcdir)/scsh/lib/cset-package.scm \
$(srcdir)/scsh/lib/string-package.scm \
$(srcdir)/scsh/lib/list-pack.scm \
$(srcdir)/scsh/lib/ccp-pack.scm \
$(srcdir)/scsh/lib/char-package.scm
$(srcdir)/scsh/lib/char-package.scm \
$(srcdir)/scsh/lib/cset-obsolete.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
# Doing ,load-package scheme-with-scsh here gives us much better start-up times
scsh/scsh.image: $(VM) $(SCHEME) $(IMAGE)
(echo ",translate =scheme48/ `(cd $(srcdir) && echo $$PWD)`/scheme/"; \
echo ",translate $(srcdir)/scsh/machine/ $(srcdir)/scsh/@machine@/"; \
echo ",translate $(srcdir)/scsh/endian.scm `pwd`/scsh/endian.scm"; \
echo ",translate $(srcdir)/scsh/configure.scm `pwd`/scsh/configure.scm"; \
(echo ",translate =scheme48/ `pwd`/scheme/"; \
echo ",batch on"; \
echo ",config ,load $(loads)"; \
echo ",open $(opens)"; \
echo ",load-package scheme-with-scsh"; \
echo "(dump-scsh \"$@\")"; \
) \
| ./$(VM) -i $(IMAGE) -h 10000000
echo ",load-package floatnums"; \
echo ",config"; \
echo ",load $(loads)"; \
echo ",load-package scsh"; \
echo ",load-package scsh-here-string-hax"; \
echo ",load-package list-lib"; \
echo ",load-package string-lib"; \
echo ",load-package ccp-lib"; \
echo ",in scsh-level-0"; \
echo ",user"; \
echo ",open floatnums"; \
echo ",open scsh"; \
echo ",open list-lib string-lib ccp-lib"; \
echo ",batch off"; \
echo ",open scsh-top-package"; \
echo ",keep names maps files source tabulate"; \
echo "(dump-scsh \"scsh/scsh.image\")"; \
echo ",batch on") \
| ./$(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/ `(cd $(srcdir) && echo $$PWD)`/scheme/"; \
echo ",translate $(srcdir)/scsh/machine/ $(srcdir)/scsh/@machine@/"; \
echo ",translate $(srcdir)/scsh/endian.scm `pwd`/scsh/endian.scm"; \
echo ",translate $(srcdir)/scsh/configure.scm `pwd`/scsh/configure.scm"; \
echo ",batch on"; \
echo ",config ,load $(loads)"; \
echo ",open $(opens)"; \
echo ",load-package scheme-with-scsh"; \
echo ",flush"; \
echo "(dump-scsh \"$@\")";) \
| ./$(VM) -i $(IMAGE) -h 10000000
install-scsh: scsh install-scsh-image install-stripped-scsh-image
$(RM) $(DESTDIR)$(bindir)/$(RUNNABLE)
$(INSTALL_PROGRAM) $(srcdir)/scsh/scsh $(DESTDIR)$(bindir)/$(RUNNABLE)
$(INSTALL_PROGRAM) $(srcdir)/$(LIBSCSHVM) $(DESTDIR)$(libdir)/$(LIBSCSHVM)
$(INSTALL_PROGRAM) $(srcdir)/$(LIBSCSH) $(DESTDIR)$(libdir)/$(LIBSCSH)
$(RANLIB) $(DESTDIR)$(libdir)/$(LIBSCSH)
install-scsh: scsh install-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 $(DESTDIR)$(LIB)/scsh/; done
do $(INSTALL_DATA) $$f $(LIB)/scsh/; done
install-scsh-image: $(VM) scsh/scsh.image
( echo ',translate =scheme48 $(LIB)'; \
echo ",translate $(srcdir)/scsh/machine/ $(srcdir)/scsh/@machine@/"; \
echo ',in lib-dirs (set-default-lib-dirs! (quote $(lib_dirs_list)))'; \
echo '(dump-scsh "$(DESTDIR)$(LIB)/scsh.image")'; \
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 ",translate $(srcdir)/scsh/machine/ $(srcdir)/scsh/@machine@/"; \
echo ',in lib-dirs (set-default-lib-dirs! (quote $(lib_dirs_list)))'; \
echo '(dump-scsh "$(DESTDIR)$(LIB)/stripped-scsh.image")'; \
echo ',exit'; \
) | ./$(VM) -i scsh/stripped-scsh.image
) | ./$(VM) -i scsh/scsh.image
clean-scsh:
$(RM) scsh/*.o scsh/rx/*.o scsh/*/*.o
$(RM) scsh/*.image
$(RM) scsh/configure.scm
$(RM) scsh/*.o scsh/rx/*.o scsh/machine/*.o
$(RM) scsh/*.image
$(RM) $(LIBSCSHVM) $(LIBSCSH) scsh/scsh$(EXEEXT)
$(RM) scsh-config
# rm -rf * && mkdir -p scsh/rx c/unix c/srfi && ~/sw/scsh-HEAD/configure --srcdir=/afs/wsi//home/gasbichl/sw/scsh-HEAD/ && make=======
scsh/configure.scm: $(srcdir)/scsh/configure.scm.in
sed -e 's|@scsh_host@|$(host)|g' \
-e 's|@scsh_prefix@|$(prefix)|g' \
-e 's|@scsh_exec_prefix@|$(exec_prefix)|g' \
-e 's|@scsh_bindir@|$(bindir)|g' \
-e 's|@scsh_libdir@|$(libdir)|g' \
-e 's|@scsh_includedir@|$(incdir)|g' \
-e 's|@scsh_mandir@|$(mandir)|g' \
-e 's|@scsh_lib_dirs_list@|$(lib_dirs_list)|g' \
-e 's|@scsh_LIBS@|$(LIBS)|g' \
-e 's|@scsh_DEFS@|$(DEFS)|g' \
-e 's|@scsh_CFLAGS@|$(CFLAGS)|g' \
-e 's|@scsh_CPPFLAGS@|$(CPPFLAGS)|g' \
-e 's|@scsh_LDFLAGS@|$(LDFLAGS)|g' $(srcdir)/scsh/configure.scm.in > $@

10
README
View File

@ -3,17 +3,17 @@
Copyright (c) 1994 Brian D. Carlstrom
See file COPYING for copying information.
Please report bugs to scsh-users@scsh.net, and include
Please report bugs to scsh-bugs@zurich.ai.mit.edu, and include
the version number in your message.
Installation instructions in file INSTALL.
A scsh manual is in directory doc/scsh-manual/.
A scsh paper is in directory doc/scsh-paper/.
A scsh manual is in file doc/scsh-manual{/*.tex,.ps}.
A scsh paper is in file doc/scsh-paper.{tex,ps}.
A scsh quick reference is in file doc/cheat.txt.
Send mail to scsh-users-request@scsh.net 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.
A road-map of the source tree is also in the doc directory.

328
RELEASE
View File

@ -1,10 +1,13 @@
Scsh 0.6.7 Release notes -*- outline -*-
Scsh 0.6.1 Release notes -*- outline -*-
We are pleased to release scsh version 0.6.1. This release fixes most
of the known bugs of the previous version. Users of version 0.6.0 are
strongly encouraged to upgrade to the new version.
We are pleased to release scsh version 0.6.7.
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.7. (Emacs should display this document is in outline mode. Say
release 0.6.1. (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).)
@ -18,12 +21,8 @@ Obtaining and installing scsh
Getting in touch
The World-Wide What?
New in this release
New in 0.6.6
New in 0.6.5
New in 0.6.4
New in 0.6.3
New in 0.6.2
New in 0.6.1
API changes
Bugfixes
New in 0.6.0
Thanks
@ -80,7 +79,7 @@ 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:
of Lisp and Symbolic Computation." This paper is also available by ftp:
ftp://ftp.scsh.net/pub/scsh/papers/scsh-paper.ps
@ -100,12 +99,11 @@ Unix platforms. We currently have scsh implementations for:
IRIX
Linux
NetBSD
OpenBSD
Solaris
SunOS
Ultrix
Win32
Darwin/Mac OS X
GNU Hurd
Scsh code should run without change across these systems.
Porting to new platforms is usually not difficult.
@ -138,26 +136,23 @@ 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.
Currently, there is a mailing-list which is mirrored to a newsgroup.
To (un)subscribe to the mailing-list, send a message to
scsh-users-request@scsh.net. To submit a message to the
mailing-list, send it to scsh-users@scsh.net.
The mailing-list is also readable as a standard newsgroup, thanks to
gmane, a mail-to-news gateway. More information is available at the
following URL:
http://gmane.org/info.php?group=gmane.lisp.scheme.scsh
There used to be a newsgroup dedicated to scsh, called
comp.lang.scheme.scsh but it is now deprecated.
Bugs can be reported to the same list
scsh-users@scsh.net
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:
@ -168,262 +163,6 @@ We manage the project using SourceForge:
* New in this release
=====================
** Support for interix
** Ignoring of synchronous signals
The procedures IGNORE-SIGNAL and HANDLE-SIGNAL-DEFAULT have been
added.
** Support for gcc 4.0
** 0.6 for module path
The standard module path now contains
${prefix}/lib/scsh/modules/0.6 in addition to
$prefix/lib/scsh/modules for compatibility with install-lib
** New implementation of open-pty
Instead of search for /dev/pty??, scsh now tries a wide variety of
ways to aquire a new pty and the corresponding tty.
** Bug fixes
argv[0] is now the first element of command-line
Fixes found by new test suite
Regexp for empty string
Argument checking for COPY-BYTES!
GC_PROTECTs for send_substring
format_date support for #f timezone
Added predicates for user-info and group-info
Reaping of stopped processes: Do not mark stopped processes as dead
md5-digest-for-port
| regexps return char-sets
standard-let in srfi-5
(%)read-delimited! checks for mutable buffer
leap second for srfi-19
The default image for the scshvm is now the installed scsh.image.
* New in 0.6.6
===============
** Removed or replaced non-free code
Some files in the previous versions of scsh did not conform to
scsh's BSD-style license. We therefore removed the directory
scheme/infix and asked the copyright holders of the rest of the
code to put their code under a compatible license. The code of the
sort package has been replaced by a new version (see below).
** New code for sorting
The old package SORT from Scheme 48 has been replaced by a
sophisticated library written by Olin Shivers for the withdrawn
SRFI 32.
** Separate documentation of the library directories search facility
The manual now contains a separate section that describes the
library directories search facility. The description of the
respective switches has been adapted accordingly.
** New module CONFIGURE
The new module CONFIGURE permits access to some of the values
obtained during the run of the configure script.
** Argument processing more robust
Any number of whitespaces may now occur between the arguments to
the VM.
** Ultrix is no longer supported
The Ultrix platform is lacking support for POSIX regular
expressions and is therefore no longer supported.
** Bug fixes
Fix WITH-LOCk
Ensure that the exit value is 1 if scsh exits due to an error
Load the package scheme-with-scsh before dumping images to get
better start-up times
Fix two bugs in GLOB related to quotation
The optmizer AUTO-INTEGRATE can now inline procedures with
macro-generated arguments
The optmizer FLAT-ENVIRONMENTS now works if invoked after AUTO-INTEGRATE
Fixed a bug in the parser of "-" sre forms
Removed accidentally committed expansion of paths in SCSH_LIB_DIR
Fix the various SELECT-like procedures for 0 timeouts
Let PATH-LIST->FILE-NAME return "/" for '("").
Fix bug in S48_RECORD_TYPE: third parameter to s48_stob_ref was missing.
Fixed check for -rdynamic
FIELD-READER returns (values EOF '()) on an empty port
Fixed STRING-CONTAINS and STRING-CONCATENATE-REVERSE/SHARED from SRFI-13
* New in 0.6.5
==============
** New platform: GNU Hurd
Andreas Vögele ported scsh to GNU Hurd.
** ./configure option to set default scsh library directories
The ./configure script now accepts the option --with-lib-dirs-list
to specify a list of default scsh library directories. In
previous versions of scsh this list was hardwired to
/usr/local/lib/scsh/modules.
** Support for DESTDIR for easier packaging
The install target of the Makefile now respects the environment
variable DESTDIR to allow package maintainers to use a staging
directory.
** New SRFI
This release adds support for SRFI 42.
** Switch to load exec scripts from library path
The new switch -lel searches the library path for a file and loads
the file into the exec package.
** Removed scheme/infix/
The directory scheme/infix/ had a non-free copyright licence and
has been removed.
** Bug fixes
- SEEK currently works on unbuffered ports only. Check this in the
implementation and oopsify it in the manual.
- Adjust documentation of some low-level regexp procedures
- Removed message argument form errno-error
- After fork/pipe, make the ports returned by the pipe the
current-in/output-ports
- Get the names of MAKE-STRING-PORT-FILTER and
MAKE-CHAR-PORT-FILTER right in the doc
- Fixed memory leak in scheme_cwd
- Fixed memory leak in format_date
- Avoid calling SOCKET-OPTION twice in case of an error
- Fix for (rx (|)) by Peter Wang
- Fix for (posix-string->regexp "$") by Peter Wang
** API changes
None known.
* New in 0.6.4
==============
** 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.
** New SRFIs
This release adds support for SRFI 25, 26, 27, 28 and 30.
** 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-port-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.
@ -517,6 +256,27 @@ 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.
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
Reini Urban
Peter Biber
Roland Weiss
Richard Günther
Dirk Staneker
Johannes Hirche
Brought to you by the Scheme Underground. Go forth and write elegant systems

7
Thanks
View File

@ -23,10 +23,3 @@ Post-0.5.2-release bug reports:
Michel Schinz
Alan Bawden
Bengt Kleberg
RT Happe
Dorai Sitaram
Peter Wang
Stephen Ma
stktrc
Jan Alleman
Taylor Campbell

70
acconfig.h Normal file
View File

@ -0,0 +1,70 @@
/*
* 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
/*
* Define if your tm struct in <time.h> has a tm_gmtoff field.
*/
#undef HAVE_GMTOFF
/*
* Define if you have dlopen() and related routines (dynamic linking
* of shared object files).
*/
#undef HAVE_DLOPEN
/* Define if your sys_errlist is a const definition */
#undef HAVE_CONST_SYS_ERRLIST
/* Define if you have the nlist() function. This is a
not-very-portable way of looking up external symbols. */
#undef HAVE_NLIST
#undef _HPUX_SOURCE
#undef hpux
#undef _XOPEN_SOURCE_EXTENDED
#undef CYGWIN
#undef HAVE_SETEGID
#undef HAVE_SETREGID
#undef HAVE_SETEUID
#undef HAVE_SETREUID
#undef socklen_t
#undef HAVE_HARRIS
@BOTTOM@
/* Include info we know about the system from config.scsh */
#include "../scsh/machine/sysdep.h"
#include "fake/sigact.h"
#include "fake/strerror.h"
#include "fake/sys-select.h"

6
autogen.sh
View File

@ -1,11 +1,11 @@
#! /bin/sh
#! /bin/sh
autoheader &&
autoconf &&
./configure &&
touch scsh/*.c &&
touch build/filenames.scm &&
rm -f scheme48.image scsh/scsh.image &&
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 &&
@ -13,4 +13,4 @@ make i-know-what-i-am-doing &&
make c/scheme48.h&&
make linker &&
make build/initial.image &&
make distclean
make distclean

6
build/build-usual-image
View File

@ -9,13 +9,11 @@ vm=$4
initial=$5
USER=${USER-`logname 2>/dev/null || echo '*GOK*'`}
./$vm -o ./$vm -i $initial -- batch <<EOF
./$vm -o ./$vm -i $initial batch <<EOF
,load $srcdir/scheme/env/init-defpackage.scm
((*structure-ref filenames 'set-translation!)
"=scheme48/" "$srcdir/scheme/")
,load =scheme48/more-interfaces.scm
,load =scheme48/sort/interfaces.scm
,load =scheme48/link-packages.scm
,load =scheme48/more-interfaces.scm =scheme48/link-packages.scm
,load =scheme48/more-packages.scm
(ensure-loaded command-processor)
(ensure-loaded usual-commands)

1
build/filenames.scm
View File

@ -6,7 +6,6 @@
; 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"))

BIN
build/initial.image
View File

Binary file not shown.

4
build/initial.scm
View File

@ -1,4 +1,4 @@
; Copyright (c) 1993-2000 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 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 package-name type)
(lambda (name type)
(if (not (assq name l))
(let ((s (eval name env)))
(if (structure? s)

2
build/minor-version-number
View File

@ -1 +1 @@
6.7
6.1

6
c/event.h
View File

@ -1,7 +1,5 @@
enum event_enum { KEYBOARD_INTERRUPT_EVENT,
IO_READ_COMPLETION_EVENT, IO_WRITE_COMPLETION_EVENT,
ALARM_EVENT,
OS_SIGNAL_EVENT, ERROR_EVENT, NO_EVENT };
enum event_enum { KEYBOARD_INTERRUPT_EVENT, IO_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);

77
c/external.c
View File

@ -500,130 +500,71 @@ s48_raise_closed_channel_error() {
void
s48_raise_os_error(int the_errno) {
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 2,
s48_enter_integer(the_errno),
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)));
}
void
s48_raise_os_error_1(int the_errno, s48_value arg1) {
s48_value sch_errno = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(2);
S48_GC_PROTECT_2 (arg1, sch_errno);
sch_errno = s48_enter_integer(the_errno);
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 3,
sch_errno,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1);
S48_GC_UNPROTECT();
}
void
s48_raise_os_error_2(int the_errno, s48_value arg1, s48_value arg2) {
s48_value sch_errno = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(3);
S48_GC_PROTECT_3 (arg1, arg2, sch_errno);
sch_errno = s48_enter_integer(the_errno);
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 4,
sch_errno,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2);
S48_GC_UNPROTECT();
}
void
s48_raise_os_error_3(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3) {
s48_value sch_errno = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(4);
S48_GC_PROTECT_4 (arg1, arg2, arg3, sch_errno);
sch_errno = s48_enter_integer(the_errno);
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 5,
sch_errno,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3);
S48_GC_UNPROTECT();
}
void
s48_raise_os_error_4(int the_errno, s48_value arg1, s48_value arg2,
s48_value arg3, s48_value arg4) {
s48_value sch_errno = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(5);
S48_GC_PROTECT_5 (arg1, arg2, arg3, arg4, sch_errno);
sch_errno = s48_enter_integer(the_errno);
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 6,
sch_errno,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3, arg4);
S48_GC_UNPROTECT();
}
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_value sch_errno = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(6);
S48_GC_PROTECT_6 (arg1, arg2, arg3, arg4, arg5, sch_errno);
sch_errno = s48_enter_integer(the_errno);
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 7,
sch_errno,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3, arg4, arg5);
S48_GC_UNPROTECT();
}
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_value sch_errno = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(7);
S48_GC_PROTECT_7 (arg1, arg2, arg3, arg4, arg5, arg6, sch_errno);
sch_errno = s48_enter_integer(the_errno);
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 8,
sch_errno,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3, arg4, arg5, arg6);
S48_GC_UNPROTECT();
}
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_value sch_errno = S48_UNSPECIFIC;
S48_DECLARE_GC_PROTECT(8);
S48_GC_PROTECT_8 (arg1, arg2, arg3, arg4, arg5, arg6, arg7, sch_errno);
sch_errno = s48_enter_integer(the_errno);
s48_raise_scheme_exception(S48_EXCEPTION_OS_ERROR, 9,
sch_errno,
s48_enter_fixnum(the_errno),
s48_enter_string(strerror(the_errno)),
arg1, arg2, arg3, arg4, arg5, arg6, arg7);
S48_GC_UNPROTECT();
}
void
@ -1173,7 +1114,7 @@ s48_value
s48_enter_substring(char *str, int length)
{
s48_value obj = s48_allocate_stob(S48_STOBTYPE_STRING, length + 1);
memcpy(S48_UNSAFE_EXTRACT_STRING(obj), str, length);
strncpy(S48_UNSAFE_EXTRACT_STRING(obj), str, length);
*(S48_UNSAFE_EXTRACT_STRING(obj) + length) = '\0';
return obj;
}

7
c/init.c
View File

@ -15,6 +15,8 @@ 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,
@ -28,12 +30,12 @@ int s48_main (long heap_size, long stack_size,
}
int
internal_s48_main(long heap_size, long stack_size,
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 = 0;
int warn_undefined_imported_bindings_p = 1;
#if defined(STATIC_AREAS)
extern long static_entry;
@ -43,6 +45,7 @@ internal_s48_main(long heap_size, long stack_size,
extern long i_count, *i_areas[], i_sizes[];
#endif
prog_name = _prog_name;
s48_object_file = object_file;
s48_reloc_file = NULL;

35
c/main.c
View File

@ -9,8 +9,8 @@
** the top. -Olin
*/
#if !defined(DEFAULT_HEAP_SIZE)
/* 5 megacell = 20 megabytes (10 meg per semispace) */
#define DEFAULT_HEAP_SIZE 5000000L
/* 4 megacell = 16 megabytes (8 meg per semispace) */
#define DEFAULT_HEAP_SIZE 4500000L
#endif
#if !defined(DEFAULT_STACK_SIZE)
@ -24,22 +24,22 @@
/* DEFAULT_IMAGE_NAME should be defined using the -D switch to cc. */
#if !defined(DEFAULT_IMAGE_NAME)
#define DEFAULT_IMAGE_NAME "scsh.image"
#define DEFAULT_IMAGE_NAME "scheme48.image"
#endif
#endif /* STATIC_AREAS */
void process_args(char **argv,
long *heap_size,
long *stack_size,
char **object_file,
char **image_name);
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* 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
@ -62,13 +62,12 @@ main(argc, argv)
#endif
long vm_argc = 0;
prog_name = *argv++;/* Save program name. */
char *me = *argv; /* Save program name. */
prog_name = *argv++;
process_args(argv,
&heap_size, &stack_size,
&object_file, &image_name);
argv--;
argv[0] = prog_name;
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, object_file, image_name, argc, argv);
return internal_s48_main(heap_size, stack_size, prog_name, object_file, image_name, argc, argv);
}

72
c/scheme48.h
View File

@ -282,6 +282,9 @@ 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)
@ -309,38 +312,36 @@ 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_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_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_CAR_OFFSET 0
#define S48_CAR(x) (s48_stob_ref((x), S48_STOBTYPE_PAIR, 0))
@ -365,11 +366,6 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_UNSAFE_CONTENTS(x) (S48_STOB_REF((x), 1))
#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))
@ -457,7 +453,7 @@ extern void s48_check_record_type(s48_value record, s48_value type_binding);
#define S48_RECORD_SET(x, i, v) (s48_stob_set((x), S48_STOBTYPE_RECORD, (i) + 1, (v)))
#define S48_UNSAFE_RECORD_REF(x, i) (S48_STOB_REF((x), (i) + 1))
#define S48_UNSAFE_RECORD_SET(x, i, v) S48_STOB_SET((x), (i) + 1, (v))
#define S48_RECORD_TYPE(x) (s48_stob_ref((x), S48_STOBTYPE_RECORD, 0))
#define S48_RECORD_TYPE(x) (s48_stob_ref((x), S48_STOBTYPE_RECORD))
#define S48_UNSAFE_RECORD_TYPE(x) (STOB_REF((x), 0))
#define S48_BYTE_VECTOR_LENGTH(x) (s48_stob_byte_length((x), S48_STOBTYPE_BYTE_VECTOR))
#define S48_BYTE_VECTOR_REF(x, i) (s48_stob_byte_ref((x), S48_STOBTYPE_BYTE_VECTOR, (i)))

1027
c/scheme48heap.c
View File

File diff suppressed because it is too large Load Diff

1
c/scheme48vm-prelude.h
View File

@ -1,6 +1,5 @@
#include <stdlib.h>
#include <stdio.h>
#include <string.h> /* memcpy, strlen */
#include "c-mods.h"
#include "write-barrier.h"

14132
c/scheme48vm.c
View File

File diff suppressed because it is too large Load Diff

2
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_signals(s48_value list);
extern void s48_set_os_signal(s48_value type, s48_value argument);
/* imported and exported bindings */
extern void s48_define_exported_binding(char *, s48_value);

240
c/srfi/srfi-27.c
View File

@ -1,240 +0,0 @@
/* 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 */
#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);
}

128
c/unix/event.c
View File

@ -1,7 +1,6 @@
/* Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees.
See file COPYING. */
#include "sysdep.h"
#include <signal.h> /* for sigaction() (POSIX.1) */
#include <stdlib.h>
#include <unistd.h>
@ -10,6 +9,7 @@
#include <sys/time.h>
#include <sys/times.h>
#include <errno.h> /* for errno, (POSIX?/ANSI) */
#include "sysdep.h"
#include "c-mods.h"
#include "scheme48vm.h"
#include "event.h"
@ -30,10 +30,7 @@ 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 long interrupt_count[32];
static int s48_os_signal_pending(void);
static bool s48_os_signal_happend(void);
@ -45,6 +42,7 @@ void s48_start_alarm_interrupts(void);
void
s48_sysdep_init(void)
{
int i;
if (!s48_setcatcher(SIGINT, when_keyboard_interrupt)
|| !s48_setcatcher(SIGALRM, when_alarm_interrupt)
|| !s48_setcatcher(SIGPIPE, when_sigpipe_interrupt)) {
@ -53,6 +51,8 @@ s48_sysdep_init(void)
errno);
exit(1);
}
for (i = 0; i < max_sig; i++)
interrupt_count[i] = 0;
sigfillset (&full_sigset);
@ -286,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-{read/write}-completion)
* (values (enum event-type i/o-completion)
* (dequeue! ready-ports)))
* ((>= *current_time* *alarm-time*)
* (set! *alarm-time* max-integer)
@ -301,20 +301,9 @@ s48_stop_alarm_interrupts(void)
* (values (enum event-type no-event) #f))))))
*/
#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);
static bool there_are_ready_ports(void);
static int next_ready_port(void);
static int queue_ready_ports(bool wait, long seconds, long ticks);
int
s48_get_next_event(long *ready_fd, long *status)
@ -324,8 +313,6 @@ 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);
*/
@ -346,14 +333,10 @@ s48_get_next_event(long *ready_fd, long *status)
}
}
if (there_are_ready_ports()) {
f = next_ready_fd_struct();
*ready_fd = f->fd;
*ready_fd = next_ready_port();
*status = 0; /* chars read or written */
/* fprintf(stderr, "[i/o completion]\n"); */
if (f->is_input)
return (IO_READ_COMPLETION_EVENT);
else
return (IO_WRITE_COMPLETION_EVENT);
return (IO_COMPLETION_EVENT);
}
if (alarm_time != -1 && s48_current_time >= alarm_time) {
alarm_time = -1;
@ -380,6 +363,17 @@ 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
@ -464,14 +458,14 @@ there_are_ready_ports(void)
}
static fd_struct *
next_ready_fd_struct(void)
static int
next_ready_port(void)
{
fd_struct *p;
p = rmque(&ready.first, &ready);
p->status = FD_QUIESCENT;
return (p);
return (p->fd);
}
@ -625,10 +619,11 @@ queue_ready_ports(bool wait, long seconds, long ticks)
tvp = &tv;
if (wait)
if (seconds == -1){
tvp = NULL;
tv.tv_sec = 1;
tv.tv_usec = 0;
}
else {
tv.tv_sec = seconds;
tv.tv_sec = (seconds > 0) ? 1 : 0;
tv.tv_usec = ticks * (1000000 / TICKS_PER_SECOND);
}
else
@ -653,6 +648,18 @@ queue_ready_ports(bool wait, long seconds, long ticks)
poll_time = -1;
return NO_ERRORS;
}
else if (wait && (left == 0) && (limfd == 0)){
if (seconds > 1){
seconds--;
tv.tv_sec = 1; /* select maybe destroyed tv */
tv.tv_usec = 0; /* we already waited the usecs */
}
else if (seconds > -1) return NO_ERRORS;
else { /* loop if seconds == -1 */
tv.tv_sec = 1;
tv.tv_usec = 0;
}
}
else if (left == 0)
return NO_ERRORS;
else if (errno == EINTR) {
@ -664,25 +671,11 @@ queue_ready_ports(bool wait, long seconds, long ticks)
}
}
/*
* 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]);
interrupt_count[sig2int[signo]] +=1;
NOTE_EVENT;
return;
}
@ -710,34 +703,31 @@ static void when_scsh_interrupt(int signo)
* 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.
*/
/* 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; }
for (i = 0; i < max_sig; i++){
if (interrupt_count[i] > 0){
--interrupt_count[i];
allow_interrupts();
s48_set_os_signal(S48_UNSAFE_ENTER_FIXNUM(i),
S48_UNSAFE_ENTER_FIXNUM(0));
return TRUE;
}
}
return FALSE;
}
bool
s48_os_signal_happend(void) {
return (next_interrupt != 0);
int i;
for (i = 0; i < max_sig; i++){
if (interrupt_count[i] > 0){
return TRUE;
}
}
return FALSE;
}

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

@ -1,7 +1,6 @@
/* Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees.
See file COPYING. */
#include "sysdep.h"
#include <unistd.h>
#include <stdio.h>
#include <sys/types.h>
@ -9,6 +8,7 @@
#include <fcntl.h>
#include <sys/time.h>
#include <errno.h> /* for errno, (POSIX?/ANSI) */
#include "sysdep.h"
#include "c-mods.h"
#include "scheme48vm.h"
#include "event.h"
@ -111,16 +111,6 @@ bool ps_check_fd(long fd_as_long, bool is_read, long *status)
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)
@ -211,7 +201,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);

38
c/unix/io.c
View File

@ -146,6 +146,26 @@ ps_write_char(char ch, FILE *port)
return 0; }
}
long
ps_write_integer(long n, FILE *port)
{
int status;
static long write_integer(unsigned long n, FILE *port);
if (n == 0) {
WRITE_CHAR('0', port, status);
return status; }
else if (n > 0)
return write_integer(n, port);
else {
WRITE_CHAR('-', port, status);
if (status == 0)
return write_integer(- n, port);
else
return status; }
}
static long
write_integer(unsigned long n, FILE *port)
{
@ -162,24 +182,6 @@ write_integer(unsigned long n, FILE *port)
return status;
}
long
ps_write_integer(long n, FILE *port)
{
int status;
if (n == 0) {
WRITE_CHAR('0', port, status);
return status; }
else if (n > 0)
return write_integer(n, port);
else {
WRITE_CHAR('-', port, status);
if (status == 0)
return write_integer(- n, port);
else
return status; }
}
long
ps_write_string(char *string, FILE *port)
{

50
c/unix/socket.c
View File

@ -36,23 +36,9 @@ 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)
{
@ -64,7 +50,6 @@ 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);
}
/*
@ -381,38 +366,11 @@ s48_close_socket_half(s48_value channel, s48_value input_p)
static s48_value
s48_get_host_name(void)
{
char *mbuff = NULL;
size_t mbuff_len = 0;
int status = 0;
s48_value name;
char mbuff[MAXHOSTNAMELEN];
do {
char *tmp;
mbuff_len += 256; /* Initial guess */
tmp = (char *) realloc(mbuff, mbuff_len);
if (tmp == NULL) {
free(mbuff);
s48_raise_os_error(ENOMEM);
}
else
mbuff = tmp;
} while (((status = gethostname(mbuff, mbuff_len)) == 0
&& !memchr(mbuff, '\0', mbuff_len))
#ifdef ENAMETOOLONG
|| errno == ENAMETOOLONG
#endif
);
if (status != 0 && errno != 0) {
/* gethostname failed, abort. */
free(mbuff);
if (gethostname(mbuff, sizeof(mbuff)) < 0)
s48_raise_os_error(errno);
}
name = s48_enter_string(mbuff);
free(mbuff);
return name;
return s48_enter_string(mbuff);
}

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); */
/* } */

1123
config.guess vendored
View File

File diff suppressed because it is too large Load Diff

483
config.sub vendored
View File

@ -1,9 +1,9 @@
#! /bin/sh
# Configuration validation subroutine script.
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
# 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
# Free Software Foundation, Inc.
timestamp='2005-07-08'
timestamp='2001-03-09'
# This file is (in principle) common to ALL GNU software.
# The presence of a machine in this file suggests that SOME GNU software
@ -21,17 +21,15 @@ timestamp='2005-07-08'
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA
# 02110-1301, USA.
#
# Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
# As a special exception to the GNU General Public License, if you
# distribute this file as part of a program that contains a
# configuration script generated by Autoconf, you may include it under
# the same distribution terms that you use for the rest of that program.
# Please send patches to <config-patches@gnu.org>. Submit a context
# diff and a properly formatted ChangeLog entry.
# Please send patches to <config-patches@gnu.org>.
#
# Configuration subroutine to validate and canonicalize a configuration type.
# Supply the specified configuration type as an argument.
@ -71,7 +69,7 @@ Report bugs and patches to <config-patches@gnu.org>."
version="\
GNU config.sub ($timestamp)
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
@ -84,11 +82,11 @@ Try \`$me --help' for more information."
while test $# -gt 0 ; do
case $1 in
--time-stamp | --time* | -t )
echo "$timestamp" ; exit ;;
echo "$timestamp" ; exit 0 ;;
--version | -v )
echo "$version" ; exit ;;
echo "$version" ; exit 0 ;;
--help | --h* | -h )
echo "$usage"; exit ;;
echo "$usage"; exit 0 ;;
-- ) # Stop option processing
shift; break ;;
- ) # Use stdin as input.
@ -100,7 +98,7 @@ while test $# -gt 0 ; do
*local*)
# First pass through any local machine types.
echo $1
exit ;;
exit 0;;
* )
break ;;
@ -119,8 +117,7 @@ esac
# Here we must recognize all the valid KERNEL-OS combinations.
maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'`
case $maybe_os in
nto-qnx* | linux-gnu* | linux-dietlibc | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | \
kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | storm-chaos* | os2-emx* | rtmk-nova*)
nto-qnx* | linux-gnu* | storm-chaos* | os2-emx*)
os=-$maybe_os
basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`
;;
@ -146,7 +143,7 @@ case $os in
-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
-apple | -axis | -knuth | -cray)
-apple | -axis)
os=
basic_machine=$1
;;
@ -160,14 +157,6 @@ case $os in
os=-vxworks
basic_machine=$1
;;
-chorusos*)
os=-chorusos
basic_machine=$1
;;
-chorusrdb)
os=-chorusrdb
basic_machine=$1
;;
-hiux*)
os=-hiuxwe2
;;
@ -226,57 +215,24 @@ esac
case $basic_machine in
# Recognize the basic CPU types without company name.
# Some are omitted here because they have special meanings below.
1750a | 580 \
| a29k \
| alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \
| alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \
| am33_2.0 \
| arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr \
| bfin \
| c4x | clipper \
| d10v | d30v | dlx | dsp16xx \
| fr30 | frv \
| h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \
| i370 | i860 | i960 | ia64 \
| ip2k | iq2000 \
| m32r | m32rle | m68000 | m68k | m88k | maxq | mcore \
| mips | mipsbe | mipseb | mipsel | mipsle \
| mips16 \
| mips64 | mips64el \
| mips64vr | mips64vrel \
| mips64orion | mips64orionel \
| mips64vr4100 | mips64vr4100el \
| mips64vr4300 | mips64vr4300el \
| mips64vr5000 | mips64vr5000el \
| mips64vr5900 | mips64vr5900el \
| mipsisa32 | mipsisa32el \
| mipsisa32r2 | mipsisa32r2el \
| mipsisa64 | mipsisa64el \
| mipsisa64r2 | mipsisa64r2el \
| mipsisa64sb1 | mipsisa64sb1el \
| mipsisa64sr71k | mipsisa64sr71kel \
| mipstx39 | mipstx39el \
| mn10200 | mn10300 \
| ms1 \
| msp430 \
| ns16k | ns32k \
| or32 \
| pdp10 | pdp11 | pj | pjl \
| powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
| pyramid \
| sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | shbe | shle | sh[1234]le | sh3ele \
| sh64 | sh64le \
| sparc | sparc64 | sparc64b | sparc86x | sparclet | sparclite \
| sparcv8 | sparcv9 | sparcv9b \
| strongarm \
| tahoe | thumb | tic4x | tic80 | tron \
| v850 | v850e \
| we32k \
| x86 | xscale | xscalee[bl] | xstormy16 | xtensa \
| z8k)
basic_machine=$basic_machine-unknown
;;
m32c)
tahoe | i860 | ia64 | m32r | m68k | m68000 | m88k | ns32k | arc \
| arm | arme[lb] | arm[bl]e | armv[2345] | armv[345][lb] | strongarm | xscale \
| pyramid | mn10200 | mn10300 | tron | a29k \
| 580 | i960 | h8300 \
| x86 | ppcbe | mipsbe | mipsle | shbe | shle \
| hppa | hppa1.0 | hppa1.1 | hppa2.0 | hppa2.0w | hppa2.0n \
| hppa64 \
| alpha | alphaev[4-8] | alphaev56 | alphapca5[67] \
| alphaev6[78] \
| we32k | ns16k | clipper | i370 | sh | sh[34] \
| powerpc | powerpcle \
| 1750a | dsp16xx | pdp10 | pdp11 \
| mips16 | mips64 | mipsel | mips64el \
| mips64orion | mips64orionel | mipstx39 | mipstx39el \
| mips64vr4300 | mips64vr4300el | mips64vr4100 | mips64vr4100el \
| mips64vr5000 | miprs64vr5000el | mcore | s390 | s390x \
| sparc | sparclet | sparclite | sparc64 | sparcv9 | v850 | c4x \
| thumb | d10v | d30v | fr30 | avr | openrisc)
basic_machine=$basic_machine-unknown
;;
m6811 | m68hc11 | m6812 | m68hc12)
@ -284,13 +240,13 @@ case $basic_machine in
basic_machine=$basic_machine-unknown
os=-none
;;
m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k)
m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | z8k | v70 | h8500 | w65 | pj | pjl)
;;
# We use `pc' rather than `unknown'
# because (1) that's what they normally are, and
# (2) the word "unknown" tends to confuse beginning users.
i*86 | x86_64)
i[234567]86 | x86_64)
basic_machine=$basic_machine-pc
;;
# Object if more than one company name word.
@ -299,67 +255,30 @@ case $basic_machine in
exit 1
;;
# Recognize the basic CPU types with company name.
580-* \
| a29k-* \
| alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \
| alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \
| alphapca5[67]-* | alpha64pca5[67]-* | arc-* \
| arm-* | armbe-* | armle-* | armeb-* | armv*-* \
| avr-* \
| bfin-* | bs2000-* \
| c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \
| clipper-* | craynv-* | cydra-* \
| d10v-* | d30v-* | dlx-* \
| elxsi-* \
| f30[01]-* | f700-* | fr30-* | frv-* | fx80-* \
| h8300-* | h8500-* \
| hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \
| i*86-* | i860-* | i960-* | ia64-* \
| ip2k-* | iq2000-* \
| m32r-* | m32rle-* \
| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
| m88110-* | m88k-* | maxq-* | mcore-* \
| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
| mips16-* \
| mips64-* | mips64el-* \
| mips64vr-* | mips64vrel-* \
| mips64orion-* | mips64orionel-* \
| mips64vr4100-* | mips64vr4100el-* \
| mips64vr4300-* | mips64vr4300el-* \
| mips64vr5000-* | mips64vr5000el-* \
| mips64vr5900-* | mips64vr5900el-* \
| mipsisa32-* | mipsisa32el-* \
| mipsisa32r2-* | mipsisa32r2el-* \
| mipsisa64-* | mipsisa64el-* \
| mipsisa64r2-* | mipsisa64r2el-* \
| mipsisa64sb1-* | mipsisa64sb1el-* \
| mipsisa64sr71k-* | mipsisa64sr71kel-* \
| mipstx39-* | mipstx39el-* \
| mmix-* \
| ms1-* \
| msp430-* \
| none-* | np1-* | ns16k-* | ns32k-* \
| orion-* \
| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
| pyramid-* \
| romp-* | rs6000-* \
| sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | shbe-* \
| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
| sparc-* | sparc64-* | sparc64b-* | sparc86x-* | sparclet-* \
| sparclite-* \
| sparcv8-* | sparcv9-* | sparcv9b-* | strongarm-* | sv1-* | sx?-* \
| tahoe-* | thumb-* \
| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \
| tron-* \
| v850-* | v850e-* | vax-* \
| we32k-* \
| x86-* | x86_64-* | xps100-* | xscale-* | xscalee[bl]-* \
| xstormy16-* | xtensa-* \
| ymp-* \
| z8k-*)
;;
m32c-*)
# FIXME: clean up the formatting here.
vax-* | tahoe-* | i[234567]86-* | i860-* | ia64-* | m32r-* | m68k-* | m68000-* \
| m88k-* | sparc-* | ns32k-* | fx80-* | arc-* | c[123]* \
| arm-* | armbe-* | armle-* | armv*-* | strongarm-* | xscale-* \
| mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \
| power-* | none-* | 580-* | cray2-* | h8300-* | h8500-* | i960-* \
| xmp-* | ymp-* \
| x86-* | ppcbe-* | mipsbe-* | mipsle-* | shbe-* | shle-* \
| hppa-* | hppa1.0-* | hppa1.1-* | hppa2.0-* | hppa2.0w-* \
| hppa2.0n-* | hppa64-* \
| alpha-* | alphaev[4-8]-* | alphaev56-* | alphapca5[67]-* \
| alphaev6[78]-* \
| we32k-* | cydra-* | ns16k-* | pn-* | np1-* | xps100-* \
| clipper-* | orion-* \
| sparclite-* | pdp10-* | pdp11-* | sh-* | powerpc-* | powerpcle-* \
| sparc64-* | sparcv9-* | sparc86x-* | mips16-* | mips64-* | mipsel-* \
| mips64el-* | mips64orion-* | mips64orionel-* \
| mips64vr4100-* | mips64vr4100el-* | mips64vr4300-* | mips64vr4300el-* \
| mipstx39-* | mipstx39el-* | mcore-* \
| f30[01]-* | f700-* | s390-* | s390x-* | sv1-* | t3e-* \
| [cjt]90-* \
| m88110-* | m680[01234]0-* | m683?2-* | m68360-* | z8k-* | d10v-* \
| thumb-* | v850-* | d30v-* | tic30-* | c30-* | fr30-* \
| bs2000-* | tic54x-* | c54x-* | x86_64-*)
;;
# Recognize the various machine names and aliases which stand
# for a CPU type and a company and sometimes even an OS.
@ -377,9 +296,6 @@ case $basic_machine in
basic_machine=a29k-amd
os=-udi
;;
abacus)
basic_machine=abacus-unknown
;;
adobe68k)
basic_machine=m68010-adobe
os=-scout
@ -394,12 +310,6 @@ case $basic_machine in
basic_machine=a29k-none
os=-bsd
;;
amd64)
basic_machine=x86_64-pc
;;
amd64-*)
basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
amdahl)
basic_machine=580-amdahl
os=-sysv
@ -431,10 +341,6 @@ case $basic_machine in
basic_machine=ns32k-sequent
os=-dynix
;;
c90)
basic_machine=c90-cray
os=-unicos
;;
convex-c1)
basic_machine=c1-convex
os=-bsd
@ -455,45 +361,30 @@ case $basic_machine in
basic_machine=c38-convex
os=-bsd
;;
cray | j90)
basic_machine=j90-cray
cray | ymp)
basic_machine=ymp-cray
os=-unicos
;;
craynv)
basic_machine=craynv-cray
os=-unicosmp
cray2)
basic_machine=cray2-cray
os=-unicos
;;
cr16c)
basic_machine=cr16c-unknown
os=-elf
[cjt]90)
basic_machine=${basic_machine}-cray
os=-unicos
;;
crds | unos)
basic_machine=m68k-crds
;;
crisv32 | crisv32-* | etraxfs*)
basic_machine=crisv32-axis
;;
cris | cris-* | etrax*)
basic_machine=cris-axis
;;
crx)
basic_machine=crx-unknown
os=-elf
;;
da30 | da30-*)
basic_machine=m68k-da30
;;
decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
basic_machine=mips-dec
;;
decsystem10* | dec10*)
basic_machine=pdp10-dec
os=-tops10
;;
decsystem20* | dec20*)
basic_machine=pdp10-dec
os=-tops20
;;
delta | 3300 | motorola-3300 | motorola-delta \
| 3300-motorola | delta-motorola)
basic_machine=m68k-motorola
@ -502,10 +393,6 @@ case $basic_machine in
basic_machine=m88k-motorola
os=-sysv3
;;
djgpp)
basic_machine=i586-pc
os=-msdosdjgpp
;;
dpx20 | dpx20-*)
basic_machine=rs6000-bull
os=-bosx
@ -618,19 +505,19 @@ case $basic_machine in
basic_machine=i370-ibm
;;
# I'm not sure what "Sysv32" means. Should this be sysv3.2?
i*86v32)
i[34567]86v32)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-sysv32
;;
i*86v4*)
i[34567]86v4*)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-sysv4
;;
i*86v)
i[34567]86v)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-sysv
;;
i*86sol2)
i[34567]86sol2)
basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'`
os=-solaris2
;;
@ -678,20 +565,28 @@ case $basic_machine in
basic_machine=m68k-atari
os=-mint
;;
mipsel*-linux*)
basic_machine=mipsel-unknown
os=-linux-gnu
;;
mips*-linux*)
basic_machine=mips-unknown
os=-linux-gnu
;;
mips3*-*)
basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
;;
mips3*)
basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
;;
mmix*)
basic_machine=mmix-knuth
os=-mmixware
;;
monitor)
basic_machine=m68k-rom68k
os=-coff
;;
morphos)
basic_machine=powerpc-unknown
os=-morphos
;;
msdos)
basic_machine=i386-pc
os=-msdos
@ -771,13 +666,6 @@ case $basic_machine in
basic_machine=hppa1.1-oki
os=-proelf
;;
openrisc | openrisc-*)
basic_machine=or32-unknown
;;
os400)
basic_machine=powerpc-ibm
os=-os400
;;
OSE68000 | ose68000)
basic_machine=m68000-ericsson
os=-ose
@ -800,58 +688,42 @@ case $basic_machine in
pbb)
basic_machine=m68k-tti
;;
pc532 | pc532-*)
pc532 | pc532-*)
basic_machine=ns32k-pc532
;;
pentium | p5 | k5 | k6 | nexgen | viac3)
pentium | p5 | k5 | k6 | nexgen)
basic_machine=i586-pc
;;
pentiumpro | p6 | 6x86 | athlon | athlon_*)
pentiumpro | p6 | 6x86 | athlon)
basic_machine=i686-pc
;;
pentiumii | pentium2 | pentiumiii | pentium3)
pentiumii | pentium2)
basic_machine=i686-pc
;;
pentium4)
basic_machine=i786-pc
;;
pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*)
pentium-* | p5-* | k5-* | k6-* | nexgen-*)
basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pentiumpro-* | p6-* | 6x86-* | athlon-*)
basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*)
pentiumii-* | pentium2-*)
basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pentium4-*)
basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
pn)
basic_machine=pn-gould
;;
power) basic_machine=power-ibm
;;
ppc) basic_machine=powerpc-unknown
;;
;;
ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ppcle | powerpclittle | ppc-le | powerpc-little)
basic_machine=powerpcle-unknown
;;
;;
ppcle-* | powerpclittle-*)
basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ppc64) basic_machine=powerpc64-unknown
;;
ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ppc64le | powerpc64little | ppc64-le | powerpc64-little)
basic_machine=powerpc64le-unknown
;;
ppc64le-* | powerpc64little-*)
basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'`
;;
ps2)
basic_machine=i386-ibm
;;
@ -869,26 +741,10 @@ case $basic_machine in
rtpc | rtpc-*)
basic_machine=romp-ibm
;;
s390 | s390-*)
basic_machine=s390-ibm
;;
s390x | s390x-*)
basic_machine=s390x-ibm
;;
sa29200)
basic_machine=a29k-amd
os=-udi
;;
sb1)
basic_machine=mipsisa64sb1-unknown
;;
sb1el)
basic_machine=mipsisa64sb1el-unknown
;;
sei)
basic_machine=mips-sei
os=-seiux
;;
sequent)
basic_machine=i386-sequent
;;
@ -896,10 +752,7 @@ case $basic_machine in
basic_machine=sh-hitachi
os=-hms
;;
sh64)
basic_machine=sh64-unknown
;;
sparclite-wrs | simso-wrs)
sparclite-wrs)
basic_machine=sparclite-wrs
os=-vxworks
;;
@ -966,42 +819,22 @@ case $basic_machine in
os=-dynix
;;
t3e)
basic_machine=alphaev5-cray
os=-unicos
;;
t90)
basic_machine=t90-cray
basic_machine=t3e-cray
os=-unicos
;;
tic54x | c54x*)
basic_machine=tic54x-unknown
os=-coff
;;
tic55x | c55x*)
basic_machine=tic55x-unknown
os=-coff
;;
tic6x | c6x*)
basic_machine=tic6x-unknown
os=-coff
;;
tx39)
basic_machine=mipstx39-unknown
;;
tx39el)
basic_machine=mipstx39el-unknown
;;
toad1)
basic_machine=pdp10-xkl
os=-tops20
;;
tower | tower-32)
basic_machine=m68k-ncr
;;
tpf)
basic_machine=s390x-ibm
os=-tpf
;;
udi29k)
basic_machine=a29k-amd
os=-udi
@ -1023,8 +856,8 @@ case $basic_machine in
os=-vms
;;
vpp*|vx|vx-*)
basic_machine=f301-fujitsu
;;
basic_machine=f301-fujitsu
;;
vxworks960)
basic_machine=i960-wrs
os=-vxworks
@ -1045,17 +878,13 @@ case $basic_machine in
basic_machine=hppa1.1-winbond
os=-proelf
;;
xbox)
basic_machine=i686-pc
os=-mingw32
;;
xps | xps100)
basic_machine=xps100-honeywell
;;
ymp)
basic_machine=ymp-cray
xmp)
basic_machine=xmp-cray
os=-unicos
;;
xps | xps100)
basic_machine=xps100-honeywell
;;
z8k-*-coff)
basic_machine=z8k-unknown
os=-sim
@ -1076,12 +905,16 @@ case $basic_machine in
op60c)
basic_machine=hppa1.1-oki
;;
mips)
if [ x$os = x-linux-gnu ]; then
basic_machine=mips-unknown
else
basic_machine=mips-mips
fi
;;
romp)
basic_machine=romp-ibm
;;
mmix)
basic_machine=mmix-knuth
;;
rs6000)
basic_machine=rs6000-ibm
;;
@ -1098,13 +931,13 @@ case $basic_machine in
we32k)
basic_machine=we32k-att
;;
sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele)
sh3 | sh4)
basic_machine=sh-unknown
;;
sparc | sparcv8 | sparcv9 | sparcv9b)
sparc | sparcv9)
basic_machine=sparc-sun
;;
cydra)
cydra)
basic_machine=cydra-cydrome
;;
orion)
@ -1119,8 +952,9 @@ case $basic_machine in
pmac | pmac-mpw)
basic_machine=powerpc-apple
;;
*-unknown)
# Make sure to match an already-canonicalized machine name.
c4x*)
basic_machine=c4x-none
os=-coff
;;
*)
echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
@ -1174,47 +1008,36 @@ case $os in
| -aos* \
| -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
| -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \
| -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* | -openbsd* \
| -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \
| -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
| -hiux* | -386bsd* | -netbsd* | -openbsd* | -freebsd* | -riscix* \
| -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \
| -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \
| -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \
| -chorusos* | -chorusrdb* \
| -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \
| -mingw32* | -linux-gnu* | -linux-uclibc* | -uxpv* | -beos* | -mpeix* | -udk* \
| -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \
| -mingw32* | -linux-gnu* | -uxpv* | -beos* | -mpeix* | -udk* \
| -interix* | -uwin* | -rhapsody* | -darwin* | -opened* \
| -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \
| -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \
| -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
| -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
| -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
| -skyos* | -haiku*)
| -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* | -os2*)
# Remember, each alternative MUST END IN *, to match a version number.
;;
-qnx*)
case $basic_machine in
x86-* | i*86-*)
x86-* | i[34567]86-*)
;;
*)
os=-nto$os
;;
esac
;;
-nto-qnx*)
;;
-nto*)
os=`echo $os | sed -e 's|nto|nto-qnx|'`
os=-nto-qnx
;;
-sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \
| -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \
| -windows* | -osx | -abug | -netware* | -os9* | -beos* \
| -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*)
;;
-mac*)
os=`echo $os | sed -e 's|mac|macos|'`
;;
-linux-dietlibc)
os=-linux-dietlibc
;;
-linux*)
os=`echo $os | sed -e 's|linux|linux-gnu|'`
;;
@ -1227,9 +1050,6 @@ case $os in
-opened*)
os=-openedition
;;
-os400*)
os=-os400
;;
-wince*)
os=-wince
;;
@ -1248,23 +1068,14 @@ case $os in
-acis*)
os=-aos
;;
-atheos*)
os=-atheos
;;
-syllable*)
os=-syllable
;;
-386bsd)
os=-bsd
;;
-ctix* | -uts*)
os=-sysv
;;
-nova*)
os=-rtmk-nova
;;
-ns2 )
os=-nextstep2
os=-nextstep2
;;
-nsk*)
os=-nsk
@ -1276,9 +1087,6 @@ case $os in
-sinix*)
os=-sysv4
;;
-tpf*)
os=-tpf
;;
-triton*)
os=-sysv3
;;
@ -1306,17 +1114,8 @@ case $os in
-xenix)
os=-xenix
;;
-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
os=-mint
;;
-aros*)
os=-aros
;;
-kaos*)
os=-kaos
;;
-zvmoe)
os=-zvmoe
-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
os=-mint
;;
-none)
;;
@ -1349,14 +1148,10 @@ case $basic_machine in
arm*-semi)
os=-aout
;;
c4x-* | tic4x-*)
os=-coff
;;
# This must come before the *-dec entry.
pdp10-*)
os=-tops20
;;
pdp11-*)
pdp11-*)
os=-none
;;
*-dec | vax-*)
@ -1383,9 +1178,6 @@ case $basic_machine in
mips*-*)
os=-elf
;;
or32-*)
os=-coff
;;
*-tti) # must be before sparc entry or we get the wrong os.
os=-sysv3
;;
@ -1395,15 +1187,9 @@ case $basic_machine in
*-be)
os=-beos
;;
*-haiku)
os=-haiku
;;
*-ibm)
os=-aix
;;
*-knuth)
os=-mmixware
;;
*-wec)
os=-proelf
;;
@ -1455,19 +1241,19 @@ case $basic_machine in
*-next)
os=-nextstep3
;;
*-gould)
*-gould)
os=-sysv
;;
*-highlevel)
*-highlevel)
os=-bsd
;;
*-encore)
os=-bsd
;;
*-sgi)
*-sgi)
os=-irix
;;
*-siemens)
*-siemens)
os=-sysv4
;;
*-masscomp)
@ -1536,16 +1322,10 @@ case $basic_machine in
-mvs* | -opened*)
vendor=ibm
;;
-os400*)
vendor=ibm
;;
-ptx*)
vendor=sequent
;;
-tpf*)
vendor=ibm
;;
-vxsim* | -vxworks* | -windiss*)
-vxsim* | -vxworks*)
vendor=wrs
;;
-aux*)
@ -1560,16 +1340,13 @@ case $basic_machine in
-*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*)
vendor=atari
;;
-vos*)
vendor=stratus
;;
esac
basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
;;
esac
echo $basic_machine$os
exit
exit 0
# Local variables:
# eval: (add-hook 'write-file-hooks 'time-stamp)

341
configure.in
View File

@ -3,7 +3,27 @@ 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
@ -33,39 +53,10 @@ dnl Note, on some Sun's, you can link with -rdynamic but the resulting
dnl a.out always core dumps.
define(S48_RDYNAMIC, [dnl
AC_MSG_CHECKING([link with -rdynamic])
AC_RUN_IFELSE(AC_LANG_PROGRAM([
#include <stdio.h>
#include <dlfcn.h>
int export_test = 0;],
[
#ifndef RTLD_LAZY
#define RTLD_LAZY 0
#endif
#ifndef RTLD_GLOBAL
#define RTLD_GLOBAL 0
#endif
void *dlhandle;
void *intp;
char *err;
dlhandle = dlopen(NULL, RTLD_LAZY | RTLD_GLOBAL);
if ((err = dlerror()) != NULL) {
return 1;
}
(void *)intp = dlsym(dlhandle, "export_test");
if ((err = dlerror()) != NULL) {
return 1;
}
return 0;
]),
AC_TRY_COMPILE([],
[#if defined(__linux__) && defined(__ELF__)
this must not compile
#endif],
[AC_MSG_RESULT(no)],
[AC_MSG_RESULT(yes)
LDFLAGS="$LDFLAGS -rdynamic"])
@ -77,7 +68,7 @@ define(S48_USCORE, [dnl
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, 1, [Define to 1 if symbols start with _])
AC_DEFINE(USCORE)
else
AC_MSG_RESULT([no])
fi
@ -88,7 +79,7 @@ dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_TZNAME,[
AC_MSG_CHECKING(for tzname)
AC_CACHE_VAL(scsh_cv_tzname,[
AC_TRY_COMPILE([#include <time.h>],
AC_TRY_COMPILE([#include <time.h>],
[return (int) tzname;],
scsh_cv_tzname=yes,
scsh_cv_tzname=no)])
@ -98,6 +89,20 @@ AC_DEFUN(SCSH_TZNAME,[
fi
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_GMTOFF,[
AC_MSG_CHECKING(for gmtoff)
AC_CACHE_VAL(scsh_cv_gmtoff,[
AC_TRY_COMPILE([#include <time.h>],
[struct tm time;
return time.tm_gmtoff;],
scsh_cv_gmtoff=yes,
scsh_cv_gmtoff=no)])
AC_MSG_RESULT($scsh_cv_gmtoff)
if test $scsh_cv_gmtoff = yes; then
AC_DEFINE(HAVE_GMTOFF)
fi
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_DEFUN(SCSH_ELF, [
AC_MSG_CHECKING(for ELF)
@ -109,45 +114,47 @@ AC_DEFUN(SCSH_ELF, [
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])
mkdir -p scsh
${CC} -o scsh_aux $srcdir/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
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, [
@ -172,13 +179,13 @@ 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>],
#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])
AC_DEFINE(HAVE_CONST_SYS_ERRLIST)
fi
])
@ -192,29 +199,21 @@ AC_DEFUN(SCSH_SOCKLEN_T,[
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_DEFINE(socklen_t,size_t)], [
AC_MSG_RESULT(int)
AC_DEFINE(socklen_t,int)])])
])
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
define(SCSH_CREATE_BUILD_DIRS, [dnl
mkdir -p scsh/machine
mkdir -p scsh/rx
mkdir -p c/srfi
mkdir -p c/unix
])dnl
dnl -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
AC_INIT(c/scheme48vm.c)
AC_CONFIG_HEADER(c/sysdep.h)
SCSH_CREATE_BUILD_DIRS
AC_CANONICAL_HOST
S48_PROG_CC
SCSH_SIG_NRS
AC_ISC_POSIX
SCSH_LINUX_STATIC_DEBUG
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
@ -231,33 +230,36 @@ AC_INIT(c/scheme48vm.c)
case "$host" in
## CX/UX
m88k-harris-cxux* )
machine=cxux
dir=cxux
CC="cc -Xa"
CFLAGS="-O"
LDFLAGS="-O -Wl,-Bexport"
AC_DEFINE(HAVE_HARRIS, 1, [Define to 1 on m88k-harris-cxux])
AC_DEFINE(HAVE_HARRIS)
;;
## DEC Ultrix
mips-dec-ultrix* )
AC_MSG_ERROR("Ultrix is not supported.")
dir=ultrix
if test ${CC} = cc; then
LDFLAGS=-N
fi
;;
## HP 9000 series 700 and 800, running HP/UX
hppa*-hp-hpux* )
machine=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])
AC_DEFINE(_HPUX_SOURCE)
AC_DEFINE(hpux)
AC_DEFINE(_XOPEN_SOURCE_EXTENDED)
;;
## IBM AIX
rs6000-ibm-aix*|powerpc-ibm-aix* )
machine=aix
dir=aix
LDFLAGS="-O"
if test ${CC} = gcc; then
LDFLAGS_AIX="-Xlinker -bexport:exportlist.aix"
@ -270,7 +272,7 @@ AC_INIT(c/scheme48vm.c)
## Linux
*-*-linux* )
machine=linux
dir=linux
# gross, but needed for some older a.out systems for 0.4.x
LIBS=-lc
SCSH_ELF
@ -278,58 +280,52 @@ AC_INIT(c/scheme48vm.c)
## NetBSD and FreeBSD ( and maybe 386BSD also)
*-*-*bsd*|*-*-darwin* )
machine=bsd
dir=bsd
SCSH_ELF
;;
## NeXT
*-next-* )
machine=next
dir=next
CC="$CC -posix"
AC_DEFINE(HAVE_SIGACTION)
;;
## SGI IRIX
mips-sgi-irix* )
machine=irix
dir=irix
S48_CFLAG_CKR
INSTALL='$(srcdir)/install-sh'
;;
## SunOS
sparc*-sun-sunos* )
machine=sunos
dir=sunos
;;
## Solaris - Sparc and i386
*-*-solaris* )
machine=solaris
dir=solaris
AC_DEFINE(HAVE_NLIST)
;;
## NT - cygwin32
*-*-cygwin* )
AC_DEFINE(CYGWIN, 1, [Define to 1 on cygwin])
machine=cygwin32
AC_DEFINE(CYGWIN)
dir=cygwin32
EXEEXT=".exe"
;;
## The GNU Hurd
*-*-gnu* )
machine=gnu
SCSH_ELF
;;
## Generic Configuration
* )
machine=generic
dir=generic
echo "WARNING: "
echo "WARNING: Using generic configuration."
echo "WARNING: See doc/porting.txt for more information."
echo "WARNING: "
;;
esac
(mkdir -p ./scsh/$machine scsh/rx c/unix c/srfi)
(cd $srcdir/scsh && rm -rf machine && ln -s $dir machine)
AC_CHECK_LIB(m, main)
AC_CHECK_LIB(dl, main)
@ -346,36 +342,32 @@ esac
AC_RETSIGTYPE
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])
have_dlopen="yes"],
[AC_CHECK_FUNC(nlist, [AC_LIBOBJ([c/fake/libdl1])],
[AC_LIBOBJ([c/fake/libdl2])])
have_dlopen="no"])
AC_CHECK_HEADERS(crypt.h)
AC_CHECK_FUNCS(gettimeofday ftime nlist select setitimer sigaction)
SCSH_SOCKLEN_T
AC_CHECK_FUNC(dlopen, AC_DEFINE(HAVE_DLOPEN),
AC_CHECK_FUNC(nlist, [LIBOBJS="$LIBOBJS c/fake/libdl1.o"],
[LIBOBJS="$LIBOBJS c/fake/libdl2.o"]))
AC_CHECK_FUNCS(socket chroot)
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(strerror, AC_DEFINE(HAVE_STRERROR),
[LIBOBJS="$LIBOBJS c/fake/strerror.o"])
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(seteuid, AC_DEFINE(HAVE_SETEUID),
AC_CHECK_FUNC(setreuid, AC_DEFINE(HAVE_SETREUID),
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_FUNC(setegid, AC_DEFINE(HAVE_SETEGID),
AC_CHECK_FUNC(setregid, AC_DEFINE(HAVE_SETREGID),
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([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_MSG_CHECKING([__NEXT__])
AC_TRY_LINK(,[
#ifdef __NeXT__
@ -389,68 +381,16 @@ fail
AC_MSG_RESULT([yes]),
AC_MSG_RESULT([no]))
S48_USCORE
if test $have_dlopen = yes; then
S48_RDYNAMIC
fi
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]))
dnl ----------------------------------------------------------------
dnl Check for pty support
dnl ----------------------------------------------------------------
dnl There is no "standard" pty allocation method. Every system is different.
dnl getpt() is the preferred pty allocation method on glibc systems.
dnl _getpty() is the preferred pty allocation method on SGI systems.
dnl grantpt(), unlockpt(), ptsname() are defined by Unix98.
AC_CHECK_FUNCS(getpt _getpty grantpt unlockpt ptsname killpg tcgetpgrp)
dnl openpty() is the preferred pty allocation method on BSD and Tru64 systems.
dnl openpty() might be declared in:
dnl - pty.h (Tru64 or Linux)
dnl - libutil.h (FreeBSD)
dnl - util.h (NetBSD)
AC_CHECK_FUNC(openpty, have_openpty=yes, [
AC_CHECK_LIB(util, openpty, have_openpty=yes need_libutil=yes)])
if test "$have_openpty" = "yes"; then
AC_DEFINE(HAVE_OPENPTY, 1, [Define to 1 if you have the 'openpty' function])
AC_CHECK_HEADERS(libutil.h util.h, break)
if test "$need_libutil" = "yes"; then
LIBS="${LIBS} -lutil"
fi
fi
dnl Check for system-specific pty header files
dnl Often the TIOCSIG* symbols are hiding there.
case "$opsys" in
dnl HPUX pty.h #defines TRUE and FALSE, so just use ptyio.h there.
hpux*) AC_CHECK_HEADERS(sys/ptyio.h) ;;
*) AC_CHECK_HEADERS(pty.h)
test "$ac_cv_header_pty_h" = "no" && AC_CHECK_HEADERS(sys/pty.h)
;;
esac
dnl Check for System V STREAM support functions.
AC_CHECK_HEADERS(stropts.h)
AC_CHECK_FUNCS(isastream)
SCSH_CONST_SYS_ERRLIST
SCSH_GMTOFF
SCSH_CONST_SYS_ERRLIST
CFLAGS1=${CFLAGS}
lib_dirs_list='("${prefix}/lib/scsh/modules" "${prefix}/lib/scsh/modules/0.6")'
AC_ARG_WITH(lib-dirs-list,
AC_HELP_STRING([--with-lib-dirs-list],
[list of default scsh library directories (default ("$prefix/lib/scsh/modules" "${prefix}/lib/scsh/modules/0.6"))]),
lib_dirs_list="$withval")
AC_SUBST(lib_dirs_list)
AC_SUBST(CFLAGS)
AC_SUBST(LIBOBJS)
AC_SUBST(LDFLAGS)
AC_SUBST(AIX_P)
AC_SUBST(AR)
@ -458,14 +398,13 @@ AC_CHECK_FUNCS(isastream)
AC_SUBST(CFLAGS)
AC_SUBST(CFLAGS1)
AC_SUBST(EXEEXT)
AC_SUBST(ENDIAN) #does currently not occur
AC_SUBST(ENDIAN)
AC_SUBST(LDFLAGS)
AC_SUBST(LDFLAGS_AIX)
AC_SUBST(LIBS)
AC_SUBST(TMPDIR)
AC_SUBST(machine)
AC_CONFIG_FILES(Makefile scsh-config)
AC_CONFIG_COMMANDS([scsh-config+x],[chmod +x scsh-config])
AC_OUTPUT
AC_OUTPUT(Makefile scsh/endian.scm scsh/static.scm)
chmod +x scsh/static.scm

5
doc/scsh-manual/.gitignore vendored
View File

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

24
doc/scsh-manual/Makefile
View File

@ -1,29 +1,25 @@
.SUFFIXES: .tex .dvi .ps .pdf $(.SUFFIXES)
.SUFFIXES: .idx .ind .tex .dvi .ps $(.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)
man.dvi: $(TEX) man.ind
man.ind: man.idx
.dvi.ps:
dvips -j0 -o $@ $<
dvips -o $@ $<
.tex.dvi:
latex $< && latex $<
makeindex $(<:.tex=.idx)
latex $<
rm $*.log
.tex.pdf:
pdflatex $< && thumbpdf $@ && pdflatex $<
makeindex $(<:.tex=.idx)
rm $*.log
.idx.ind:
makeindex $<
clean:
-rm -f *.log *.png man.out man.dvi man.ps man.pdf thumb*.png
rm -rf html
-rm *.log
rm -rf html
INSTALL_DATA= install -c -m 644
@ -31,7 +27,7 @@ tar:
tar cf - *.tex sty | gzip > man.tar.gz
html: $(TEX)
$(TEX2PAGE) man && $(TEX2PAGE) man
tex2page man && tex2page man
install: man.ps
@echo WARNING:

186
doc/scsh-manual/awk.tex
View File

@ -42,7 +42,7 @@ characters.
procedure is invoked as follows:
%
\codex{(\var{reader} \var{[port]}) $\longrightarrow$
\textrm{\textit{{\str} or eof}}}
\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
@ -58,16 +58,16 @@ characters.
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}
\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
@ -85,21 +85,21 @@ characters.
\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}}
\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}
\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
@ -109,7 +109,7 @@ These functions return a parser function that can be used as follows:
\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) \\
\multicolumn{1}{l}{} & \ex{(rx (+ white))} & (infix delimiter: white space) \\
\var{field} & \verb|(rx (+ (~ white)))| & (non-white-space) \\
@ -147,10 +147,10 @@ These functions return a parser function that can be used as follows:
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.
\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}
@ -165,10 +165,10 @@ These functions return a parser function that can be used as follows:
The field parser produced is a procedure that can be employed as
follows:
\codex{(\var{parse} \var{string} \var{[start]}) \evalto \var{string-list}}
\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})}$.
$\var{start} > \ex{(string-length \var{string})}$.
The parsers returned by the four parser generators implement different
kinds of field parsing:
@ -184,13 +184,13 @@ These functions return a parser function that can be used as follows:
\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}
\begin{inset}
\begin{tabular}{lcll}
\synvar{record} & ::= & \ex{""} \qquad (Empty record) \\
& $|$ & \synvar{element} \synvar{delim}
\synvar{record}
\end{tabular}
\end{inset}
\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
@ -202,16 +202,16 @@ These functions return a parser function that can be used as follows:
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} \\
\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} \synvar{delim}
\synvar{real-infix-record} \\
& $|$ & \synvar{element}
\end{tabular}
\end{inset}
\end{tabular}
\end{inset}
Note that separator semantics doesn't really allow for empty
records---the straightforward grammar (\ie, \synvar{real-infix-record})
@ -221,7 +221,7 @@ These functions return a parser function that can be used as follows:
and \ex{append} isomorphic. For example,
\codex{((infix-splitter ":") (string-append \var{x} ":" \var{y}))}
doesn't always equal
\begin{code}
\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.
@ -252,9 +252,9 @@ These functions return a parser function that can be used as follows:
\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{""} & \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}
@ -294,7 +294,7 @@ Record & : suffix & \verb!:|$! suffix & : infix & non-: field \\
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}).
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 ()]}}
@ -313,7 +313,7 @@ Record & : suffix & \verb!:|$! suffix & : infix & non-: field \\
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)}
\codex{((field-reader (infix-splitter ":" 7)) p)}
returns two values:
{\small
\begin{widecode}
@ -463,7 +463,7 @@ the entire line read, and a seven-element list of the split-out fields.
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)}
\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
@ -491,81 +491,81 @@ 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
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.
in the scope of the record and state variables.
The \var{test} form can be one of:
\begin{inset}
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.
\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
\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
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. \\
\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}
\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}}
\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;
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))}
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}
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
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.
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,
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.
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,
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.
of the entire awk form.
If there is no \ex{after} clause, \ex{awk} returns the loop's state
variables as multiple values.
If there is no \ex{after} clause, \ex{awk} returns the loop's state
variables as multiple values.
\end{itemize}
\subsection{Examples}
@ -573,7 +573,7 @@ Here are some examples of \ex{awk} being used to process various types
of input stream.
\begin{code}
(define $ list-ref) ; Saves typing.
(define $ nth) ; Saves typing.
;;; Print out the name and home-directory of everyone in /etc/passwd:
(let ((read-passwd (field-reader (infix-splitter ":" 7))))

17
doc/scsh-manual/css.t2p
View File

@ -4,13 +4,11 @@
% A basic style for HTML documents generated
% with tex2page.
\ifx\shipout\UNDEFINED
\cssblock
body {
color: black;
/* background-color: #e5e5e5;*/
background-color: #ffffff;
background-color: #e5e5e5;
/*background-color: beige;*/
margin-top: 2em;
margin-left: 8%;
@ -22,11 +20,11 @@ h1,h2,h3,h4,h5,h6 {
}
.partheading {
font-size: 100%;
font-size: 70%;
}
.chapterheading {
font-size: 100%;
font-size: 70%;
}
pre {
@ -78,10 +76,6 @@ ol ol ol ol {
color: teal;
}
.schemeresponse {
color: green;
}
.navigation {
color: red;
text-align: right;
@ -108,7 +102,4 @@ font-size: 75%;
width: 40%;
}
\endcssblock
\fi
% ex:ft=css
\endcssblock

13
doc/scsh-manual/decls.tex
View File

@ -15,8 +15,8 @@
\def\RnRS{R5RS}
\def\Posix{\textsc{Posix}}
\def\sharpf{\textnormal{\texttt{\#f}}}
\def\sharpt{\textnormal{\texttt{\#t}}}
\def\sharpf{\normalfont\texttt{\#f}}
\def\sharpt{\normalfont\texttt{\#t}}
\newcommand{\synteq}{\textnormal{::=}}
\def\maketildeother{\catcode`\~=12}
@ -129,11 +129,6 @@
\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{\+}{$^+$}
@ -142,7 +137,7 @@
\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{\synvar}[1]{\textrm{\textit{$<$#1$>$}}} %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$}}
@ -239,7 +234,7 @@
\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{\defun} [3] {\dfn{#1}{#2}{#3}{procedure}} % preskip
\newcommand{\defunx}[3]{\dfnx{#1}{#2}{#3}{procedure}} % no skip
\newenvironment{defundescx}[3]%

4
doc/scsh-manual/front.tex
View File

@ -1,9 +1,9 @@
%&latex -*- latex -*-
\title{Scsh Reference Manual}
\subtitle{For scsh release 0.6.7}
\subtitle{For scsh release 0.6.1}
\author{Olin Shivers, Brian D.~Carlstrom, Martin Gasbichler, and Mike Sperber}
\date{May 2006}
\date{February 2002}
\maketitle
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

42
doc/scsh-manual/intro.tex
View File

@ -22,7 +22,15 @@ 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.
For years, scsh's underlying Scheme implementation, Scheme 48, did not have an
open-source copyright. However, around 1999/2000, the Scheme 48 authors
graciously retrofitted a BSD-style open-source copyright onto the system.
Swept up by the fervor, we tacked an ideologically hip license onto scsh
source, ourselves (BSD-style, as well). Not that we ever cared before what you
did with the system.
As a result, the whole system is now open source, top-to-bottom.
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
@ -45,7 +53,11 @@ We currently release scsh to the following Internet sites:
\ex{\urlh{http://prdownloads.sourceforge.net/scsh/}{http://prdownloads.sourceforge.net/scsh/}} \\
\end{flushleft}
\end{inset}
%
These sites are
the MIT Project Mac ftp server,
the Scheme Shell home page, and
the Indiana Scheme Repository home page,
respectively.
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,
@ -60,7 +72,7 @@ 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.
Linux, NetBSD, 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,
@ -69,7 +81,7 @@ building scsh should require exactly the following steps:
\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{cd scsh-0.6} & \emph{Move to the source directory.} \\
\ex{./configure} & \emph{Examine host; build Makefile.} \\
\ex{make} & \emph{Build system.}
\end{tabular}
@ -109,6 +121,14 @@ 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.
In the current release, the system has some rough edges.
It is quite slow to start up---loading the initial image into the
{\scm} virtual machine induces a noticeable delay.
This can be fixed with the static heap linker provided with this release.
We welcome parties interested in porting the manual to a more portable
XML or SGML format; please contact us if you are interested in doing so.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Naming conventions}
Scsh follows a general naming scheme that consistently employs a set of
@ -403,9 +423,12 @@ 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.
prefers,\footnote{He wrote it.}
or the identically named but wholly different \ex{define-record-type}
macro that Richard Kelsey prefers.\footnote{He wrote it.}
The former can be found in file \ex{rts/jar-defrecord.scm} and package
\ex{define-record-types}; the latter can be found in file
\ex{big/defrecord.scm} and package \ex{defrecord}.
Alternatively, you may define your own, of course.
@ -428,8 +451,3 @@ 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:

57
doc/scsh-manual/man.t2p
View File

@ -9,7 +9,7 @@
% tex2page man
\input css.t2p
\htmlmathstyle{no-image}
\dontuseimgforhtmlmath
\let\pagebreak\relax
@ -63,41 +63,34 @@
\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)))
%
%}}
\evalh{
\def\spaceifnotempty#1{%
\def\TEMP{#1}%
\ifx\TEMP\empty\else\ \fi}
(define all-blanks?
(lambda (s)
(andmap
char-whitespace?
(string->list s))))
\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\spaceifnotempty{\evalh{
(let ((x (ungroup (get-token))))
(unless (all-blanks? x)
(emit #\space)))
}}
\def\dfnix#1#2#3#4{\leftline{{\tt(#1\spaceifnotempty{#2}{\it#2})} \quad $\longrightarrow$ \quad {\it #3} \qquad (#4)} \index}
\def\ex#1{{\tt #1}}
\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}$}
\def\var#1{{\it #1\/}}
\def\vari#1#2{\mbox{{\it #1\/}\undefcsactive\$$_{#2}$}}
\renewenvironment{boxedfigure}{\def\srecomment#1{\\#1\\}%
\begin{figure}\pagestyle}{\end{figure}}
@ -110,8 +103,8 @@
\def\evalto{==> }%
\defcsactive\%{\%}\obeywhitespace}
\newenvironment{code}{\begin{quote}\setupcode\GOBBLEOPTARG}
{\end{quote}}
\newenvironment{code}{\begin{quote}\bgroup\setupcode\GOBBLEOPTARG}
{\egroup\end{quote}}
\newenvironment{codebox}{\begin{tableplain}\bgroup\setupcode\GOBBLEOPTARG}
{\egroup\end{tableplain}}
@ -130,4 +123,4 @@
\renewenvironment{leftinset}{\begin{quote}}{\end{quote}}
\renewenvironment{tightinset}{\begin{quote}}{\end{quote}}
\renewenvironment{tightleftinset}{\begin{quote}}{\end{quote}}
}
}

12
doc/scsh-manual/man.tex
View File

@ -10,20 +10,12 @@
% 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.7},
\usepackage[dvipdfm,hyperindex,hypertex,
pdftitle={scsh manual, release 0.6.1},
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,
colorlinks=true,linkcolor=blue,pagecolor=blue,urlcolor=blue]{hyperref}
\fi
\endtexonly
% These fonts are good choices for screen-readable pdf, but the man needs

150
doc/scsh-manual/miscprocs.tex
View File

@ -17,6 +17,36 @@
A left shift is $j > 0$; a right shift is $j < 0$.
\end{desc}
\section{List procedures}
\dfn{nth}{list i}{object}{procedure \textbf{(obsolete)}}
\begin{desc}
Returns the $i^{\mathrm th}$ element of \var{list}.
The first element (the car) is \ex{(nth \var{list} 0)},
the second element is \ex{(nth \var{list} 1)}, and so on.
This procedure is provided as it is useful for accessing elements
from the lists returned by the field-readers (chapter~\ref{chapt:fr-awk}).
The functionality of \ex{nth} is equivalent to that of \RnRS{}'s
\ex{list-ref}. Therefore, \ex{nth} will go away in a future release.
\end{desc}
\section{Top level}
\defun{repl}{}\undefined
\begin{desc}
This runs a {\scm} read-eval-print loop,
reading forms from the current input port,
and writing their values to the current output port.
If you wish to try something dangerous,
and want to be able to recover your shell state, you can
fork off a subshell with the following form:
\codex{(run (begin (repl)))}
{\ldots}or, rephrased for the proceduralists:
\codex{(wait (fork repl))}
\end{desc}
\section{Password encryption}
\defun {crypt} {key salt} {encrypted value}
@ -45,7 +75,7 @@ Here is scsh's interface to dot-locking:
before it retries. If the lock cannot be obtained after
\var{retry-number} attempts, the procedure returns \sharpf,
otherwise \sharpt. The default value of \var{retry-number} is
\sharpf{} which corresponds to an infinite number of retires.
\sharpf which corresponds to an infinite number of retires.
If \var{stale-time} is non-\sharpf, it specifies the minimum age a
lock may have (in seconds) before it is considered \textit{stale}.
@ -58,7 +88,7 @@ Here is scsh's interface to dot-locking:
Note that it is possible that \ex{obtain-dot-lock} breaks a lock
but nevertheless fails to obtain it otherwise. If it is necessary
to handle this case specially, use \ex{break-dot-lock} directly
(see below) rather than specifying a non-\sharpf{} \var{stale-time}
(see below) rather than specifying a non-\sharpf \var{stale-time}
\end{desc}
\defun {break-dot-lock} {file-name} {undefined}
@ -85,10 +115,10 @@ Here is scsh's interface to dot-locking:
\dfnx{with-dot-lock} {file-name body \ldots} {value(s) of body}{syntax}
\begin{desc}
The procedure \ex{with-dot-lock*} obtains the requested lock, and
then calls \ex{(\var{thunk})}. When \var{thunk} returns, the lock is
released. A non-local exit (\eg, throwing to a saved continuation
or raising an exception) also causes the lock to be released.
This procedure obtains the requested lock, and then calls
\ex{(\var{thunk})}. When \var{thunk} returns, the lock is released.
A non-local exit (\eg, throwing to a saved continuation or raising
an exception) also causes the lock to be released.
After a normal return from \var{thunk}, its return values are
returned by \ex{with-dot-lock*}. The \ex{with-dot-lock} special
@ -343,114 +373,6 @@ not necessary to explicitly open a syslog channel to do logging.
specified form of calling \ex{syslog} logs to the specified channel.
\end{desc}
\section{MD5 interface}
\label{sec:md5}
Scsh provides a direct interface to the MD5 functions to compute the
``fingerprint'' or ``message digest'' of a file or string. It uses the
C library written by Colin Plum.
\defun{md5-digest-for-string}{string}{md5-digest}
\begin{desc}
Calculates the MD5 digest for the given string.
\end{desc}
\defun{md5-digest-for-port}{port [buffer-size]}{md5-digest}
\begin{desc}
Reads the contents of the port and calculates the MD5 digest for it.
The optional argument \var{buffer-size} determines the size of the
port's input buffer in bytes. It defaults to 1024 bytes.
\end{desc}
\defun{md5-digest?}{thing}{boolean}
\begin{desc}
The type predicate for MD5 digests: \ex{md5-digest?} returns true if
and only if \var{thing} is a MD5 digest.
\end{desc}
\defun{md5-digest->number}{md5-digest}{number}
\begin{desc}
Returns the number corresponding to the MD5 digest.
\end{desc}
\defun{number->md5-digest}{number}{md5-digest}
\begin{desc}
Creates a MD5 digest from a number.
\end{desc}
\defun{make-md5-context}{}{md5-context}
\defunx{md5-context?}{thing}{boolean}
\defunx{update-md5-context!}{md5-context string}\undefined
\defunx{md5-context->md5-digest}{md5-context}{md5-digest}
\begin{desc}
These procedures provide a low-level interface to the library. A
\var{md5-context} stores the state of a MD5 computation, it is
created by \ex{make-md5-context}, its type predicate is
\ex{md5-context?}. The procedure \ex{update-md5-context!} extends
the \var{md5-context} by the given string. Finally,
\ex{md5-context->md5-digest} returns the \var{md5-digest} for the
\var{md5-context}. With these procedures it is possible to
incrementally add strings to a \var{md5-context} before computing
the digest.
\end{desc}
\section{Configuration variables}
\label{sec:configure}
This section describes procedures to access the configuration
parameters used to compile scsh and flags needed to build C extensions
for scsh.
\defun{host}{}{string}
\defunx{machine}{}{string}
\defunx{vendor}{}{string}
\defunx{os}{}{string}
\begin{desc}
These procedures return the description of the host, scsh was built
on, as determined by the script \texttt{config.guess}.
\end{desc}
%
\defun{prefix}{}{string}
\defunx{exec-prefix}{}{string}
\defunx{bin-dir}{}{string}
\defunx{lib-dir}{}{string}
\defunx{include-dir}{}{string}
\defunx{man-dir}{}{string}
\begin{desc}
These procedures return the various directories of
the scsh installation.
\end{desc}
%
\defun{lib-dirs-list}{}{symbol list}
\begin{desc}
Returns the default list of library directories. See
Section~\ref{sec:scsh-switches} for more information about the
library search facility.
\end{desc}
%
\defun{libs}{}{string}
\defunx{defs}{}{string}
\defunx{cflags}{}{string}
\defunx{cppflags}{}{string}
\defunx{ldflags}{}{string}
\begin{desc}
The values returned by these procedures correspond to the values
\texttt{make} used to compile scsh's C files.
\end{desc}
%
\defunx{compiler-flags}{}{string}
\begin{desc}
The procedure \var{compiler-flags} returns flags suitable for
running the C compiler when compiling a C file that uses scsh's
foreign function interface.
\end{desc}
\defun{linker-flags}{}{string}
\begin{desc}
Scsh also comes as a library that can be linked into other programs.
The procedure \var{linker-flags} returns the appropriate flags to
link the scsh library to another program.
\end{desc}
%%% Local Variables:
%%% mode: latex
%%% TeX-master: "man"

46
doc/scsh-manual/network.tex
View File

@ -65,15 +65,6 @@ This procedure does not return, but loops indefinitely accepting
connections from client programs.
\end{desc}
\defun {bind-prepare-listen-accept-loop} {protocol-family prepare proc arg} {does-not-return}
\begin{desc}
Same as \ex{bind-listen-accept-loop} but runs the thunk
\var{prepare} after binding the address and before entering the
loop. The typical task of the \var{prepare} procedure is to change
the user id from the superuser to some unprivileged id once the
address has been bound.
\end{desc}
\section{Sockets}
\defun {create-socket} {protocol-family type [protocol]} {socket}
@ -133,20 +124,6 @@ is preferred to explicitly closing the inport and outport because using
\end{desc}
\defun {port->socket} {port protocol-family} {socket}
\begin{desc}
This procedure turns \var{port} into a socket object. The port's
underlying file descriptor must be a socket with protocol family
\var{protocol-family}. \ex{port->socket} applies \ex{dup->inport}
and \ex{dup->outport} to \var{port} to create the ports of the
socket object.
\ex{port->socket} comes in handy for writing
servers which run as children of \texttt{inetd}: after receiving a
connection \texttt{inetd} creates a socket and passes it as
standard input to its child.
\end{desc}
\section{Socket addresses}
The format of a socket-address depends on the address family of the
@ -235,20 +212,7 @@ connected at all if the remote address is specified with each
may be disassociated from a remote address by connecting to a null
remote address.
\end{desc}
\defun {connect-socket-no-wait} {socket socket-address} \boolean
\defunx {connect-socket-successful?} {socket} \boolean
\begin{desc}
Just like \ex{connect-socket}, \ex{connect-socket-no-wait} sets up a
connection from a \var{socket} to a remote \var{socket-address}.
Unlike \ex{connect-socket}, \ex{connect-socket-no-wait} does not
block if it cannot establish the connection immediately. Instead it
will return \sharpf{} at once. In this case a subsequent \ex{select} on
the output port of the socket will report the output port as ready
as soon as the operation system has established the connection or as
soon as setting up the connection led to an error. Afterwards, the
procedure \ex{connect-socket-successful?} can be used to test
whether the connection has been established successfully or not.
\end{desc}
\defun {bind-socket} {socket socket-address} \undefined
\begin{desc}
\ex{bind-socket} assigns a certain local \var{socket-address} to a
@ -305,14 +269,14 @@ shutdown/sends+receives\end{code}
\section{Performing input and output on sockets}
\defun {receive-message} {socket length [flags]} {[string-or-\sharpf{} socket-address]}
\defun {receive-message} {socket length [flags]} {[string-or-\sharpf socket-address]}
\dfnix {receive-message!} {socket string [start] [end] [flags]}
{[count-or-\sharpf{} socket-address]}{procedure}
{[count-or-\sharpf socket-address]}{procedure}
{receive-message"!@\texttt{receive-message"!}}
\defunx {receive-message/partial} {socket length [flags]}
{[string-or-\sharpf{} socket-address]}
{[string-or-\sharpf socket-address]}
\dfnix {receive-message!/partial} {socket string [start] [end] [flags]}
{[count-or-\sharpf{} socket-address]}{procedure}
{[count-or-\sharpf socket-address]}{procedure}
{receive-message"!/partial@\texttt{receive-message"!/partial}}
\defun {send-message} {socket string [start] [end] [flags] [socket-address]}
\undefined

14
doc/scsh-manual/pdfcond.tex
View File

@ -1,14 +0,0 @@
\newif\ifpdf
\ifx\pdfoutput\undefined
\pdffalse % we are not running PDFLaTeX
\else
\pdfoutput=1 % we are running PDFLaTeX
\pdftrue
\fi
% Then use your new variable \ifpdf
% \ifpdf
% \usepackage[pdftex]{graphicx}
% \pdfcompresslevel=9
% \else
% \usepackage{graphicx}
% \fi

22
doc/scsh-manual/procnotation.tex
View File

@ -8,7 +8,7 @@ standard {\Scheme} code.
The basic elements of this notation are \emph{process forms},
\emph{extended process forms}, and \emph{redirections}.
\section{Extended process forms and I/O redirections}
\section{Extended process forms and i/o redirections}
An \emph{extended process form} is a specification of a {\Unix} process to
run, in a particular I/O environment:
\codex{\var{epf} {\synteq} (\var{pf} $ \var{redir}_1$ {\ldots} $ \var{redir}_n $)}
@ -35,7 +35,7 @@ So \ex{(> ,x)} means
and \ex{(< /usr/shivers/.login)} means ``read from \ex{/usr/shivers/.login}.''
\pagebreak
Here are two more examples of I/O redirection:
Here are two more examples of i/o redirection:
%
\begin{center}
\begin{codebox}
@ -73,7 +73,7 @@ In this case, it is an error if the port is not a file port
(\eg, a string port).
More complex redirections can be accomplished using the \ex{begin}
process form, discussed below, which gives the programmer full control
of I/O redirection from {\Scheme}.
of i/o redirection from {\Scheme}.
\subsection{Port and file descriptor sync}
\begin{sloppypar}
@ -95,7 +95,7 @@ that program would of course not see the {\Scheme} string port as its standard
output.
\end{sloppypar}
To keep stdio synced with the values of {\Scheme}'s current I/O ports,
To keep stdio synced with the values of {\Scheme}'s current i/o ports,
use the special redirection \ex{stdports}.
This causes 0, 1, 2 to be redirected from the current {\Scheme} standard ports.
It is equivalent to the three redirections:
@ -105,9 +105,9 @@ It is equivalent to the three redirections:
(= 2 ,(error-output-port))\end{code}
%
The redirections are done in the indicated order. This will cause an error if
one of the current I/O ports isn't a {\Unix} port (\eg, if one is a string
one of the current i/o ports isn't a {\Unix} port (\eg, if one is a string
port).
This {\Scheme}/{\Unix} I/O synchronisation can also be had in {\Scheme} code
This {\Scheme}/{\Unix} i/o synchronisation can also be had in {\Scheme} code
(as opposed to a redirection spec) with the \ex{(stdports->stdio)}
procedure.
@ -192,7 +192,7 @@ There are three basic {\Scheme} forms that use extended process forms:
\begin{desc}
\index{exec-epf} \index{\&} \index{run}
The \ex{(exec-epf . \var{epf})} form nukes the current process: it establishes
the I/O redirections and then overlays the current process with the requested
the i/o redirections and then overlays the current process with the requested
computation.
The \ex{(\& . \var{epf})} form is similar, except that the process is forked
@ -205,7 +205,7 @@ and returns its exit status.
These special forms are macros that expand into the equivalent
series of system calls.
The definition of the \ex{exec-epf} macro is non-trivial,
as it produces the code to handle I/O redirections and set up pipelines.
as it produces the code to handle i/o redirections and set up pipelines.
However, the definitions of the \cd{&} and \ex{run} macros are very simple:
\begin{leftinset}
\begin{tabular}{@{}l@{\quad$\equiv$\quad}l@{}}
@ -426,7 +426,7 @@ might produce the list
What is the deadlock hazard that causes \ex{run/collecting} to use temp files?
Processes with multiple output streams can lock up if they use pipes
to communicate with {\Scheme} I/O readers. For example, suppose
to communicate with {\Scheme} i/o readers. For example, suppose
some {\Unix} program \ex{myprog} does the following:
\begin{enumerate}
\item First, outputs a single ``\ex{(}'' to stderr.
@ -510,7 +510,7 @@ These forms allow conditional execution of a sequence of processes.
These procedures are useful for forking off processes to filter
text streams.
\begin{defundesc}{make-char-port-filter}{filter}{\proc}
\begin{defundesc}{char-filter}{filter}{\proc}
The \var{filter} argument is a character$\rightarrow$character procedure.
Returns a procedure that when called, repeatedly reads a character
from the current input port, applies \var{filter} to the character,
@ -529,7 +529,7 @@ text streams.
(> spell-errors.txt))\end{code}
\end{defundesc}
\begin{defundesc}{make-string-port-filter}{filter [buflen]}{\proc}
\begin{defundesc}{string-filter}{filter [buflen]}{\proc}
The \var{filter} argument is a string$\rightarrow$string procedure.
Returns a procedure that when called, repeatedly reads a string
from the current input port, applies \var{filter} to the string,

8
doc/scsh-manual/rdelim.tex
View File

@ -72,8 +72,8 @@ See section~\ref{sec:char-sets} for information on character set manipulation.
The \var{handle-delim} parameter determines how the terminating character
is handled. It is described above, and defaults to \ex{'trim}.
The \var{char-set} argument may be a charset, a string, or a
character; it is coerced to a charset.
The \var{char-set} argument may be a charset, a string, a character, or a
character predicate; it is coerced to a charset.
\end{desc}
\dfni{read-delimited!} {char-set buf [port handle-delim start end]}
@ -143,8 +143,8 @@ the procedure call.
\begin{defundesc} {skip-char-set} {skip-chars [port]} {\integer}
Skip characters occurring in the set \var{skip-chars};
return the number of characters skipped.
The \var{skip-chars} argument may be a charset, a string, or a
character; it is coerced to a charset.
The \var{skip-chars} argument may be a charset, a string, a character, or a
character predicate; it is coerced to a charset.
\end{defundesc}
%%% Local Variables:

434
doc/scsh-manual/running.tex
View File

@ -146,141 +146,44 @@ all, we recommend taking the time to learn and use it.
The effort will pay off in the construction of modular, factorable programs.
\subsubsection{Module warning}
Most scsh programs will need to import from the \ex{scheme} structure
as well as from the \ex{scsh} structure. However, putting both of
these structures in the same \texttt{open} clause is a bad idea
because the structures \ex{scheme} and \ex{scsh} export some names of
I/O functions in common but with different definitions. The current
implementation of the module system does not recognize this as an
error but silently overwrites the exports of one structure with the
exports of the other. If the \ex{scheme} structure overwrites the
exports of the \ex{scsh} structures the program will access the
R$^5$RS definitions of the I/O functions which is not what you want.
Previous versions of this manual suggested to list \ex{scheme} and
\ex{scsh} in a specific order in the \texttt{open} clause of a
structure to ensure that the definitions from \ex{scsh} overwrite the
ones from \ex{scheme}. This approach is error-prone and fragile: A
simple change in the implementation of the module system will render
thousands of programs useless. Starting with release 0.6.3 scsh
provides a better means to deal with this problem: the structure
\ex{scheme-with-scsh} provides all the exports of the modules
\ex{scheme} and \ex{scsh} but exports the right denotations for the
I/O functions in question. To make a long story short:
Programmers who open both the \ex{scheme} and \ex{scsh} structures in their
own packages should make sure to always put the \ex{scsh} reference first.
\begin{center}
Scsh programs should open the structure \ex{scheme-with-scsh} if
they need access to the exports of \ex{scheme} and \ex{scsh}.
\begin{tabular}{l@{\qquad}l}
Do this: & Not this: \strut \\
\quad{\begin{codebox}[b]
(define-structure web-server
(open scsh
scheme
net-hax
\vdots)
(file web))\end{codebox}}
&
\quad{\begin{codebox}[b]
(define-structure web-server
(open scheme
scsh
net-hax
\vdots)
(file web))\end{codebox}}\\
%
Open \ex{scsh} before \ex{scheme}. &
Not \ex{scsh} after \ex{scheme}.
\end{tabular}
\end{center}
Ordering the two packages like this is necessary because scsh overrides
some of the standard R4RS Scheme definitions exported by the \ex{scheme}
package with its own definitions.
For example, scsh's versions of the R4RS I/O functions such as \ex{display}
and \ex{write} take integer file descriptors as arguments, as well as Scheme
ports.
If you open the \ex{scheme} structure before the \ex{scsh} structure,
you'll get the standard {\scm} definitions, which is not what you want.
For programs which should run in versions of scsh prior to release
0.6.3, programmers should make sure to always put the \ex{scsh}
reference first.
\subsection{Library directories search facility}
\label{sec:lib-dirs}
Scsh's command line switches allow loading of code not present in the
script file or the heap image at startup. To relief the user from
specifying full path names and to improve flexibility, scsh offers the
library directories path list. This list contains directories in which
scsh searches automatically for a file name argument of the
\texttt{-ll} or \texttt{-le} switch.
This section describes the programmatic interface to the library
directories search facility. In addition, various command line
switches for scsh modify the library directories path list. Section
\ref{sec:scsh-switches} describes these switches and the switches to
actually load files.
Another way to change the library directories path list is the
environment variable \texttt{\$SCSH\_LIB\_DIRS}. If this variable is
set, scsh uses it to set library directories path list. The value of
this environment variable is treated as a sequence of s-expressions,
which are ``read'' from the string:
\begin{itemize}
\item A string is treated as a directory,
\item \sharpf{} is replaced with the default list of directories.
\end{itemize}
A \texttt{\$SCSH\_LIB\_DIRS} assignment of this form
\begin{small}
\begin{verbatim}
SCSH_LIB_DIRS='"." "/usr/contrib/lib/scsh/" #f "/home/shivers/lib/scsh"'
\end{verbatim}
\end{small}
would produce this list of strings for the
\textit{library-directories} list:
%
\begin{verbatim}
("." "/usr/contrib/lib/scsh/"
"/usr/local/lib/scsh/modules/"
"/home/shivers/lib/scsh")
\end{verbatim}
%
It is a startup error if reading the \texttt{\$SCSH\_LIB\_DIRS}
environment variable causes a read error, or produces a value that
isn't a list of strings or \sharpf.
\defvar{default-lib-dirs}{string list}
\begin{desc}
The default list of \textit{library directories}. The original value
of this variable is \verb+("$prefix/lib/scsh/modules/")+. %$ but
starting with version 0.6.5 the option \verb+--with-lib-dirs-list+ of
the \texttt{configure} script changes for a new installation.
\end{desc}
\defun{find-library-file}{file lib-dirs script-file}{\undefined}
\begin{desc}
Searches the list of library directories \var{lib-dirs} for
\var{file} and returns the full path. The variable \var{script-file}
is used to resolve references to the directory of the current
script.
When searching for a directory containing a given library module,
nonexistent or read-protected directories are silently ignored; it
is not an error to have them in the \textit{library-directories}
list.
Directory search can be recursive. A directory name that ends with a
slash is recursively searched.
\end{desc}
\defun{lib-dirs}{}{string list}
\begin{desc}
Returns the current library directories path list.
\end{desc}
\defun{lib-dirs-prepend-script-dir!}{}{\undefined}
\defunx{lib-dirs-append-script-dir!}{}{\undefined}
\begin{desc}
Add the directory of the current script file to the beginning or end
of the \textit{library-directories} path list, respectively.
\end{desc}
\defun{lib-dirs-append!}{dir}{\undefined}
\defunx{lib-dirs-prepend!}{dir}{\undefined}
\begin{desc}
Add directory \var{lib-dir} to the beginning or end of the
\textit{library-directories} path list, respectively.
\end{desc}
\defun{clear-lib-dirs!}{}{\undefined}
\begin{desc}
Set the \textit{library-directories} path list to the empty list.
\end{desc}
\defun{reset-lib-dirs!}{}{\undefined}
\begin{desc}
Set the \textit{library-directories} path list to system default,
i.e. to the value of \var{default-lib-dirs}.
\end{desc}
\subsection{Switches}
\label{sec:scsh-switches}
The scsh top-level takes command-line switches in the following
format:
The scsh top-level takes command-line switches in the following format:
%
\codex{scsh [\var{meta-arg}] [\vari{switch}i {\ldots}]
[\var{end-option} \vari{arg}1 {\ldots} \vari{arg}n]}
@ -306,38 +209,12 @@ where
& \ex{-lm} \var{module-file-name}
& Load module into config package. \\
& \ex{-le} \var{exec-file-name}
& Load module into exec package. \\
& \ex{-l} \var{file-name}
& Load file into current package. \\
& \ex{-ll} \var{module-file-name}
& As in -lm, but search the library path list.\\
& \ex{-lel} \var{exec-file-name}
& As in -le, but search the library path list.\\
& \ex{+lp} \var{dir}
& Add dir to front of library path list.\\
& \ex{lp+} \var{dir}
& Add dir to end of library path list.\\
& \ex{+lpe} \var{dir}
& +lp, with env var and \~user expansion.\\
& \ex{lpe+} \var{dir}
& lp+, with env var and \~user expansion.\\
& \ex{+lpsd}
& Add script-file's dir to front of path list.\\
& \ex{lpsd+}
& Add script-file's dir to end of path list.\\
& \ex{-lp-clear}
& Clear library path list to ().\\
& \ex{-lp-default}
& Reset library path list to system default.\\
& \ex{-ds} & Do script. \\
& \ex{-dm} & Do script module. \\
& \ex{-de} & Do script exec. \\
& \ex{-ds} & Do script. \\
\\
\var{end-option:} & \ex{-s} \var{script} \\
& \ex{-sfd} \var{num} \\
@ -347,19 +224,19 @@ where
\end{flushleft}
\end{inset}
%
These command-line switches essentially provide a little linker
language for linking a shell script or a program together with {\scm}
modules or {\scm} exec programs \footnote{See the Section ``Command
programs'' in the {\scm} manual for a description of the exec language.}.
The command-line processor serially opens structures and loads code
into a given package. Switches that side-effect a package operate on
a particular ``current'' package; there are switches to change this
package. (These switches provide functionality equivalent to the
interactive \ex{,open} \ex{,load} \ex{,in} and \ex{,new} commands.)
Except where indicated, switches specify actions that are executed in
a left-to-right order. The initial current package is the user
package, which is completely empty and opens (imports the bindings of)
the \RnRS{} and scsh structures.
These command-line switches
essentially provide a little linker language for linking a shell script or a
program together with {\scm} modules.
The command-line processor serially opens structures and loads code into a
given package.
Switches that side-effect a package operate on a particular ``current''
package; there are switches to change this package.
(These switches provide functionality equivalent to the interactive
\ex{,open} \ex{,load} \ex{,in} and \ex{,new} commands.)
Except where indicated, switches specify actions that are executed in a
left-to-right order.
The initial current package is the user package, which is completely
empty and opens (imports the bindings of) the R4RS and scsh structures.
If the Scheme process is started up in an interactive mode, then the current
package in force at the end of switch scanning is the one inside which
@ -390,7 +267,7 @@ The following switches and end options are defined:
the new package is anonmyous, with no associated named structure.
The new package initially opens no other structures,
not even the \RnRS{} bindings. You must follow a ``\ex{-n foo}''
not even the R4RS bindings. You must follow a ``\ex{-n foo}''
switch with ``\ex{-o scheme}'' to access the standard identifiers such
as \ex{car} and \ex{define}.
@ -404,11 +281,6 @@ The following switches and end options are defined:
must contain source written in the Scheme 48 module language
(``load module''). Does not alter the current package.
\Item{-le \var{exec-file-name}}
Load the specified file into scsh's exec package --- the file
must contain source written in the Scheme 48 exec language
(``load exec''). Does not alter the current package.
\Item{-l \var{file-name}}
Load the specified file into the current package.
@ -444,12 +316,11 @@ The following switches and end options are defined:
\Item{-s \var{script}}
Specify a file to load.
A \ex{-ds} (do-script), \ex{-dm} (do-module), or \ex{-de}
(do-exec) switch occurring earlier in the switch list gives the
place where the script should be loaded. If there is no \ex{-ds},
\ex{-dm}, or \ex{-de} switch, then the script is loaded at the end of switch
scanning, into the module that is current at the end of switch
scanning.
A \ex{-ds} (do-script) or \ex{-dm} (do-module) switch occurring earlier in
the switch list gives the place where the script should be loaded. If
there is no \ex{-ds} or \ex{-dm} switch, then the script is loaded at the
end of switch scanning, into the module that is current at the end of
switch scanning.
We use the \ex{-ds} switch to violate left-to-right switch execution order
as the \ex{-s} switch is \emph{required} to be last
@ -500,65 +371,6 @@ The following switches and end options are defined:
This switch is provided to make it easy to write shell scripts in the
{\scm} module language.
\Item{-de}
As above, but the current module is ignored. The script is loaded into the
\ex{exec} package (``do-exec''), and hence must be written in the
{\scm} exec language.
This switch is provided to make it easy to write shell scripts in the
{\scm} exec language.
\Item{-ll \var{module-file-name}}
Load library module into config package.
This is just like the \ex{-lm} switch, except that it searches the
library-directory path list (see Section \ref{sec:lib-dirs})
for the file to load.
Specifically, it means: search through the
\textit{library-directories} list of directories looking for a
module file of the given name, and load it in. Scsh uses the
procedure \var{find-library-file} from Section \ref{sec:lib-dirs}
to perform the search.
\Item{-lel \var{exec-file-name}}
As above, but load the specified file into scsh's exec package.
This is just like the \ex{-le} switch, except that it searches the
library-directory path list for the file to load.
\Item{+lp \var{lib-dir},lp+ \var{lib-dir}}
Add directory \var{lib-dir} to the beginning or end of the
\textit{library-directories} path list, respectively.
\var{lib-dir} is a single directory. It is not split at colons or
otherwise processed. These switches correspond to the procedures
\ex{lib-dirs-prepend!} and \ex{lib-dirs-append!} from Section
\ref{sec:lib-dirs}.
\Item{+lpe, lpe+}
As above, except that \~ home-directory syntax and environment
variables are expanded out.
\Item{+lpsd,lpsd+}
Add script-file's directory to the beginning or end of the
\textit{library-directories} path list, respectively. These switches
correspond to the procedures
\ex{lib-dirs-prepend-script-dir!} and \ex{lib-dirs-append-script-dir!} from Section
\ref{sec:lib-dirs}.
\Item{-lp-clear, -lp-default}
Set the \textit{library-directories} path list to the empty list and
the system default, respectively. These switches correspond to
the procedures \ex{clear-lib-dirs!} and \ex{reset-lib-dirs!} from Section
\ref{sec:lib-dirs}.
The two switches are useful if you would like to protect your
script from influence by the \texttt{\$SCSH\_LIB\_DIRS} variable.
In these cases, the \texttt{\$SCSH\_LIB\_DIRS} environment variable is never
even parsed, so a bogus value will not affect the script's
execution at all.
\end{itemize}
\subsection{The meta argument}
@ -899,17 +711,6 @@ Notice that you are not allowed to pass arguments to the heap image's
top-level procedure (\eg, scsh) without delimiting them with \ex{-i}
or \ex{--} flags.
\subsection{Stripped image}
Besides the standard image \ex{scsh.image} scsh also ships with the
much smaller image \ex{stripped-scsh.image}. This image contains the
same code as the standard image but has almost all debugging
information removed. \ex{stripped-scsh.image} is intended to be used
with standalone programs where startup time and memory consumption
count but debugging the scheme code is not that important. To use the
image the VM has to be called directly and the path to the image must
be given after the \ex{-i} argument.
\subsection{Inserting interpreter triggers into heap images}
{\scm}'s heap image format allows for an informational header:
when the vm loads in a heap image, it ignores all data occurring before
@ -984,6 +785,131 @@ heap image.
One occasionally hears rumours that this is being addressed
by the {\scm} development team.
\section{Statically linking heap images}
The static heap linker converts a {\scm} bytecode image contained
in a .image file to a C representation. This C code is then compiled and
linked in with a virtual machine, producing a single executable.
Some of the benefits are:
\begin{itemize}
\item Instantaneous start-up time.
\item Improved paging; scsh images can be shared between different
processes.
\item Vastly reduced GC copying---the whole initial image
is moved out of the heap, and neither traced nor copied.
\item Result program no longer depends on the filesystem for its
initial image.
\end{itemize}
The static heap linker takes arguments in the following form:
\codex{scsh-hlink \var{image} \var{executable} [\var{option} \ldots]}
It reads in the heap image \var{image}, translates it into C code,
compiles the C code, and links it against the scsh vm, producing the
standalone binary file \var{executable}.
Each C file represents part of the heap image as a constant C \ex{long} vector
that looks something like this:
{\small\begin{verbatim}
const long p116[]={0x882,0x24,0x19,
0x882,(long)(&p19[785])+7,(long)(&p119[125])+7,
0x882,(long)(&p119[128])+7,(long)(&p119[131])+7,
0x882,(long)(&p102[348])+7,(long)(&p3[114])+7,
0xfc2,0x2030200,0x7100209,0x1091002,0x1c075a,
0x882,(long)(&p29[1562])+7,(long)(&p119[137])+7,
0x882,(long)(&p78[692])+7,(long)(&p119[140])+7,
.
.
.
};
\end{verbatim}}%
%
Translating to a C declaration gives us freedom from the various
object-file formats.\footnote{This idea is due to Jonathan Rees.}
Note that the const declaration allows the compiler to put this array in the
text pages of the executable.
The heap is split into parts because many C compilers cannot handle
multi-megabyte initialised vector declarations.
The allowed options to the heap linker are:
\begin{itemize}
\def\Item#1{\item{\ex{#1}}\\}
\Item{--temp \var{dir}} The temporary directory to hold .c and .o files.
The default is typically configured to be
\ex{/usr/tmp}, and can be overridden by the
environment variable \ex{TMPDIR}.
Example:
\codex{--temp /tmp}
\Item{--cc \var{command}} The command to run the C compiler.
The default can be overridden by the environment
variable \ex{CC}.
Example:
\codex{--cc "gcc -g -O"}
\Item{--ld \var{command}} The arguments to run the C compiler as a linker.
The default can be overridden by the
environment variable \ex{LDFLAGS}.
Example:
\codex{--ld "-Wl,-E"}
\Item{--libs \var{libs}} The libraries needed to link the VM and heap.
The default can be overridden by the
environment variable \ex{LIBS}.
Example:
\codex{--libs "-ldld -lld -lm"}
\end{itemize}
Be warned that the current heap linker has many shortcomings.
\begin{itemize}
\item It is extremely slow. Really, really slow. Translating the standard
scsh heap image into a standalone binary takes well over an hour on a
40Mb/133Mhz Pentium system.
A memory-starved 486 could take all night.
\item It cannot be applied to itself. The current implementation
works by replacing some of the heap-dumping code. This means
you cannot load the heap-linker code into a scsh system and
subsequently use \ex{dump-scsh-program} to create a heap-linker
heap image.
\item The interface leaves a lot to be desired.
\begin{itemize}
\item It requires the heap image to be referenced by a file-name;
the linker will not allow you to feed it the input heap image
on a port.
\item The heap-image is linked against the vm contained in
\begin{tightcode}
/usr/local/lib/scsh/libscshvm.a\end{tightcode}
This is wired in at the time scsh is installed on your system.
\item There is no Scheme procedural interface.
\end{itemize}
\item The program produced uses the default VM argv parser \verb|process_args|
from the scsh source file \ex{main.c} to process the command line
before handing it off to the heap image's top-level procedure.
This is not what you want for many programs.
The system needs to be changed to allow users to override this default
with their own VM argument parsers.
\item A possible problem is the Unix limits on the number of command
line arguments. The heap-linker calls the C linker with a large number of
object files. Its conceivable that on some Unix systems this could fail
now or if scsh grows in the future. The solution could be to create
library archives of a few dozen files and then link the result few dozen
library archives to make the executable.
\end{itemize}
In spite of these many shortcomings, we are providing the static linker
as it stands in this release so that people may get some experience with
it.
Here is an example of how one might use the heap linker:
\begin{code}
scsh-hlink scsh.image fastscsh\end{code}
We'd love it if someone would dive into the source and improve it.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\section{Standard file locations}
Because the scshvm binary is intended to be used for writing shell
@ -1006,7 +932,3 @@ so \ex{scsh.image} should have a \ex{\#!} trigger of the following form:
-o /usr/local/lib/scsh/scshvm -i
{\ldots} \textnormal{\emph{heap image goes here}} \ldots\end{code}
%%% Local Variables:
%%% mode: latex
%%% TeX-master: "man"
%%% End:

19
doc/scsh-manual/sre.tex
View File

@ -108,8 +108,8 @@ the next section is a friendlier tutorial introduction.
integers. \\
\var{M} may also be \ex{\#f}, meaning ``infinity.''} \\
\\
\ex{(| \var{sre} {\ldots})} & Choice (\ex{or} is \RnRS{} symbol; \\
\ex{(or \var{sre} {\ldots})} & \ex{|} is not specified by \RnRS{}.) \\
\ex{(| \var{sre} {\ldots})} & Choice (\ex{or} is R5RS symbol; \\
\ex{(or \var{sre} {\ldots})} & \ex{|} is not specified by R5RS.) \\
\\
\ex{(: \var{sre} {\ldots})} & Sequence (\ex{seq} is legal \\
\ex{(seq \var{sre} {\ldots})} & Common Lisp symbol) \\
@ -290,8 +290,7 @@ set brackets are \ex{("} and \ex{")}.
\paragraph{Wild card}
Another simple SRE is the symbol \ex{any},
which matches any single character---including newline, but excluding
ASCII NUL.
which matches any single character---including newline and \textsc{Ascii} nul.
\paragraph{Sequences}
@ -309,12 +308,12 @@ The regexp \ex{(seq \var{sre} \ldots)} is
completely equivalent to \ex{(: \var{sre} \ldots)};
it's included in order to have a syntax that doesn't require
\ex{:} to be a legal symbol \footnote{That is, for use within s-expression
syntax frameworks that, unlike \RnRS, don't allow for \ex{:} as a legal symbol.
syntax frameworks that, unlike R5RS, don't allow for \ex{:} as a legal symbol.
A Common Lisp embedding of SREs, for example, would need to use
\ex{seq} instead of \ex{:}.}
\paragraph{Choices}
\section{Choices}
The SRE \ex{(| \var{sre} \ldots)} is a regexp that matches anything any of the
\var{sre} regexps match. So the regular expression
@ -1213,7 +1212,7 @@ readable format.
\end{desc}
\defun {posix-string->regexp}{string}{re}
\defunx{regexp->posix-string}{re}{[string syntax-level paren-count submatches-vector]}
\defunx{regexp->posix-string}{re}{string}
\begin{desc}
These two functions are the Posix notation parser and unparser.
That is, \ex{posix-string->regexp} maps a Posix-notation regular
@ -1250,14 +1249,14 @@ The \ex{\ldots:tsm} accessor returns the total number of submatches
contained in the regular expression.
\dfn {re-seq?}{x}{boolean}{Type predicate}
\dfnx{make-re-seq}{re-list}{re}{Basic constructor}
\dfnx{re-seq}{re-list}{re}{Smart constructor}
\dfnx{make-re-seq}{re \ldots}{re}{Basic constructor}
\dfnx{re-seq}{re \ldots}{re}{Smart constructor}
\dfnx{re-seq:elts}{re}{re-list}{Accessor}
\dfnx{re-seq:tsm}{re}{integer}{Accessor}
\dfn {re-choice?}{x}{boolean}{Type predicate}
\dfnx{make-re-choice}{re-list}{re}{Basic constructor}
\dfnx{re-choice}{re-list}{re}{Smart constructor}
\dfnx{re-choice}{re \ldots}{re}{Smart constructor}
\dfnx{re-choice:elts}{re}{re-list}{Accessor}
\dfnx{re-choice:tsm}{re}{integer}{Accessor}

43
doc/scsh-manual/strings.tex
View File

@ -153,11 +153,11 @@ which is both a directory (current working directory), and a file name
\begin{tabular}{lll}
File name & \ex{\ldots-directory?} & \ex{\ldots-non-directory?} \\
\hline
\ex{"src/des"} & \ex{\sharpf} & \ex{\sharpt} \\
\ex{"src/des"} & \ex{\sharpf} & \ex{\sharpt} \\
\ex{"src/des/"} & \ex{\sharpt} & \ex{\sharpf} \\
\ex{"/"} & \ex{\sharpt} & \ex{\sharpf} \\
\ex{"."} & \ex{\sharpf} & \ex{\sharpt} \\
\ex{""} & \ex{\sharpt} & \ex{\sharpt}
\ex{"/"} & \ex{\sharpt} & \ex{\sharpf} \\
\ex{"."} & \ex{\sharpf} & \ex{\sharpt} \\
\ex{""} & \ex{\sharpt} & \ex{\sharpt}
\end{tabular}
\end{center}
\end{desc}
@ -444,11 +444,11 @@ is also frequently useful for expanding file-names.
\begin{desc}
Each of these predicates tests for membership in one of the standard
character sets provided by the SRFI-14 character-set library.
Additionally, the following redundant bindings are provided for {\RnRS}
Additionally, the following redundant bindings are provided for {R5RS}
compatibility:
\begin{inset}
\begin{tabular}{ll}
{\RnRS} name & scsh definition \\ \hline
{R5RS} name & scsh definition \\ \hline
\ex{char-alphabetic?} & \ex{char-letter+digit?} \\
\ex{char-numeric?} & \ex{char-digit?} \\
\ex{char-alphanumeric?} & \ex{char-letter+digit?}
@ -474,28 +474,23 @@ the equivalent SRFI-13 binding. This obsolete library is deprecated and
new code should use the SRFI-13 bindings.
\begin{inset}
\begin{tabular}{ll}
Old \ex{obsolete-char-set-lib} & SRFI-13 \ex{char-set-lib} \\ \hline
Old \ex{obsolete-char-set-lib} & SRFI-13 \ex{char-set-lib} \\ \hline
\ex{char-set-members} & \ex{char-set->list} \\
\ex{chars->char-set} & \ex{list->char-set} \\
\ex{ascii-range->char-set} & \ex{ucs-range->char-set} (not exact) \\
\ex{predicate->char-set} & \ex{char-set-filter} (not exact) \\
\ex{char-set-every}? & \ex{char-set-every} \\
\ex{char-set-any}? & \ex{char-set-any} \\
\ex{char-set-members} & \ex{char-set->list} \\
\ex{chars->char-set} & \ex{list->char-set} \\
\ex{ascii-range->char-set} & \ex{ucs-range->char-set} (not exact) \\
\ex{predicate->char-set} & \ex{char-set-filter} (not exact) \\
\ex{char-set-every}? & \ex{char-set-every} \\
\ex{char-set-any}? & \ex{char-set-any} \\
\\
\ex{char-set-invert} & \ex{char-set-complement} \\
\ex{char-set-invert}! & \ex{char-set-complement!} \\
\ex{char-set-invert} & \ex{char-set-complement} \\
\ex{char-set-invert}! & \ex{char-set-complement!} \\
\\
\ex{char-set:alphabetic} & \ex{char-set:letter} \\
\ex{char-set:numeric} & \ex{char-set:digit} \\
\ex{char-set:alphanumeric} & \ex{char-set:letter+digit} \\
\ex{char-set:control} & \ex{char-set:iso-control}
\ex{char-set:alphabetic} & \ex{char-set:letter} \\
\ex{char-set:numeric} & \ex{char-set:digit} \\
\ex{char-set:alphanumeric} & \ex{char-set:letter+digit} \\
\ex{char-set:control} & \ex{char-set:iso-control}
\end{tabular}
\end{inset}
Note also that the \ex{->char-set} procedure no longer handles a predicate
argument.
%%% Local Variables:
%%% mode: latex
%%% TeX-master: "man"
%%% End:

534
doc/scsh-manual/syscalls.tex
View File

@ -132,9 +132,9 @@ This can be overridden if the programmer wishes.
\section{I/O}
\subsection{Standard {\RnRS} I/O procedures}
In scsh, most standard {\RnRS} I/O operations (such as \ex{display} or
In scsh, most standard {\RnRS} i/o operations (such as \ex{display} or
\ex{read-char}) work on both integer file descriptors and {\Scheme} ports.
When doing I/O with a file descriptor, the I/O operation is done
When doing i/o with a file descriptor, the i/o operation is done
directly on the file, bypassing any buffered data that may have
accumulated in an associated port.
Note that character-at-a-time operations such as \ex{read-char}
@ -297,10 +297,10 @@ You may safely skim or completely skip this section on a first reading.
Dealing with {\Unix} file descriptors in a {\Scheme} environment is difficult.
In {\Unix}, open files are part of the process environment, and are referenced
by small integers called \emph{file descriptors}. Open file descriptors are
the fundamental way I/O redirections are passed to subprocesses, since
the fundamental way i/o redirections are passed to subprocesses, since
file descriptors are preserved across fork's and exec's.
{\Scheme}, on the other hand, uses ports for specifying I/O sources. Ports are
{\Scheme}, on the other hand, uses ports for specifying i/o sources. Ports are
garbage-collected {\Scheme} objects, not integers. Ports can be garbage
collected; when a port is collected, it is also closed. Because file
descriptors are just integers, it's impossible to garbage collect them---you
@ -548,13 +548,12 @@ and some port is already using that file descriptor,
the port is first quietly shifted (with another \ex{dup})
to some other file descriptor (zeroing its revealed count).
Since {\Scheme} doesn't provide read/write ports, \ex{dup->inport} and
\ex{dup->outport} can be useful for getting an output version of an
input port, or \emph{vice versa}. For example, if \ex{p} is an input
port open on a tty, and we would like to do output to that tty, we can
simply use \ex{(dup->outport p)} to produce an equivalent output port
for the tty. Be sure to open the file with the \ex{open/read+write}
flag for this.
Since {\Scheme} doesn't provide read/write ports,
\ex{dup->inport} and \ex{dup->outport} can be useful for
getting an output version of an input port, or \emph{vice versa}.
For example, if \ex{p} is an input port open on a tty, and
we would like to do output to that tty, we can simply use
\ex{(dup->outport p)} to produce an equivalent output port for the tty.
\end{desc}
\defun {seek} {fd/port offset [whence]} {\integer}
@ -572,7 +571,6 @@ this is dependent on the OS implementation.
The return value is the resulting position of the I/O cursor in the I/O stream.
\oops{The current implementation doesn't handle \var{offset} arguments
that are not immediate integers (\ie, representable in 30 bits).}
\oops{The current implementation doesn't handle buffered ports.}
\end{desc}
@ -594,7 +592,7 @@ this is dependent on the OS implementation.
The returned port is an input port if the \var{flags} permit it,
otherwise an output port. \RnRS/\scm/scsh do not have input/output ports,
so it's one or the other. This should be fixed. (You can hack simultaneous
I/O on a file by opening it r/w, taking the result input port,
i/o on a file by opening it r/w, taking the result input port,
and duping it to an output port with \ex{dup->outport}.)
\end{defundesc}
@ -747,7 +745,7 @@ Returns two ports, the read and write end-points of a {\Unix} pipe.
(barring eof).
There is one case in which the forward-progress guarantee is cancelled:
when the programmer explicitly sets the port to non-blocking I/O.
when the programmer explicitly sets the port to non-blocking i/o.
In this case, if no data is immediately available,
the procedure will not block, but will immediately return a zero-byte read.
@ -765,7 +763,7 @@ Returns two ports, the read and write end-points of a {\Unix} pipe.
A request to read zero bytes returns immediatedly, with no eof check.
In sum, there are only three ways you can get a zero-byte read:
(1) you request one, (2) you turn on non-blocking I/O, or (3) you
(1) you request one, (2) you turn on non-blocking i/o, or (3) you
try to read at eof.
These are the routines to use for non-blocking input.
@ -777,109 +775,48 @@ Returns two ports, the read and write end-points of a {\Unix} pipe.
\defun {select }{rvec wvec evec [timeout]}{[rvec' wvec' evec']}
\defunx{select!}{rvec wvec evec [timeout]}{[nr nw ne]}
\begin{desc}
The \ex{select} procedure allows a process to block and wait for
events on multiple I/O channels. The \var{rvec} and \var{evec}
arguments are vectors of input ports and integer file descriptors;
\var{wvec} is a vector of output ports and integer file
descriptors. The procedure returns three vectors whose elements
are subsets of the corresponding arguments. Every element of
\var{rvec'} is ready for input; every element of \var{wvec'} is
ready for output; every element of \var{evec'} has an exceptional
condition pending.
The \ex{select} call will block until at least one of the I/O
channels passed to it is ready for operation. For an input port
this means that it either has data sitting its buffer or that the
underlying file descriptor has data waiting. For an output port
this means that it either has space available in the associated
buffer or that the underlying file descriptor can accept output.
For file descriptors, no buffers are checked, even if they have
associated ports.
\emph{These two procedures have been de-released for version 0.6.
They will come back in a later verison of Scsh.}
% The \ex{select} procedure allows a process to block and wait for
% events on multiple I/O channels. The \var{rvec} and \var{evec}
% arguments are vectors of input ports and integer file descriptors;
% \var{wvec} is a vector of output ports and integer file
% descriptors. The procedure returns three vectors whose elements
% are subsets of the corresponding arguments. Every element of
% \var{rvec'} is ready for input; every element of \var{wvec'} is
% ready for output; every element of \var{evec'} has an exceptional
% condition pending.
The \var{timeout} value can be used to force the call to time-out
after a given number of seconds. It defaults to the special value
\ex{\#f}, meaning wait indefinitely. A zero value can be used to
poll the I/O channels.
If an I/O channel appears more than once in a given
vector---perhaps occuring once as a Scheme port, and once as the
port's underlying integer file descriptor---only one of these two
references may appear in the returned vector. Buffered I/O ports
are handled specially---if an input port's buffer is not empty, or
an output port's buffer is not yet full, then these ports are
immediately considered eligible for I/O without using the actual,
primitive \ex{select} system call to check the underlying file
descriptor. This works pretty well for buffered input ports, but
is a little problematic for buffered output ports.
The \ex{select!} procedure is similar, but indicates the subset of
active I/O channels by side-effecting the argument vectors.
Non-active I/O channels in the argument vectors are overwritten
with {\sharpf} values. The call returns the number of active
elements remaining in each vector. As a convenience, the vectors
passed in to \ex{select!} are allowed to contain {\sharpf} values
as well as integers and ports.
\remark{\texttt{Select} and \texttt{select!} do not
call their POSIX counterparts directly---there is a POSIX
\texttt{select} sitting at the very heart of the Scheme 48/scsh
I/O system, so \emph{all} multiplexed I/O is really
\texttt{select}-based. Therefore, you cannot expect a
performance increase from writing a single-threaded program
using \texttt{select} and \texttt{select!} instead of writing a
multi-threaded program where each thread handles one I/O
connection.
The moral of this story is that \texttt{select} and
\texttt{select!} make sense in only two situations: legacy code
written for an older version of scsh, and programs which make
inherent use of \texttt{select}/\texttt{select!} which do not
benefit from multiple threads. Examples are network clients
that send requests to multiple alternate servers and discard all
but one of them.
In any case, the \texttt{select-ports} and
\texttt{select-port-channels} procedures described below
are usually a preferable alternative to
\texttt{select}/\texttt{select!}: they are much simpler to use, and
also have a slightly more efficient implementation.}
\end{desc}
\defun {select-ports}{timeout port \ldots}{ready-ports}
\begin{desc}
The \ex{select-ports} call will block until at least one of the
ports passed to it is ready for operation or until the timeout has
expired. For an input port this means that it either has data
sitting its buffer or that the underlying file descriptor has data
waiting. For an output port this means that it either has space
available in the associated buffer or that the underlying file
descriptor can accept output.
% The \ex{select} call will block until at least one of the I/O
% channels passed to it is ready for operation. The \var{timeout}
% value can be used to force the call to time-out after a given
% number of seconds. It defaults to the special value \ex{\#f},
% meaning wait indefinitely. A zero value can be used to poll the
% I/O channels.
The \var{timeout} value can be used to force the call to time out
after a given number of seconds. A value of \ex{\#f} means to wait
indefinitely. A zero value can be used to poll the ports.
\texttt{Select-ports} returns a list of the ports ready for
operation. Note that this list may be empty if the timeout expired
before any ports became ready.
\end{desc}
\defun {select-port-channels}{timeout port \ldots}{ready-ports}
\begin{desc}
\texttt{Select-port-channels} is like \texttt{select-ports}, except
that it only looks at the operating system objects the ports refer
to, ignoring any buffering performed by the ports.
\remark{\texttt{Select-port-channels} should be used with care: for
example, if an input port has data in the buffer but no data
available on the underlying file descriptor,
\texttt{select-port-channels} will block, even though a read
operation on the port would be able to complete without blocking.
% If an I/O channel appears more than once in a given
% vector---perhaps occuring once as a Scheme port, and once as the
% port's underlying integer file descriptor---only one of these two
% references may appear in the returned vector. Buffered I/O ports
% are handled specially---if an input port's buffer is not empty, or
% an output port's buffer is not yet full, then these ports are
% immediately considered eligible for I/O without using the actual,
% primitive \ex{select} system call to check the underlying file
% descriptor. This works pretty well for buffered input ports, but
% is a little problematic for buffered output ports.
\texttt{Select-port-channels} is intended for situations where the
program is not checking for available data, but rather for waiting
until a port has established a connection---for example, to a
network port.}
% The \ex{select!} procedure is similar, but indicates the subset of
% active I/O channels by side-effecting the argument vectors.
% Non-active I/O channels in the argument vectors are overwritten
% with {\sharpf} values. The call returns the number of active
% elements remaining in each vector. As a convenience, the vectors
% passed in to \ex{select!} are allowed to contain {\sharpf} values
% as well as integers and ports.
% \remark{I have found the \ex{select!} interface to be the more
% useful of the two. After the system call, it allows you to check
% a specific I/O channel in constant time.}
\end{desc}
\begin{defundescx}{write-string}{string [fd/port start end]}\undefined
@ -888,7 +825,7 @@ Returns two ports, the read and write end-points of a {\Unix} pipe.
(due to interrupts or partial writes),
it will perform multiple write operations until all the data is written
or an error has occurred.
A non-blocking I/O error is considered an error.
A non-blocking i/o error is considered an error.
(Error exception packets for this syscall include the amount of
data partially transferred before the error occurred.)
@ -913,9 +850,9 @@ Returns two ports, the read and write end-points of a {\Unix} pipe.
asked for.
Partial writes can occur when (1) we write off the physical end of
the media, (2) the write is interrrupted, or (3) the file descriptor
is set for non-blocking I/O.
is set for non-blocking i/o.
If the file descriptor is not set up for non-blocking I/O, then
If the file descriptor is not set up for non-blocking i/o, then
a successful return from these procedures makes a forward progress
guarantee---that is, a partial write took place of at least one byte:
\begin{itemize}
@ -928,18 +865,15 @@ Returns two ports, the read and write end-points of a {\Unix} pipe.
\end{itemize}
If we request a zero-byte write, then the call immediately returns 0.
If the file descriptor is set for non-blocking I/O, then the call
If the file descriptor is set for non-blocking i/o, then the call
may return 0 if it was unable to immediately write anything
(\eg, full pipe).
Barring these two cases, a write either returns $\var{nwritten} > 0$,
or raises an error exception.
Non-blocking I/O is only available on file descriptors and unbuffered
ports. Doing non-blocking I/O to a buffered port is not well-defined,
Non-blocking i/o is only available on file descriptors and unbuffered
ports. Doing non-blocking i/o to a buffered port is not well-defined,
and is an error (the problem is the subsequent flush operation).
\oops{\ex{write-string/partial} is currently not implemented.
Consider using threads to achive the same functionality.}
\end{defundescx}
\subsection{Buffered I/O}
@ -961,12 +895,6 @@ this reason, all shells, including sh, csh, and scsh, read stdin unbuffered.
Applications that can tolerate buffered input on stdin can reset
\ex{(current-input-port)} to block buffering for higher performance.
\note{So support \texttt{peek-char} a Scheme implementation has to
maintain a buffer for all input ports. In scsh, for ``unbuffered''
input ports the buffer size is one. As you cannot request less then
one character there is no unrequested reading so this can still be
called ``unbuffered input''.}
\begin{defundesc}{set-port-buffering}{port policy [size]}\undefined
This procedure allows the programmer to assign a particular I/O buffering
policy to a port, and to choose the size of the associated buffer.
@ -974,9 +902,9 @@ It may only be used on new ports, \ie, before I/O is performed on the port.
There are three buffering policies that may be chosen:
\begin{inset}
\begin{tabular}{l@{\qquad}l}
\exi{bufpol/block} & General block buffering (general default) \\
\exi{bufpol/line} & Line buffering (tty default) \\
\exi{bufpol/none} & Direct I/O---no buffering\footnote{But see the note above}
\ex{bufpol/block} & General block buffering (general default) \\
\ex{bufpol/line} & Line buffering (tty default) \\
\ex{bufpol/none} & Direct I/O---no buffering
\end{tabular}
\end{inset}
The line buffering policy flushes output whenever a newline is output;
@ -985,13 +913,10 @@ Line buffering is the default for ports open on terminal devices.
\oops{The current implementation doesn't support \ex{bufpol/line}.}
The \var{size} argument requests an I/O buffer of \var{size} bytes.
For output ports, \var{size} must be non-negative, for input ports
\var{size} must be positve. If not given, a reasonable default is
used. For output ports, if given and zero, buffering is turned off
(\ie, $\var{size} = 0$ for any policy is equivalent to $\var{policy} =
\ex{bufpol/none}$). For input ports, setting the size to one
corresponds to unbuffered input as defined above. If given, \var{size}
must be zero respectively one for \ex{bufpol/none}.
If not given, a reasonable default is used; if given and zero,
buffering is turned off
(\ie, $\var{size} = 0$ for any policy is equivalent to
$\var{policy} = \ex{bufpol/none}$).
\end{defundesc}
\begin{defundesc}{force-output} {[fd/port]}{\undefined}
@ -1050,10 +975,10 @@ Locked regions are described by the \emph{lock-region} record:
len
whence
proc)\end{code}%
\indextt{lock-region?}%
\indextt{lock-region:exclusive?} \indextt{lock-region:whence}%
\indextt{lock-region:start} \indextt{lock-region:end}%
\indextt{lock-region:len} \indextt{lock-region:proc}%
\index{lock-region?}%
\index{lock-region:exclusive?} \index{lock-region:whence}%
\index{lock-region:start} \index{lock-region:end}%
\index{lock-region:len} \index{lock-region:proc}%
%
\begin{itemize}
\item
@ -1273,10 +1198,10 @@ while \ex{delete-filesys-object} simply returns.
atime ; Time of last access.
mtime ; Time of last mod.
ctime) ; Time of last status change.\end{code}
\indextt{file-info:type}\indextt{file-info:device}\indextt{file-info:inode}%
\indextt{file-info:mode}\indextt{file-info:nlinks}\indextt{file-info:uid}%
\indextt{file-info:gid}\indextt{file-info:size}\indextt{file-info:atime}%
\indextt{file-info:mtime}\indextt{file-info:ctime}%
\index{file-info:type}\index{file-info:device}\index{file-info:inode}%
\index{file-info:mode}\index{file-info:nlinks}\index{file-info:uid}%
\index{file-info:gid}\index{file-info:size}\index{file-info:atime}%
\index{file-info:mtime}\index{file-info:ctime}%
%
The uid field of a file-info record is accessed with the procedure
\codex{(file-info:uid x)}
@ -1288,18 +1213,19 @@ The following procedures all return selected information about
a file; they are built on top of \ex{file-info}, and are
called with the same arguments that are passed to it.
\begin{inset}
\newcommand{\Ex}[1]{\ex{#1}\index{#1@{\tt{#1}}}}
\begin{tabular}{ll}
Procedure & returns \\\hline
\exi{file-type} & type \\
\exi{file-inode} & inode \\
\exi{file-mode} & mode \\
\exi{file-nlinks} & nlinks \\
\exi{file-owner} & uid \\
\exi{file-group} & gid \\
\exi{file-size} & size \\
\exi{file-last-access} & atime \\
\exi{file-last-mod} & mtime \\
\exi{file-last-status-change} & ctime
\Ex{file-type} & type \\
\Ex{file-inode} & inode \\
\Ex{file-mode} & mode \\
\Ex{file-nlinks} & nlinks \\
\Ex{file-owner} & uid \\
\Ex{file-group} & gid \\
\Ex{file-size} & size \\
\Ex{file-last-access} & atime \\
\Ex{file-last-mod} & mtime \\
\Ex{file-last-status-change} & ctime
\end{tabular}
\end{inset}
%
@ -1333,6 +1259,7 @@ They are applied to the same arguments to which \ex{file-info} is applied;
the sole exception is \ex{file-symlink?}, which does not take
the optional \var{chase?} second argument.
\begin{inset}
\newcommand{\Ex}[1]{\ex{#1}\index{\tt{#1}}}
\begin{tabular}{l@{\qquad}l}
\end{tabular}
\end{inset}
@ -1340,19 +1267,7 @@ For example,
\codex{(file-directory? "/usr/dalbertz")\qquad\evalto\qquad\sharpt}
\end{desc}
There are variants of these procedures which work directly on
\ex{file-info} records:
\defun {file-info-directory?}{file-info}{\boolean}
\defunx {file-info-fifo?}{file-info}{\boolean}
\defunx {file-info-regular?}{file-info}{\boolean}
\defunx {file-info-socket?}{file-info}{\boolean}
\defunx {file-info-special?}{file-info}{\boolean}
\defunx {file-info-symlink?}{file-info}{\boolean}
The following set of procedures are a convenient means to work on the
permission bits of a file:
\defun {file-not-readable?} {fname/fd/port} \boolean
\defun {file-not-readable?} {fname/fd/port} \boolean
\defunx{file-not-writable?} {fname/fd/port} \boolean
\defunx{file-not-executable?} {fname/fd/port} \boolean
\begin{desc}
@ -1412,15 +1327,6 @@ permission bits of a file:
Refer to them for a discussion of their problems and limitations.
\end{desc}
\defun {file-info-not-readable?} {file-info} \boolean
\defunx{file-info-not-writable?} {file-info} \boolean
\defunx{file-info-not-executable?} {file-info} \boolean
\defun {file-info-readable?} {file-info} \boolean
\defunx {file-info-writable?} {file-info} \boolean
\defunx {file-info-executable?} {file-info} \boolean
There are variants which work directly on \ex{file-info} records.
\begin{defundesc}{file-not-exists?} {fname/fd/port [chase?]} \object
Returns:
\begin{optiontable}
@ -1469,21 +1375,6 @@ Returns:
split into separate entries. Using \ex{directory-files} is reliable.
\end{desc}
\defun {open-directory-stream} {dir} {directory-stream-record}
\defun {read-directory-stream} {directory-stream-record} {string or \sharpf}
\defun {close-directory-stream} {directory-stream-record} {\undefined}
These functions implement a direct interface to the
\ex{\urlh{http://www.freebsd.org/cgi/man.cgi?query=opendir&apropos=0&sektion=0&manpath=FreeBSD+4.3-RELEASE&format=html}{opendir()}}/
\ex{\urlh{http://www.freebsd.org/cgi/man.cgi?query=readdir&apropos=0&sektion=0&manpath=FreeBSD+4.3-RELEASE&format=html}{readdir()}}/
\ex{\urlh{http://www.freebsd.org/cgi/man.cgi?query=closedir&apropos=0&sektion=0&manpath=FreeBSD+4.3-RELEASE&format=html}{closedir()}}
family of functions for processing directory streams.
\ex{(open-directory-stream dir)} creates a stream of files in the
directory \ex{dir}. \ex{(read-directory-stream directory-stream)}
returns the next file in the stream or \sharpf if no such file exists.
Finally, \ex{(close-directory-stream directory-stream)} closes the
stream.
\defun {glob} {\vari{pat}1 \ldots} {string list}
\begin{desc}
Glob each pattern against the filesystem and return the sorted list.
@ -1684,7 +1575,7 @@ delimiter.
that collisions are less likely to occur. This speeds things up, but does
not affect correctness.
Security note: doing I/O to files created this way in \ex{/var/tmp/} is
Security note: doing i/o to files created this way in \ex{/var/tmp/} is
not necessarily secure. General users have write access to \ex{/var/tmp/},
so even if an attacker cannot access the new temp file, he can delete it
and replace it with one of his own. A subsequent open of this filename
@ -1695,7 +1586,7 @@ delimiter.
allocated when the file is opened. This will work if the file
only needs to be opened once.
\item If the file needs to be opened twice or more, create it in a
protected directory, \eg, \verb|$HOME|.%$
protected directory, \eg, \verb|$HOME|.
\item Ensure that \ex{/var/tmp} has its sticky bit set. This
requires system administrator privileges.
\end{enumerate}
@ -1796,7 +1687,7 @@ delimiter.
simply see and report an end of file. This is bad.
In order to ensure that an end-of-file returned to the reader is
legitimate, the reader and writer must serialise their I/O. The
legitimate, the reader and writer must serialise their i/o. The
simplest way to do this is for the reader to delay doing input
until the writer has completely finished doing output, or exited.
\end{itemize}
@ -1824,7 +1715,7 @@ The path-searching variants search the directories in the list
A path-search is not performed if the program name contains
a slash character---it is used directly. So a program with a name like
\ex{"bin/prog"} always executes the program \ex{bin/prog} in the current working
directory. See \verb|$path| and \verb|exec-path-list|, below.%$
directory. See \verb|$path| and \verb|exec-path-list|, below.
Note that there is no analog to the C function \ex{\urlh{http://www.FreeBSD.org/cgi/man.cgi?query=execv&apropos=0&sektion=0&manpath=FreeBSD+4.3-RELEASE&format=html}{execv()}}.
To get the effect just do
@ -1881,7 +1772,7 @@ it with \ex{\%exec}, the file's status might change.
The only atomic way to do the search is to loop over the candidate
file names, exec'ing each one and looping when the exec operation fails.
See \cd{$path} and \ex{exec-path-list}, below.%$
See \cd{$path} and \ex{exec-path-list}, below.
\end{desc}
\defun {exit} {[status]} \noreturn
@ -1909,31 +1800,25 @@ without flushing buffered output.
Suspend the current process with a SIGSTOP signal.
\end{defundesc}
\defun {fork} {[thunk or \sharpf] [continue-threads?]} {proc or \sharpf}
\defunx {\%fork} {[thunk or \sharpf] [continue-threads?]} {proc or \sharpf}
\defun {fork} {[thunk]} {proc or \sharpf}
\defunx {\%fork} {[thunk]} {proc or \sharpf}
\begin{desc}
\ex{fork} with no arguments or \sharpf{} instead of a thunk is like
C
\ex{\urlh{http://www.FreeBSD.org/cgi/man.cgi?query=fork&apropos=0&sektion=0&manpath=FreeBSD+4.3-RELEASE&format=html}{fork()}}.
In the parent process, it returns the child's \emph{process object}
(see below for more information on process objects). In the child
process, it returns {\sharpf}.
\ex{fork} with no arguments is like C \ex{\urlh{http://www.FreeBSD.org/cgi/man.cgi?query=fork&apropos=0&sektion=0&manpath=FreeBSD+4.3-RELEASE&format=html}{fork()}}.
In the parent process, it returns the child's \emph{process object}
(see below for more information on process objects).
In the child process, it returns {\sharpf}.
\ex{fork} with an argument only returns in the parent process, returning
the child's process object.
The child process calls \var{thunk} and then exits.
\ex{fork} flushes buffered output before forking, and sets the child
process to non-interactive. \verb|%fork| does not perform this bookkeeping;
it simply forks.
The optional boolean argument \var{continue-threads?} specifies
whether the currently active threads continue to run in the child or
not. The default is \sharpf.
\ex{fork} with an argument only returns in the parent process, returning
the child's process object.
The child process calls \var{thunk} and then exits.
\ex{fork} flushes buffered output before forking, and sets the child
process to non-interactive. \verb|%fork| does not perform this bookkeeping;
it simply forks.
\end{desc}
\defun {fork/pipe} {[thunk] [continue-threads?]} {proc or \sharpf}
\defunx{\%fork/pipe} {[thunk] [continue-threads?]} {proc or \sharpf}
\defun {fork/pipe} {[thunk]} {proc or \sharpf}
\defunx{\%fork/pipe} {[thunk]} {proc or \sharpf}
\begin{desc}
Like \ex{fork} and \ex{\%fork}, but the parent and child communicate via a
pipe connecting the parent's stdin to the child's stdout. These procedures
@ -1984,7 +1869,7 @@ Suspend the current process with a SIGSTOP signal.
(with-current-output-port (fdes->outport 1)
(display "Hello, world.\\n"))))
(set-current-input-port! (fdes->inport 0))
(set-current-input-port! (fdes->inport 0)
(read-line) ; Read the string output by the child.\end{code}
None of this is necessary when the I/O is performed by an exec'd
program in the child or parent process, only when the pipe will
@ -1992,8 +1877,8 @@ be referenced by Scheme code through one of the default current I/O
ports.
\end{desc}
\defun {fork/pipe+} {conns [thunk] [continue-threads?]} {proc or \sharpf}
\defunx {\%fork/pipe+} {conns [thunk] [continue-threads?]} {proc or \sharpf}
\defun {fork/pipe+} {conns [thunk]} {proc or \sharpf}
\defunx {\%fork/pipe+} {conns [thunk]} {proc or \sharpf}
\begin{desc}
Like \ex{fork/pipe}, but the pipe connections between the child and parent
are specified by the connection list \var{conns}.
@ -2340,7 +2225,9 @@ I can't remember how \ex{set-priority} and \ex{priority} work, so no
\defunx {user-login-name}{} \str
\defunx {user-uid}{} \fixnum
\defunx {user-effective-uid}{} \fixnum
\defunx {user-gid}{} \fixnum
\defunx {user-effective-gid}{} \fixnum
\defunx {user-supplementary-gids}{} {{\fixnum} list}
\defunx {set-uid} {uid} \undefined
\defunx {set-gid} {gid} \undefined
@ -2350,22 +2237,6 @@ The \ex{set-uid} and \ex{set-gid} routines correspond to the {\Posix}
\ex{\urlh{http://www.FreeBSD.org/cgi/man.cgi?query=setuid&apropos=0&sektion=0&manpath=FreeBSD+4.3-RELEASE&format=html}{setuid()}} and \ex{\urlh{http://www.FreeBSD.org/cgi/man.cgi?query=setgid&apropos=0&sektion=0&manpath=FreeBSD+4.3-RELEASE&format=html}{setgid()}} procedures.
\end{desc}
\defunx {user-effective-uid}{} \fixnum
\defunx {set-user-effective-uid}{\fixnum} \undefined
\defunx {with-user-effective-uid*} {\fixnum{} thunk} {value(s) of thunk}
\dfnx {with-user-effective-uid} {\fixnum{} . body} {value(s) of body} {syntax}
\defunx {user-effective-gid}{} \fixnum
\defunx {set-user-effective-gid}{\fixnum} \undefined
\defunx {with-user-effective-gid*} {\fixnum{} thunk} {value(s) of thunk}
\dfnx {with-user-effective-gid} {\fixnum{} . body} {value(s) of body} {syntax}
\begin{desc}
These forms manipulate the effective user/group IDs. Possible values
for setting this resource are either the real user/group ID or the
saved set-user/group-ID. The \texttt{with-...} forms perform the ususal
temprary assignment during the execution of the second argument. The
effective user and group IDs are thread-local.
\end{desc}
\defun {process-times} {} {[{\fixnum} {\fixnum} {\fixnum} \fixnum]}
\begin{desc}
@ -2400,12 +2271,12 @@ These procedures are used to access the user and group databases
\begin{desc}
Return a \ex{user-info} record giving the recorded information for a
particular user:
\indextt{user-info}
\indextt{user-info:name}
\indextt{user-info:uid}
\indextt{user-info:gid}
\indextt{user-info:home-dir}
\indextt{user-info:shell}
\index{user-info}
\index{user-info:name}
\index{user-info:uid}
\index{user-info:gid}
\index{user-info:home-dir}
\index{user-info:shell}
\begin{code}
(define-record user-info
name uid gid home-dir shell)\end{code}
@ -2423,10 +2294,10 @@ form.
\begin{desc}
Return a \ex{group-info} record giving the recorded information for a
particular group:
\indextt{group-info}
\indextt{group-info:name}
\indextt{group-info:gid}
\indextt{group-info:members}
\index{group-info}
\index{group-info:name}
\index{group-info:gid}
\index{group-info:members}
\begin{code}
(define-record group-info
name gid members)\end{code}
@ -2528,24 +2399,6 @@ This may be a local name, such as ``solar,'' as opposed to a
fully-qualified domain name such as ``solar.csie.ntu.edu.tw.''
\end{desc}
\defun {uname}{} {uname-record}
\begin{desc}
Returns a \emph{uname-record} of the following structure:
\begin{code}
(define-record uname
os-name
node-name
release
version
machine)\end{code}%
Each of the fields contains a string.
Be aware that POSIX limits the length of all entries to 32 characters,
and that the node name does not necessarily correspond to the
fully-qualified domain name.
\end{desc}
\section{Signal system}
Signal numbers are bound to the variables \ex{signal/hup}, \ex{signal/int},
@ -2561,13 +2414,8 @@ The \var{proc} and \var{prgrp} arguments are either processes
or integer process ids.
\end{desc}
\defun{itimer}{secs} \undefined
\begin{desc}
Schedules a timer interrupt in \var{secs} seconds.
\end{desc}
\note{As the thread system needs the timer interrupt for its own purpose,
\ex{itimer} works by spawning a thread which calls the interrupt
handler for \ex{interrupt/alrm} after the specified time.}
\defun{itimer}{???} \undefined
\defunx{pause-until-interrupt}{} \undefined
\defun{process-sleep}{secs} \undefined
\defunx{process-sleep-until}{time}\undefined
@ -2583,7 +2431,6 @@ or integer process ids.
\end{desc}
\subsubsection{Interrupt handlers}
\label{sec:int_handlers}
Scsh interrupt handlers are complicated by the fact that scsh is implemented on
top of the {\scm} virtual machine, which has its own interrupt system,
independent of the Unix signal system.
@ -2591,7 +2438,7 @@ This means that {\Unix} signals are delivered in two stages: first,
{\Unix} delivers the signal to the {\scm} virtual machine, then
the {\scm} virtual machine delivers the signal to the executing Scheme program
as a {\scm} interrupt.
This ensures that signal delivery happens between two VM instructions,
This ensures that signal delivery happens between two vm instructions,
keeping individual instructions atomic.
The {\scm} machine has its own set of interrupts, which includes the
@ -2599,36 +2446,37 @@ asynchronous {\Unix} signals (table~\ref{table:signals-and-interrupts}).
\begin{table}
\begin{minipage}{\textwidth}
\begin{center}
\newcommand{\kwd}[1]{\index{\texttt{#1}}\texttt{#1}}
\begin{tabular}{lll}\hline
Interrupt & Unix signal & OS Variant \\ \hline\hline
\exi{interrupt/alrm}\footnote{Also bound to {\scm} interrupt
\exi{interrupt/alarm}.}
& \exi{signal/alrm} & \Posix \\
\kwd{interrupt/alrm}\footnote{Also bound to {\scm} interrupt
\kwd{interrupt/alarm}.}
& \kwd{signal/alrm} & \Posix \\
%
\exi{interrupt/int}\footnote{Also bound to {\scm} interrupt
\exi{interrupt/keyboard}.}
& \exi{signal/int} & \Posix \\
\kwd{interrupt/int}\footnote{Also bound to {\scm} interrupt
\kwd{interrupt/keyboard}.}
& \kwd{signal/int} & \Posix \\
%
\exi{interrupt/memory-shortage} & N/A & \\
\exi{interrupt/chld} & \exi{signal/chld} & \Posix \\
\exi{interrupt/cont} & \exi{signal/cont} & \Posix \\
\exi{interrupt/hup} & \exi{signal/hup} & \Posix \\
\exi{interrupt/quit} & \exi{signal/quit} & \Posix \\
\exi{interrupt/term} & \exi{signal/term} & \Posix \\
\exi{interrupt/tstp} & \exi{signal/tstp} & \Posix \\
\exi{interrupt/usr1} & \exi{signal/usr1} & \Posix \\
\exi{interrupt/usr2} & \exi{signal/usr2} & \Posix \\
\kwd{interrupt/memory-shortage} & N/A & \\
\kwd{interrupt/chld} & \kwd{signal/chld} & \Posix \\
\kwd{interrupt/cont} & \kwd{signal/cont} & \Posix \\
\kwd{interrupt/hup} & \kwd{signal/hup} & \Posix \\
\kwd{interrupt/quit} & \kwd{signal/quit} & \Posix \\
\kwd{interrupt/term} & \kwd{signal/term} & \Posix \\
\kwd{interrupt/tstp} & \kwd{signal/tstp} & \Posix \\
\kwd{interrupt/usr1} & \kwd{signal/usr1} & \Posix \\
\kwd{interrupt/usr2} & \kwd{signal/usr2} & \Posix \\
\\
\exi{interrupt/info} & \exi{signal/info} & BSD only \\
\exi{interrupt/io} & \exi{signal/io} & BSD + SVR4 \\
\exi{interrupt/poll} & \exi{signal/poll} & SVR4 only \\
\exi{interrupt/prof} & \exi{signal/prof} & BSD + SVR4 \\
\exi{interrupt/pwr} & \exi{signal/pwr} & SVR4 only \\
\exi{interrupt/urg} & \exi{signal/urg} & BSD + SVR4 \\
\exi{interrupt/vtalrm} & \exi{signal/vtalrm} & BSD + SVR4 \\
\exi{interrupt/winch} & \exi{signal/winch} & BSD + SVR4 \\
\exi{interrupt/xcpu} & \exi{signal/xcpu} & BSD + SVR4 \\
\exi{interrupt/xfsz} & \exi{signal/xfsz} & BSD + SVR4 \\
\kwd{interrupt/info} & \kwd{signal/info} & BSD only \\
\kwd{interrupt/io} & \kwd{signal/io} & BSD + SVR4 \\
\kwd{interrupt/poll} & \kwd{signal/poll} & SVR4 only \\
\kwd{interrupt/prof} & \kwd{signal/prof} & BSD + SVR4 \\
\kwd{interrupt/pwr} & \kwd{signal/pwr} & SVR4 only \\
\kwd{interrupt/urg} & \kwd{signal/urg} & BSD + SVR4 \\
\kwd{interrupt/vtalrm} & \kwd{signal/vtalrm} & BSD + SVR4 \\
\kwd{interrupt/winch} & \kwd{signal/winch} & BSD + SVR4 \\
\kwd{interrupt/xcpu} & \kwd{signal/xcpu} & BSD + SVR4 \\
\kwd{interrupt/xfsz} & \kwd{signal/xfsz} & BSD + SVR4 \\
\end{tabular}
\end{center}
\caption{{\scm} virtual-machine interrupts and related {\Unix} signals.
@ -2640,25 +2488,26 @@ Interrupt & Unix signal & OS Variant \\ \hline\hline
\end{table}
%
\begin{table}
\newcommand{\kwd}[1]{\index{\texttt{#1}}\texttt{#1}}
\begin{center}
\begin{tabular}{lll}\hline
Unix signal & Type & OS Variant \\ \hline\hline
\exi{signal/stop} & Uncatchable & \Posix \\
\exi{signal/kill} & Uncatchable & \Posix \\
\kwd{signal/stop} & Uncatchable & \Posix \\
\kwd{signal/kill} & Uncatchable & \Posix \\
\\
\exi{signal/abrt} & Synchronous & \Posix \\
\exi{signal/fpe} & Synchronous & \Posix \\
\exi{signal/ill} & Synchronous & \Posix \\
\exi{signal/pipe} & Synchronous & \Posix \\
\exi{signal/segv} & Synchronous & \Posix \\
\exi{signal/ttin} & Synchronous & \Posix \\
\exi{signal/ttou} & Synchronous & \Posix \\
\kwd{signal/abrt} & Synchronous & \Posix \\
\kwd{signal/fpe} & Synchronous & \Posix \\
\kwd{signal/ill} & Synchronous & \Posix \\
\kwd{signal/pipe} & Synchronous & \Posix \\
\kwd{signal/segv} & Synchronous & \Posix \\
\kwd{signal/ttin} & Synchronous & \Posix \\
\kwd{signal/ttou} & Synchronous & \Posix \\
\\
\exi{signal/bus} & Synchronous & BSD + SVR4 \\
\exi{signal/emt} & Synchronous & BSD + SVR4 \\
\exi{signal/iot} & Synchronous & BSD + SVR4 \\
\exi{signal/sys} & Synchronous & BSD + SVR4 \\
\exi{signal/trap} & Synchronous & BSD + SVR4 \\
\kwd{signal/bus} & Synchronous & BSD + SVR4 \\
\kwd{signal/emt} & Synchronous & BSD + SVR4 \\
\kwd{signal/iot} & Synchronous & BSD + SVR4 \\
\kwd{signal/sys} & Synchronous & BSD + SVR4 \\
\kwd{signal/trap} & Synchronous & BSD + SVR4 \\
\end{tabular}
\end{center}
\caption{Uncatchable and synchronous {\Unix} signals. While these signals
@ -2670,11 +2519,17 @@ Unix signal & Type & OS Variant \\ \hline\hline
here.}
\label{table:uncatchable-signals}
\end{table}
Note that scsh does \emph{not} support signal handlers for
``synchronous'' {\Unix} signals, such as \ex{signal/ill} or
\ex{signal/pipe} (see table~\ref{table:uncatchable-signals}).
Synchronous occurrences of these signals are better handled by raising
a Scheme exception. We recommend you avoid using signal handlers
unless you absolutely have to; Section \ref{sec:event-interf-interr}
describes a better interface to signals.
\begin{defundesc}{signal->interrupt}{\integer}{\integer}
The programmer maps from {\Unix} signals to {\scm} interrupts with the
\ex{signal->interrupt} procedure.
If the signal does not have a defined {\scm} interrupt, an error is signaled.
If the signal does not have a defined {\scm} interrupt, an errror is signaled.
\end{defundesc}
@ -2716,7 +2571,6 @@ the \ex{interrupt-set} function).
\end{desc}
\begin{defundesc}{set-interrupt-handler}{interrupt handler}{old-handler}
Assigns a handler for a given interrupt,
and returns the interrupt's old handler.
@ -2736,10 +2590,6 @@ handler, see \ex{set-enabled-interrupts})
\note{If you set a handler for the \ex{interrupt/chld} interrupt,
you may break scsh's autoreaping process machinery. See the
discussion of autoreaping in section~\ref{sec:proc-objects}.}
\note{We recommend you avoid using interrupt handlers unless you absolutely
have to; Section \ref{sec:event-interf-interr} describes a better
interface to handling signals.}
\end{defundesc}
\begin{defundesc}{interrupt-handler}{interrupt}{handler}
@ -2749,28 +2599,6 @@ A handler is either \ex{\#f} (ignore), \ex{\#t} (default), or a
procedure taking an integer argument.
\end{defundesc}
Note that scsh does \emph{not} support interrupt handlers for
``synchronous'' {\Unix} signals, such as \ex{signal/ill} or
\ex{signal/pipe} (see table~\ref{table:uncatchable-signals}).
Synchronous occurrences of these signals are better handled by raising
a Scheme exception. There are, however, some rare situtations where it
is necessary to ignore the occurrence of a synchronous signal. For
this case, the following procedures exist:
\defun{ignore-signal}{\integer}{\undefined}
\defunx{handle-signal-default}{\integer}{\undefined}
\begin{desc}
The procedure \ex{ignore-signal} tells the process to ignore the
given signal. The procedure \ex{handle-signal-default} resets the
signal handler to the default handler.
These procedures manipulate the raw signal handler of the scsh
process and therfore undermine the signal handling facility of the
VM. They are intended to be used for igoring synchronous signals if
system calls cannot succeed otherwise. Do not use these procedures
for asynchronous signals!
\end{desc}
% %set-unix-signal-handler
% %unix-signal-handler
@ -2872,8 +2700,7 @@ This is described for each procedure below.
are optional, and default to \ex{\#f}, \ex{\#f}, \ex{\#f}, 0,
and 0 respectively.
This is useful when creating a \ex{date} record to pass as an
argument to \ex{time}. Other procedures, however, may refuse to work
with these incomplete \ex{date} records.
argument to \ex{time}.
\end{desc}
\subsection{Time zones}
@ -3334,24 +3161,19 @@ Scsh never uses \cd{$USER} at all.
It computes \ex{(user-login-name)} from the system call \ex{(user-uid)}.
\defvar {home-directory} \str
\defvarx {exec-path-list} {{\str} list thread-fluid}
\defvarx {exec-path-list} {{\str} list fluid}
\begin{desc}
Scsh accesses \cd{$HOME} at start-up time, and stores the value in the
global variable \ex{home-directory}. It uses this value for \ex{\~}
lookups and for returning to home on \ex{(chdir)}.
Scsh accesses \cd{$PATH} at start-up time, colon-splits the path list, and
stores the value in the thread fluid \ex{exec-path-list}. This list is
stores the value in the fluid \ex{exec-path-list}. This list is
used for \ex{exec-path} and \ex{exec-path/env} searches.
To access, rebind or side-effect thread-fluid cells, you must open
the \ex{thread-fluids} package.
To access, rebind or side-effect fluid cells, you must open
the \ex{fluids} package.
\end{desc}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\input{tty}
%%% Local Variables:
%%% mode: latex
%%% TeX-master: "man"
%%% End:

9
doc/scsh-manual/tex2page.sty Normal file
View File

@ -0,0 +1,9 @@
% tex2page.sty
% Dorai Sitaram
% Loading this file in a LaTeX document
% gives it all the macros of tex2page.tex,
% but via a more LaTeX-convenient filename.
\input{tex2page}

29
doc/scsh-manual/threads.tex
View File

@ -191,15 +191,6 @@ variable \texttt{state} by USR1 and USR2:
(set! state #t)
(lp next))))
\end{code}
\textbf{Warning:} The current version of scsh also defines
asynchronous handlers for interrupts (See Section
\ref{sec:int_handlers}). The default action of some of these handlers
is to terminate the process in which case you will most likely not see
an effect of the synchronous event interface described here. It is
therefore recommended to disable the corresponding interrupt handler
using \texttt{(set-interrupt-handler interrupt \#f)}.
\section{Interaction between threads and process state}
\label{sec:ps_interac}
@ -212,12 +203,11 @@ the global, asynchronous signals handlers into modular, synchronous
sigevents. Concurrent programming also benefit from sigevents as every
thread may chase down the sigevent chain separately.
Scsh treats the working directory, umask, environment, and the
effective user/group ID as thread-local resources. The initial value
of the resources is determined by the way a thread is started:
\texttt{spawn} assigns the initial values whereas \texttt{fork-thread}
adopts the values of its parent. Here is a detailed description of the
whole facility:
Scsh treats working directory, umask and environment as a thread-local
resource. The initial value of the resources is determined by the way
a thread is started: \texttt{spawn} assigns the initial values whereas
\texttt{fork-thread} adopts the values of its parent. Here is a
detailed description of the whole facility:
\begin{itemize}
\item The procedures to access and modify the resources remain as
@ -239,16 +229,9 @@ is similar to what happens at process forking.
to another.
\end{itemize}
\defun{spoon} {thunk} \undefined
This is just an alias for \ex{fork-thread} suggested by Alan Bawden.
For user and group identities arbitrary changing is not possible.
Therefore they remain global process state: If a thread changes one of
these values, all other threads see the new value. Consequently, scsh
does not provide \texttt{with-uid} and friends.
%%% Local Variables:
%%% mode: latex
%%% TeX-master: "man"
%%% End:

6
doc/scsh-manual/tty.tex
View File

@ -7,9 +7,13 @@
\newcommand{\fr}[1]{\makebox[0pt][r]{#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}}}
Scsh provides a complete set of routines for manipulating terminal
devices---putting them in ``raw'' mode, changing and querying their
special characters, modifying their I/O speeds, and so forth.
special characters, modifying their i/o speeds, and so forth.
The scsh interface is designed both for generality and portability
across different Unix platforms, so you don't have to rewrite your
program each time you move to a new system.

1
doc/scsh-paper/.tex2page.hdir
View File

@ -1 +0,0 @@
html

33
doc/scsh-paper/Makefile
View File

@ -1,33 +0,0 @@
.SUFFIXES: .idx .ind .tex .dvi .ps .pdf $(.SUFFIXES)
TEX= headings.tex scsh-paper.tex
TEX2PAGE=tex2page
scsh-paper.dvi: $(TEX)
scsh-paper.pdf: $(TEX)
.dvi.ps:
dvips -j0 -o $@ $<
.tex.dvi:
latex $< && latex $<
rm $*.log
.tex.pdf:
pdflatex $< && thumbpdf $@ && pdflatex $<
rm $*.log
.idx.ind:
makeindex $<
clean:
-rm -f *.log *.png scsh-paper.out scsh-paper.dvi scsh-paper.ps scsh-paper.pdf thumb*.png
rm -rf html
INSTALL_DATA= install -c -m 644
html: $(TEX)
$(TEX2PAGE) scsh-paper && $(TEX2PAGE) scsh-paper

114
doc/scsh-paper/css.t2p
View File

@ -1,114 +0,0 @@
% 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

16
doc/scsh-paper/headings.tex
View File

@ -1,16 +0,0 @@
% 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

115
doc/scsh-paper/scsh-paper.t2p
View File

@ -1,115 +0,0 @@
% scsh-paper.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-paper.tex.
% Copy (or link) this file alongside scsh-paper.tex and run
% tex2page scsh-paper
\input css.t2p
\dontuseimgforhtmlmath
\let\clearpage\relax
\let\cleardoublepage\relax
\let\pagebreak\relax
\let\PRIMsection\section
\let\subsectionORIG\subsection
\let\subsubsectionORIG\subsubsection
%\let\PRIMtableofcontents\tableofcontents
%\def\tableofcontents{\section*{Contents}\PRIMtableofcontents}
\def\notenum#1{\def\savenotenum{#1}}
\def\project#1{\def\saveproject{#1}}
%\let\PRIMtitle\title
%\def\title#1{\PRIMtitle{#1}\def\savetitle{#1}}
%\def\author#1{\def\saveauthor{#1}}
%\def\date#1{\def\savedate{#1}}
\def\maketitle{
\leftline{\sc massachusetts institute of technology}
\smallskip
\centerline{Laboratory for Computer Science}
\smallskip
\leftline{\saveproject\ Note \savenotenum\ \qquad \TIIPdate}
\hr
\subject{\TIIPtitle}
\smallskip
{\def\\{\egroup\break\bgroup}
\centerline{\bf\TIIPauthor}}
\smallskip
\bigskip
\bigskip}
\let\PRIMfigure\figure
\let\PRIMendfigure\endfigure
\def\figure{\par\hrule\PRIMfigure}
\def\endfigure{\PRIMendfigure\hrule\par}
\let\PRIMdocument\document
\def\document{\PRIMdocument
\def\headingquote##1##2{
\eject
\TIIPendgraf
\rawhtml<div align=right><table ><tr><td><em>
\endrawhtml
##1
\rawhtml</em><br>\endrawhtml
~~~~~~---##2
\TIIPendgraf
\rawhtml</td></tr></table></div>\endrawhtml}
\def\section{\def\section{\vfill\eject\PRIMsection}%
\PRIMsection}
%headings.tex redefines \[sub]*section, which
%emit unwanted output, pointed out by Martin
%Gasbichler. Let's therefore restore original
%definitions for these commands.
\let\subsection\subsectionORIG
\let\subsubsection\subsubsectionORIG
%\let\ttchars\relax
\let\ttt\tt
\def\cd##1{{\tt\def\\{\char`\\}\defcsactive\${\char`\$}%
\defcsactive\&{\char`\&}##1}}
\def\cddollar{\undefcsactive\$}
%\def\ex#1{{\tt #1}}
\def\l##1{lambda (##1)}
\def\lx##1{lambda {##1}}
%\def\var#1{{\it #1\/}}
\def\vari##1##2{\mbox{\undefcsactive\$${\it
##1}_{##2}$}}
%\def\vari#1#2{\mbox{{\it #1\/}\undefcsactive\$$_{#2}$}}
%\renewcommand{\proto}[3]{{\tt(#1 {\it #2})} \qquad (#3)}
\def\proto##1##2##3{{\tt(##1 {\it ##2})} \qquad (##3)}
\def\setupcode{\tt%
\def\\{\char`\\}%
\defcsactive\${\$}%
\def\evalto{==> }%
\defcsactive\%{\%}\obeywhitespace}
\newenvironment{code}{\begin{quote}\bgroup\setupcode\GOBBLEOPTARG}
{\egroup\end{quote}}
\newenvironment{codebox}{\begin{tableplain}\bgroup\setupcode\GOBBLEOPTARG}
{\egroup\end{tableplain}}
\newenvironment{tightcode}{\begin{code}}{\end{code}}
\renewenvironment{inset}{\begin{quote}}{\end{quote}}
\renewenvironment{leftinset}{\begin{quote}}{\end{quote}}
\renewenvironment{tightinset}{\begin{quote}}{\end{quote}}
\newenvironment{tightleftinset}{\begin{quote}}{\end{quote}}
\renewenvironment{column}{\end{center}\bgroup\let\\\break}
{\egroup\begin{center}}
}

3
doc/src/external.tex
View File

@ -443,7 +443,7 @@ The `extract' ones convert from Scheme to C and the `enter's go the other
\cproto{unsigned char s48\_extract\_char(s48\_value)}
\cproto{char * \ \ \ s48\_extract\_string(s48\_value)}
\cproto{char * \ \ \ s48\_extract\_byte\_vector(s48\_value)}
\cgcproto{long \ \ \ \ \ s48\_extract\_integer(s48\_value)}
\cproto{long \ \ \ \ \ s48\_extract\_integer(s48\_value)}
\cproto{double \ \ \ s48\_extract\_double(s48\_value)}
\cproto{s48\_value S48\_ENTER\_BOOLEAN(int)}
\cproto{s48\_value s48\_enter\_char(unsigned char)}
@ -866,6 +866,7 @@ They are provided for the purpose of writing more efficient code;
\begin{protos}
\cproto{char \ \ \ \ \ S48\_UNSAFE\_EXTRACT\_CHAR(s48\_value)}
\cproto{char * \ \ \ S48\_UNSAFE\_EXTRACT\_STRING(s48\_value)}
\cproto{long \ \ \ \ \ S48\_UNSAFE\_EXTRACT\_INTEGER(s48\_value)}
\cproto{long \ \ \ \ \ S48\_UNSAFE\_EXTRACT\_DOUBLE(s48\_value)}
\end{protos}
\begin{protos}

73
doc/src/module.tex
View File

@ -132,14 +132,6 @@ The configuration language consists of top-level defining forms for
\>\altz{}~ \tt(\syn{name} \syn{type}) \\
\>\altz{}~ \tt((\arbno{\syn{name}}) \syn{type}) \\
\syn{structure} \=\goesto{}~ \syn{name} \\
\>\altz{}~ \tt(modify \syn{structure} \arbno{\syn{modifier}}) \\
\>\altz{}~ \tt(subset \syn{structure} (\arbno{\syn{name}})) \\
\>\altz{}~ \tt(with-prefix \syn{structure} \syn{name}) \\
\syn{modifier} \=\goesto{}~ \tt(expose \arbno{\syn{name}}) \\
\>\altz{}~ \tt(hide \arbno{\syn{name}}) \\
\>\altz{}~ \tt(rename \arbno{(\syn{name}$_0$ \syn{name}$_1$)}) \\
\>\altz{}~ \tt(alias \arbno{(\syn{name}$_0$ \syn{name}$_1$)}) \\
\>\altz{}~ \tt(prefix \syn{name}) \\
\end{tabbing}
\caption{The configuration language.}
\end{figure}
@ -164,58 +156,19 @@ For building structures that export structures, there is a {\tt defpackage}
Many other structures, such as record and hash table facilities, are also
available in the \hack{} implementation.
The \codemainindex{{modify}}, \codemainindex{{subset}}, and
\codemainindex{{prefix}} forms produce new
views on existing structures by renaming or hiding exported names.
\code{Subset} returns a new structure that exports only the listed names
from its \syn{structure} argument.
\code{With-prefix} returns a new structure that adds \syn{prefix}
to each of the names exported by the \syn{structure} argument.
For example, if structure \code{s} exports \code{a} and \code{b},
then
\begin{example}
(subset s (a))
\end{example}
exports only \code{a} and
\begin{example}
(with-prefix s p/)
\end{example}
exports \code{a} as \code{p/a} and \code{b} as \code{p/b}.
Both \code{subset} and \code{with-prefix} are simple macros that
expand into uses of \code{modify}, a more general renaming form.
In a \code{modify} structure specification the \syn{command}s are applied to
the names exported
by \syn{structure} to produce a new set of names for the \syn{structure}'s
bindings.
\code{Expose} makes only the listed names visible.
\code{Hide} makes all but the listed names visible.
\code{Rename} makes each \syn{name}$_0$ visible as \syn{name}$_1$
name and not visible as \syn{name}$_0$ , while
\code{alias} makes each \syn{name}$_0$ visible as both \syn{name}$_0$
and \syn{name}$_1$.
\code{Prefix} adds \syn{name} to the beginning of each exported name.
The modifiers are applied from right to left. Thus
\begin{example}
(modify scheme (prefix foo/) (rename (car bus))))
\end{example}
makes \code{car} available as \code{foo/bus}..
% Use modify instead of structure-ref.
%
%An {\tt access} clause specifies which bindings of names to structures
%will be visible inside the package body for use in {\tt structure-ref}
%forms. {\tt structure-\ok{}ref} has the following syntax:
%\begin{tabbing}
%\qquad \syn{expression} \goesto{}~
% \tt(structure-ref \syn{struct-name} \syn{name})
%\end{tabbing}
%The \syn{struct-name} must be the name of an {\tt access}ed structure,
%and \syn{name} must be something that the structure exports. Only
%structures listed in an {\tt access} clause are valid in a {\tt
%structure-ref}. If a package accesses any structures, it should
%probably open the {\tt structure-refs} structure so that the {\tt
%structure-ref} operator itself will be available.
An {\tt access} clause specifies which bindings of names to structures
will be visible inside the package body for use in {\tt structure-ref}
forms. {\tt structure-\ok{}ref} has the following syntax:
\begin{tabbing}
\qquad \syn{expression} \goesto{}~
\tt(structure-ref \syn{struct-name} \syn{name})
\end{tabbing}
The \syn{struct-name} must be the name of an {\tt access}ed structure,
and \syn{name} must be something that the structure exports. Only
structures listed in an {\tt access} clause are valid in a {\tt
structure-ref}. If a package accesses any structures, it should
probably open the {\tt structure-refs} structure so that the {\tt
structure-ref} operator itself will be available.
The package's body is specified by {\tt begin} and/or {\tt files}
clauses. {\tt begin} and {\tt files} have the same semantics, except

61
doc/src/utilities.tex
View File

@ -725,67 +725,6 @@ Structure \code{c-system-function} provides access to the C \code{system()}
\evalsto 'foo
\end{example}
\section{SRFIs}
`SRFI' stands for `Scheme Request For Implementation'.
An SRFI is a description of an extension to standard Scheme.
Draft and final SRFI documents, a FAQ, and other information about SRFIs
can be found at the
\xlink{SRFI web site}[ at \code{http://srfi.schemers.org}]
{http://srfi.schemers.org}.
Scheme~48 includes implementations of the following (final) SRFIs:
\begin{itemize}
\item SRFI 1 -- List Library
\item SRFI 2 -- \code{and-let*}
\item SRFI 5 -- \code{let} with signatures and rest arguments
\item SRFI 6 -- Basic string ports
\item SRFI 7 -- Program configuration
\item SRFI 8 -- \code{receive}
\item SRFI 9 -- Defining record types
\item SRFI 11 -- Syntax for receiving multiple values
\item SRFI 13 -- String Library
\item SRFI 14 -- Character-Set Library (see note below)
\item SRFI 16 -- Syntax for procedures of variable arity
\item SRFI 17 -- Generalized \code{set!}
\item SRFI 23 -- Error reporting mechanism
\end{itemize}
Documentation on these can be found at the web site mentioned above.
SRFI~14 includes the procedure \code{->char-set} which is not a standard
Scheme identifier (in R$^5$RS the only required identifier starting
with \code{-} is \code{-} itself).
In the Scheme~48 version of SRFI~14 we have renamed \code{->char-set}
as \code{x->char-set}.
The SRFI bindings can be accessed either by opening the appropriate structure
(the structure \code{srfi-}\cvar{n} contains SRFI \cvar{n})
or by loading structure \code{srfi-7} and then using
the \code{,load-srfi-7-program} command to load an SRFI 7-style program.
The syntax for the command is
\begin{example}
\code{,load-srfi-7-program \cvar{name} \cvar{filename}}
\end{example}
This creates a new structure and associated package, binds the structure
to \cvar{name} in the configuration package, and then loads the program
found in \cvar{filename} into the package.
As an example, if the file \code{test.scm} contains
\begin{example}
(program (code (define x 10)))
\end{example}
this program can be loaded as follows:
\begin{example}
> ,load-package srfi-7
> ,load-srfi-7-program test test.scm
[test]
> ,in test
test> x
10
test>
\end{example}
%\W \chapter*{Index}
%\W \htmlprintindex
%\T \input{doc.ind}

5
emacs/cmulisp.el
View File

@ -1,6 +1,9 @@
;;; -*-Emacs-Lisp-*- cmulisp.el
;;; Copyright Olin Shivers (1988).
;;; See file COPYING
;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
;;; notice appearing here to the effect that you may use this code any
;;; way you like, as long as you don't charge money for it, remove this
;;; notice, or hold me liable for its results.
;;; This replaces the standard inferior-lisp mode.
;;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88

5
emacs/cmuscheme.el
View File

@ -1,6 +1,9 @@
;;; cmuscheme.el -- Scheme process in a buffer. Adapted from tea.el.
;;; Copyright Olin Shivers (1988)
;;; See file COPYING
;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
;;; notice appearing here to the effect that you may use this code any
;;; way you like, as long as you don't charge money for it, remove this
;;; notice, or hold me liable for its results.
;;;
;;; This is a customisation of comint-mode (see comint.el)
;;;

5
emacs/cmushell.el
View File

@ -1,6 +1,9 @@
;;; -*-Emacs-Lisp-*- General command interpreter in a window stuff
;;; Copyright Olin Shivers (1988).
;;; See file COPYING
;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
;;; notice appearing here to the effect that you may use this code any
;;; way you like, as long as you don't charge money for it, remove this
;;; notice, or hold me liable for its results.
;;; The changelog is at the end of file.

5
emacs/comint.el
View File

@ -1,6 +1,9 @@
;;; -*-Emacs-Lisp-*- General command interpreter in a window stuff
;;; Copyright Olin Shivers (1988).
;;; See file COPYING
;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
;;; notice appearing here to the effect that you may use this code any
;;; way you like, as long as you don't charge money for it, remove this
;;; notice, or hold me liable for its results.
;;; The changelog is at the end of this file.

3
ps-compiler/compile-gc.scm
View File

@ -13,7 +13,6 @@
"../scheme/vm/gc-package-defs.scm")
's48-heap-init
"../scheme/vm/scheme48heap.c"
'(header "#include <string.h>")
'(header "#include \"scheme48vm.h\"")
'(header "#include \"scheme48vm.h\"")
;'(copy (heap walk-over-type-in-area))
'(integrate (real-copy-object s48-trace-locations!)))))

149
scheme/alt/config.scm
View File

@ -1,8 +1,11 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Stub support for DEFINE-PACKAGE and DEFINE-INTERFACE macros.
; Interfaces are ignored. Only dependencies are significant.
(define (load-configuration filename . rest)
(let ((save filename))
(dynamic-wind (lambda () (set! *source-file-name* filename))
@ -40,51 +43,34 @@
; --------------------
(define (make-indirect-interface name thunk)
(thunk))
(define (make-simple-interface name items)
(cons 'export items))
(define (make-compound-interface name . sigs)
(cons 'compound-interface sigs))
; Structures are views into packages.
; In this implementation, interface information is completely ignored.
(define (make-structure package int-thunk . name-option)
(let ((struct (vector '<structure>
#f
package
(if (procedure? int-thunk)
int-thunk
(lambda () int-thunk))
#f)))
(if (not (null? name-option))
(note-structure-name! struct (car name-option)))
struct))
(define (structure? thing)
(and (vector? thing)
(not (zero? (vector-length thing)))
(eq? '<structure> (vector-ref thing 0))))
(define-syntax make-structure
(syntax-rules ()
((make-structure ?package ?interface ?name)
(vector '<structure> ?name ?package))
((make-structure ?package ?interface)
(make-structure ?package ?interface #f))))
(define (structure-name s) (vector-ref s 1))
(define (set-structure-name! s name) (vector-set! s 1 name))
(define (structure-package s) (vector-ref s 2))
(define (structure-interface-thunk s) (vector-ref s 3))
(define (structure-interface-really s) (vector-ref s 4))
(define (set-structure-interface! s i) (vector-set! s 4 i))
(define (structure-interface s)
(or (structure-interface-really s)
(begin (initialize-structure! s)
(structure-interface-really s))))
(define (initialize-structure! s)
(let ((int ((structure-interface-thunk s))))
(begin (set-structure-interface! s int)
(note-reference-to-interface! int s))))
(define (verify-later! thunk) 'lose)
(define (set-verify-later! proc) 'lose)
;(define *all-files* '())------------
;(define *all-files* '())
; We assume that the commands are not actually necessary.
(define (make-modified-structure struct commands)
struct)
; Packages are not what they appear to be.
(define (make-a-package opens-thunk accesses-thunk tower
@ -103,65 +89,29 @@
(define (package-loaded? p) (vector-ref p 5))
(define (set-package-loaded?! p ?) (vector-set! p 5 ?))
(define (initialize-package! p) 'lose)
; The package hierarchy
(define (first p l)
(let loop ((l l))
(and (not (null? l))
(or (and (p (car l)) (car l))
(loop (cdr l))))))
(define *structures* '())
(define (all-structures) *structures*)
(define (find-structure name)
(first (lambda (struct)
(eq? name (structure-name struct)))
*structures*))
(define *packages* '())
(define *interfaces* '())
(define (register-structure! struct)
(set! *structures* (cons struct *structures*)))
(define (register-interface! int)
(set! *interfaces* (cons int *interfaces*)))
(define (register-package! p)
(set! *packages* (cons p *packages*)))
(define (initialize-module-system!)
(set! *structures* '())
(set! *packages* '())
(set! *interfaces* '()))
(define (note-name! thing name)
(cond ((interface? thing)
(note-interface-name! thing name))
((structure? thing)
(note-structure-name! thing name)))
thing)
(define (note-structure-name! struct name)
(if (and name (not (structure-name struct)))
(begin
(set-structure-name! struct name)
(note-package-name! (structure-package struct) name)
(register-structure! struct))))
(define (note-package-name! package name)
(register-package! package))
(define dummy-package
(make-a-package (lambda () '()) (lambda () '()) #f "" '() #f))
(define dummy-interface
(make-simple-interface 'dummy-interface '()))
; source-file-names ?
(define module-system
(make-structure dummy-package dummy-interface 'module-system))
(define scheme
(make-structure dummy-package dummy-interface 'scheme))
(define module-system (make-structure dummy-package #f 'module-system))
(define scheme (make-structure dummy-package #f 'scheme))
(define built-in-structures
(make-structure dummy-package dummy-interface 'built-in-structures))
(make-structure dummy-package #f 'built-in-structures))
(define (note-name! thing name)
thing)
; Handy
(define (setdiff l1 l2)
(cond ((null? l2) l1)
((null? l1) l1)
((member (car l1) l2)
(setdiff (cdr l1) l2))
(else (cons (car l1)
(setdiff (cdr l1) l2)))))
; Stuff copied from rts/filename.scm... ugh...
@ -231,6 +181,19 @@
((eq? thing (string-ref s i)) i)
(else (loop (+ i 1))))))
(define interface-of structure-interface)
; Types
(define :value ':value)
(define :syntax ':syntax)
(define :structure ':structure)
(define :procedure ':procedure)
(define :number ':number)
(define :type ':type)
(define-syntax proc
(lambda (e r c) ''proc-lossage))
(define-syntax interface-of
(lambda (e r c) ''interface-of-lossage))
(define-reflective-tower-maker list)

7
scheme/alt/define-macro-define-syntax.scm
View File

@ -1,7 +0,0 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
(define-macro (define-syntax macro-name transformer . stuff)
`(define-macro (,macro-name . args)
(,transformer (cons ',macro-name args)
(lambda (x) x)
eq?)))

41
scheme/alt/dummy-interface.scm
View File

@ -1,41 +0,0 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Interfaces are ignored. Only dependencies are significant.
(define (make-indirect-interface name thunk)
(thunk))
(define (make-simple-interface name items)
(cons 'export items))
(define (make-compound-interface name . sigs)
(cons 'compound-interface sigs))
; Types
(define :value ':value)
(define :syntax ':syntax)
(define :structure ':structure)
(define :procedure ':procedure)
(define :number ':number)
(define :type ':type)
(define-syntax proc
(lambda (e r c) ''proc-lossage))
(define-syntax interface-of
(lambda (e r c) ''interface-of-lossage))
(define (note-reference-to-interface! int thing)
'int-lossage)
(define (interface-name int)
'int-lossage)
(define (interface? int)
(and (pair? int)
(or (eq? 'export (car int))
(eq? 'compound-interface (car int)))))
(define (note-interface-name! int name)
'int-lossage)

20
scheme/alt/primitives.scm
View File

@ -1,4 +1,4 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Alternate implementation of PRIMITIVES module.
@ -102,17 +102,13 @@
(define (unimplemented name)
(lambda args (underlying-error "unimplemented primitive" name args)))
(define collect (unimplemented 'collect))
(define call-external-value (unimplemented 'call-external-value))
(define lookup-shared-binding (unimplemented 'lookup-shared-binding))
(define define-shared-binding (unimplemented 'define-shared-binding))
(define undefine-shared-binding (unimplemented 'undefine-shared-binding))
(define (shared-binding? x) #f)
(define make-shared-binding (unimplemented 'make-shared-binding))
(define shared-binding-name (unimplemented 'shared-binding-name))
(define shared-binding-is-import? (unimplemented 'shared-binding-is-import?))
(define shared-binding-ref (unimplemented 'shared-binding-ref))
(define shared-binding-set! (unimplemented 'shared-binding-set!))
(define external-call (unimplemented 'external-call))
(define external-lookup (unimplemented 'external-lookup))
(define external-name (unimplemented 'external-name))
(define external-value (unimplemented 'external-value))
(define (external? x) #f)
(define find-all (unimplemented 'find-all))
(define make-external (unimplemented 'make-external))
(define vm-extension (unimplemented 'vm-extension))
(define (memory-status which arg)
@ -175,7 +171,7 @@
(underlying-error "vm-return" rest)))
(define (?start entry-point arg) ;E.g. (?start (usual-resumer bare #t) 0)
(define (?start entry-point arg) ;E.g. (?start (usual-resumer bare) 0)
(clear-registers!)
(call-with-current-continuation
(lambda (k)

13
scheme/alt/schemetoc-define-syntax.scm
View File

@ -1,13 +0,0 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
(define-macro define-syntax
(lambda (form expander)
(expander `(define-macro ,(cadr form)
(let ((transformer ,(caddr form)))
(lambda (form expander)
(expander (transformer form
(lambda (x) x)
eq?)
expander))))
expander)))

16
scheme/alt/syntax.scm
View File

@ -1,4 +1,18 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; This definition of define-syntax is appropriate for Scheme-to-C.
(define-macro define-syntax
(lambda (form expander)
(expander `(define-macro ,(cadr form)
(let ((transformer ,(caddr form)))
(lambda (form expander)
(expander (transformer form
(lambda (x) x)
eq?)
expander))))
expander)))
; Rewrite-rule compiler (a.k.a. "extend-syntax")

18
scheme/bcomp/comp-prim.scm
View File

@ -74,9 +74,9 @@
(exact?
,(proc (number-type) boolean-type))
(exact->inexact
,(proc (number-type) inexact-type))
,(proc (exact-type) inexact-type))
(inexact->exact
,(proc (number-type) exact-type))
,(proc (inexact-type) exact-type))
((exp log sin cos tan asin acos sqrt)
,(proc (number-type) number-type))
((atan)
@ -223,6 +223,20 @@
(apply define-data-struct-primitives stuff))
stob-data)
; For flat environments
(let ((:value (sexp->type ':value #t))
(:vector (sexp->type ':vector #t)))
(define-simple-primitive 'make-cell
(proc (:value) :vector)
(instruction (enum op make-stored-object) 1 (enum stob vector)))
(define-simple-primitive 'cell-ref
(proc (:vector) :value)
(instruction (enum op stored-object-ref) (enum stob vector) 0))
(define-simple-primitive 'cell-set!
(proc (:vector :value) unspecific-type)
(instruction (enum op stored-object-set!) (enum stob vector) 0)))
; Define primitives for vector-like stored objects.
(define (define-vector-primitives name element-type make length ref set!)

409
scheme/bcomp/interface.scm
View File

@ -1,19 +1,7 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Interfaces
;
; An interface has four fields:
; - A procedure for looking up names in the interface. The procedure
; returns a base name and a type. If the name is not exported the
; base name is #F.
; - A procedure for walking over the declarations in the interfaces.
; The name, base-name, and type of each exported name are passed
; to the action procedure.
; - A population containing the structures that export this interface and
; any compound or modified interfaces that build on it. This population
; is used for propogating changes when an interface or structure is
; redefined.
; - A name for debugging.
(define-record-type interface :interface
(really-make-interface ref walk clients name)
@ -24,8 +12,23 @@
(name interface-name set-interface-name!))
(define-record-discloser :interface
(lambda (int)
(list 'interface (interface-name int))))
(lambda (int) (list 'interface (interface-name int))))
(define (interface-ref int name)
((ref-method int) name))
(define (for-each-declaration proc int)
((walk-method int) proc))
(define (note-reference-to-interface! int thing)
(let ((pop (interface-clients int)))
(if pop
(add-to-population! thing pop)
;; If it's compound, we really ought to descend into its components
)))
; If name is #f, then the interface is anonymous, so we don't need to
; make a population.
(define (make-interface ref walk name)
(really-make-interface ref
@ -33,64 +36,16 @@
(make-population)
name))
; The generic lookup function, and a simplified version for use when the
; base name and type are not needed.
(define (interface-ref int name)
((ref-method int) name))
(define (interface-member? int name)
(mvlet (((base-name type)
(interface-ref int name)))
base-name))
; The generic walk function.
(define (for-each-declaration proc int)
((walk-method int) proc))
; Adding to the client population.
(define (note-reference-to-interface! int thing)
(let ((pop (interface-clients int)))
(if pop
(add-to-population! thing pop))))
; Adding a late name.
(define (note-interface-name! int name)
(if (and name (not (interface-name int)))
(set-interface-name! int name)))
;----------------
; Simple interfaces. ITEMS is a list of items of the form:
; - <name> ; use the default type
; - (<name> <type>) ; use <type>
; - ((<name> ...) <type>) ; use <type> for each <name>
;
; We make a table of the names and use it appropriately.
; Simple interfaces (export (name type) ...)
(define (make-simple-interface name items)
(let ((table (make-simple-interface-table items)))
(make-interface (lambda (name)
(let ((type (table-ref table name)))
(if type
(values name type)
(values #f #f))))
(lambda (proc)
(table-walk (lambda (name type)
(proc name name type))
table))
name)))
(define (make-simple-interface-table items)
(let ((table (make-symbol-table)))
(for-each (lambda (item)
(if (pair? item)
(let ((name (car item))
(type (cadr item)))
(if (or (null? name)
(pair? name))
(if (or (null? name) (pair? name))
;; Allow ((name1 name2 ...) type)
(for-each (lambda (name)
(table-set! table name type))
name)
@ -98,309 +53,35 @@
(table-set! table item undeclared-type)))
items)
(make-table-immutable! table)
table))
(really-make-simple-interface table name)))
;----------------
; Compound interfaces
;
; A compound interface is the union of a set of existing interfaces.
; To do lookups or walks we walk down the list of included interfaces.
(define (really-make-simple-interface table name)
(make-interface (lambda (name) (table-ref table name))
(lambda (proc) (table-walk proc table))
name))
; Compoune interfaces
(define (make-compound-interface name . ints)
(let ((int (make-interface (lambda (name)
(let loop ((ints ints))
(if (null? ints)
(values #f #f)
(mvlet (((new-name type)
(interface-ref (car ints) name)))
(if new-name
(values new-name type)
(loop (cdr ints)))))))
(lambda (proc)
(for-each (lambda (int)
(for-each-declaration proc int))
ints))
name)))
(let ((int
(make-interface (lambda (name)
(let loop ((ints ints))
(if (null? ints)
#f
(or (interface-ref (car ints) name)
(loop (cdr ints))))))
(lambda (proc)
(for-each (lambda (int)
(for-each-declaration proc int))
ints))
name)))
(for-each (lambda (i)
(note-reference-to-interface! i int))
ints)
int))
;----------------
; Modified interfaces.
;
; We return a new interface that is INTERFACE modified by COMMANDS. Commands
; are:
; (prefix <symbol>)
; Add <symbol> to the beginning of every name in INTERFACE.
; (expose <symbol> ...)
; Export only those names in INTERFACE that are listed.
; (hide <symbol> ...)
; Do not export any of the names listed.
; (alias (<old> <new>) ...)
; Make name <old> also visible as <new>.
; (rename (<old> <new>) ...)
; Make name <old> visible as <new> but not as <old>.
; The commands are interpreted last-to-first. Thus
; ((expose foo:bar) (prefix foo:))
; and
; ((prefix foo:) (expose bar))
; both make BAR visible as FOO:BAR but
; ((expose bar) (prefix foo:))
; does not allow any names to be seen.
(define (make-modified-interface interface commands)
(if (and (proper-list? commands)
(every okay-command? commands))
(mvlet (((alist hidden default)
(process-commands commands)))
(let ((lookup (make-lookup alist hidden default interface))
(walker (if default
(make-default-walker alist hidden default interface)
(make-alist-walker alist interface))))
(let ((int (make-interface lookup walker #f)))
(note-reference-to-interface! interface int)
int)))
(error "badly-formed structure modifiers" commands)))
; We process COMMANDS and compute three values:
; - an alist mapping visible names to their real names in the package
; - a list of names that are hidden (these may also appear in the alist;
; the hiding overrides the alist).
; - a default, which applies to all other names:
; = #f, there are no other visible names
; = #t, all other names are visible
; = <symbol>, names beginning with this prefix are visible
;
; We just loop over the commands, dispatching on the type of command.
(define (process-commands commands)
(let loop ((alist '())
(hidden '())
(default #t)
(commands (reverse commands)))
(if (null? commands)
(values (filter (lambda (pair)
(not (memq (car pair) hidden)))
alist)
hidden
default)
(mvlet (((alist hidden default)
(let ((proc (case (caar commands)
((prefix) process-prefix)
((expose) process-expose)
((hide) process-hide)
((alias) process-alias)
((rename) process-rename))))
(proc (cdar commands) alist hidden default))))
(loop alist hidden default (cdr commands))))))
; Checks that COMMAND is properly formed.
(define (okay-command? command)
(and (proper-list? command)
(pair? command)
(symbol? (car command))
(pair? (cdr command))
(let ((args (cdr command)))
(case (car command)
((prefix)
(and (symbol? (car args))
(null? (cdr args))))
((expose hide)
(every symbol? args))
((alias rename)
(every (lambda (spec)
(and (proper-list? spec)
(= 2 (length spec))
(symbol? (car spec))
(symbol? (cadr spec))))
args))
(else
#f)))))
; Checks that L is a proper list.
(define (proper-list? l)
(cond ((null? l)
#t)
((pair? l)
(proper-list? (cdr l)))
(else
#f)))
; We add the prefix to the names in ALIST and HIDDEN. If DEFAULT is already
; a prefix we add this one to it, otherwise the prefix is the new default.
(define (process-prefix args alist hidden default)
(let ((prefix (car args)))
(values (map (lambda (pair)
(cons (symbol-append prefix (car pair))
(cdr pair)))
alist)
(map (lambda (name)
(symbol-append prefix name))
hidden)
(cond ((symbol? default)
(symbol-append default prefix))
((not default)
#f)
(else
prefix)))))
; We make a new ALIST with the exposed names and with package names are looked
; up in the current state. Then we start again with no hidden names and no
; default.
(define (process-expose args alist hidden default)
(values (let loop ((args args) (new-alist '()))
(if (null? args)
(reverse new-alist)
(let* ((name (car args))
(pname (interface-lookup name alist hidden default)))
(loop (cdr args)
(if pname
(cons (cons name pname)
new-alist)
new-alist)))))
'()
#f))
; Just add the names to the hidden list.
(define (process-hide args alist hidden default)
(values alist
(append args hidden)
default))
; Add the new aliases to ALIST.
(define (process-alias args alist hidden default)
(values (append (map (lambda (spec)
(cons (cadr spec)
(car spec)))
args)
alist)
hidden
default))
; Add the new aliases to ALIST and add the old names to HIDDEN.
(define (process-rename args alist hidden default)
(values (append (map (lambda (spec)
(cons (cadr spec)
(car spec)))
args)
alist)
(append (map car args) hidden)
default))
;----------------
; Look up a name, returning the name by which it is known in the base structure.
; - If it is in HIDDEN then it is not exported.
; - If there is an alias, then return the alias.
; - If there is no default the name is not exported.
; - A default of #T means every name is passed through.
; - Otherwise, check that NAME begins with the default and return the
; suffix after the default.
(define (interface-lookup name alist hidden default)
(cond ((memq name hidden)
#f)
((assq name alist)
=> cdr)
((not default)
#f)
((eq? default #t)
name)
((prefix-match? (symbol->string name)
(symbol->string default))
(remove-prefix (symbol->string name)
(symbol->string default)))
(else
#f)))
; Curried version of MAKE-LOOKUP for making the INTERFACE-REF method for
; modified structures.
(define (make-lookup alist hidden default interface)
(lambda (name)
(let ((alias (interface-lookup name alist hidden default)))
(if alias
(interface-ref interface alias)
(values #f #f)))))
; True if NAME begins with PREFIX (and is not just PREFIX).
(define (prefix-match? name prefix)
(and (< (string-length prefix)
(string-length name))
(let loop ((i 0))
(cond ((= i (string-length prefix))
#t)
((char=? (string-ref name i)
(string-ref prefix i))
(loop (+ i 1)))
(else
#f)))))
; Return the portion of NAME that follows PREFIX.
(define (remove-prefix name prefix)
(string->symbol (substring name
(string-length prefix)
(string-length name))))
;----------------
; Return a procedure for walking over the declarations in a modified interface.
; There are two versions, depending on whether names are passed on by default.
; If there is a default we need to walk over the declarations in the base
; interface and pass on the ones that are not hidden.
(define (make-default-walker alist hidden default interface)
(lambda (proc)
(for-each-declaration
(lambda (name base-name type)
(if (not (memq name hidden))
(proc (cond ((cdr-assq name alist)
=> car)
((symbol? default)
(symbol-append default name))
(else
name))
base-name
type)))
interface)))
; Same as ASSQ except we look for THING as the cdr instead of the car.
(define (cdr-assq thing alist)
(let loop ((alist alist))
(cond ((null? alist)
#f)
((eq? thing (cdar alist))
(car alist))
(else
(loop (cdr alist))))))
; With no default, all of the names are in the ALIST and we do not need to
; walk over the declarations in the base interface.
(define (make-alist-walker alist interface)
(lambda (proc)
(for-each (lambda (pair)
(mvlet (((base-name type)
(interface-ref interface (cdr pair))))
(if base-name
(proc (car pair)
base-name
type))))
alist)))
;----------------
; Random utility.
(define (symbol-append a b)
(string->symbol (string-append (symbol->string a)
(symbol->string b))))
(define (note-interface-name! int name)
(if (and name (not (interface-name int)))
(set-interface-name! int name)))

21
scheme/bcomp/module-language.scm
View File

@ -1,4 +1,4 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; The DEFINE-INTERFACE and DEFINE-STRUCTURE macros.
@ -50,6 +50,7 @@
((compound-interface ?int ...)
(make-compound-interface #f ?int ...))))
; <item> ::= <name> | (<name> <type>) | ((<name> ...) <type>)
(define-syntax export
@ -104,24 +105,6 @@
(let ((p (a-package #f ?clause ...)))
(values (make-structure p (lambda () ?int))
...)))))
(define-syntax modify
(syntax-rules ()
((modify ?struct ?command ...)
(make-modified-structure ?struct '(?command ...)))))
; Two handy shorthands for MODIFY.
(define-syntax subset
(syntax-rules ()
((restrict struct (name ...))
(modify struct (expose name ...)))))
(define-syntax with-prefix
(syntax-rules ()
((with-prefix struct the-prefix)
(modify struct (prefix the-prefix)))))
; Packages
(define-syntax a-package

30
scheme/bcomp/mtype.scm
View File

@ -1,4 +1,4 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Type lattice.
; Sorry this is so hairy, but before it was written, type checking
@ -619,8 +619,6 @@
(reduce join-type (car l) (cdr l))))
((mask->type)
(mask->type (cadr x)))
((variable)
(variable-type (sexp->type (cadr x) r?)))
(else (error "unrecognized type" x))))
(else (error "unrecognized type" x))))
@ -643,20 +641,18 @@
; Convert type to S-expression
(define (type->sexp t r?)
(if (variable-type? t)
`(variable ,(type->sexp (variable-value-type t) r?))
(if (> (bitwise-and (type-mask t) mask/&rest) 0)
(if (same-type? t any-values-type)
':values
`(some-values ,@(rail-type->sexp t r?)))
(let ((j (disjoin-type t)))
(cond ((null? j) ':error)
((null? (cdr j))
(atomic-type->sexp (car j) r?))
(else
`(join ,@(map (lambda (t)
(atomic-type->sexp t r?))
j))))))))
(if (> (bitwise-and (type-mask t) mask/&rest) 0)
(if (same-type? t any-values-type)
':values
`(some-values ,@(rail-type->sexp t r?)))
(let ((j (disjoin-type t)))
(cond ((null? j) ':error)
((null? (cdr j))
(atomic-type->sexp (car j) r?))
(else
`(join ,@(map (lambda (t)
(atomic-type->sexp t r?))
j)))))))
(define (atomic-type->sexp t r?)
(let ((m (type-mask t)))

56
scheme/bcomp/package-undef.scm
View File

@ -1,4 +1,4 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; The entry point for all this.
@ -41,7 +41,7 @@
((variable-type? want-type)
(get-location-for-unassignable cenv name))
(else
(warn "invalid variable reference" name cenv)
(warn "invalid variable reference" name)
(note-caching! cenv name place)
place)))
(get-location-for-undefined cenv name)))
@ -79,12 +79,12 @@
(if (not (table-ref (package-definitions package) name))
(let loop ((opens (package-opens package)))
(if (not (null? opens))
(if (interface-member? (structure-interface (car opens))
name)
(if (interface-ref (structure-interface (car opens))
name)
(begin (table-set! (package-cached package) name place)
(package-note-caching!
(structure-package (car opens))
name place))
(structure-package (car opens))
name place))
(loop (cdr opens))))))))
; Find the actual package providing PLACE and remember that it is being used.
@ -147,8 +147,8 @@
(let loop ((opens (package-opens package)))
(if (null? opens)
(get-undefined package name)
(if (interface-member? (structure-interface (car opens))
name)
(if (interface-ref (structure-interface (car opens))
name)
(location-for-reference (structure-package (car opens)) name)
(loop (cdr opens))))))
@ -190,28 +190,18 @@
(not (generic-lookup env name)))
names)))
(if (not (null? names))
(let ((names (map (lambda (name)
(if (generated? name)
(generated-name name)
name))
(reverse names))))
(apply warn
"undefined variables"
env
names)))))
; (let ((out (current-noise-port)))
; (newline out)
; (display "Undefined" out)
; (if (and current-package
; (not (eq? env current-package)))
; (begin (display " in " out)
; (write env out)))
; (display ": " out)
; (write (map (lambda (name)
; (if (generated? name)
; (generated-name name)
; name))
; (reverse names))
; out)
; (newline out)))))
(let ((out (current-noise-port)))
(newline out)
(display "Undefined" out)
(if (and current-package
(not (eq? env current-package)))
(begin (display " in " out)
(write env out)))
(display ": " out)
(write (map (lambda (name)
(if (generated? name)
(generated-name name)
name))
(reverse names))
out)
(newline out)))))

39
scheme/bcomp/package.scm
View File

@ -63,18 +63,6 @@
(add-to-population! struct (package-clients package))
struct))
; Make a structure by using COMMANDS to modify the STRUCTURE's interface.
(define (make-modified-structure structure commands)
(let ((new-struct (make-structure (structure-package structure)
(lambda ()
(make-modified-interface
(structure-interface structure)
commands)))))
(if (structure-unstable? structure)
(add-to-population! new-struct (structure-clients structure)))
new-struct))
; STRUCT has name NAME. NAME can then also be used to refer to STRUCT's
; package.
@ -83,7 +71,7 @@
(begin (set-structure-name! struct name)
(note-package-name! (structure-package struct) name))))
; A structure is unstable if its package is. An unstable package is one
; A structure is unstable if it's package is. An unstable package is one
; where new code may be added, possibly modifying the exported bindings.
(define (structure-unstable? struct)
@ -94,8 +82,8 @@
(define (for-each-export proc struct)
(let ((int (structure-interface struct)))
(for-each-declaration
(lambda (name base-name want-type)
(let ((binding (real-structure-lookup struct base-name want-type #t)))
(lambda (name want-type)
(let ((binding (real-structure-lookup struct name want-type #t)))
(proc name
(if (and (binding? binding)
(eq? want-type undeclared-type))
@ -268,7 +256,8 @@
; --------------------
; The definitions table
; Each entry in the package-definitions table is a binding.
; Each entry in the package-definitions table is a binding
; #(type place static).
(define (package-definition package name)
(initialize-package-if-necessary! package)
@ -310,7 +299,8 @@
; --------------------
; Lookup
; Look up a name in a package. Returns a binding if bound or #F if not.
; Look up a name in a package. Returns a binding if bound, or a name if
; not. In the unbound case we return #f.
(define (package-lookup package name)
(really-package-lookup package name (package-integrate? package)))
@ -338,13 +328,10 @@
(loop (cdr opens))))))
(define (structure-lookup struct name integrate?)
(call-with-values
(lambda ()
(interface-ref (structure-interface struct) name))
(lambda (base-name type)
(if type
(real-structure-lookup struct base-name type integrate?)
#f))))
(let ((type (interface-ref (structure-interface struct) name)))
(if type
(real-structure-lookup struct name type integrate?)
#f)))
(define (real-structure-lookup struct name type integrate?)
(impose-type type
@ -361,8 +348,8 @@
name
(package-integrate? (structure-package env)))
(call-error "not exported" generic-lookup env name)))
((procedure? env)
(lookup env name))
;((procedure? env)
; (lookup env name))
(else
(error "invalid environment" env name))))

25
scheme/bcomp/read-form.scm
View File

@ -12,23 +12,16 @@
(define (read-forms pathname package)
(let* ((filename (namestring pathname #f *scheme-file-type*))
(truename (translate filename))
(port (open-input-file truename)))
(dynamic-wind
(lambda ()
(if (not port)
(error "attempt to throw back into a file read"))) ; message needs work
(lambda ()
((fluid $note-file-package) filename package)
(let ((o-port (current-noise-port)))
(display truename o-port)
(force-output o-port)
(read-forms-from-port port)))
(lambda ()
(close-input-port port)
(set! port #f)))))
(truename (translate filename)))
(call-with-input-file truename
(lambda (port)
((fluid $note-file-package) filename package)
(let ((o-port (current-noise-port)))
(display truename o-port)
(force-output o-port)
(really-read-forms port))))))
(define (read-forms-from-port port)
(define (really-read-forms port)
(let loop ((forms '()))
(let ((form (read port)))
(if (eof-object? form)

74
scheme/big/either.scm
View File

@ -1,74 +0,0 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Nondeterminism, Prolog, or whatever you want to call it. This is
; depth-first search implemented using call/cc.
; The fluid variable $FAIL is bound to a thunk to be called in case of failure.
(define $fail
(make-fluid (make-cell
(lambda ()
(error "call to FAIL outside WITH-NONDETERMINISM")))))
(define (with-nondeterminism thunk)
(let-fluid $fail
(make-cell (lambda ()
(error "nondeterminism ran out of choices")))
thunk))
; Call the current failure function.
(define (fail)
((fluid-cell-ref $fail)))
; For the alternation operator, Icon's a | b or McCarthy's (amb a b),
; we write (either a b).
(define-syntax either
(syntax-rules ()
((either) (fail))
((either x) x)
((either x y ...)
(%either (lambda () x) (lambda () (either y ...))))))
; 1. Save the current failure procedure and continuation.
; 2. Install a new failure procedure that restores the old failure procedure
; and continuation and then calls THUNK2.
; 3. Call THUNK1.
(define (%either thunk1 thunk2)
(let ((save (fluid-cell-ref $fail)))
((call-with-current-continuation
(lambda (k)
(fluid-cell-set! $fail
(lambda ()
(fluid-cell-set! $fail save)
(k thunk2)))
thunk1)))))
; (one-value x) is Prolog's CUT operator. X is allowed to return only once.
(define-syntax one-value
(syntax-rules ()
((one-value x) (%one-value (lambda () x)))))
(define (%one-value thunk)
(let ((save (fluid-cell-ref $fail)))
(call-with-values thunk
(lambda args
(fluid-cell-set! $fail save)
(apply values args)))))
; (all-values a) returns a list of all the possible values of the
; expression a. Prolog calls this "bagof"; I forget what Icon calls it.
(define-syntax all-values
(syntax-rules ()
((all-values x) (%all-values (lambda () x)))))
(define (%all-values thunk)
(let ((results '()))
(either (let ((new-result (thunk)))
(set! results (cons new-result results))
(fail))
(reverse results))))

5
scheme/big/external.scm
View File

@ -98,11 +98,6 @@
losers)
#f))))))
; Re-lookup one external.
(define (lookup-external external)
(external-lookup (external-name external)
(external-value external)))
; Quietly look up all externals, returning #F if unsuccessful

2
scheme/big/more-port.scm
View File

@ -182,7 +182,7 @@
(lambda (ignore)
(list 'string-input-port))
(lambda (ignore)
(if #f #f))
(values))
(lambda (ignore buffer start needed)
(eof-object))
(lambda (port) #f)))

20
scheme/big/placeholder.scm
View File

@ -16,14 +16,17 @@
'()))))
(define (make-placeholder . id-option)
(really-make-placeholder (make-queue)
(really-make-placeholder (make-thread-queue)
(if (null? id-option) #f (car id-option))))
(define (placeholder-value placeholder)
(with-interrupts-inhibited
(lambda ()
(if (placeholder-queue placeholder)
(block-on-queue (placeholder-queue placeholder)))
(begin
(enqueue-thread! (placeholder-queue placeholder)
(current-thread))
(block)))
(placeholder-real-value placeholder))))
(define (placeholder-set! placeholder value)
@ -33,17 +36,14 @@
(cond (queue
(set-placeholder-value! placeholder value)
(set-placeholder-queue! placeholder #f)
(let loop ((waiters '()))
(cond
((maybe-dequeue-thread! queue)
=> (lambda (thread)
(loop (cons thread waiters))))
(else
waiters))))
(do ((waiters '() (cons (dequeue-thread! queue)
waiters)))
((thread-queue-empty? queue)
waiters)))
(else #f)))))))
(if waiters
(for-each make-ready waiters)
(if (not (eq? value (placeholder-value placeholder)))
(error "placeholder is already assigned"
placeholder
value)))))
value)))))

23
scheme/big/queue.scm
View File

@ -26,11 +26,9 @@
; The procedures for manipulating queues.
(define (queue-empty? q)
;; (debug-message "queue-empty?" (queue? q))
(null? (queue-head q)))
(define (enqueue! q v)
;; (debug-message "enqueue!" (queue? q))
(let ((p (cons v '())))
(if (null? (queue-head q)) ;(queue-empty? q)
(set-queue-head! q p)
@ -38,13 +36,11 @@
(set-queue-tail! q p)))
(define (queue-front q)
;; (debug-message "queue-front" (queue? q))
(if (queue-empty? q)
(error "queue is empty" q)
(car (queue-head q))))
(define (dequeue! q)
;; (debug-message "dequeue!" (queue? q))
(let ((pair (queue-head q)))
(cond ((null? pair) ;(queue-empty? q)
(error "empty queue" q))
@ -56,25 +52,7 @@
(set-queue-tail! q '())) ; don't retain pointers
value)))))
; Same again, except that we return #F if the queue is empty.
; This is a simple way of avoiding a race condition if the queue is known
; not to contain #F.
(define (maybe-dequeue! q)
;; (debug-message "maybe-dequeue!" (queue? q))
(let ((pair (queue-head q)))
(cond ((null? pair) ;(queue-empty? q)
#f)
(else
(let ((value (car pair))
(next (cdr pair)))
(set-queue-head! q next)
(if (null? next)
(set-queue-tail! q '())) ; don't retain pointers
value)))))
(define (on-queue? v q)
;; (debug-message "on-queue!" (queue? q))
(memq v (queue-head q)))
; This removes the first occurrence of V from Q.
@ -83,7 +61,6 @@
(delete-from-queue-if! q (lambda (x) (eq? x v))))
(define (delete-from-queue-if! q pred)
;; (debug-message "delete-from-queue-if!" (queue? q))
(let ((list (queue-head q)))
(cond ((null? list)
#f)

151
scheme/big/sort.scm Normal file
View File

@ -0,0 +1,151 @@
;;; Copyright (c) 1985 Yale University
;;; Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
;;; This material was developed by the T Project at the Yale
;;; University Computer Science Department. Permission to copy this
;;; software, to redistribute it, and to use it for any purpose is
;;; granted, subject to the following restric- tions and
;;; understandings.
;;; 1. Any copy made of this software must include this copyright
;;; notice in full.
;;; 2. Users of this software agree to make their best efforts (a) to return
;;; to the T Project at Yale any improvements or extensions that they make,
;;; so that these may be included in future releases; and (b) to inform
;;; the T Project of noteworthy uses of this software.
;;; 3. All materials developed as a consequence of the use of this software
;;; shall duly acknowledge such use, in accordance with the usual standards
;;; of acknowledging credit in academic research.
;;; 4. Yale has made no warrantee or representation that the operation of
;;; this software will be error-free, and Yale is under no obligation to
;;; provide any services, by way of maintenance, update, or otherwise.
;;; 5. In conjunction with products arising from the use of this material,
;;; there shall be no use of the name of the Yale University nor of any
;;; adaptation thereof in any advertising, promotional, or sales literature
;;; without prior written consent from Yale in each case.
;;;
;;; We gratefully acknowledge Bob Nix
;;; SORT:ONLINE-MERGE-SORT!
;;; =======================
;;; On-Line Merge sort, a fast and stable algorithm for sorting a list.
;;; This is a very neat algorithm! Consider the following code:
;;;
;;; (DEFINE (MERGE-SORT L)
;;; (IF (NULL? (CDR L))
;;; L
;;; (MERGE (MERGE-SORT (FIRST-HALF-OF L))
;;; (MERGE-SORT (SECOND-HALF-OF L)))))
;;;
;;; The nested calls to MERGE above form a binary tree, with MERGE's of
;;; singleton lists at the leaves, and a MERGE of two lists of size N/2 at
;;; the top. The algorithm below traverses this MERGE-tree in post-order,
;;; moving from the lower left hand corner to the right.
;;;
;;; This algorithm sorts N objects with about NlgN+2N comparisons and exactly
;;; lgN conses. The algorithm used is a version of mergesort that is
;;; amenable to Lisp's data accessing primitives. The first phase of the
;;; algorithm is an "addition" phase in which each element X is added to
;;; a list of lists of sorted runs B in much the same manner as a one is
;;; added to a binary number. If the first "digit" of B is 0, i.e. the first
;;; list in B is NIL, then the element to be added becomes the first digit
;;; of B. If that digit is non empty then you merge the digit with X and
;;; recurse on the rest of B -- setting the first digit of B to be zero.
;;; For example:
;;;
;;; Reversed LIST B
;;; Binary # Each sublist is sorted.
;;;
;;; 0000 ()
;;; 1000 ((x))
;;; 0100 (() (x x))
;;; 1100 ((x) (x x))
;;; 0010 (() () (x x x x))
;;; 1010 ((x) () (x x x x))
;;; 0110 (() (x x) (x x x x))
;;; 1110 ((x) (x x) (x x x x))
;;; 0001 (() () () (x x x x x x x x))
;;; 1001 ((x) () () (x x x x x x x x))
;;;
;;; The algorithm then merges the sublists of these lists into
;;; one list, and returns that list.
;;;
;;; To see the algorithm in action, trace LIST-MERGE!.
;;;
;;; Returns list L sorted using OBJ-< for comparisons.
(define (sort-list l obj-<)
(cond ((or (null? l)
(null? (cdr l)))
l)
(else
(online-merge-sort! (append l '()) ; copy-list
obj-<))))
;;; Returns list L sorted using OBJ-< for comparisons.
;;; L is destructively altered.
(define (sort-list! l obj-<)
(cond ((or (null? l)
(null? (cdr l)))
l)
(else
(online-merge-sort! l obj-<))))
;;; The real sort procedure. Elements of L are added to B, a list of sorted
;;; lists as defined above. When all elements of L have been added to B
;;; the sublists of B are merged together to get the desired sorted list.
(define (online-merge-sort! l obj-<)
(let ((b (cons '() '())))
(let loop ((l l))
(cond ((null? l)
(do ((c (cddr b) (cdr c))
(r (cadr b) (list-merge! (car c) r obj-<)))
((null? c)
r)))
(else
(let ((new-l (cdr l)))
(set-cdr! l '())
(add-to-sorted-lists l b obj-<)
(loop new-l)))))))
;;; X is a list that is merged into B, the list of sorted lists.
(define (add-to-sorted-lists x b obj-<)
(let loop ((x x) (b b))
(let ((l (cdr b)))
(cond ((null? l)
(set-cdr! b (cons x '())))
((null? (car l))
(set-car! l x))
(else
(let ((y (list-merge! x (car l) obj-<)))
(set-car! l '())
(loop y l)))))))
;;; Does a stable side-effecting merge of L1 and L2.
(define (list-merge! l1 l2 obj-<)
(cond ((null? l1) l2)
((null? l2) l1)
((obj-< (car l1) (car l2))
(real-list-merge! l2 (cdr l1) obj-< l1)
l1)
(else
(real-list-merge! l1 (cdr l2) obj-< l2)
l2)))
;;; Does the real work of LIST-MERGE!. L1 is assumed to be non-empty.
(define (real-list-merge! l1 l2 obj-< prev)
(let loop ((a l1) (b l2) (prev prev))
(cond ((null? b)
(set-cdr! prev a))
((obj-< (car a) (car b))
(set-cdr! prev a)
(loop b (cdr a) a))
(else
(set-cdr! prev b)
(loop a (cdr b) b)))))

2
scheme/big/thread-fluid.scm
View File

@ -69,5 +69,3 @@
(define (fork-thread thunk . rest)
(apply spawn (preserve-thread-fluids thunk) rest))
(define spoon fork-thread)

7
scheme/comp-packages.scm
View File

@ -178,11 +178,10 @@
; Reading the forms in a file.
; This is used by scan-package and rts/eval.scm.
(define-structure reading-forms (export read-forms read-forms-from-port $note-file-package)
(define-structure reading-forms (export read-forms $note-file-package)
(open scheme-level-2
fluids filenames
signals ;error
features ;current-noise-port force-output
features ;current-noise-port force-output
)
(files (bcomp read-form)))
@ -201,8 +200,6 @@
(define-structure interfaces interfaces-interface
(open scheme-level-2
define-record-types tables
util
signals
weak ; populations
meta-types)
(files (bcomp interface))

49
scheme/env/command-level.scm vendored
View File

@ -152,7 +152,7 @@
; lazily generated list of this level's threads
(define (make-command-level repl-thunk repl-data dynamic-env levels throw)
(let ((level (really-make-command-level (make-queue)
(let ((level (really-make-command-level (make-thread-queue)
(make-counter)
dynamic-env
levels
@ -172,7 +172,7 @@
(let ((thread (make-thread thunk (command-level-dynamic-env level) id)))
(set-thread-scheduler! thread (command-thread))
(set-thread-data! thread level)
(enqueue! (command-level-queue level) thread)
(enqueue-thread! (command-level-queue level) thread)
(increment-counter! (command-level-thread-counter level))
thread))
@ -294,7 +294,12 @@
(*out?* #f))
(for-each (lambda (thread)
(if (thread-continuation thread)
(terminate-level-thread thread level)))
(begin
(remove-thread-from-queues! thread)
(interrupt-thread thread
(lambda ignore
(terminate-current-thread)))
(enqueue-thread! queue thread))))
threads)
(dynamic-wind
(lambda ()
@ -308,16 +313,6 @@
(if (not (null? levels))
(reset-command-input! (car levels))))))))
; Put the thread on the runnable queue if it is not already there and then
; terminate it. Termination removes the thread from any blocking queues
; and interrupts with a throw that will run any pending dynamic-winds.
(define (terminate-level-thread thread level)
(let ((queue (command-level-queue level)))
(if (not (on-queue? thread queue))
(enqueue! queue thread))
(terminate-thread! thread)))
(define (reset-command-input! level)
(let ((repl (command-level-repl-thread level)))
(if repl
@ -360,11 +355,6 @@
((spawned)
(spawn-on-command-level level (car args) (cadr args))
#t)
((narrowed)
(handle-narrow-event command-quantum
(command-level-dynamic-env level)
args)
#t)
((runnable)
(let* ((thread (car args))
(level (thread-data thread)))
@ -372,7 +362,8 @@
(error "non-command-level thread restarted on a command level"
thread))
((memq level levels)
(enqueue! (command-level-queue level) thread))
(enqueue-thread! (command-level-queue level)
thread))
(else
(warn "dropping thread from exited command level"
thread)))
@ -451,7 +442,7 @@
(if repl-thread
(begin
(set-command-level-repl-thread! level #f)
(terminate-level-thread repl-thread level)))))
(kill-thread! repl-thread)))))
((eq? token repl-data-token)
(command-level-repl-data level))
((eq? token set-repl-data!-token)
@ -528,10 +519,14 @@
(define (kill-paused-thread! level)
(let ((paused (command-level-paused-thread level)))
(if paused
(begin
(if (eq? paused (command-level-repl-thread level))
(spawn-repl-thread! level))
(terminate-thread! paused) ; it's already running, so no enqueue
(set-command-level-paused-thread! level #f))
(warn "level has no paused thread" level))))
(if (not paused)
(error "level has no paused thread" level))
(if (eq? paused (command-level-repl-thread level))
(spawn-repl-thread! level))
(interrupt-thread paused terminate-current-thread)
; (lambda ignore
; (terminate-current-thread)))
;(enqueue-thread! (command-level-queue level) paused)
(set-command-level-paused-thread! level #f)))

8
scheme/env/debug.scm vendored
View File

@ -290,12 +290,12 @@ Kind should be one of: names maps files source tabulate"
(let ((after (memory-status memory-status-option/available #f)))
(display "Before: " port)
(write before port)
(display " words free in semispace" port)
(newline port)
(display " words free in semispace")
(newline)
(display "After: " port)
(write after port)
(display " words free in semispace" port)
(newline port))))
(display " words free in semispace")
(newline))))
(define memory-status-option/available (enum memory-status-option available))

14
scheme/env/disclosers.scm vendored
View File

@ -48,14 +48,12 @@
(define-method &disclose ((obj :code-vector))
; (list 'byte-vector (code-vector-length obj))
(let ((z (code-vector-length obj)))
(cons 'byte-vector
(cons (list 'length z)
(do ((i (min (- z 1) 15) (- i 1))
(l '() (cons (code-vector-ref obj i) l)))
((< i 0) (if (> z 16)
(append l (list '...))
l)))))))
(cons 'byte-vector
(let ((z (code-vector-length obj)))
(do ((i (- z 1) (- i 1))
(l '() (cons (code-vector-ref obj i) l)))
((< i 0) l))))
)
(define-method &disclose ((obj :channel))
(let ((status (channel-status obj)))

61
scheme/env/list-interface.scm vendored
View File

@ -1,63 +1,46 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; ,open interfaces packages meta-types sort syntactic
; ,config scheme
; Print out the names and types exported by THING, which is either a structure
; or an interface.
(define (list-interface thing)
(cond ((structure? thing)
(list-interface-1 (structure-interface thing)
(lambda (name type)
(lambda (name)
(let ((x (structure-lookup thing name #t)))
(if (binding? x)
(binding-type x)
#f)))))
((interface? thing)
(list-interface-1 thing
(lambda (name type)
type)))
(list-interface-1 thing (lambda (name)
(interface-ref thing name))))
(else '?)))
; LOOKUP is passed the package-name and the type from the interface and
; returns a (possibly different) type.
(define (list-interface-1 int lookup)
(let ((names '()))
(for-each-declaration (lambda (name package-name type)
(if (not (assq name names)) ;compound signatures...
(set! names
(cons (cons name
(lookup package-name type))
names))))
(let ((l '()))
(for-each-declaration (lambda (name type)
(if (not (memq name l)) ;compound signatures...
(set! l (cons name l))))
int)
(for-each (lambda (pair)
(let ((name (car pair))
(type (cdr pair)))
(write name)
(display (make-string
(max 0 (- 25 (string-length
(symbol->string name))))
#\space))
(write-char #\space)
(write (careful-type->sexp type)) ;( ...)
(newline)))
(sort-list names
(lambda (pair1 pair2)
(string<? (symbol->string (car pair1))
(symbol->string (car pair2))))))))
(for-each (lambda (name)
(write name)
(display (make-string
(max 0 (- 25 (string-length
(symbol->string name))))
#\space))
(write-char #\space)
(write (careful-type->sexp (lookup name))) ;( ...)
(newline))
(sort-list l (lambda (name1 name2)
(string<? (symbol->string name1)
(symbol->string name2)))))))
(define (careful-type->sexp thing)
(cond ((not thing) 'undefined)
((or (symbol? thing)
(null? thing)
(number? thing))
((or (symbol? thing) (null? thing) (number? thing))
thing) ;?
((pair? thing) ;e.g. (variable #{Type :value})
(cons (careful-type->sexp (car thing))
(careful-type->sexp (cdr thing))))
(else
(type->sexp thing #t))))
(else (type->sexp thing #t))))

79
scheme/env/pedit.scm vendored
View File

@ -1,4 +1,5 @@
; Copyright (c) 1993-2001 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Package / structure / interface mutation operations.
@ -78,23 +79,18 @@
(let recur ((q p))
(let loop ((opens (package-opens q)))
(if (not (null? opens))
(call-with-values
(lambda ()
(interface-ref (structure-interface (car opens))
name))
(lambda (base-name type)
(if base-name
;; Shadowing
(let* ((q (structure-package (car opens)))
(probe (table-ref (package-undefineds q)
base-name)))
(if probe
(begin (if *debug?*
(note "undefined -> shadowed"
name loc probe))
(cope-with-mutation p name loc probe))
(recur q)))
(loop (cdr opens)))))))))
(if (interface-ref (structure-interface (car opens)) name)
;; Shadowing
(let* ((q (structure-package (car opens)))
(probe (table-ref (package-undefineds q)
name)))
(if probe
(begin (if *debug?*
(note "undefined -> shadowed"
name loc probe))
(cope-with-mutation p name loc probe))
(recur q)))
(loop (cdr opens)))))))
loc))
; COPE-WITH-MUTATION:
@ -138,21 +134,16 @@
(list package)
(let ((losers '())) ; was (list package) but that disables the
; entire procedure
(let recur ((package-or-structure package))
(let ((package (if (package? package-or-structure)
package
(structure-package package-or-structure))))
(if (and (not (memq package losers))
(not (table-ref (package-definitions package) name)))
(begin (set! losers (cons package losers))
(walk-population
(lambda (struct)
(if (interface-member? (structure-interface struct)
name)
(walk-population recur
(structure-clients struct))))
(package-clients package))))))
losers)))
(let recur ((package package))
(if (and (not (memq package losers))
(not (table-ref (package-definitions package) name)))
(begin (set! losers (cons package losers))
(walk-population
(lambda (struct)
(if (interface-ref (structure-interface struct) name)
(walk-population recur (structure-clients struct))))
(package-clients package)))))
losers)))
(define (set-location-forward! loser new name p)
(if *debug?*
@ -192,18 +183,18 @@
(define (verify-loser loser)
(if *debug?*
(begin (write `(verify-loser ,loser)) (newline)))
(cond ((interface? loser)
(walk-population verify-loser (interface-clients loser)))
((structure? loser)
(cond ((structure? loser)
(reinitialize-structure! loser)
(walk-population verify-loser (structure-clients loser)))
((package? loser)
(reinitialize-package! loser)
(let ((losers (fluid $package-losers)))
(if (not (memq loser losers))
(set-fluid! $package-losers
(cons loser losers)))))))
(walk-population
(lambda (p)
(reinitialize-package! p)
(let ((ps (fluid $package-losers)))
(if (not (memq p ps))
(set-fluid! $package-losers
(cons p ps)))))
(structure-clients loser)))
((interface? loser)
(walk-population verify-loser (interface-clients loser)))))
(define (drain flu check)
(let loop ()

29
scheme/infix/packages.scm Normal file
View File

@ -0,0 +1,29 @@
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Infix stuff
(define-structure tokenizer (export make-tokenizer-table
set-up-usual-tokenization!
set-char-tokenization!
tokenize)
(open scheme records signals defpackage ascii)
(access primitives)
(files tokenize))
(define-structure pratt (export toplevel-parse
parse
make-operator
make-lexer-table set-char-tokenization!
lexer-ttab define-keyword define-punctuation
prsmatch comma-operator delim-error erb-error
if-operator
then-operator else-operator parse-prefix
parse-nary parse-infix
parse-matchfix end-of-input-operator
port->stream)
(open scheme records signals tokenizer tables)
(files pratt))
(define-structure sgol (export sgol-read sgol-repl)
(open scheme signals pratt)
(files sgol))

308
scheme/infix/pratt.scm Normal file
View File

@ -0,0 +1,308 @@
; -*- Mode: Scheme; -*-
;
; A simple Pratt-Parser for SIOD: 2-FEB-90, George Carrette, GJC@PARADIGM.COM
; Siod may be obtained by anonymous FTP to world.std.com:pub/gjc.
;
; * COPYRIGHT (c) 1988-1994 BY *
; * PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS. *
; * ALL RIGHTS RESERVED *
;
;Permission to use, copy, modify, distribute and sell this software
;and its documentation for any purpose and without fee is hereby
;granted, provided that the above copyright notice appear in all copies
;and that both that copyright notice and this permission notice appear
;in supporting documentation, and that the name of Paradigm Associates
;Inc not be used in advertising or publicity pertaining to distribution
;of the software without specific, written prior permission.
;
;PARADIGM DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
;ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
;PARADIGM BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
;ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
;WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
;ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
;SOFTWARE.
;
; Based on a theory of parsing presented in:
;
; Pratt, Vaughan R., ``Top Down Operator Precedence,''
; ACM Symposium on Principles of Programming Languages
; Boston, MA; October, 1973.
;
; The following terms may be useful in deciphering this code:
; NUD -- NUll left Denotation (op has nothing to its left (prefix))
; LED -- LEft Denotation (op has something to left (postfix or infix))
; LBP -- Left Binding Power (the stickiness to the left)
; RBP -- Right Binding Power (the stickiness to the right)
;
; Mods for Scheme 48 by J Rees 6-14-90
; From: <gjc@mitech.com>
;
; Now a neat thing that CGOL had was a way of packaging and scoping
; different parsing contexts. The maclisp implementation was simple,
; instead of just NUD and LED and other properties there was a list
; of property indicators. And a lookup operation.
;
; One use of the local-context thing, in parsing the C language
; you can use a different binding-power for ":" depending on
; what kind of statement you are parsing, a general statement
; context where ":" means a label, a "switch" or the "if for value
; " construct of (a > b) > c : d;
(define (peek-token stream)
(stream 'peek #f))
(define (read-token stream)
(stream 'get #f))
(define (toplevel-parse stream)
(if (eq? end-of-input-operator (peek-token stream))
(read-token stream)
(parse -1 stream)))
; A token is either an operator or atomic (number, identifier, etc.)
(define operator-type
(make-record-type 'operator
'(name lbp rbp nud led)))
(define make-operator
(let ()
(define make
(record-constructor operator-type '(name lbp rbp nud led)))
(define (make-operator name lbp rbp nud led)
(make name
(or lbp default-lbp)
(or rbp default-rbp)
(or nud default-nud)
(or led default-led)))
make-operator))
(define operator? (record-predicate operator-type))
(define operator-name (record-accessor operator-type 'name))
(define operator-nud (record-accessor operator-type 'nud))
(define operator-led (record-accessor operator-type 'led))
(define operator-lbp (record-accessor operator-type 'lbp))
(define operator-rbp (record-accessor operator-type 'rbp))
(define (default-nud operator stream)
(if (eq? (operator-led operator) default-led)
operator
(error 'not-a-prefix-operator operator)))
(define (nudcall token stream)
(if (operator? token)
((operator-nud token) token stream)
token))
(define default-led #f)
;+++ To do: fix this to make juxtaposition work (f x+y)
(define (ledcall token left stream)
((or (and (operator? token)
(operator-led token))
(error 'not-an-infix-operator token))
token
left
stream))
(define default-lbp 200)
(define (lbp token)
(if (operator? token)
(operator-lbp token)
default-lbp))
(define default-rbp 200)
(define (rbp token)
(if (operator? token)
(operator-rbp token)
default-rbp))
(define-record-discloser operator-type
(lambda (obj)
(list 'operator (operator-name obj))))
; Mumble
(define (delim-error token stream)
(error 'invalid-use-of-delimiter token))
(define (erb-error token left stream)
(error 'too-many-right-parentheses token))
(define (premterm-err token stream)
(error 'premature-termination-of-input token))
; Parse
(define *parse-debug* #f)
(define (parse rbp-level stream)
(if *parse-debug* (print `(parse ,rbp-level)))
(let parse-loop ((translation (nudcall (read-token stream) stream)))
(if (< rbp-level (lbp (peek-token stream)))
(parse-loop (ledcall (read-token stream) translation stream))
(begin (if *parse-debug* (print translation))
translation))))
(define (print s) (write s) (newline))
(define (parse-prefix operator stream)
(list (operator-name operator)
(parse (rbp operator) stream)))
(define (parse-infix operator left stream)
(list (operator-name operator)
left
(parse (rbp operator) stream)))
(define (parse-nary operator left stream)
(cons (operator-name operator) (cons left (prsnary operator stream))))
(define (prsnary operator stream)
(define (loop l)
(if (eq? operator (peek-token stream))
(begin (read-token stream)
(loop (cons (parse (rbp operator) stream) l)))
(reverse l)))
(loop (list (parse (rbp operator) stream))))
; Parenthesis matching, with internal commas.
; Kind of a kludge if you ask me.
(define (parse-matchfix operator stream) ; |x|
(cons (operator-name operator)
(prsmatch operator stream)))
(define (prsmatch close-op stream)
(if (eq? (peek-token stream) close-op)
(begin (read-token stream)
'())
(let loop ((l (list (parse 10 stream))))
(if (eq? (peek-token stream) close-op)
(begin (read-token stream)
(reverse l))
(if (eq? (peek-token stream) comma-operator)
(begin (read-token stream)
(loop (cons (parse 10 stream) l)))
(error 'comma-or-match-not-found (read-token stream)))))))
(define comma-operator (make-operator 'comma 10 #f delim-error #f))
; if A then B [else C]
(define (if-nud token stream)
(let* ((pred (parse (rbp token) stream))
(then (if (eq? (peek-token stream) then-operator)
(parse (rbp (read-token stream)) stream)
(error 'missing-then pred))))
(if (eq? (peek-token stream) else-operator)
`(if ,pred ,then ,(parse (rbp (read-token stream)) stream))
`(if ,pred ,then))))
(define if-operator (make-operator 'if #f 45 if-nud #f))
(define then-operator (make-operator 'then 5 25 delim-error #f))
(define else-operator (make-operator 'else 5 25 delim-error #f))
; Lexer support:
(define lexer-type
(make-record-type 'lexer '(ttab punctab keytab)))
(define lexer-ttab (record-accessor lexer-type 'ttab))
(define lexer-punctab (record-accessor lexer-type 'punctab))
(define lexer-keytab (record-accessor lexer-type 'keytab))
(define make-lexer-table
(let ((make (record-constructor lexer-type '(ttab punctab keytab))))
(lambda ()
(let ((ttab (make-tokenizer-table)))
(set-up-usual-tokenization! ttab)
(make ttab (make-table) (make-table))))))
(define (lex ltab port)
(let ((thing (tokenize (lexer-ttab ltab) port)))
(cond ((eof-object? thing)
end-of-input-operator)
((symbol? thing)
(or (table-ref (lexer-keytab ltab) thing)
thing))
(else thing))))
; Keywords
(define (define-keyword ltab name op)
(table-set! (lexer-keytab ltab) name op))
; Punctuation
; lexnode = (* operator (table-of char (+ lexnode #f))) -- discrimination tree
(define (define-punctuation ltab string op)
(let ((end (- (string-length string) 1)))
(let loop ((i 0)
(table (lexer-punctab ltab)))
(let* ((c (string-ref string i))
(lexnode
(or (table-ref table c)
(let ((lexnode
(cons (error-operator (substring string 0 (+ i 1)))
(make-table))))
(table-set! table c lexnode)
(if (= i 0)
(set-char-tokenization! (lexer-ttab ltab)
c
(operator-reader lexnode)
#t))
lexnode))))
(if (>= i end)
(set-car! lexnode op)
(loop (+ i 1) (cdr lexnode)))))))
(define (operator-reader lexnode)
(lambda (c port)
(let loop ((lexnode lexnode))
(let ((nextc (peek-char port)))
(let ((nextnode (table-ref (cdr lexnode) nextc)))
(if nextnode
(begin (read-char port)
(loop nextnode))
(car lexnode)))))))
(define (error-operator string)
(make-operator 'invalid-operator #f #f
(lambda rest (error "invalid operator" string))
#f))
; Mumble
(define end-of-input-operator
(make-operator "end of input" -1 #f premterm-err #f))
(define (port->stream port ltab)
(define (really-get)
(lex ltab port))
(define peeked? #f)
(define peek #f)
(define (stream op arg)
(case op
((get) (if peeked?
(begin (set! peeked? #f) peek)
(really-get)))
((peek) (if peeked?
peek
(begin (set! peeked? #t)
(set! peek (really-get))
peek)))))
stream)

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