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-2
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 516eede561 Synthetic commit for incomplete tag release-0-6-2 2002-05-10 08:18:09 +00:00
323 changed files with 36993 additions and 38072 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:

422
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)
@ -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,67 @@ 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 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/; \
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)/; \
do $(INSTALL_DATA) $$f $(htmldir)/; \
done && \
for f in $(srcdir)/doc/scsh-paper/*.tex \
$(srcdir)/doc/scsh-paper/*.sty \
$(srcdir)/doc/scsh-paper/*.dvi \
$(srcdir)/doc/scsh-paper/*.ps; \
do $(INSTALL_DATA) $$f $(DESTDIR)$(LIB)/doc/scsh-paper/; \
do $(INSTALL_DATA) $$f $(LIB)/doc/scsh-paper/; \
done && \
for f in $(srcdir)/doc/scsh-paper/html/*.html \
$(srcdir)/doc/scsh-paper/html/*.css; \
do $(INSTALL_DATA) $$f $(DESTDIR)$(LIB)/doc/scsh-paper/html; \
do $(INSTALL_DATA) $$f $(LIB)/doc/scsh-paper/html; \
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 +401,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; \
{ mkdir -p $(LIB)/$$dir && [ -w $(LIB)/$$dir ]; } || { \
echo "$(LIB)/$$dir not a writable directory" >&2; \
exit 1; \
}; \
done
@ -420,27 +424,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 +475,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,16 +487,12 @@ 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 \
@ -506,16 +506,14 @@ DISTFILES = README COPYING INSTALL RELEASE configure config.sub config.guess \
doc/scsh-paper/html/*.html doc/scsh-paper/html/*.css
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) && \
dist: build/initial.image
(cd doc/src && hyperlatex manual.tex) && \
(cd doc/scsh-manual && makeindex man && make man.ps && \
make man.pdf && make html) && \
(cd doc/scsh-paper && make scsh-paper.ps && make html) && \
distname=$(distname) && \
distfile=$(distdir)/$$distname.tar.gz && \
distfile=$(distdir)/$$distname.tgz && \
if [ -d $(distdir) ] && \
[ -w $$distfile -o -w $(distdir) ]; then \
rm -f $$distname && \
@ -532,8 +530,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 +607,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 +685,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 +723,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 +835,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 > $@

4
README
View File

@ -3,7 +3,7 @@
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.
@ -12,7 +12,7 @@ A scsh manual is in directory doc/scsh-manual/.
A scsh paper is in directory doc/scsh-paper/.
A scsh quick reference is in file doc/cheat.txt.
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.

269
RELEASE
View File

@ -1,10 +1,14 @@
Scsh 0.6.7 Release notes -*- outline -*-
Scsh 0.6.2 Release notes -*- outline -*-
We are pleased to release scsh version 0.6.2. This release
incorporates many SRFIs into scsh. The enhanced module language of the
recent Scheme 48 releases is now also part of scsh. In addition most
of the known bugs of the previous version have been fixed.
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.2. (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,11 +22,12 @@ 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
SRFIs
port->socket
New forms in the module language
API changes
PDF version of the manual
Bugfixes
New in 0.6.1
New in 0.6.0
Thanks
@ -80,7 +85,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
@ -103,9 +108,9 @@ Unix platforms. We currently have scsh implementations for:
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 +143,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,221 +170,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

7
Thanks
View File

@ -24,9 +24,4 @@ Post-0.5.2-release bug reports:
Alan Bawden
Bengt Kleberg
RT Happe
Dorai Sitaram
Peter Wang
Stephen Ma
stktrc
Jan Alleman
Taylor Campbell
Dorai Sitaram

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)

BIN
build/initial.image
View File

Binary file not shown.

2
build/minor-version-number
View File

@ -1 +1 @@
6.7
6.2

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;

31
c/main.c
View File

@ -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);
}

5
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)
@ -457,7 +460,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)))

991
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"

14124
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

25
doc/scsh-manual/Makefile
View File

@ -1,29 +1,30 @@
.SUFFIXES: .tex .dvi .ps .pdf $(.SUFFIXES)
.SUFFIXES: .idx .ind .tex .dvi .ps .pdf $(.SUFFIXES)
TEX= front.tex intro.tex procnotation.tex syscalls.tex network.tex \
strings.tex awk.tex miscprocs.tex running.tex
TEX2PAGE=tex2page
man.dvi: $(TEX)
man.pdf: $(TEX)
man.dvi: $(TEX) man.ind
man.ind: man.idx
man.pdf: $(TEX) man.ind
.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)
pdflatex $<
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 +32,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

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

@ -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.2}
\author{Olin Shivers, Brian D.~Carlstrom, Martin Gasbichler, and Mike Sperber}
\date{May 2006}
\date{May 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}}
}
}

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

@ -13,16 +13,18 @@
\input{pdfcond}
\ifpdf
\usepackage[pdftex,hyperindex,
pdftitle={scsh manual, release 0.6.7},
pdftitle={scsh manual, release 0.6.2},
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}
pdftitle={scsh manual, release 0.6.2},
pdfauthor={Olin Shivers, Brian D.~Carlstrom, Martin Gasbichler,
and Mike Sperber}
colorlinks=true,linkcolor=blue,pagecolor=blue,urlcolor=blue,
pdfstartview=FitH,pdfview=FitH]{hyperref}
\fi
\endtexonly

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"

38
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}
@ -137,11 +128,7 @@ is preferred to explicitly closing the inport and outport because using
\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
\var{protocol-family}. \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.
@ -235,20 +222,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 +279,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

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:

476
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
@ -2340,7 +2231,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 +2243,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 +2277,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 +2300,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 +2405,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 +2420,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 +2437,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 +2444,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 +2452,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 +2494,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 +2525,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 +2577,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 +2596,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 +2605,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

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.

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

17
doc/scsh-paper/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

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

@ -16,9 +16,6 @@
\let\PRIMsection\section
\let\subsectionORIG\subsection
\let\subsubsectionORIG\subsubsection
%\let\PRIMtableofcontents\tableofcontents
%\def\tableofcontents{\section*{Contents}\PRIMtableofcontents}
@ -53,43 +50,28 @@
\let\PRIMdocument\document
\def\document{\PRIMdocument
\def\headingquote##1##2{
\eject
\TIIPendgraf
\def\headingquote#1#2{\eject
\rawhtml<div align=right><table ><tr><td><em>
\endrawhtml
##1
#1
\rawhtml</em><br>\endrawhtml
~~~~~~---##2
\TIIPendgraf
~~~~~~---#2
\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\ttchars\relax
\let\ttt\tt
\def\cd##1{{\tt\def\\{\char`\\}\defcsactive\${\char`\$}%
\defcsactive\&{\char`\&}##1}}
\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}$}}
\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{{\it #1\/}\undefcsactive\$$_{#2}$}}
%\renewcommand{\proto}[3]{{\tt(#1 {\it #2})} \qquad (#3)}
\def\proto##1##2##3{{\tt(##1 {\it ##2})} \qquad (##3)}
\renewcommand{\proto}[3]{{\tt(#1 {\it #2})} \qquad (#3)}
\def\setupcode{\tt%
\def\\{\char`\\}%

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}

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!)))))

4
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)

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)))

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)

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)

5
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)))

44
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
@ -372,7 +367,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 +447,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 +524,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)))

47
scheme/env/pedit.scm vendored
View File

@ -138,21 +138,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-member? (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 +187,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)

11
scheme/infix/sgol-runtime.scm Normal file
View File

@ -0,0 +1,11 @@
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
(define (%unspecific)
(if #f #f))
(define (!= x y)
(not (= x y)))
(define (%tuple . rest)
(list->vector (cons 'tuple rest)))

213
scheme/infix/sgol.scm Normal file
View File

@ -0,0 +1,213 @@
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; Lexer for Infix Scheme (JAR's obscure syntax)
; Bears no relation to Pratt's CGOL
; To do: add ML-ish binding constructs.
; (sgol-read) reads an expression
;
; semicolon terminates input
; comment character is # (comment goes to end of line)
;
; f(x, y) reads as (f x y)
;
; if x then y else z reads as (if x y z)
; x and y, x or y, not x do the obvious thing
;
; x + y reads as (+ x y) - similarly for - * / = < > <= >=
;
; x::y reads as (cons x y) - ML's syntax
; x++y reads as (append x y) - whose syntax? Haskell's?
; [] reads as '()
; [a, b, ...] reads as (list a b ...)
;
; () reads as the-unit
; (x, y, ...) reads as (tuple x y ...)
;
; a[i] reads as (vector-ref a i)
; a[i, j, ...] reads as (array-ref a i j ...)
;
; x := y reads as (set! x y)
; car(x) := y reads as (set-car! x y) - similarly for cdr
; x[y] := z reads as (vector-set! x y z) - similarly for array-ref
;
; 'foo' tries to read as 'foo but usually loses
(define sgol-lexer-table (make-lexer-table))
(set-char-tokenization! (lexer-ttab sgol-lexer-table)
#\#
(lambda (c port)
c ;ignored
(gobble-line port)
(read port))
#t)
(define (gobble-line port)
(let loop ()
(let ((c (read-char port)))
(cond ((eof-object? c) c)
((char=? c #\newline) #f)
(else (loop))))))
;
(define (define-sgol-keyword name op)
(define-keyword sgol-lexer-table name op))
(define (define-sgol-punctuation string op)
(define-punctuation sgol-lexer-table string op))
; Arguments to make-operator are: name lbp rbp nud led
(define (open-paren-nud token stream)
(let ((right (prsmatch close-paren-operator stream)))
(if (null? right)
'the-unit ; ()
(if (null? (cdr right))
(car right) ; (x)
(cons 'tuple right))))) ; (x, y, ..., z)
; f(x, y) reads as (f x y)
; f((x, y)) reads as (f (tuple x y))
(define (open-paren-led token left stream)
(cons left (prsmatch close-paren-operator stream)))
(define-sgol-punctuation "("
(make-operator 'open-paren 200 #f open-paren-nud open-paren-led))
(define-sgol-punctuation "," comma-operator)
(define close-paren-operator
(make-operator 'close-paren 5 #f delim-error erb-error))
(define-sgol-punctuation ")" close-paren-operator)
; Boolean operators
(define-sgol-keyword 'true '#t)
(define-sgol-keyword 'false '#f)
(define-sgol-keyword 'if if-operator)
(define-sgol-keyword 'then then-operator)
(define-sgol-keyword 'else else-operator)
(define-sgol-keyword 'not (make-operator 'not 70 70 parse-prefix #f))
(define-sgol-keyword 'and (make-operator 'and 65 #f #f parse-nary))
(define-sgol-keyword 'or (make-operator 'or 60 #f #f parse-nary))
; Lists
(define (open-bracket-nud token stream)
(let ((elements (prsmatch close-bracket-operator stream)))
(if (null? elements)
`'()
`(list ,@elements))))
(define (open-bracket-led token left stream)
(let ((subscripts (prsmatch close-bracket-operator stream)))
(if (and (not (null? subscripts))
(null? (cdr subscripts)))
`(vector-ref ,left ,@subscripts)
`(array-ref ,left ,@subscripts))))
(define-sgol-punctuation "["
(make-operator 'open-bracket 200 #f open-bracket-nud open-bracket-led))
(define close-bracket-operator
(make-operator 'close-bracket 5 #f delim-error erb-error))
(define-sgol-punctuation "]" close-bracket-operator)
(define-sgol-punctuation "::"
(make-operator 'cons 75 74 #f parse-infix))
(define-sgol-punctuation "++"
(make-operator 'append 75 74 #f parse-nary))
; Quotation
(define-sgol-punctuation "'"
(make-operator 'quote 5 #f parse-matchfix #f)) ;This isn't right
; Arithmetic
(define-sgol-punctuation "+"
(make-operator '+ 100 100 parse-prefix parse-infix))
(define-sgol-punctuation "-"
(make-operator '- 100 100 parse-prefix parse-infix))
(define-sgol-punctuation "*"
(make-operator '* 120 120 #f parse-infix)) ;should be parse-nary
(define-sgol-punctuation "/"
(make-operator '/ 120 120 #f parse-infix))
(define-sgol-punctuation "="
(make-operator '= 80 80 #f parse-infix))
(define-sgol-punctuation ">"
(make-operator '> 80 80 #f parse-infix))
(define-sgol-punctuation "<"
(make-operator '< 80 80 #f parse-infix))
(define-sgol-punctuation ">="
(make-operator '>= 80 80 #f parse-infix))
(define-sgol-punctuation "<="
(make-operator '<= 80 80 #f parse-infix))
(define-sgol-punctuation "!="
(make-operator '!= 80 80 #f parse-infix))
; Side effects
(define (:=-led token left stream)
(let* ((form (parse-infix token left stream))
(lhs (cadr form))
(rhs (caddr form)))
(if (pair? lhs)
(case (car lhs)
((car) `(set-car! ,@(cdr lhs) ,rhs))
((cdr) `(set-cdr! ,@(cdr lhs) ,rhs))
((vector-ref) `(vector-set! ,@(cdr lhs) ,rhs))
((array-ref) `(array-set! ,@(cdr lhs) ,rhs))
(else (error "invalid LHS for :=" form)))
form)))
(define-sgol-punctuation ":="
(make-operator 'set! 70 #f #f :=-led))
; End of input...
(define-sgol-punctuation ";" end-of-input-operator)
; Read using Pratt parser with SGOL tokenizer table
(define (sgol-read . port-option)
(toplevel-parse (port->stream (if (null? port-option)
(current-input-port)
(car port-option))
sgol-lexer-table)))
; Read/print loop
(define (rpl)
(let ((thing (sgol-read)))
(if (not (eq? thing end-of-input-operator))
(begin (write thing)
(newline)
(rpl)))))
; Read/eval/print loop
(define (rpl)
(let ((thing (sgol-read)))
(if (not (eq? thing end-of-input-operator))
(begin (write thing)
(newline)
(rpl)))))

154
scheme/infix/tokenize.scm Normal file
View File

@ -0,0 +1,154 @@
; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; A tokenizer.
; Nonstandard things needed:
; record package
; char->ascii
; peek-char
; reverse-list->string
; error
(define (reverse-list->string l n)
(list->string (reverse l)))
; Tokenizer tables
(define tokenizer-table-type
(make-record-type 'tokenizer-table
'(translation dispatch-vector terminating?-vector)))
(define make-tokenizer-table
(let ()
(define make
(record-constructor tokenizer-table-type
'(translation dispatch-vector terminating?-vector)))
(define (make-tokenizer-table)
(make (if (char=? (string-ref (symbol->string 't) 0) #\T)
char-upcase
char-downcase)
(make-vector 256 (lambda (c port)
(error "illegal character read" c)))
(make-vector 256 #t)))
make-tokenizer-table))
(define ttab-translation
(record-accessor tokenizer-table-type 'translation))
(define ttab-dispatch-vector
(record-accessor tokenizer-table-type 'dispatch-vector))
(define ttab-terminating?-vector
(record-accessor tokenizer-table-type 'terminating?-vector))
(define set-tokenizer-table-translator!
(record-modifier tokenizer-table-type 'translation))
(define (set-char-tokenization! ttab char reader term?)
(vector-set! (ttab-dispatch-vector ttab) (char->ascii char) reader)
(vector-set! (ttab-terminating?-vector ttab) (char->ascii char) term?))
; Main dispatch
(define (tokenize ttab port)
(let ((c (read-char port)))
(if (eof-object? c)
c
((vector-ref (ttab-dispatch-vector ttab) (char->ascii c))
c port))))
; Atoms (symbols and numbers)
(define (scan-atom c ttab port)
(let ((translate (ttab-translation ttab)))
(let loop ((l (list (translate c))) (n 1))
(let ((c (peek-char port)))
(cond ((or (eof-object? c)
(vector-ref (ttab-terminating?-vector ttab)
(char->ascii c)))
(reverse-list->string l n))
(else
(loop (cons (translate (read-char port)) l)
(+ n 1))))))))
; Allow ->foo, -v-, etc.
(define (parse-atom string)
(let ((c (string-ref string 0)))
(cond ((char=? c #\+)
(parse-possible-number string))
((char=? c #\-)
(parse-possible-number string))
((char=? c #\.)
(parse-possible-number string))
(else
(if (char-numeric? c)
(parse-number string)
(string->symbol string))))))
; First char is + - .
(define (parse-possible-number string)
(if (and (> (string-length string) 1)
(char-numeric? (string-ref string 1)))
(parse-number string)
(string->symbol string)))
(define (parse-number string)
(or (string->number string 'e 'd)
(error "unsupported number syntax" string)))
; Usual stuff (what you'd expect to be common to Scheme and ML syntax)
(define (set-up-usual-tokenization! ttab)
(define (tokenize-whitespace c port) c ;ignored
(tokenize ttab port))
(define (tokenize-constituent c port)
(parse-atom (scan-atom c ttab port)))
(for-each (lambda (c)
(set-char-tokenization! ttab (ascii->char c)
tokenize-whitespace #t))
ascii-whitespaces)
(for-each (lambda (c)
(set-char-tokenization! ttab c tokenize-constituent #f))
(string->list
(string-append ".0123456789"
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"abcdefghijklmnopqrstuvwxyz")))
(set-char-tokenization! ttab #\" tokenize-string #t)
)
(define (make-constituent! c ttab)
(set-char-tokenization! ttab c
(lambda (c port)
(parse-atom (scan-atom c ttab port)))
#f))
(define (tokenize-string c port) c ;ignored
(let loop ((l '()) (i 0))
(let ((c (read-char port)))
(cond ((eof-object? c)
(error "end of file within a string"))
((char=? c #\\)
(let ((c (read-char port)))
(if (or (char=? c #\\) (char=? c #\"))
(loop (cons c l) (+ i 1))
(error "invalid escaped character in string" c))))
((char=? c #\") (reverse-list->string l i))
(else (loop (cons c l) (+ i 1)))))))
; Auxiliary for parse-atom and tokenize-string
;(define (reverse-list->string l n) ;In microcode?
; (let ((s (make-string n)))
; (do ((l l (cdr l))
; (i (- n 1) (- i 1)))
; ((< i 0) s)
; (string-set! s i (car l)))))

26
scheme/interfaces.scm
View File

@ -54,7 +54,6 @@
(define-interface primitives-interface
(export add-finalizer!
add-pending-channel
call-external-value
checked-record-ref
checked-record-set!
@ -141,9 +140,7 @@
byte-vector-length
byte-vector-ref
byte-vector-set!
make-byte-vector
byte-vector))
make-byte-vector))
; Same again, but with old names for compatibility.
@ -200,7 +197,6 @@
(export lock?
make-lock
obtain-lock
obtain-lock-multiple
maybe-obtain-lock
release-lock
lock-owner-uid)) ;really should be internal
@ -547,7 +543,6 @@
output-channel+closer->port ;big/socket.scm
; call WAIT-FOR-CHANNEL with interrupts disabled
wait-for-channels
wait-for-channel ;big/socket.scm
port->channel ;posix
@ -573,10 +568,12 @@
current-thread
enqueue-thread!
make-thread-queue
thread-queue-empty?
maybe-dequeue-thread!
block-on-queue
enqueue-thread!
multiple-enqueue-thread!
dequeue-thread!
remove-thread-from-queues!
event-pending?
get-next-event!
@ -588,16 +585,13 @@
block
make-ready
set-thread-cell! clear-thread-cell!
spawn-on-scheduler spawn-on-root
wait
upcall propogate-upcall
interrupt-thread
kill-thread!
terminate-thread!
wake-some-threads
register-dozer
all-threads ; for command-levels
@ -615,9 +609,8 @@
decrement-counter!))
(define-interface queues-interface
(export make-queue enqueue! dequeue! maybe-dequeue! queue-empty?
queue? queue->list queue-front queue-length
delete-from-queue! on-queue?))
(export make-queue enqueue! dequeue! queue-empty?
queue? queue->list queue-length delete-from-queue!))
(define-interface exceptions-interface
(export define-exception-handler
@ -655,7 +648,7 @@
(define-interface rts-sigevents-internal-interface
(export waiting-for-sigevent?
with-sigevents))
initialize-sigevents!))
(define-interface writing-interface
(export write
@ -1181,7 +1174,6 @@
(define-interface evaluation-interface
(export eval load load-into eval-from-file
load-port
; eval-scanned-forms
))

5
scheme/link/generate-c-header.scm
View File

@ -88,6 +88,9 @@
(let ((name (upcase (car imm))))
(c-define "S48_~A (S48_MISC_IMMEDIATE(~D))" name i)))
(newline)
(c-define "S48_ENTER_BOOLEAN(n) ((n) ? S48_TRUE : S48_FALSE)")
(c-define "S48_EXTRACT_BOOLEAN(x) ((x) != S48_FALSE)")
(newline)
(c-define "S48_UNSAFE_ENTER_CHAR(c) (S48_CHAR | ((c) << 8))")
(c-define "S48_UNSAFE_EXTRACT_CHAR(x) ((x) >> 8)")
(c-define "S48_CHAR_P(x) ((((long) (x)) & 0xff) == S48_CHAR)"))
@ -174,7 +177,7 @@
type index))
'("VECTOR" "RECORD")
'("(i)" "(i) + 1"))
(c-define "S48_RECORD_TYPE(x) (s48_stob_ref((x), S48_STOBTYPE_RECORD, 0))")
(c-define "S48_RECORD_TYPE(x) (s48_stob_ref((x), S48_STOBTYPE_RECORD))")
(c-define "S48_UNSAFE_RECORD_TYPE(x) (STOB_REF((x), 0))")
(for-each (lambda (type)
(c-define "S48_~A_LENGTH(x) (s48_stob_byte_length((x), S48_STOBTYPE_~A))"

4
scheme/misc/annotate.scm
View File

@ -7,7 +7,7 @@
(define annotate-procedure
(lap annotate-procedure ()
0 (protocol 2)
0 (check-nargs= 2)
2 (make-env 2)
4 (local0 2)
6 (stored-object-ref closure 0)
@ -24,7 +24,7 @@
(define procedure-annotation
(lap procedure-anotation ()
0 (protocol 1)
0 (check-nargs= 1)
2 (make-env 1)
4 (literal '2)
6 (push)

141
scheme/more-interfaces.scm
View File

@ -289,7 +289,6 @@
(export dynamic-load
get-external
lookup-external
lookup-all-externals
external?
@ -352,8 +351,7 @@
set-thread-fluid!
make-preserved-thread-fluid
preserve-thread-fluids
fork-thread
spoon))
fork-thread))
(define-interface search-trees-interface
(export make-search-tree
@ -418,8 +416,7 @@
; Olin's encyclopedic SRFIs.
(define-interface srfi-1-interface
(export map for-each member assoc ; redefined from R5RS
xcons make-list list-tabulate cons* list-copy
(export xcons make-list list-tabulate cons* list-copy
proper-list? circular-list? dotted-list? not-pair? null-list? list=
circular-list length+
iota
@ -482,7 +479,6 @@
string-concatenate
string-concatenate/shared
string-concatenate-reverse
string-concatenate-reverse/shared
string-append/shared
xsubstring string-xcopy!
string-null?
@ -535,136 +531,3 @@
))
(define-interface srfi-19-interface
(export;; Constants
time-duration
time-monotonic
time-process
time-tai
time-thread
time-utc
;; Current time and clock resolution
current-date
current-julian-day
current-modified-julian-day
current-time
time-resolution
;; Time object and accessors
make-time
time?
time-type
time-nanosecond
time-second
set-time-type!
set-time-nanosecond!
set-time-second!
copy-time
;; Time comparison procedures
time<=?
time<?
time=?
time>=?
time>?
;; Time arithmetic procedures
time-difference
time-difference!
add-duration
add-duration!
subtract-duration
subtract-duration!
;; Date object and accessors
make-date
date?
date-nanosecond
date-second
date-minute
date-hour
date-day
date-month
date-year
date-zone-offset
date-year-day
date-week-day
date-week-number
;; Time/Date/Julian Day/Modified Julian Day converters
date->julian-day
date->modified-julian-day
date->time-monotonic
date->time-tai
date->time-utc
julian-day->date
julian-day->time-monotonic
julian-day->time-tai
julian-day->time-utc
modified-julian-day->date
modified-julian-day->time-monotonic
modified-julian-day->time-tai
modified-julian-day->time-utc
time-monotonic->date
time-monotonic->time-tai
time-monotonic->time-tai!
time-monotonic->time-utc
time-monotonic->time-utc!
time-tai->date
time-tai->julian-day
time-tai->modified-julian-day
time-tai->time-monotonic
time-tai->time-monotonic!
time-tai->time-utc
time-tai->time-utc!
time-utc->date
time-utc->julian-day
time-utc->modified-julian-day
time-utc->time-monotonic
time-utc->time-monotonic!
time-utc->time-tai
time-utc->time-tai!
;; Date to string/string to date converters.
date->string
string->date))
(define-interface srfi-27-interface
(export random-integer
random-real
default-random-source
make-random-source
random-source?
random-source-state-ref
random-source-state-set!
random-source-randomize!
random-source-pseudo-randomize!
random-source-make-integers
random-source-make-reals))
(define-interface srfi-31-interface
(export (rec :syntax)))
(define-interface srfi-37-interface
(export
option
option?
option-names
option-required-arg?
option-optional-arg?
option-processor
args-fold))
(define-interface srfi-42-interface
(export ((do-ec
list-ec append-ec
string-ec string-append-ec
vector-ec vector-of-length-ec
sum-ec product-ec
min-ec max-ec
any?-ec every?-ec
first-ec last-ec
fold-ec fold3-ec) :syntax)
((:
:list :string :vector
:integers
:range :real-range :char-range
:port
:dispatched) :syntax)
((:do :let :parallel :while :until) :syntax)
:-dispatch-ref :-dispatch-set! make-initial-:-dispatch
(:generator-proc :syntax)))

180
scheme/more-packages.scm
View File

@ -63,7 +63,6 @@
session-data
define-record-types
threads threads-internal
queues
scheduler
interrupts
weak
@ -409,13 +408,12 @@
(define-structure placeholders placeholder-interface
(open scheme-level-1 define-record-types
threads threads-internal queues
threads threads-internal
interrupts
signals)
(files (big placeholder))
(optimize auto-integrate))
;----------------
; Big Scheme
@ -424,6 +422,10 @@
signals) ;call-error
(files (big random)))
(define-structure sort (export sort-list sort-list!)
(open scheme-level-2)
(files (big sort)))
(define-structure pp (export p pretty-print define-indentation)
(open scheme-level-2
tables
@ -492,87 +494,6 @@
threads thread-cells fluids)
(files (big thread-fluid)))
;;; Package defs for the Scheme Underground sorting package,
;;; The general sort package:
(define-structure sorting sorting-interface
(open scheme
list-merge-sort
vector-heap-sort
vector-merge-sort
sorted
delete-neighbor-duplicates)
(files (sort sort))
(optimize auto-integrate))
(define-structure sorted sorted-interface
(open scheme
vector-utils)
(files (sort sortp))
(optimize auto-integrate))
(define-structure delete-neighbor-duplicates delete-neighbor-duplicates-interface
(open scheme
receiving
vector-utils)
(files (sort delndups))
(optimize auto-integrate))
(define-structure binary-searches binary-searches-interface
(open scheme
vector-utils)
(files (sort vbinsearch)))
(define-structure list-merge-sort list-merge-sort-interface
(open scheme
receiving
(subset signals (error)))
(files (sort lmsort))
(optimize auto-integrate))
(define-structure vector-merge-sort vector-merge-sort-interface
(open scheme
receiving
vector-utils
vector-insertion-sort-internal)
(files (sort vmsort))
(optimize auto-integrate))
(define-structure vector-heap-sort vector-heap-sort-interface
(open scheme
receiving
vector-utils)
(files (sort vhsort))
(optimize auto-integrate))
(define-structures ((vector-insertion-sort vector-insertion-sort-interface)
(vector-insertion-sort-internal
vector-insertion-sort-internal-interface))
(open scheme
vector-utils)
(files (sort visort))
(optimize auto-integrate))
(define-structure vector-utils (export vector-copy
vector-portion-copy
vector-portion-copy!
vector-start+end
vectors-start+end-2)
(open scheme)
(files (sort vector-util)))
;;; end Package defs for the Scheme Underground sorting package,
(define-structure sort (export sort-list sort-list!)
(open scheme-level-2
sorting)
(begin
(define (sort-list l obj-<)
(list-sort obj-< l))
(define (sort-list! l obj-<)
(list-sort! obj-< l))))
(define-structure big-util big-util-interface
(open scheme-level-2
formats
@ -773,7 +694,7 @@
; SRFI-4 - needs hacks to the reader
(define-structure srfi-5 (export (let :syntax))
(open (modify scheme-level-2 (rename (let standard-let))))
(open (modify scheme-level-2 (hide let)))
(files (srfi srfi-5)))
(define-structure srfi-6 (export open-input-string
@ -806,10 +727,7 @@
(begin
(define available-srfis
'(srfi-1 srfi-2 srfi-5 srfi-6 srfi-7 srfi-8 srfi-9
srfi-11 srfi-13 srfi-14 srfi-16 srfi-17 srfi-19 srfi-23
srfi-25 srfi-26 srfi-27 srfi-28
srfi-30 srfi-31 srfi-37
srfi-42))
srfi-11 srfi-13 srfi-14 srfi-16 srfi-17 srfi-23))
; Some SRFI's redefine Scheme variables.
(define shadowed
@ -885,79 +803,14 @@
(files (srfi srfi-17)))
; SRFI-18 - no implementation given
(define (make-srfi-19 scheme-with-scsh)
(structure srfi-19-interface
(open scheme-with-scsh
(subset srfi-1 (reverse!))
srfi-6
srfi-8
srfi-9
srfi-23)
(files (srfi srfi-19))))
; SRFI-19 - implementation is specific to MzScheme
; SRFI-20 - withdrawn
; SRFI-21 - no implementation given
; SRFI-22 - no implementation given
; SRFI-22 - not final yet
(define-structure srfi-23 (export error)
(open (subset signals (error))))
; SRFI-24 - withdrawn
(define-structure srfi-25 (export
array? make-array shape array
array-rank
array-start array-end
array-ref array-set! share-array)
(open scheme
srfi-23
srfi-9)
(files (srfi srfi-25)))
(define-structure srfi-26 (export ((cut cute) :syntax))
(open scheme)
(files (srfi srfi-26)))
(define-structure srfi-27 srfi-27-interface
(open
scheme-level-1
floatnums
external-calls
(subset srfi-9 (define-record-type))
(subset srfi-23 (error)))
;; scsh doesn't have S48's posix subsystem yet:
; (subset posix-time (current-time))
; (subset posix (time-seconds)))
(files (srfi srfi-27)))
(define-structure srfi-28 (export format)
(open scheme
srfi-23
srfi-6)
(files (srfi srfi-28)))
; SRFI-29 - requires access to the current locale
; SRFI-30 - scheme/rts/read.scm contains the reader for #|...|# comments
(define-structure srfi-31 srfi-31-interface
(open scheme)
(files (srfi srfi-31)))
(define-structure srfi-37 srfi-37-interface
(open scheme
srfi-9
srfi-11)
(files (srfi srfi-37)))
; Eager Comprehensions
(define-structure srfi-42 srfi-42-interface
(open scheme
srfi-23)
(files (srfi srfi-42)))
; ... end of package definitions.
; Temporary compatibility stuff
@ -1020,17 +873,7 @@
search-trees
sicp
sockets
sort
delete-neighbor-duplicates
binary-searches
sorted
list-merge-sort
vector-merge-sort
vector-heap-sort
vector-insertion-sort
sorting
strong
thread-fluids
traverse
@ -1053,10 +896,7 @@
; SRFI packages
srfi-1 srfi-2 srfi-5 srfi-6 srfi-7 srfi-8 srfi-9
srfi-11 srfi-13 srfi-14 srfi-16 srfi-17
srfi-23 srfi-25 srfi-26 srfi-27 srfi-28
srfi-31 srfi-37
srfi-42
srfi-23
)
:structure)
make-srfi-19
((define-signature define-package) :syntax)))

2
scheme/opt/flatten.scm
View File

@ -9,7 +9,7 @@
(set-optimizer! 'flat-environments
(lambda (forms package)
(map (lambda (form)
(flatten-form (force-node form)))
(flatten-form (force form)))
forms)))
(define (flatten-form node)

4
scheme/opt/inline.scm
View File

@ -87,7 +87,9 @@
; I'm aware that this is pedantic.
(define (unused-name env name)
(let ((sym (name->symbol name)))
(let ((sym (if (generated? name)
(generated-name name)
name)))
(do ((i 0 (+ i 1))
(name sym
(string->symbol (string-append (symbol->string sym)

4
scheme/opt/usage.scm
View File

@ -189,10 +189,6 @@
free
usages)))
(define-usage-analyzer 'flat-lambda #f
(lambda (node free usages)
(error "Inliner applied on flat lambda, please swap OPTIMIZE clauses")))
;--------------------
; Usage records record the number of times that a variable is referenced, set!,
; and called.

16
scheme/rts-packages.scm
View File

@ -101,7 +101,7 @@
channels low-channels
architecture code-vectors wind
define-record-types
queues threads threads-internal locks cells
queues threads threads-internal locks
exceptions interrupts
ascii ports util
session-data
@ -224,9 +224,8 @@
(define-structures ((rts-sigevents rts-sigevents-interface)
(rts-sigevents-internal rts-sigevents-internal-interface))
(open scheme-level-1 define-record-types queues
(open scheme-level-1 define-record-types
threads threads-internal
wind
interrupts
architecture)
(files (rts sigevents))
@ -237,7 +236,7 @@
(define-structures ((threads threads-interface)
(threads-internal threads-internal-interface))
(open scheme-level-1 enumerated define-record-types queues cells
(open scheme-level-1 enumerated define-record-types queues
interrupts
wind
fluids
@ -259,7 +258,6 @@
(define-structure scheduler scheduler-interface
(open scheme-level-1 threads threads-internal locks
enumerated enum-case
queues
debug-messages
signals) ;error
(files (rts scheduler)))
@ -269,7 +267,6 @@
scheme-exit-now
call-when-deadlocked!)
(open scheme-level-1 threads threads-internal scheduler structure-refs
queues
session-data
signals ;error
handle ;with-handler
@ -303,8 +300,7 @@
(unspecific))))))
(define-structure queues queues-interface
(open scheme-level-1 define-record-types signals
debug-messages)
(open scheme-level-1 define-record-types signals)
(files (big queue))
(optimize auto-integrate))
@ -318,7 +314,7 @@
; (optimize auto-integrate))
(define-structure locks locks-interface
(open scheme-level-1 define-record-types queues interrupts threads threads-internal)
(open scheme-level-1 define-record-types interrupts threads threads-internal)
(optimize auto-integrate)
(files (rts lock)))
@ -330,7 +326,7 @@
fluids-internal ;initialize-dynamic-state!
exceptions ;initialize-exceptions!
interrupts ;initialize-interrupts!
rts-sigevents-internal ;with-sigevents
rts-sigevents-internal ;initialize-sigevents!
records-internal ;initialize-records!
export-the-record-type ;just what it says
threads-internal ;start threads

262
scheme/rts/channel-io.scm
View File

@ -2,58 +2,33 @@
; Channel interrupt stuff.
; Install an interrupt handler that cells up the results of completed I/O
; Install an interrupt handler that queues up the results of completed I/O
; operations and spawn a thread to cope with them. This is written so as
; to avoid having state in top-level variables, because their values are
; saved in dumped images.
(define (initialize-channel-i/o!)
(session-data-set! channel-wait-cells-slot '())
(session-data-set! channel-wait-queues-slot '())
(session-data-set! channel-wait-count-slot 0)
(set-interrupt-handler! (enum interrupt i/o-read-completion)
(make-i/o-completion-handler
(lambda (cell channel)
(let ((old (cell-ref cell)))
(cell-set! cell
(cons (cons channel (car old))
(cdr old)))))))
(set-interrupt-handler! (enum interrupt i/o-write-completion)
(make-i/o-completion-handler
(lambda (cell channel)
(let ((old (cell-ref cell)))
(cell-set! cell
(cons (car old)
(cons channel (cdr old)))))))))
(set-interrupt-handler! (enum interrupt i/o-completion)
i/o-completion-handler))
; The warning message is printed using DEBUG-MESSAGE because to try to make
; sure it appears in spite of whatever problem's the I/O system is having.
;
; Called with interrupts disabled.
(define (make-i/o-completion-handler update-ready-cell)
;; Called with interrupts disabled.
(lambda (channel status enabled-interrupts)
(call-with-values
(lambda () (fetch-channel-wait-cell! channel))
(lambda (thread-cell maybe-ready-cell)
(cond
((and thread-cell (cell-ref thread-cell))
=> (lambda (thread)
(decrement-channel-wait-count!)
(make-ready thread status)))
;; The problem with the debug message is that
;; WAIT-FOR-CHANNELS can trigger this warning in a perfectly
;; legimitate situation because of a race I don't know how to
;; avoid. --Mike
; (else
; (debug-message "Warning: dropping ignored channel i/o result {Channel "
; (channel-os-index channel)
; " "
; (channel-id channel)
; "}"))
)
(cond
((and maybe-ready-cell
(cell-ref maybe-ready-cell))
(update-ready-cell maybe-ready-cell channel)))))))
(define (i/o-completion-handler channel status enabled-interrupts)
(let ((queue (fetch-channel-wait-queue! channel)))
(if queue
(begin
(decrement-channel-wait-count!)
(make-ready (dequeue-thread! queue) status))
(debug-message "Warning: dropping ignored channel i/o result {Channel "
(channel-os-index channel)
" "
(channel-id channel)
"}"))))
; Exported procedure
@ -69,113 +44,46 @@
; terminated.
(define (wait-for-channel channel)
(call-with-values
(lambda () (fetch-channel-wait-cell! channel))
(lambda (thread-cell maybe-ready-cell)
(if (and thread-cell (cell-ref thread-cell))
(begin
(add-channel-wait-cell! channel thread-cell #f)
(warn "channel has two pending operations" channel)
(terminate-current-thread))
(let ((cell (make-cell (current-thread))))
(increment-channel-wait-count!)
(set-thread-cell! (current-thread) cell)
(add-channel-wait-cell! channel cell #f)
(dynamic-wind nothing
block
(lambda ()
(with-interrupts-inhibited
(lambda ()
(if (cell-ref cell)
;; we're being terminated
(begin
(fetch-channel-wait-cell! channel)
(channel-abort channel)
(wait-for-channel channel))))))))))))
(let ((queue (fetch-channel-wait-queue! channel)))
(if queue
(begin
(add-channel-wait-queue! channel queue)
(warn "channel has two pending operations" channel)
(terminate-current-thread))
(let ((queue (make-thread-queue)))
(increment-channel-wait-count!)
(enqueue-thread! queue (current-thread))
(add-channel-wait-queue! channel queue)
(dynamic-wind nothing
block
(lambda ()
(disable-interrupts!)
(let ((new-queue (fetch-channel-wait-queue! channel)))
(cond ((eq? queue new-queue)
(channel-abort channel)
(wait-for-channel channel))
(new-queue
(add-channel-wait-queue! channel new-queue)))
(enable-interrupts!))))))))
(define (nothing) #f)
(define (channel-check-waiter channel)
(if (channel-has-waiter? channel)
(begin
(warn "channel has two pending operations" channel)
(terminate-current-thread))))
(define (wait-for-channels read-channels write-channels timeout)
;; check if we're borked from the outset
(for-each channel-check-waiter read-channels)
(for-each channel-check-waiter write-channels)
(let ((thread-cell (make-cell (current-thread)))
(ready-channels-cell (make-cell (cons '() '())))
(ready-read-channels '())
(ready-write-channels '()))
(if (or (not timeout)
(register-dozer thread-cell timeout))
(begin
;; register us with every channel we're waiting for
(set-thread-cell! (current-thread) thread-cell)
(let ((signup (lambda (channel)
(add-channel-wait-cell! channel
thread-cell ready-channels-cell)
(increment-channel-wait-count!))))
(for-each signup read-channels)
(for-each signup write-channels))
;; block
(dynamic-wind
nothing
(lambda ()
(block)
(disable-interrupts!)
(let ((pair (cell-ref ready-channels-cell)))
(set! ready-read-channels (car pair))
(set! ready-write-channels (cdr pair)))
(cell-set! ready-channels-cell #f)
(enable-interrupts!)
(values ready-read-channels ready-write-channels))
;; clean up
(lambda ()
(let ((aborting? (and (cell-ref thread-cell) #t)))
(with-interrupts-inhibited
(lambda ()
;; this ain't so great ...
(let ((make-cleanup
(lambda (ready-channels)
(lambda (channel)
(if (not (memq channel ready-channels))
(begin
(fetch-channel-wait-cell! channel)
(if (not aborting?)
(decrement-channel-wait-count!)
(begin
(channel-abort channel)
(wait-for-channel channel)))))))))
(for-each (make-cleanup ready-read-channels) read-channels)
(for-each (make-cleanup ready-write-channels) write-channels))))))))
;; the timeout was zero or less
(enable-interrupts!))))
; Abort any pending operation on by OWNER on CHANNEL.
; Called with interrupts disabled.
(define (steal-channel! channel owner)
(call-with-values
(lambda () (fetch-channel-wait-cell! channel))
(lambda (thread-cell maybe-ready-cell)
(cond
((cell-ref thread-cell)
=> (lambda (thread)
(cond ((eq? thread owner)
(clear-thread-cell! thread)
(decrement-channel-wait-count!)
(channel-abort channel))
(else
(warn "channel in use by other than port owner"
channel thread owner)
#f))))
(else #f)))))
(let ((queue (fetch-channel-wait-queue! channel)))
(if queue
(let ((thread (dequeue-thread! queue)))
(cond ((eq? thread owner)
(decrement-channel-wait-count!)
(channel-abort channel))
(else
(warn "channel in use by other than port owner"
channel thread owner)
(enqueue-thread! queue thread)
#f)))
#f)))
; Have CHANNEL-READ and CHANNEL-WRITE wait if a pending-channel-i/o
; exception occurs.
@ -202,7 +110,7 @@
; Two session slots
; - the number of threads waiting for I/O completion events
; - an alist mapping channels to cells for waiting threads
; - an alist mapping channels to queues for waiting threads
(define channel-wait-count-slot (make-session-data-slot! 0))
@ -215,47 +123,39 @@
(define (decrement-channel-wait-count!)
(session-data-set! channel-wait-count-slot (- (channel-wait-count) 1)))
(define channel-wait-cells-slot (make-session-data-slot! '()))
(define channel-wait-queues-slot (make-session-data-slot! '()))
; Adding a cell and channel - the caller has already determined there is no
; existing cell for this channel.
; Adding a queue and channel - the caller has already determined there is no
; existing queue for this channel.
(define (add-channel-wait-cell! channel cell maybe-ready-channels-cell)
(session-data-set! channel-wait-cells-slot
(cons (cons channel (cons cell maybe-ready-channels-cell))
(session-data-ref channel-wait-cells-slot))))
(define (add-channel-wait-queue! channel queue)
(session-data-set! channel-wait-queues-slot
(cons (cons channel queue)
(session-data-ref channel-wait-queues-slot))))
; This is just deleting from an a-list.
(define (fetch-channel-wait-cell! channel)
(let* ((cells (session-data-ref channel-wait-cells-slot))
(cell+ready-channels-cell
(cond ((null? cells)
#f)
((eq? channel (caar cells))
(session-data-set! channel-wait-cells-slot
(cdr cells))
(cdar cells))
(else
(let loop ((cells (cdr cells)) (prev cells))
(cond ((null? cells)
#f)
((eq? channel (caar cells))
(set-cdr! prev (cdr cells))
(cdar cells))
(else
(loop (cdr cells) cells))))))))
(cond
(cell+ready-channels-cell
=> (lambda (pair)
(let ((thread-cell (car pair))
(ready-cell (cdr pair)))
(values thread-cell ready-cell))))
(else
(values #f #f)))))
(define (channel-has-waiter? channel)
(and (assq channel
(session-data-ref channel-wait-cells-slot))
#t))
(define (fetch-channel-wait-queue! channel)
(let* ((queues (session-data-ref channel-wait-queues-slot))
(queue (cond ((null? queues)
#f)
((eq? channel (caar queues))
(session-data-set! channel-wait-queues-slot
(cdr queues))
(cdar queues))
(else
(let loop ((queues (cdr queues)) (prev queues))
(cond ((null? queues)
#f)
((eq? channel (caar queues))
(set-cdr! prev (cdr queues))
(cdar queues))
(else
(loop (cdr queues) queues))))))))
(if (or (not queue)
(thread-queue-empty? queue))
#f
queue)))

21
scheme/rts/eval.scm
View File

@ -29,13 +29,24 @@
(interaction-environment)
(car package-option))))
(really-load-into filename package #t)))
; JMG For scsh.
(define (load-into-port port p)
(error "JMG: load into port called. See rts/eval"))
; (compile-and-run-port port p
; (lambda (template)
; (invoke-template template p))
; (current-noise-port)
; #t)); JMG whatever #t means...
(define (load-port port . package-option)
(let ((package (if (null? package-option)
(interaction-environment)
(car package-option)))
(forms (read-forms-from-port port)))
(compile-and-run forms package #f #t)))
(error "JMG: load port called. See rts/eval "))
; (let ((p (if (null? package-option)
; (interaction-environment)
; (car package-option))))
; (noting-undefined-variables p
; (lambda ()
; (load-into-port port p)))))
;----------------

5
scheme/rts/init.scm
View File

@ -13,9 +13,7 @@
(initialize-rts in out error
(lambda ()
(initialize-records! records)
(with-sigevents
(lambda ()
(entry-point (vector->list resume-arg))))))))
(entry-point (vector->list resume-arg))))))
(define (initialize-rts in out error thunk)
(initialize-session-data!)
@ -32,6 +30,7 @@
(lambda ()
(with-threads
(lambda ()
(initialize-sigevents!)
(root-scheduler thunk
200 ; thread quantum, in msec
300)))))))))) ; port-flushing quantum

4
scheme/rts/jar-defrecord.scm
View File

@ -46,9 +46,9 @@
(%unspecific (r 'unspecific))
(name (cadr e))
(type (caddr e))
(args (map r (map car (cadddr e))))
(args (map car (cadddr e)))
(arg-types (map cadr (cadddr e)))
(fields (map r (caddr (cddr e)))))
(fields (caddr (cddr e))))
(define (mem? name list)
(cond ((null? list) #f)
((c name (car list)) #t)

39
scheme/rts/lock.scm
View File

@ -20,13 +20,15 @@
(define (make-lock)
(let ((uid *lock-uid*))
(set! *lock-uid* (+ uid 1))
(really-make-lock #f (make-queue) uid)))
(really-make-lock #f (make-thread-queue) uid)))
(define (obtain-lock lock)
(with-interrupts-inhibited
(lambda ()
(if (lock-owner-uid lock)
(block-on-queue (lock-queue lock))
(begin
(enqueue-thread! (lock-queue lock) (current-thread))
(block))
(set-lock-owner-uid! lock (thread-uid (current-thread)))))))
(define (maybe-obtain-lock lock)
@ -38,34 +40,17 @@
(set-lock-owner-uid! lock (thread-uid (current-thread)))
#t)))))
(define (obtain-lock-multiple . all-locks)
(with-interrupts-inhibited
(lambda ()
(let loop ((locks all-locks))
(cond
((null? locks)
(for-each (lambda (lock)
(enqueue-thread! (lock-queue lock) (current-thread)))
all-locks)
(block))
((lock-owner-uid (car locks))
(loop (cdr locks)))
(else
(set-lock-owner-uid! (car locks)
(thread-uid (current-thread)))))))))
; Returns #t if the lock has no new owner.
(define (release-lock lock)
(with-interrupts-inhibited
(lambda ()
(let ((queue (lock-queue lock)))
(cond
((maybe-dequeue-thread! queue)
=> (lambda (next)
(set-lock-owner-uid! lock (thread-uid next))
(make-ready next)
#f))
(else
(set-lock-owner-uid! lock #f)
#t))))))
(if (thread-queue-empty? queue)
(begin
(set-lock-owner-uid! lock #f)
#t)
(let ((next (dequeue-thread! queue)))
(set-lock-owner-uid! lock (thread-uid next))
(make-ready next)
#f))))))

14
scheme/rts/low.scm
View File

@ -187,20 +187,6 @@
(define (undefine-exported-binding name)
(undefine-shared-binding name #f))
; This really shouldn't be here, but I don't know where else to put it.
(define (byte-vector . l)
(let ((v (make-byte-vector (secret-length l 0) 0)))
(do ((i 0 (+ i 1))
(l l (cdr l)))
((eq? l '()) v)
(byte-vector-set! v i (car l)))))
(define (secret-length list length)
(if (eq? list '())
length
(secret-length (cdr list) (+ length 1))))
; Writing debugging messages.
(define (debug-message . stuff)

8
scheme/rts/numio.scm
View File

@ -121,14 +121,6 @@
#f) ;inexact
((char=? (string-ref string pos) #\#)
#f)
((and (= radix 10)
(case (char-downcase (string-ref string pos))
;; One day, we have to include #\s #\f #\d #\l.
;; We don't now because STRING->FLOAT actually does the
;; wrong thing for these currently, so we'd rather barf.
((#\e) #t)
(else #f)))
#f)
(else (loop (+ pos 1))))))))))))
(define-generic really-string->number &really-string->number)

101
scheme/rts/port.scm
View File

@ -181,13 +181,6 @@
((port-handler-close (port-handler port)) (port-data port))))))
(call-error "invalid argument" close-input-port port)))
;; Flushing the port may raise an error. If the port is marked closed
;; before, subsequent calls will never close the underlying channel.
;; This installs an error handler before calling REALLY-FORCE-OUTPUT,
;; the handler will try to close the port and raise the error
;; afterwards. The inner close has an additional error handler which
;; will invoke the original handler.
(define (close-output-port port)
(if (output-port? port)
(protect-port-op
@ -196,16 +189,7 @@
(if (open-output-port? port)
(begin
(make-output-port-closed! port)
(with-handler
(lambda (condition more)
(with-handler
(lambda (cond2 more2)
(more))
(lambda ()
((port-handler-close (port-handler port)) (port-data port))
(more))))
(lambda ()
(really-force-output port)))
(really-force-output port)
((port-handler-close (port-handler port)) (port-data port))))))
(call-error "invalid argument" close-output-port port)))
@ -565,43 +549,32 @@
; all non-empty buffers, because the system has nothing to do and is going
; to pause while waiting for external events.
(define (output-port-forcers use-flushed?-flags? . maybe-ignore-port-locks?)
(let ((ignore-port-locks? (if (null? maybe-ignore-port-locks?) #f #t)))
(let loop ((next (cdr *flush-these-ports*))
(last *flush-these-ports*)
(thunks '()))
(if (null? next)
thunks
(let ((port (weak-pointer-ref (car next))))
(cond ((or (not port) ; GCed or closed
(not (open-output-port? port))) ; so drop it from the list
(set-cdr! last (cdr next))
(loop (cdr next) last thunks))
(ignore-port-locks?
(cond ((and use-flushed?-flags? ; flushed recently
(port-flushed? port))
(set-port-flushed?! port #f)
(loop (cdr next) next thunks))
((< 0 (port-index port)) ; non-empty
(loop (cdr next) next
(cons (make-forcing-thunk port ignore-port-locks?)
thunks)))
(else (loop (cdr next) next thunks))))
((not (maybe-obtain-port-lock port)) ; locked
(loop (cdr next) next thunks))
((and use-flushed?-flags? ; flushed recently
(port-flushed? port))
(set-port-flushed?! port #f)
(release-port-lock port)
(loop (cdr next) next thunks))
((< 0 (port-index port)) ; non-empty
(release-port-lock port)
(loop (cdr next) next
(cons (make-forcing-thunk port ignore-port-locks?)
thunks)))
(else ; empty
(release-port-lock port)
(loop (cdr next) next thunks))))))))
(define (output-port-forcers use-flushed?-flags?)
(let loop ((next (cdr *flush-these-ports*))
(last *flush-these-ports*)
(thunks '()))
(if (null? next)
thunks
(let ((port (weak-pointer-ref (car next))))
(cond ((or (not port) ; GCed or closed
(not (open-output-port? port))) ; so drop it from the list
(set-cdr! last (cdr next))
(loop (cdr next) last thunks))
((not (maybe-obtain-port-lock port)) ; locked
(loop (cdr next) next thunks))
((and use-flushed?-flags? ; flushed recently
(port-flushed? port))
(set-port-flushed?! port #f)
(release-port-lock port)
(loop (cdr next) next thunks))
((< 0 (port-index port)) ; non-empty
(release-port-lock port)
(loop (cdr next) next
(cons (make-forcing-thunk port)
thunks)))
(else ; empty
(release-port-lock port)
(loop (cdr next) next thunks)))))))
; Returns a list of the current ports that are flushed whenever.
; This is used to flush channel ports before forking.
@ -628,20 +601,18 @@
; Write out PORT's buffer. If a problem occurs it is reported and PORT
; is closed.
(define (make-forcing-thunk port ignore-port-lock?)
(define (make-forcing-thunk port)
(lambda ()
(if (and (report-errors-as-warnings
(lambda ()
(cond ((maybe-obtain-port-lock port)
(with-handler
(lambda (condition punt)
(release-port-lock port)
(punt))
(lambda ()
(really-force-output port)
(release-port-lock port))))
(ignore-port-lock?
(really-force-output port))))
(if (maybe-obtain-port-lock port)
(with-handler
(lambda (condition punt)
(release-port-lock port)
(punt))
(lambda ()
(really-force-output port)
(release-port-lock port)))))
"error when flushing buffer; closing port"
port)
(open-output-port? port))

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