removed accidentally added files
This commit is contained in:
mainzelm
parent
dee3f345f5
commit
2d1dd3b4c1
906
Makefile
906
Makefile
|
|
@ -1,906 +0,0 @@
|
||||||
# Generated automatically from Makefile.in by configure.
|
|
||||||
# Scheme 48 Makefile
|
|
||||||
# Documentation in files INSTALL and doc/install.txt
|
|
||||||
|
|
||||||
SHELL = /bin/sh
|
|
||||||
|
|
||||||
### Filled in by `configure' ###
|
|
||||||
srcdir = .
|
|
||||||
CC = gcc
|
|
||||||
DEFS = -DHAVE_CONFIG_H
|
|
||||||
LIBS = -lm
|
|
||||||
CFLAGS = -O2
|
|
||||||
INSTALL = /usr/local/bin/install -c
|
|
||||||
INSTALL_PROGRAM = ${INSTALL}
|
|
||||||
INSTALL_DATA = ${INSTALL} -m 644
|
|
||||||
|
|
||||||
LDFLAGS = -g
|
|
||||||
LIBOBJS =
|
|
||||||
|
|
||||||
RM = rm -f
|
|
||||||
|
|
||||||
AR = ar cq
|
|
||||||
RANLIB = ranlib
|
|
||||||
|
|
||||||
prefix = /home/ai/marting/install06
|
|
||||||
exec_prefix = ${prefix}
|
|
||||||
### End of `configure' section###
|
|
||||||
|
|
||||||
bindir = $(exec_prefix)/bin
|
|
||||||
libdir = $(exec_prefix)/lib
|
|
||||||
incdir = $(exec_prefix)/include
|
|
||||||
manext = 1
|
|
||||||
mandir = $(prefix)/man/man$(manext)
|
|
||||||
|
|
||||||
# HP 9000 series, if you don't have gcc
|
|
||||||
# CC = cc
|
|
||||||
# CFLAGS = -Aa -O +Obb1800
|
|
||||||
# DEFS = -D_HPUX_SOURCE -Dhpux
|
|
||||||
|
|
||||||
# Ultrix
|
|
||||||
# LDFLAGS = -N
|
|
||||||
|
|
||||||
.c.o:
|
|
||||||
$(CC) -c $(CPPFLAGS) $(DEFS) -I$(srcdir)/c -I$(srcdir)/cig $(CFLAGS) -o $@ $<
|
|
||||||
|
|
||||||
# You might want to change RUNNABLE to "s48"
|
|
||||||
RUNNABLE = scsh06
|
|
||||||
MANPAGE = $(RUNNABLE).$(manext)
|
|
||||||
LIB = $(libdir)/$(RUNNABLE)
|
|
||||||
|
|
||||||
distdir = /tmp
|
|
||||||
|
|
||||||
# If make barfs on this include line, just comment it out. It's only
|
|
||||||
# really needed if you want to build the linker or rebuild initial.image.
|
|
||||||
include $(srcdir)/build/filenames.make
|
|
||||||
#
|
|
||||||
#NetBSD make wants to see this instead:
|
|
||||||
#.include "$(srcdir)/build/filenames.make"
|
|
||||||
|
|
||||||
|
|
||||||
# Static linker:
|
|
||||||
#
|
|
||||||
# You only need the linker if you're going to make changes to the
|
|
||||||
# things that go into the initial.image, which in general means the
|
|
||||||
# files in rts/. If you decide you need to use the linker, then you
|
|
||||||
# gots your choice; it can run in just about any version of Scheme 48
|
|
||||||
# or Pseudoscheme. (It has also been made to run in Scheme->C.) It
|
|
||||||
# doesn't matter a whole lot which Scheme you use as long as it's not
|
|
||||||
# broken or unavailable. The two best choices are:
|
|
||||||
# 1. As below: build the linker on the scheme48vm and scheme48.image
|
|
||||||
# that are in the current directory.
|
|
||||||
# 2. LINKER_VM = $(RUNNABLE) $(BIG_HEAP)
|
|
||||||
# LINKER_RUNNABLE = $(RUNNABLE)
|
|
||||||
# These settings requires you to already have a $(RUNNABLE)
|
|
||||||
# command. This is desirable if you are making changes to the
|
|
||||||
# system that might break scheme48vm and/or scheme48.image. But it
|
|
||||||
# requires you to have squirreled away a previous working version
|
|
||||||
# of scheme48.
|
|
||||||
|
|
||||||
BIG_HEAP = -h 5000000
|
|
||||||
# JMG: 1. is broken ...
|
|
||||||
# LINKER_VM = ./$(VM) $(BIG_HEAP)
|
|
||||||
# LINKER_RUNNABLE = $(LINKER_VM) -i $(IMAGE)
|
|
||||||
|
|
||||||
# JMG now according 2
|
|
||||||
LINKER_VM = /home/ai/marting/lib/scheme48/scheme48vm $(BIG_HEAP)
|
|
||||||
LINKER_RUNNABLE = s4853
|
|
||||||
|
|
||||||
LINKER_IMAGE = build/linker.image
|
|
||||||
LINKER = $(LINKER_VM) -i $(LINKER_IMAGE)
|
|
||||||
START_LINKER = echo ',batch' && echo ',bench on'
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# You shouldn't have to change anything below this point, except for possibly
|
|
||||||
# the external code rules.
|
|
||||||
|
|
||||||
# Targets:
|
|
||||||
|
|
||||||
IMAGE = scsh.image
|
|
||||||
INITIAL = build/initial.image
|
|
||||||
#JMG: renamed the vm
|
|
||||||
#JMG: we need cig at the moment
|
|
||||||
VM = scsh06vm
|
|
||||||
LIBCIG = cig/lib$(VM).a
|
|
||||||
CIG = cig/cig
|
|
||||||
CIGOBJS = cig/libcig.o cig/libcig1.o
|
|
||||||
|
|
||||||
#JMG: the scsh-lib
|
|
||||||
LIBSCSH = scsh/lib$(VM).a
|
|
||||||
SCSHVMHACKS = scsh/proc2.o
|
|
||||||
|
|
||||||
#JMG: and it's object files
|
|
||||||
#JMG left out: scsh/re.o scsh/re1.o scsh/regexp/regexp.o scsh/regexp/regsub.o
|
|
||||||
#
|
|
||||||
#
|
|
||||||
SCSHOBJS = \
|
|
||||||
scsh/dirstuff1.o \
|
|
||||||
scsh/fdports1.o \
|
|
||||||
scsh/flock.o scsh/flock1.o \
|
|
||||||
scsh/machine/stdio_dep.o \
|
|
||||||
scsh/machine/time_dep1.o \
|
|
||||||
scsh/machine/signals1.o \
|
|
||||||
scsh/machine/libansi.o \
|
|
||||||
scsh/network.o scsh/network1.o \
|
|
||||||
scsh/putenv.o \
|
|
||||||
scsh/rdelim.o \
|
|
||||||
scsh/rx/re-low.o scsh/rx/re1.o \
|
|
||||||
scsh/select.o scsh/select1.o \
|
|
||||||
scsh/sleep1.o \
|
|
||||||
scsh/syscalls.o scsh/syscalls1.o \
|
|
||||||
scsh/time.o scsh/time1.o \
|
|
||||||
scsh/tty.o scsh/tty1.o \
|
|
||||||
scsh/userinfo1.o \
|
|
||||||
scsh/sighandlers1.o scsh/sighandlers.o \
|
|
||||||
scsh/regexp/libregex.a
|
|
||||||
|
|
||||||
UNIX_OBJS = c/unix/misc.o c/unix/io.o c/unix/fd-io.o c/unix/event.o
|
|
||||||
|
|
||||||
#JMG: I omit process_args.o and SCSHVMHACKS no longer
|
|
||||||
S48OBJS = c/scheme48vm.o c/scheme48heap.o c/extension.o c/external.o
|
|
||||||
OBJS = scsh/process_args.o $(S48OBJS) $(CIGOBJS) $(SCSHOBJS) $(SCSHVMHACKS)
|
|
||||||
|
|
||||||
FAKEHS = c/fake/dlfcn.h c/fake/sigact.h c/fake/strerror.h \
|
|
||||||
c/fake/sys-select.h
|
|
||||||
|
|
||||||
# Sources:
|
|
||||||
|
|
||||||
CONFIG_FILES = scheme/interfaces.scm scheme/low-packages.scm \
|
|
||||||
scheme/rts-packages.scm scheme/comp-packages.scm
|
|
||||||
|
|
||||||
# Rules:
|
|
||||||
|
|
||||||
# The following is the first rule and therefore the "make" command's
|
|
||||||
# default target.
|
|
||||||
enough: $(VM) $(IMAGE) go $(LIBCIG) scsh $(LIBSCSH)
|
|
||||||
#JMG: no manpages at the moment $(MANPAGE)
|
|
||||||
#JMG no notify at the moment... .notify
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# External code to include in the VM
|
|
||||||
# After changing any of these you should delete `scheme48vm' and remake it.
|
|
||||||
|
|
||||||
CIGGED = flock network select syscalls tty time sighandlers re_low rdelim
|
|
||||||
#re
|
|
||||||
CIGGEDOBJ = $(patsubst %,scsh/%.o, $(CIGGED))
|
|
||||||
CIGGEDINIT = $(patsubst %,s48_init_%, $(CIGGED))
|
|
||||||
|
|
||||||
EXTERNAL_OBJECTS = $(SOCKET_OBJECTS) $(LOOKUP_OBJECTS)
|
|
||||||
EXTERNAL_FLAGS = $(SOCKET_FLAGS)
|
|
||||||
EXTERNAL_INITIALIZERS = $(SOCKET_INITIALIZERS) $(LOOKUP_INITIALIZERS) s48_init_cig \
|
|
||||||
$(CIGGEDINIT)
|
|
||||||
|
|
||||||
|
|
||||||
# Rules for any external code.
|
|
||||||
|
|
||||||
# Socket rules
|
|
||||||
|
|
||||||
c/unix/socket.o: c/scheme48.h c/fd-io.h c/event.h
|
|
||||||
|
|
||||||
SOCKET_OBJECTS = c/unix/socket.o
|
|
||||||
SOCKET_LD_FLAGS =
|
|
||||||
SOCKET_INITIALIZERS = s48_init_socket
|
|
||||||
|
|
||||||
# End of socket rules
|
|
||||||
|
|
||||||
# Lookup rules (this is just for compatibility with old code)
|
|
||||||
|
|
||||||
c/unix/dynamo.o: c/scheme48.h
|
|
||||||
|
|
||||||
LOOKUP_OBJECTS = c/unix/dynamo.o
|
|
||||||
LOOKUP_INITIALIZERS = s48_init_external_lookup
|
|
||||||
|
|
||||||
# End of lookup rules
|
|
||||||
# End of external rules
|
|
||||||
# --------------------
|
|
||||||
|
|
||||||
# The developers are curious to know. Don't be concerned if this fails.
|
|
||||||
.notify: build/minor-version-number
|
|
||||||
touch .notify
|
|
||||||
-echo Another 0.`cat $(srcdir)/build/minor-version-number` \
|
|
||||||
installation. \
|
|
||||||
| mail scheme-48-notifications@martigny.ai.mit.edu
|
|
||||||
|
|
||||||
JMG: scsh stuff
|
|
||||||
# This says how to process .scm files with cig to make .c stubs.
|
|
||||||
.SUFFIXES: .scm
|
|
||||||
.scm.c:
|
|
||||||
# $(srcdir)/cig/cigscript $*
|
|
||||||
$(srcdir)/$(VM) -o $(srcdir)/$(VM) -i $(CIG) < $< > $*.c
|
|
||||||
|
|
||||||
# These .h files mediate between the code exported from foo1.c
|
|
||||||
# and imported into foo.scm's stub foo.c.
|
|
||||||
|
|
||||||
scsh/dirstuff1.o: scsh/dirstuff1.h
|
|
||||||
scsh/rdelim.o: scsh/fdports1.h
|
|
||||||
scsh/userinfo1.o: scsh/userinfo1.h
|
|
||||||
|
|
||||||
scsh/fdports1.o scsh/fdports.o: scsh/fdports1.h
|
|
||||||
scsh/flock1.o scsh/flock.o: scsh/flock1.h
|
|
||||||
scsh/network1.o scsh/network.o: scsh/network1.h
|
|
||||||
#JMG exists no longer in 0.5.2scsh/re1.o scsh/re.o: scsh/re1.h
|
|
||||||
scsh/select1.o scsh/select.o: scsh/select1.h
|
|
||||||
scsh/syscalls1.o scsh/syscalls.o: scsh/syscalls1.h
|
|
||||||
scsh/time1.o scsh/time.o: scsh/time1.h
|
|
||||||
scsh/tty1.o scsh/tty.o: scsh/tty1.h
|
|
||||||
|
|
||||||
scsh/rx/re1.o scsh/rx/re-low.o: scsh/rx/re1.h
|
|
||||||
|
|
||||||
scsh/syscalls.o: scsh/syscalls1.h scsh/dirstuff1.h scsh/fdports1.h \
|
|
||||||
scsh/select1.h scsh/userinfo1.h
|
|
||||||
|
|
||||||
scsh/sighandlers1.o scsh/sighandlers.o: scsh/sighandlers1.h
|
|
||||||
|
|
||||||
# Not really, but making regexp/libregex.a makes the regexp/regex.h file that
|
|
||||||
# re-low.c actually does need.
|
|
||||||
scsh/rx/re-low.o: scsh/regexp/libregex.a
|
|
||||||
|
|
||||||
include $(srcdir)/scsh/machine/Makefile.inc
|
|
||||||
# Berkeley make wants to see this instead: (or use GNU make on BSD. -bri)
|
|
||||||
#.include "$(srcdir)/scsh/machine/Makefile.inc"
|
|
||||||
|
|
||||||
$(VM): c/main.o $(OBJS) $(UNIX_OBJS) $(LIBOBJS) $(EXTERNAL_OBJECTS)
|
|
||||||
rm -f /tmp/s48_external_$$$$.c && \
|
|
||||||
build/build-external-modules /tmp/s48_external_$$$$.c \
|
|
||||||
$(EXTERNAL_INITIALIZERS) && \
|
|
||||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ c/main.o $(OBJS) $(UNIX_OBJS) \
|
|
||||||
/tmp/s48_external_$$$$.c \
|
|
||||||
$(LIBOBJS) $(LIBS) \
|
|
||||||
$(EXTERNAL_OBJECTS) $(EXTERNAL_LD_FLAGS) && \
|
|
||||||
rm -f /tmp/s48_external_$$$$.c
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
#JMG: again cig and scsh-lib
|
|
||||||
$(LIBCIG): c/main.o $(OBJS)
|
|
||||||
# $(CC) -r -o $@ main.o $(OBJS)
|
|
||||||
$(RM) $@
|
|
||||||
$(AR) $@ c/main.o $(OBJS)
|
|
||||||
$(RANLIB) $@
|
|
||||||
|
|
||||||
$(LIBSCSH): c/smain.o $(OBJS)
|
|
||||||
$(RM) $@
|
|
||||||
$(AR) $@ c/smain.o $(OBJS)
|
|
||||||
$(RANLIB) $@
|
|
||||||
|
|
||||||
c/main.o: c/main.c c/scheme48vm.h c/scheme48heap.h
|
|
||||||
$(CC) -c $(CFLAGS) -o $@ \
|
|
||||||
-DDEFAULT_IMAGE_NAME=\"$(LIB)/$(IMAGE)\" \
|
|
||||||
$(CPPFLAGS) $(DEFS) c/main.c
|
|
||||||
|
|
||||||
c/scheme48vm.o: c/prescheme.h c/scheme48vm.h c/scheme48heap.h c/event.h \
|
|
||||||
c/io.h c/fd-io.h c/scheme48vm-prelude.h
|
|
||||||
c/scheme48heap.o: c/prescheme.h c/scheme48vm.h c/scheme48heap.h c/event.h \
|
|
||||||
c/io.h c/fd-io.h
|
|
||||||
c/extension.o: c/sysdep.h $(FAKEHS) c/scheme48.h c/scheme48vm.h
|
|
||||||
c/external.o: c/sysdep.h $(FAKEHS) c/scheme48.h
|
|
||||||
c/unix/event.o: c/sysdep.h $(FAKEHS) c/scheme48vm.h c/scheme48heap.h \
|
|
||||||
c/event.h c/fd-io.h
|
|
||||||
c/unix/fd-io.o: c/sysdep.h $(FAKEHS) c/scheme48vm.h c/scheme48heap.h \
|
|
||||||
c/event.h c/fd-io.h
|
|
||||||
c/unix/misc.o: c/sysdep.h $(FAKEHS)
|
|
||||||
c/unix/io.o: c/io.h
|
|
||||||
c/fake/libdl1.o: c/fake/dlfcn.h
|
|
||||||
c/fake/libdl2.o: c/fake/dlfcn.h
|
|
||||||
c/fake/strerror.o: c/fake/strerror.h
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# Make scheme48.image from initial.image and library .scm files.
|
|
||||||
#
|
|
||||||
# For bootstrap reasons, initial.image is *not* listed as a source,
|
|
||||||
# even though it really is.
|
|
||||||
|
|
||||||
$(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
|
|
||||||
# sh $(srcdir)/build/build-usual-image "$(srcdir)" "$(LIB)" "$(IMAGE)" \
|
|
||||||
# "$(VM)" "$(INITIAL)"
|
|
||||||
build/build-usual-image . "`pwd`/scheme" '$(IMAGE)' './$(VM)' \
|
|
||||||
'$(INITIAL)'
|
|
||||||
|
|
||||||
### Fake targets: all clean install man dist
|
|
||||||
|
|
||||||
install: enough dirs inst-script inst-vm inst-misc inst-man inst-inc install-cig \
|
|
||||||
inst-image
|
|
||||||
|
|
||||||
inst-vm:
|
|
||||||
$(INSTALL_PROGRAM) $(VM) $(LIB)
|
|
||||||
|
|
||||||
inst-image:
|
|
||||||
rm -f '/tmp/$(IMAGE)' && \
|
|
||||||
build/build-usual-image . '$(LIB)' '/tmp/$(IMAGE)' './$(VM)' \
|
|
||||||
'$(INITIAL)' && \
|
|
||||||
$(INSTALL_DATA) /tmp/$(IMAGE) $(LIB) && \
|
|
||||||
rm /tmp/$(IMAGE)
|
|
||||||
|
|
||||||
inst-man:
|
|
||||||
if [ -d $(mandir) -a -w $(mandir) ]; then \
|
|
||||||
sed 's=LBIN=$(bindir)=g' doc/scheme48.man | \
|
|
||||||
sed 's=LLIB=$(LIB)=g' | \
|
|
||||||
sed 's=LS48=$(RUNNABLE)=g' >$(MANPAGE) && \
|
|
||||||
$(INSTALL_DATA) $(MANPAGE) $(mandir) && \
|
|
||||||
rm $(MANPAGE); \
|
|
||||||
else \
|
|
||||||
echo "$(mandir) not writable dir, not installing man page" \
|
|
||||||
>&2; \
|
|
||||||
fi
|
|
||||||
|
|
||||||
inst-inc:
|
|
||||||
$(INSTALL_DATA) c/scheme48.h $(incdir)
|
|
||||||
|
|
||||||
install-cig: cig
|
|
||||||
$(INSTALL_PROGRAM) $(srcdir)/$(CIG) $(LIB)/cig
|
|
||||||
$(INSTALL_PROGRAM) $(srcdir)/$(CIG).image $(LIB)/cig
|
|
||||||
$(INSTALL_DATA) $(srcdir)/$(LIBCIG) $(LIB)/cig
|
|
||||||
$(INSTALL_DATA) $(srcdir)/cig/libcig.h $(LIB)/cig
|
|
||||||
|
|
||||||
inst-misc:
|
|
||||||
for stub in env big opt misc link; do \
|
|
||||||
for f in scheme/$$stub/*.scm; do \
|
|
||||||
$(INSTALL_DATA) $$f $(LIB)/$$stub || exit 1; \
|
|
||||||
done; \
|
|
||||||
done && \
|
|
||||||
for f in scheme/rts/*num.scm scheme/rts/jar-defrecord.scm; do \
|
|
||||||
$(INSTALL_DATA) $$f $(LIB)/rts || exit 1; \
|
|
||||||
done
|
|
||||||
|
|
||||||
inst-script:
|
|
||||||
script=$(bindir)/$(RUNNABLE) && \
|
|
||||||
echo '#!/bin/sh' >$$script && \
|
|
||||||
echo >>$$script && \
|
|
||||||
echo 'lib=$(LIB)' >>$$script && \
|
|
||||||
echo 'exec $$lib/$(VM) -o $$lib/$(VM) -i $$lib/$(IMAGE) "$$@"' \
|
|
||||||
>>$$script && \
|
|
||||||
chmod +x $$script
|
|
||||||
|
|
||||||
# Script to run scheme48 in this directory.
|
|
||||||
go:
|
|
||||||
echo '#!/bin/sh' >$@ && \
|
|
||||||
echo >>$@ && \
|
|
||||||
echo "lib=`pwd`" >>$@ && \
|
|
||||||
echo 'exec $$lib/$(VM) -o $$lib/$(VM) -i $$lib/$(IMAGE) "$$@"' \
|
|
||||||
>>$@ && \
|
|
||||||
chmod +x $@
|
|
||||||
|
|
||||||
dirs:
|
|
||||||
for dir in $(libdir) $(bindir) $(incdir); do \
|
|
||||||
[ -d $$dir -a -w $$dir ] || { \
|
|
||||||
echo "$$dir not a writable directory" >&2; \
|
|
||||||
exit 1; \
|
|
||||||
}; \
|
|
||||||
done
|
|
||||||
{ mkdir -p $(LIB) && [ -w $(LIB) ]; } || { \
|
|
||||||
echo "$(LIB) not a writable directory" >&2; \
|
|
||||||
exit 1; \
|
|
||||||
}
|
|
||||||
for dir in rts env big opt misc link; do \
|
|
||||||
{ mkdir -p $(LIB)/$$dir && [ -w $(LIB)/$$dir ]; } || { \
|
|
||||||
echo "$(LIB)/$$dir not a writable directory" >&2; \
|
|
||||||
exit 1; \
|
|
||||||
}; \
|
|
||||||
done
|
|
||||||
|
|
||||||
configure: configure.in
|
|
||||||
autoheader && autoconf
|
|
||||||
#JMG: clean cig and the scsh too
|
|
||||||
clean: clean-cig clean-scsh
|
|
||||||
-rm -f $(VM) *.o c/unix/*.o c/*.o c/fake/*.o \
|
|
||||||
TAGS $(IMAGE) \
|
|
||||||
build/*.tmp $(MANPAGE) build/linker.image \
|
|
||||||
scheme/debug/*.image scheme/debug/*.debug \
|
|
||||||
scheme/vm/scheme48vm.c scheme/vm/scheme48heap.c \
|
|
||||||
go $(distname)
|
|
||||||
clean-cig:
|
|
||||||
-rm -f cig/*.o $(CIG) $(CIG).image $(LIBCIG)
|
|
||||||
|
|
||||||
clean-scm2c:
|
|
||||||
rm -f scsh/flock.c scsh/network.c scsh/rdelim.c \
|
|
||||||
scsh/re.c scsh/select.c scsh/syscalls.c scsh/tty.c scsh/time.c
|
|
||||||
|
|
||||||
#JMG: moved config.cache to distclean
|
|
||||||
distclean: clean
|
|
||||||
rm -f Makefile config.log config.status c/sysdep.h config.cache
|
|
||||||
|
|
||||||
check: $(VM) $(IMAGE) scheme/debug/check.scm
|
|
||||||
( \
|
|
||||||
echo ',batch'; \
|
|
||||||
echo ',translate =scheme48 scheme'; \
|
|
||||||
echo ',config ,load scheme/debug/test.scm'; \
|
|
||||||
echo ',exec ,load scheme/debug/check.scm'; \
|
|
||||||
echo ',exec (done)' \
|
|
||||||
) | ./$(VM) -i $(IMAGE)
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# Rules from here on down are not essential for the basic installation
|
|
||||||
# procedure, and are not expected to work when srcdir is not the
|
|
||||||
# distribution directory.
|
|
||||||
|
|
||||||
all: vm linker
|
|
||||||
$(MAKE) image
|
|
||||||
vm: $(VM)
|
|
||||||
linker: $(LINKER_IMAGE)
|
|
||||||
image: $(INITIAL)
|
|
||||||
$(MAKE) $(IMAGE)
|
|
||||||
|
|
||||||
tags:
|
|
||||||
etags scsh/*.scm scsh/*.c \
|
|
||||||
scheme/vm/arch.scm scheme/rts/*.scm scheme/bcomp/*.scm \
|
|
||||||
scheme/*.scm scheme/env/*.scm scheme/big/*.scm scheme/link/*.scm \
|
|
||||||
scheme/opt/*.scm scheme/debug/*.scm scheme/misc/*.scm
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# Distribution...
|
|
||||||
|
|
||||||
# DISTFILES should include all sources.
|
|
||||||
DISTFILES = README COPYING INSTALL configure \
|
|
||||||
acconfig.h configure.in Makefile.in install-sh \
|
|
||||||
doc/*.ps doc/*.txt doc/html/*.html doc/scheme48.man \
|
|
||||||
doc/src/*.tex doc/src/*.sty \
|
|
||||||
emacs/README build/*-version-number build/*.exec \
|
|
||||||
build/*.lisp build/build-usual-image build/filenames.make \
|
|
||||||
build/filenames.scm build/initial.debug \
|
|
||||||
build/initial.image build/initial.scm \
|
|
||||||
build/build-external-modules \
|
|
||||||
c/*.[ch] c/*/*.[ch] c/scheme48.h.in \
|
|
||||||
emacs/*.el gdbinit \
|
|
||||||
scheme/*.scm scheme/*/*.scm \
|
|
||||||
ps-compiler \
|
|
||||||
c/sysdep.h.in
|
|
||||||
|
|
||||||
distname = $(RUNNABLE)-0.`cat build/minor-version-number`
|
|
||||||
|
|
||||||
dist: build/initial.image
|
|
||||||
distname=$(distname) && \
|
|
||||||
distfile=$(distdir)/$$distname.tgz && \
|
|
||||||
if [ -d $(distdir) ] && \
|
|
||||||
[ -w $$distfile -o -w $(distdir) ]; then \
|
|
||||||
rm -f $$distname && \
|
|
||||||
ln -s . $$distname && \
|
|
||||||
files='' && \
|
|
||||||
for i in $(DISTFILES); do \
|
|
||||||
if [ "$$i" != "c/sysdep.h" ]; then \
|
|
||||||
files="$$files $$distname/$$i"; \
|
|
||||||
fi \
|
|
||||||
done && \
|
|
||||||
tar -cf - $$files | \
|
|
||||||
gzip --best >$$distfile && \
|
|
||||||
rm $$distname; \
|
|
||||||
else \
|
|
||||||
echo "Can't write $$distfile" >&2; \
|
|
||||||
exit 1; \
|
|
||||||
fi
|
|
||||||
|
|
||||||
# Increment the minor version number
|
|
||||||
inc:
|
|
||||||
f=build/minor-version-number && \
|
|
||||||
expr `cat $$f` + 1 >$$f.tmp && \
|
|
||||||
mv $$f.tmp $$f && \
|
|
||||||
echo '(define version-info "0.'`cat $$f`'")' \
|
|
||||||
>scheme/env/version-info.scm
|
|
||||||
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# Generate build/filenames.make from *packages.scm
|
|
||||||
#
|
|
||||||
# This hack traces the module dependencies described in the
|
|
||||||
# various configuration files and converts them into dependency lists
|
|
||||||
# that "make" can use for its purposes.
|
|
||||||
#
|
|
||||||
# Since the distribution comes with a filenames.make, this rule
|
|
||||||
# shouldn't be invoked for simple installations. But it will be used
|
|
||||||
# if you change any of the *-packages.scm files.
|
|
||||||
#
|
|
||||||
# You can actually run the forms in filenames.scm in any Scheme
|
|
||||||
# implementation that has syntax-rules and explicit-renaming low-level
|
|
||||||
# macros (e.g., most versions of Scheme 48 and Pseudoscheme).
|
|
||||||
# If there are errors running this script, and you need to debug,
|
|
||||||
# don't use the initial.image, use something that has a reasonable
|
|
||||||
# environment.
|
|
||||||
#
|
|
||||||
# If this fails and you don't feel like debugging or fixing the problem,
|
|
||||||
# try "touch filenames.make" and hope for the best.
|
|
||||||
|
|
||||||
PACKAGES=scheme/packages.scm scheme/rts-packages.scm scheme/alt-packages.scm \
|
|
||||||
scheme/comp-packages.scm scheme/initial-packages.scm \
|
|
||||||
scheme/link-packages.scm scheme/more-packages.scm \
|
|
||||||
build/filenames.scm
|
|
||||||
|
|
||||||
build/filenames.make: $(PACKAGES)
|
|
||||||
$(MAKE) $(VM) PACKAGES=
|
|
||||||
./$(VM) -i $(srcdir)/$(INITIAL) -a batch <build/filenames.scm
|
|
||||||
# or: $(RUNNABLE) -a batch <build/filenames.scm
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# Static linker
|
|
||||||
#
|
|
||||||
# The linker is capable of rebuilding an image from sources, even
|
|
||||||
# across an incompatible change in VM data representations.
|
|
||||||
|
|
||||||
build/linker.image: $(linker-files) scheme/alt/init-defpackage.scm
|
|
||||||
(echo ',batch'; \
|
|
||||||
echo ',bench on'; \
|
|
||||||
echo ',open signals handle features'; \
|
|
||||||
echo ',open bitwise ascii code-vectors record'; \
|
|
||||||
echo ',load $(linker-files)'; \
|
|
||||||
echo ',load scheme/alt/init-defpackage.scm'; \
|
|
||||||
echo ',dump build/linker.image' \
|
|
||||||
) | $(LINKER_RUNNABLE)
|
|
||||||
|
|
||||||
# Or, to bootstrap from Lucid Common Lisp: (last tested with
|
|
||||||
# Pseudoscheme 2.9 and Scheme 48 version 0.19)
|
|
||||||
|
|
||||||
PSEUDODIR = ../pseudo
|
|
||||||
|
|
||||||
link/linker-in-lucid: build/lucid-script.lisp $(linker-files) \
|
|
||||||
scheme/alt/pseudoscheme-features.scm \
|
|
||||||
scheme/alt/pseudoscheme-record.scm
|
|
||||||
(echo \(defvar pseudoscheme-directory \"$(PSEUDODIR)/\"\); \
|
|
||||||
cat build/lucid-script.lisp; \
|
|
||||||
echo \(dump-linker\) \(lcl:quit\)) \
|
|
||||||
| lisp
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# Initial image
|
|
||||||
#
|
|
||||||
# The initial.image is built by the static linker. The image contains
|
|
||||||
# Scheme, the byte-code compiler, and a minimal command processor, but
|
|
||||||
# no debugging environment to speak of.
|
|
||||||
|
|
||||||
$(INITIAL): $(LINKER_IMAGE) $(CONFIG_FILES) build/initial.scm $(initial-files) \
|
|
||||||
scsh/here.scm # gross and Olin hates it -bri
|
|
||||||
($(START_LINKER); \
|
|
||||||
echo '(load-configuration "scheme/interfaces.scm")'; \
|
|
||||||
echo '(load-configuration "scheme/packages.scm")'; \
|
|
||||||
echo '(flatload initial-structures)'; \
|
|
||||||
echo '(load "build/initial.scm")'; \
|
|
||||||
echo '(link-initial-system)' \
|
|
||||||
) | $(LINKER)
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# Various small images for debugging low-level changes
|
|
||||||
|
|
||||||
LOAD_DEBUG = \
|
|
||||||
$(START_LINKER); \
|
|
||||||
echo \(load-configuration \"scheme/interfaces.scm\"\); \
|
|
||||||
echo \(load-configuration \"scheme/packages.scm\"\); \
|
|
||||||
echo \(flatload debug-structures\)
|
|
||||||
|
|
||||||
scheme/debug/tiny.image: $(LINKER_IMAGE) scheme/debug/tiny-packages.scm \
|
|
||||||
scheme/debug/tiny.scm
|
|
||||||
($(START_LINKER); \
|
|
||||||
echo \(load-configuration \"scheme/debug/tiny-packages.scm\"\); \
|
|
||||||
echo \(link-simple-system \'\(scheme/debug tiny\) \'start tiny-system\)) \
|
|
||||||
| $(LINKER)
|
|
||||||
|
|
||||||
scheme/debug/low-test.image: $(LINKER_IMAGE) scheme/debug/low-test-packages.scm \
|
|
||||||
scheme/debug/low-test.scm
|
|
||||||
($(START_LINKER); \
|
|
||||||
echo \(load-configuration \"scheme/debug/low-test-packages.scm\"\); \
|
|
||||||
echo \(link-simple-system \'\(scheme/debug low-test\) \'start low-test-system\)) \
|
|
||||||
| $(LINKER)
|
|
||||||
|
|
||||||
scheme/debug/little.image: $(LINKER_IMAGE) $(CONFIG_FILES) scheme/debug-packages.scm
|
|
||||||
($(LOAD_DEBUG); echo \(link-little-system\)) \
|
|
||||||
| time $(LINKER)
|
|
||||||
|
|
||||||
scheme/debug/mini.image: $(LINKER_IMAGE) $(CONFIG_FILES)
|
|
||||||
($(LOAD_DEBUG); echo \(link-mini-system\)) \
|
|
||||||
| $(LINKER)
|
|
||||||
|
|
||||||
scheme/debug/medium.image: $(LINKER_IMAGE) $(CONFIG_FILES)
|
|
||||||
($(LOAD_DEBUG); echo \(flatload compiler-structures\); \
|
|
||||||
echo \(link-medium-system\)) \
|
|
||||||
| $(LINKER)
|
|
||||||
|
|
||||||
# The following have not been updated for the new directory organization
|
|
||||||
|
|
||||||
c/smain.o: c/main.c
|
|
||||||
$(CC) -c $(CPPFLAGS) $(DEFS) $(CFLAGS) -DSTATIC_AREAS -o $@ $(srcdir)/c/main.c
|
|
||||||
|
|
||||||
mini: mini-heap.o c/smain.o
|
|
||||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ c/smain.o mini-heap.o $(OBJS) $(LIBS)
|
|
||||||
|
|
||||||
mini-heap.o: mini-heap.c
|
|
||||||
$(CC) -c $(CPPFLAGS) $(DEFS) $(CFLAGS) -o $@ $(srcdir)/mini-heap.c
|
|
||||||
|
|
||||||
mini-heap.c: scheme/debug/mini1.image
|
|
||||||
(echo ,exec ,load misc/load-static.scm; \
|
|
||||||
echo \(do-it 150000 \"$(srcdir)/scheme/debug/mini1.image\" \"$@\"\)) \
|
|
||||||
| $(RUNNABLE) -h 3000000 -a batch
|
|
||||||
|
|
||||||
scheme/debug/mini1.image: $(VM) scheme/debug/mini.image
|
|
||||||
echo "(write-image \"scheme/debug/mini1.image\" \
|
|
||||||
(usual-resumer (lambda (args) \
|
|
||||||
(command-processor #f args))) \
|
|
||||||
\"foo\")" \
|
|
||||||
| ./$(VM) -i scheme/debug/mini.image -a batch
|
|
||||||
|
|
||||||
|
|
||||||
# --------------------
|
|
||||||
# Generate scheme48.h from VM sources
|
|
||||||
|
|
||||||
c/scheme48.h: c/scheme48.h.in scheme/vm/arch.scm scheme/vm/data.scm \
|
|
||||||
scheme/link/generate-c-header.scm
|
|
||||||
(echo ',bench'; \
|
|
||||||
echo ',batch'; \
|
|
||||||
echo ',load-package big-scheme'; \
|
|
||||||
echo ',open big-scheme'; \
|
|
||||||
echo ',load scheme/link/generate-c-header.scm'; \
|
|
||||||
echo "(make-c-header-file \"$@\" \
|
|
||||||
\"$(srcdir)/c/scheme48.h.in\" \
|
|
||||||
\"$(srcdir)/scheme/vm/arch.scm\" \
|
|
||||||
\"$(srcdir)/scheme/vm/data.scm\" \
|
|
||||||
\"$(srcdir)/scheme/rts/record.scm\")" \
|
|
||||||
) | $(RUNNABLE)
|
|
||||||
|
|
||||||
# An old version of the above for legacy code.
|
|
||||||
|
|
||||||
c/old-scheme48.h: scheme/vm/arch.scm scheme/vm/data.scm \
|
|
||||||
scheme/link/generate-old-c-header.scm
|
|
||||||
(echo ',bench'; \
|
|
||||||
echo ',batch'; \
|
|
||||||
echo ',load-package big-scheme'; \
|
|
||||||
echo ',open big-scheme'; \
|
|
||||||
echo ',load scheme/link/generate-old-c-header.scm'; \
|
|
||||||
echo "(make-c-header-file \"$@\" \
|
|
||||||
\"$(srcdir)/scheme/vm/arch.scm\" \
|
|
||||||
\"$(srcdir)/scheme/vm/data.scm\")" \
|
|
||||||
) | $(RUNNABLE)
|
|
||||||
|
|
||||||
# Generate vm (scheme48vm.c and scheme48heap.c) from VM sources.
|
|
||||||
# Never called automatically. Do not use unless you are sure you
|
|
||||||
# know what you are doing.
|
|
||||||
# Afterwards, you should probably make c/scheme48.h.
|
|
||||||
i-know: i-know-what-i-am-doing
|
|
||||||
i-know-what-i-am-doing:
|
|
||||||
cd ps-compiler && \
|
|
||||||
(echo ',batch'; \
|
|
||||||
echo ',config ,load ../scheme/prescheme/interface.scm'; \
|
|
||||||
echo ',config ,load ../scheme/prescheme/package-defs.scm'; \
|
|
||||||
echo ',exec ,load load-ps-compiler.scm'; \
|
|
||||||
echo ',exec ,load compile-vm-no-gc.scm'; \
|
|
||||||
echo ',exec ,load compile-gc.scm'; \
|
|
||||||
echo ',exit' \
|
|
||||||
) | $(RUNNABLE) -h 8000000 && \
|
|
||||||
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/standalone.image
|
|
||||||
$(RM) /tmp/cig
|
|
||||||
|
|
||||||
$(CIG)2:
|
|
||||||
(echo ",batch"; \
|
|
||||||
echo ",translate =scheme48/ $(srcdir)/scheme/"; \
|
|
||||||
echo ",config ,load $(srcdir)/cig/cig2.scm"; \
|
|
||||||
echo ",config ,load $(srcdir)/cig/libcig.scm"; \
|
|
||||||
echo ",load-package cig-standalone"; \
|
|
||||||
echo ",in cig-standalone"; \
|
|
||||||
echo ",translate =scheme48/ $(LIB)/"; \
|
|
||||||
echo '(dump-scsh-program cig-standalone-toplevel "/tmp/cig")') \
|
|
||||||
| ./$(VM) -o ./$(VM) -i ./scsh/scsh.image
|
|
||||||
$(srcdir)/cig/image2script $(LIB)/$(VM) </tmp/cig > $(CIG)2
|
|
||||||
-chmod +x $(CIG)2
|
|
||||||
$(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: cig scsh/scsh scsh/scsh.image
|
|
||||||
|
|
||||||
SCHEME =scsh/awk.scm \
|
|
||||||
scsh/char-set.scm \
|
|
||||||
scsh/defrec.scm \
|
|
||||||
scsh/endian.scm \
|
|
||||||
scsh/enumconst.scm \
|
|
||||||
scsh/event.scm \
|
|
||||||
scsh/fdports.scm \
|
|
||||||
scsh/fileinfo.scm \
|
|
||||||
scsh/filemtch.scm \
|
|
||||||
scsh/filesys.scm \
|
|
||||||
scsh/flock.scm \
|
|
||||||
scsh/fname.scm \
|
|
||||||
scsh/fr.scm \
|
|
||||||
scsh/glob.scm \
|
|
||||||
scsh/here.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/procobj.scm \
|
|
||||||
scsh/pty.scm \
|
|
||||||
scsh/rdelim.scm \
|
|
||||||
scsh/rw.scm \
|
|
||||||
scsh/scsh-condition.scm \
|
|
||||||
scsh/scsh-interfaces.scm \
|
|
||||||
scsh/scsh-package.scm \
|
|
||||||
scsh/scsh-read.scm \
|
|
||||||
scsh/scsh-version.scm \
|
|
||||||
scsh/scsh.scm \
|
|
||||||
scsh/select.scm \
|
|
||||||
scsh/startup.scm \
|
|
||||||
scsh/stringcoll.scm \
|
|
||||||
scsh/syntax-helpers.scm \
|
|
||||||
scsh/syntax.scm \
|
|
||||||
scsh/syscalls.scm \
|
|
||||||
scsh/time.scm \
|
|
||||||
scsh/top.scm \
|
|
||||||
scsh/tty.scm \
|
|
||||||
scsh/utilities.scm
|
|
||||||
|
|
||||||
# scsh/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/flock.c: scsh/flock.scm
|
|
||||||
scsh/jcontrol2.c: scsh/jcontrol2.scm
|
|
||||||
scsh/network.c: scsh/network.scm
|
|
||||||
scsh/rdelim.c: scsh/rdelim.scm
|
|
||||||
scsh/select.c: scsh/select.scm
|
|
||||||
scsh/syscalls.c: scsh/syscalls.scm
|
|
||||||
scsh/tty.c: scsh/tty.scm
|
|
||||||
scsh/time.c: scsh/time.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 \
|
|
||||||
$(srcdir)/scsh/rx/packages.scm \
|
|
||||||
$(srcdir)/scsh/rx/cond-package.scm \
|
|
||||||
$(srcdir)/scsh/scsh-package.scm \
|
|
||||||
$(srcdir)/scsh/lib/string-pack.scm \
|
|
||||||
$(srcdir)/scsh/lib/list-pack.scm \
|
|
||||||
$(srcdir)/scsh/lib/ccp-pack.scm
|
|
||||||
|
|
||||||
#JMG : not anymore appropriate
|
|
||||||
#echo ",open external-calls"; \
|
|
||||||
# echo "(lookup-all-externals)"; \
|
|
||||||
|
|
||||||
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/string-pack.scm \
|
|
||||||
$(srcdir)/scsh/lib/list-pack.scm \
|
|
||||||
$(srcdir)/scsh/lib/ccp-pack.scm
|
|
||||||
|
|
||||||
scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
|
||||||
(echo ",translate =scheme48/ $(srcdir)/scheme/"; \
|
|
||||||
echo ",batch on"; \
|
|
||||||
echo ",load-package floatnums"; \
|
|
||||||
echo ",config"; \
|
|
||||||
echo ",load $(loads)"; \
|
|
||||||
echo ",load-package scsh"; \
|
|
||||||
echo ",load-package events"; \
|
|
||||||
echo ",load-package scsh-here-string-hax"; \
|
|
||||||
echo ",translate =scheme48/ $(LIB)/"; \
|
|
||||||
echo ",load-package list-lib"; \
|
|
||||||
echo ",load-package string-lib"; \
|
|
||||||
echo ",load-package ccp-lib"; \
|
|
||||||
echo ",in scsh-level-0"; \
|
|
||||||
echo "(init-scsh-signal)";\
|
|
||||||
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 scsh06.image"; \
|
|
||||||
echo "(dump-scsh \"scsh/scsh.image\")"; \
|
|
||||||
echo ",batch on") \
|
|
||||||
| ./$(VM) -o ./$(VM) -i $(CIG).image -h 10000000
|
|
||||||
|
|
||||||
# echo ",build (lambda (args) ((scsh-stand-alone-resumer (make-scsh-starter)) args)) bla.image"; \
|
|
||||||
#scsh/scsh.image: $(VM) $(SCHEME) $(CIG).image
|
|
||||||
# (echo ",translate =scheme48/ $(srcdir)/"; \
|
|
||||||
# echo ",batch on"; \
|
|
||||||
# echo ",load-package floatnums"; \
|
|
||||||
# echo ",open externals"; \
|
|
||||||
# echo "(lookup-all-externals)"; \
|
|
||||||
# echo ",config"; \
|
|
||||||
# echo ",load $(srcdir)/scsh/let-opt.scm"; \
|
|
||||||
# echo ",load $(srcdir)/scsh/scsh-interfaces.scm"; \
|
|
||||||
# echo ",load $(srcdir)/scsh/machine/packages.scm"; \
|
|
||||||
# echo ",load $(srcdir)/scsh/scsh-package.scm"; \
|
|
||||||
# echo ",load-package scsh"; \
|
|
||||||
# echo ",load-package scsh-here-string-hax"; \
|
|
||||||
# echo ",translate =scheme48/ $(LIB)/"; \
|
|
||||||
# echo ",in scsh-level-0"; \
|
|
||||||
# echo "(%install-scsh-handlers)"; \
|
|
||||||
# echo "(autoreap-policy 'early)"; \
|
|
||||||
# echo ",user"; \
|
|
||||||
# echo ",open floatnums"; \
|
|
||||||
# echo ",open scsh"; \
|
|
||||||
# echo ",dump scsh/scsh.image") \
|
|
||||||
# | ./$(VM) -o ./$(VM) -i $(CIG).image
|
|
||||||
|
|
||||||
# Removed these lines from scsh/scsh.image rule so you don't lose so
|
|
||||||
# badly when you are debugging in scsh. -Olin 6/95
|
|
||||||
# echo ",flush";
|
|
||||||
# echo ",flush maps source names files table";
|
|
||||||
|
|
||||||
#scsh/scsh.runnable: scsh/scsh.image
|
|
||||||
# cig/image2script $(LIB)/$(VM) -o $(LIB)/$(VM) -h 1800000 \
|
|
||||||
# < scsh/scsh.image > $@
|
|
||||||
# -chmod +x $@
|
|
||||||
|
|
||||||
scsh/regexp/libregex.a:
|
|
||||||
cd ./scsh/regexp; $(MAKE) lib
|
|
||||||
|
|
||||||
scsh/scsh.vm: $(LIBSCSH) $(VM) scsh/scsh.image
|
|
||||||
./$(VM) -o ./$(VM) -h 8000000 -i scsh/scsh.image \
|
|
||||||
-lm ./vm/ps-interface.scm \
|
|
||||||
-lm ./vm/interfaces.scm \
|
|
||||||
-lm ./vm/package-defs.scm \
|
|
||||||
-lm ./vm/s48-package-defs.scm \
|
|
||||||
-dm -m static-heaps -e static-heap-linker \
|
|
||||||
-s scsh/static.scm \
|
|
||||||
-i scsh/scsh.image -o $@
|
|
||||||
|
|
||||||
install-scsh: scsh
|
|
||||||
$(RM) $(bindir)/$(RUNNABLE)
|
|
||||||
$(INSTALL_PROGRAM) $(srcdir)/scsh/scsh $(bindir)/$(RUNNABLE)
|
|
||||||
$(INSTALL_PROGRAM) $(srcdir)/scsh/scsh.image $(LIB)/scsh.image
|
|
||||||
$(INSTALL_PROGRAM) $(srcdir)/$(LIBSCSH) $(libdir)/$(LIBSCSH)
|
|
||||||
$(RANLIB) $(libdir)/$(LIBSCSH)
|
|
||||||
for f in $(srcdir)/scsh/*.scm; \
|
|
||||||
do $(INSTALL_DATA) $$f $(LIB)/scsh/; done
|
|
||||||
|
|
||||||
clean-scsh:
|
|
||||||
$(RM) scsh/*.o scsh/regexp/*.o scsh/rx/*.o scsh/machine/*.o
|
|
||||||
$(RM) scsh/*.image
|
|
||||||
$(RM) $(LIBSCSH) scsh/scsh$(EXEEXT) scsh/scsh.vm
|
|
||||||
-cd scsh/regexp; $(MAKE) clean
|
|
||||||
|
|
||||||
|
|
||||||
71
config.log
71
config.log
|
|
@ -1,71 +0,0 @@
|
||||||
This file contains any messages produced by compilers while
|
|
||||||
running configure, to aid debugging if configure makes a mistake.
|
|
||||||
|
|
||||||
configure:549: checking host system type
|
|
||||||
configure:573: checking for gcc
|
|
||||||
configure:650: checking whether the C compiler (gcc ) works
|
|
||||||
configure:664: gcc -o conftest conftest.c 1>&5
|
|
||||||
configure:684: checking whether the C compiler (gcc ) is a cross-compiler
|
|
||||||
configure:689: checking whether we are using GNU C
|
|
||||||
configure:713: checking whether gcc accepts -g
|
|
||||||
configure:749: checking for POSIXized ISC
|
|
||||||
configure:813: gcc -o conftest -O2 conftest.c 1>&5
|
|
||||||
configure:863: checking for a BSD compatible install
|
|
||||||
configure:915: checking for ranlib
|
|
||||||
configure:942: checking for working const
|
|
||||||
configure:1018: checking whether byte ordering is bigendian
|
|
||||||
configure:1149: checking for ELF
|
|
||||||
configure:1191: checking for main in -lm
|
|
||||||
configure:1234: checking for main in -ldl
|
|
||||||
configure:1277: checking for main in -lmld
|
|
||||||
configure:1320: checking for main in -lnsl
|
|
||||||
configure:1363: checking for main in -lgen
|
|
||||||
configure:1406: checking for main in -lsocket
|
|
||||||
configure:1449: checking for getpwnam in -lsun
|
|
||||||
configure:1496: checking for main in -lelf
|
|
||||||
configure:1544: checking for working const
|
|
||||||
configure:1619: checking return type of signal handlers
|
|
||||||
configure:1660: checking how to run the C preprocessor
|
|
||||||
configure:1724: checking for libgen.h
|
|
||||||
configure:1724: checking for sys/timeb.h
|
|
||||||
configure:1724: checking for posix/time.h
|
|
||||||
configure:1724: checking for sys/select.h
|
|
||||||
configure:1724: checking for nlist.h
|
|
||||||
configure:1764: checking for sys/un.h
|
|
||||||
configure:1803: checking for gettimeofday
|
|
||||||
configure:1803: checking for ftime
|
|
||||||
configure:1803: checking for nlist
|
|
||||||
configure:1803: checking for select
|
|
||||||
configure:1803: checking for setitimer
|
|
||||||
configure:1803: checking for sigaction
|
|
||||||
configure:1856: checking for dlopen
|
|
||||||
configure:1958: checking for socket
|
|
||||||
configure:1958: checking for chroot
|
|
||||||
configure:2011: checking for strerror
|
|
||||||
configure:2063: checking n_name
|
|
||||||
configure:2073: gcc -o conftest -O2 conftest.c -lm 1>&5
|
|
||||||
configure:2088: checking __NEXT__
|
|
||||||
configure:2103: gcc -o conftest -O2 conftest.c -lm 1>&5
|
|
||||||
configure: In function `main':
|
|
||||||
configure:2100: `fail' undeclared (first use this function)
|
|
||||||
configure:2100: (Each undeclared identifier is reported only once
|
|
||||||
configure:2100: for each function it appears in.)
|
|
||||||
configure: failed program was:
|
|
||||||
#line 2090 "configure"
|
|
||||||
#include "confdefs.h"
|
|
||||||
|
|
||||||
int main() {
|
|
||||||
|
|
||||||
#ifdef __NeXT__
|
|
||||||
return 0;
|
|
||||||
#else
|
|
||||||
fail
|
|
||||||
#endif
|
|
||||||
|
|
||||||
; return 0; }
|
|
||||||
configure:2119: checking underscore before symbols
|
|
||||||
configure:2134: checking link with -rdynamic
|
|
||||||
configure:2145: gcc -c -O2 conftest.c 1>&5
|
|
||||||
configure:2159: checking for tzname
|
|
||||||
configure:2194: checking for gmtoff
|
|
||||||
configure:2230: checking for const sys_errlist
|
|
||||||
|
|
@ -1,39 +0,0 @@
|
||||||
;;; Endian routines for the Scheme Shell
|
|
||||||
;;; Copyright (c) 1995 by Brian D. Carlstrom.
|
|
||||||
|
|
||||||
;; Big Endian - Motorola, Sparc, HPPA, etc
|
|
||||||
(define (net-to-host-32-big num32)
|
|
||||||
(and (<= 0 num32 #xffffffff)
|
|
||||||
num32))
|
|
||||||
|
|
||||||
(define (net-to-host-16-big num16)
|
|
||||||
(and (<= 0 num16 #xffffffff)
|
|
||||||
num16))
|
|
||||||
|
|
||||||
;; Little Endian - Intel, Vax, Alpha
|
|
||||||
(define (net-to-host-32-little num32)
|
|
||||||
(and (<= 0 num32 #xffffffff)
|
|
||||||
(let* ((num24 (arithmetic-shift num32 -8))
|
|
||||||
(num16 (arithmetic-shift num24 -8))
|
|
||||||
(num08 (arithmetic-shift num16 -8))
|
|
||||||
(byte0 (bitwise-and #b11111111 num08))
|
|
||||||
(byte1 (bitwise-and #b11111111 num16))
|
|
||||||
(byte2 (bitwise-and #b11111111 num24))
|
|
||||||
(byte3 (bitwise-and #b11111111 num32)))
|
|
||||||
(+ (arithmetic-shift byte3 24)
|
|
||||||
(arithmetic-shift byte2 16)
|
|
||||||
(arithmetic-shift byte1 8)
|
|
||||||
byte0))))
|
|
||||||
|
|
||||||
(define (net-to-host-16-little num16)
|
|
||||||
(and (<= 0 num16 #xffffffff)
|
|
||||||
(let* ((num08 (arithmetic-shift num16 -8))
|
|
||||||
(byte0 (bitwise-and #b11111111 num08))
|
|
||||||
(byte1 (bitwise-and #b11111111 num16)))
|
|
||||||
(+ (arithmetic-shift byte1 8)
|
|
||||||
byte0))))
|
|
||||||
|
|
||||||
(define net-to-host-32 net-to-host-32-little)
|
|
||||||
(define net-to-host-16 net-to-host-16-little)
|
|
||||||
(define host-to-net-32 net-to-host-32-little)
|
|
||||||
(define host-to-net-16 net-to-host-16-little)
|
|
||||||
|
|
@ -1,138 +0,0 @@
|
||||||
# Generated automatically from Makefile.in by configure.
|
|
||||||
CC = gcc
|
|
||||||
CFLAGS1 = -g -O2
|
|
||||||
|
|
||||||
RANLIB = ranlib
|
|
||||||
|
|
||||||
# You probably want to take -DREDEBUG out of CFLAGS, and put something like
|
|
||||||
# -O in, *after* testing (-DREDEBUG strengthens testing by enabling a lot of
|
|
||||||
# internal assertion checking and some debugging facilities).
|
|
||||||
# Put -Dconst= in for a pre-ANSI compiler.
|
|
||||||
# Do not take -DPOSIX_MISTAKE out.
|
|
||||||
# REGCFLAGS isn't important to you (it's for my use in some special contexts).
|
|
||||||
#CFLAGS=-I. -DPOSIX_MISTAKE -DREDEBUG $(REGCFLAGS)
|
|
||||||
CFLAGS=-I. -DPOSIX_MISTAKE $(REGCFLAGS) $(CFLAGS1)
|
|
||||||
|
|
||||||
# If you have a pre-ANSI compiler, put -o into MKHFLAGS. If you want
|
|
||||||
# the Berkeley __P macro, put -b in.
|
|
||||||
MKHFLAGS=
|
|
||||||
|
|
||||||
# Flags for linking but not compiling, if any.
|
|
||||||
LDFLAGS=
|
|
||||||
|
|
||||||
# Extra libraries for linking, if any.
|
|
||||||
LIBS=
|
|
||||||
|
|
||||||
# Internal stuff, should not need changing.
|
|
||||||
OBJPRODN=regcomp.o regexec.o regerror.o regfree.o
|
|
||||||
OBJS=$(OBJPRODN) split.o debug.o main.o
|
|
||||||
H=cclass.h cname.h regex2.h utils.h
|
|
||||||
REGSRC=regcomp.c regerror.c regexec.c regfree.c
|
|
||||||
ALLSRC=$(REGSRC) engine.c debug.c main.c split.c
|
|
||||||
|
|
||||||
# Stuff that matters only if you're trying to lint the package.
|
|
||||||
LINTFLAGS=-I. -Dstatic= -Dconst= -DREDEBUG
|
|
||||||
LINTC=regcomp.c regexec.c regerror.c regfree.c debug.c main.c
|
|
||||||
JUNKLINT=possible pointer alignment|null effect
|
|
||||||
|
|
||||||
# arrangements to build forward-reference header files
|
|
||||||
.SUFFIXES: .ih .h
|
|
||||||
.c.ih:
|
|
||||||
sh ./mkh $(MKHFLAGS) -p $< >$@
|
|
||||||
|
|
||||||
default: r
|
|
||||||
|
|
||||||
lib: purge $(OBJPRODN)
|
|
||||||
rm -f libregex.a
|
|
||||||
ar crv libregex.a $(OBJPRODN)
|
|
||||||
$(RANLIB) libregex.a
|
|
||||||
|
|
||||||
purge:
|
|
||||||
rm -f *.o
|
|
||||||
|
|
||||||
# stuff to build regex.h
|
|
||||||
REGEXH=regex.h
|
|
||||||
REGEXHSRC=regex2.h $(REGSRC)
|
|
||||||
$(REGEXH): $(REGEXHSRC) mkh
|
|
||||||
sh ./mkh $(MKHFLAGS) -i _REGEX_H_ $(REGEXHSRC) >regex.tmp
|
|
||||||
cmp -s regex.tmp regex.h 2>/dev/null || cp regex.tmp regex.h
|
|
||||||
rm -f regex.tmp
|
|
||||||
|
|
||||||
# dependencies
|
|
||||||
$(OBJPRODN) debug.o: utils.h regex.h regex2.h
|
|
||||||
regcomp.o: cclass.h cname.h regcomp.ih
|
|
||||||
regexec.o: engine.c engine.ih
|
|
||||||
regerror.o: regerror.ih
|
|
||||||
debug.o: debug.ih
|
|
||||||
main.o: main.ih
|
|
||||||
|
|
||||||
# tester
|
|
||||||
re: $(OBJS)
|
|
||||||
$(CC) $(CFLAGS) $(LDFLAGS) $(OBJS) $(LIBS) -o $@
|
|
||||||
|
|
||||||
# regression test
|
|
||||||
r: re tests
|
|
||||||
./re <tests
|
|
||||||
./re -el <tests
|
|
||||||
./re -er <tests
|
|
||||||
|
|
||||||
# 57 variants, and other stuff, for development use -- not useful to you
|
|
||||||
ra: ./re tests
|
|
||||||
-./re <tests
|
|
||||||
-./re -el <tests
|
|
||||||
-./re -er <tests
|
|
||||||
|
|
||||||
rx: ./re tests
|
|
||||||
./re -x <tests
|
|
||||||
./re -x -el <tests
|
|
||||||
./re -x -er <tests
|
|
||||||
|
|
||||||
t: ./re tests
|
|
||||||
-time ./re <tests
|
|
||||||
-time ./re -cs <tests
|
|
||||||
-time ./re -el <tests
|
|
||||||
-time ./re -cs -el <tests
|
|
||||||
|
|
||||||
l: $(LINTC)
|
|
||||||
lint $(LINTFLAGS) -h $(LINTC) 2>&1 | egrep -v '$(JUNKLINT)' | tee lint
|
|
||||||
|
|
||||||
fullprint:
|
|
||||||
ti README WHATSNEW notes todo | list
|
|
||||||
ti *.h | list
|
|
||||||
list *.c
|
|
||||||
list regex.3 regex.7
|
|
||||||
|
|
||||||
print:
|
|
||||||
ti README WHATSNEW notes todo | list
|
|
||||||
ti *.h | list
|
|
||||||
list reg*.c engine.c
|
|
||||||
|
|
||||||
|
|
||||||
mf.tmp: Makefile
|
|
||||||
sed '/^REGEXH=/s/=.*/=regex.h/' Makefile | sed '/#DEL$$/d' >$@
|
|
||||||
|
|
||||||
DTRH=cclass.h cname.h regex2.h utils.h
|
|
||||||
PRE=COPYRIGHT README WHATSNEW
|
|
||||||
POST=mkh regex.3 regex.7 tests $(DTRH) $(ALLSRC) fake/*.[ch]
|
|
||||||
FILES=$(PRE) Makefile $(POST)
|
|
||||||
DTR=$(PRE) Makefile=mf.tmp $(POST)
|
|
||||||
dtr: $(FILES) mf.tmp
|
|
||||||
makedtr $(DTR) >$@
|
|
||||||
rm mf.tmp
|
|
||||||
|
|
||||||
cio: $(FILES)
|
|
||||||
cio $(FILES)
|
|
||||||
|
|
||||||
rdf: $(FILES)
|
|
||||||
rcsdiff -c $(FILES) 2>&1 | p
|
|
||||||
|
|
||||||
# various forms of cleanup
|
|
||||||
tidy:
|
|
||||||
rm -f junk* core core.* *.core dtr *.tmp lint
|
|
||||||
|
|
||||||
clean: tidy
|
|
||||||
rm -f *.o *.s *.ih re libregex.a
|
|
||||||
|
|
||||||
# don't do this one unless you know what you're doing
|
|
||||||
spotless: clean
|
|
||||||
rm -f mkh regex.h
|
|
||||||
|
|
@ -1,35 +0,0 @@
|
||||||
/* ========= begin header generated by ./mkh ========= */
|
|
||||||
#ifdef __cplusplus
|
|
||||||
extern "C" {
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* === engine.c === */
|
|
||||||
static int matcher(register struct re_guts *g, char *string, size_t nmatch, regmatch_t pmatch[], int eflags);
|
|
||||||
static char *dissect(register struct match *m, char *start, char *stop, sopno startst, sopno stopst);
|
|
||||||
static char *backref(register struct match *m, char *start, char *stop, sopno startst, sopno stopst, sopno lev);
|
|
||||||
static char *fast(register struct match *m, char *start, char *stop, sopno startst, sopno stopst);
|
|
||||||
static char *slow(register struct match *m, char *start, char *stop, sopno startst, sopno stopst);
|
|
||||||
static states step(register struct re_guts *g, sopno start, sopno stop, register states bef, int ch, register states aft);
|
|
||||||
#define BOL (OUT+1)
|
|
||||||
#define EOL (BOL+1)
|
|
||||||
#define BOLEOL (BOL+2)
|
|
||||||
#define NOTHING (BOL+3)
|
|
||||||
#define BOW (BOL+4)
|
|
||||||
#define EOW (BOL+5)
|
|
||||||
#define CODEMAX (BOL+5) /* highest code used */
|
|
||||||
#define NONCHAR(c) ((c) > CHAR_MAX)
|
|
||||||
#define NNONCHAR (CODEMAX-CHAR_MAX)
|
|
||||||
#ifdef REDEBUG
|
|
||||||
static void print(struct match *m, char *caption, states st, int ch, FILE *d);
|
|
||||||
#endif
|
|
||||||
#ifdef REDEBUG
|
|
||||||
static void at(struct match *m, char *title, char *start, char *stop, sopno startst, sopno stopst);
|
|
||||||
#endif
|
|
||||||
#ifdef REDEBUG
|
|
||||||
static char *pchar(int ch);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef __cplusplus
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
/* ========= end header generated by ./mkh ========= */
|
|
||||||
|
|
@ -1,51 +0,0 @@
|
||||||
/* ========= begin header generated by ./mkh ========= */
|
|
||||||
#ifdef __cplusplus
|
|
||||||
extern "C" {
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* === regcomp.c === */
|
|
||||||
static void p_ere(register struct parse *p, int stop);
|
|
||||||
static void p_ere_exp(register struct parse *p);
|
|
||||||
static void p_str(register struct parse *p);
|
|
||||||
static void p_bre(register struct parse *p, register int end1, register int end2);
|
|
||||||
static int p_simp_re(register struct parse *p, int starordinary);
|
|
||||||
static int p_count(register struct parse *p);
|
|
||||||
static void p_bracket(register struct parse *p);
|
|
||||||
static void p_b_term(register struct parse *p, register cset *cs);
|
|
||||||
static void p_b_cclass(register struct parse *p, register cset *cs);
|
|
||||||
static void p_b_eclass(register struct parse *p, register cset *cs);
|
|
||||||
static char p_b_symbol(register struct parse *p);
|
|
||||||
static char p_b_coll_elem(register struct parse *p, int endc);
|
|
||||||
static char othercase(int ch);
|
|
||||||
static void bothcases(register struct parse *p, int ch);
|
|
||||||
static void ordinary(register struct parse *p, register int ch);
|
|
||||||
static void nonnewline(register struct parse *p);
|
|
||||||
static void repeat(register struct parse *p, sopno start, int from, int to);
|
|
||||||
static int seterr(register struct parse *p, int e);
|
|
||||||
static cset *allocset(register struct parse *p);
|
|
||||||
static void freeset(register struct parse *p, register cset *cs);
|
|
||||||
static int freezeset(register struct parse *p, register cset *cs);
|
|
||||||
static int firstch(register struct parse *p, register cset *cs);
|
|
||||||
static int nch(register struct parse *p, register cset *cs);
|
|
||||||
static void mcadd(register struct parse *p, register cset *cs, register char *cp);
|
|
||||||
static void mcsub(register cset *cs, register char *cp);
|
|
||||||
static int mcin(register cset *cs, register char *cp);
|
|
||||||
static char *mcfind(register cset *cs, register char *cp);
|
|
||||||
static void mcinvert(register struct parse *p, register cset *cs);
|
|
||||||
static void mccase(register struct parse *p, register cset *cs);
|
|
||||||
static int isinsets(register struct re_guts *g, int c);
|
|
||||||
static int samesets(register struct re_guts *g, int c1, int c2);
|
|
||||||
static void categorize(struct parse *p, register struct re_guts *g);
|
|
||||||
static sopno dupl(register struct parse *p, sopno start, sopno finish);
|
|
||||||
static void doemit(register struct parse *p, sop op, size_t opnd);
|
|
||||||
static void doinsert(register struct parse *p, sop op, size_t opnd, sopno pos);
|
|
||||||
static void dofwd(register struct parse *p, sopno pos, sop value);
|
|
||||||
static void enlarge(register struct parse *p, sopno size);
|
|
||||||
static void stripsnug(register struct parse *p, register struct re_guts *g);
|
|
||||||
static void findmust(register struct parse *p, register struct re_guts *g);
|
|
||||||
static sopno pluscount(register struct parse *p, register struct re_guts *g);
|
|
||||||
|
|
||||||
#ifdef __cplusplus
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
/* ========= end header generated by ./mkh ========= */
|
|
||||||
|
|
@ -1,12 +0,0 @@
|
||||||
/* ========= begin header generated by ./mkh ========= */
|
|
||||||
#ifdef __cplusplus
|
|
||||||
extern "C" {
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* === regerror.c === */
|
|
||||||
static char *regatoi(const regex_t *preg, char *localbuf);
|
|
||||||
|
|
||||||
#ifdef __cplusplus
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
/* ========= end header generated by ./mkh ========= */
|
|
||||||
|
|
@ -1,74 +0,0 @@
|
||||||
#ifndef _REGEX_H_
|
|
||||||
#define _REGEX_H_ /* never again */
|
|
||||||
/* ========= begin header generated by ./mkh ========= */
|
|
||||||
#ifdef __cplusplus
|
|
||||||
extern "C" {
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* === regex2.h === */
|
|
||||||
typedef off_t regoff_t;
|
|
||||||
typedef struct {
|
|
||||||
int re_magic;
|
|
||||||
size_t re_nsub; /* number of parenthesized subexpressions */
|
|
||||||
const char *re_endp; /* end pointer for REG_PEND */
|
|
||||||
struct re_guts *re_g; /* none of your business :-) */
|
|
||||||
} regex_t;
|
|
||||||
typedef struct {
|
|
||||||
regoff_t rm_so; /* start of match */
|
|
||||||
regoff_t rm_eo; /* end of match */
|
|
||||||
} regmatch_t;
|
|
||||||
|
|
||||||
|
|
||||||
/* === regcomp.c === */
|
|
||||||
extern int regcomp(regex_t *, const char *, int);
|
|
||||||
#define REG_BASIC 0000
|
|
||||||
#define REG_EXTENDED 0001
|
|
||||||
#define REG_ICASE 0002
|
|
||||||
#define REG_NOSUB 0004
|
|
||||||
#define REG_NEWLINE 0010
|
|
||||||
#define REG_NOSPEC 0020
|
|
||||||
#define REG_PEND 0040
|
|
||||||
#define REG_DUMP 0200
|
|
||||||
|
|
||||||
|
|
||||||
/* === regerror.c === */
|
|
||||||
#define REG_OKAY 0
|
|
||||||
#define REG_NOMATCH 1
|
|
||||||
#define REG_BADPAT 2
|
|
||||||
#define REG_ECOLLATE 3
|
|
||||||
#define REG_ECTYPE 4
|
|
||||||
#define REG_EESCAPE 5
|
|
||||||
#define REG_ESUBREG 6
|
|
||||||
#define REG_EBRACK 7
|
|
||||||
#define REG_EPAREN 8
|
|
||||||
#define REG_EBRACE 9
|
|
||||||
#define REG_BADBR 10
|
|
||||||
#define REG_ERANGE 11
|
|
||||||
#define REG_ESPACE 12
|
|
||||||
#define REG_BADRPT 13
|
|
||||||
#define REG_EMPTY 14
|
|
||||||
#define REG_ASSERT 15
|
|
||||||
#define REG_INVARG 16
|
|
||||||
#define REG_ATOI 255 /* convert name to number (!) */
|
|
||||||
#define REG_ITOA 0400 /* convert number to name (!) */
|
|
||||||
extern size_t regerror(int, const regex_t *, char *, size_t);
|
|
||||||
|
|
||||||
|
|
||||||
/* === regexec.c === */
|
|
||||||
extern int regexec(const regex_t *, const char *, size_t, regmatch_t [], int);
|
|
||||||
#define REG_NOTBOL 00001
|
|
||||||
#define REG_NOTEOL 00002
|
|
||||||
#define REG_STARTEND 00004
|
|
||||||
#define REG_TRACE 00400 /* tracing of execution */
|
|
||||||
#define REG_LARGE 01000 /* force large representation */
|
|
||||||
#define REG_BACKR 02000 /* force use of backref code */
|
|
||||||
|
|
||||||
|
|
||||||
/* === regfree.c === */
|
|
||||||
extern void regfree(regex_t *);
|
|
||||||
|
|
||||||
#ifdef __cplusplus
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
/* ========= end header generated by ./mkh ========= */
|
|
||||||
#endif
|
|
||||||
913
scsh/static.scm
913
scsh/static.scm
|
|
@ -1,913 +0,0 @@
|
||||||
#!/home/gasbichl/i386_fbsd40/scsh-0.6//lib/scsh/scshvm \
|
|
||||||
-o /home/gasbichl/i386_fbsd40/scsh-0.6//lib/scsh/scshvm -h 8000000 -i /home/gasbichl/i386_fbsd40/scsh-0.6//lib/scsh/scsh.image -lm /home/gasbichl/i386_fbsd40/scsh-0.6//lib/scsh/vm/ps-interface.scm -lm /home/gasbichl/i386_fbsd40/scsh-0.6//lib/scsh/vm/interfaces.scm -lm /home/gasbichl/i386_fbsd40/scsh-0.6//lib/scsh/vm/package-defs.scm -lm /home/gasbichl/i386_fbsd40/scsh-0.6//lib/scsh/vm/s48-package-defs.scm -dm -m static-heaps -e static-heap-linker -s
|
|
||||||
!#
|
|
||||||
|
|
||||||
#!
|
|
||||||
For testing load this at a scsh prompt
|
|
||||||
,config ,load ../vm/ps-interface.scm
|
|
||||||
,config ,load ../vm/interfaces.scm
|
|
||||||
,config ,load ../vm/package-defs.scm
|
|
||||||
,config ,load ../vm/s48-package-defs.scm
|
|
||||||
,config ,load static.scm
|
|
||||||
,load-package static-heaps
|
|
||||||
,in static-heaps
|
|
||||||
!#
|
|
||||||
|
|
||||||
;;; Static heap package for the Scheme Shell
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; Copyright (c) 1995-1996 by Brian D. Carlstrom.
|
|
||||||
;;;
|
|
||||||
;;; based on Scheme48 implementation.
|
|
||||||
;;; Copyright (c) 1993, 1994 by Richard Kelsey and Jonathan Rees.
|
|
||||||
;;;
|
|
||||||
;;; The business of this package is converting a Scheme 48 bytecode
|
|
||||||
;;; image as embodied in a .image file to a C representation. This C
|
|
||||||
;;; code is then compiled and linked in with a virtual machine. One
|
|
||||||
;;; pleasant side effect of this is reduced startup times. Another
|
|
||||||
;;; good thing is that immutable parts of the image can be shared
|
|
||||||
;;; between processes.
|
|
||||||
|
|
||||||
(define-structure static-heaps
|
|
||||||
(export static-heap-linker)
|
|
||||||
(open scheme heap memory data stob struct
|
|
||||||
heap-extra
|
|
||||||
vm-architecture
|
|
||||||
formats
|
|
||||||
enumerated
|
|
||||||
signals
|
|
||||||
tables
|
|
||||||
defrec-package
|
|
||||||
scsh)
|
|
||||||
(begin
|
|
||||||
|
|
||||||
;;; static-heap-linker
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; the external entry point
|
|
||||||
;;; real work in static-heap-linker1
|
|
||||||
;;; argl is a list of the command line arguments
|
|
||||||
(define (static-heap-linker argl)
|
|
||||||
(static-heap-linker1 (parse-options argl))
|
|
||||||
(exit 0))
|
|
||||||
|
|
||||||
;;; parse-options
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; parses the command line options
|
|
||||||
;;; returns them in an options structure
|
|
||||||
(define (parse-options argl)
|
|
||||||
(let ((options (make-options)))
|
|
||||||
|
|
||||||
(let loop ((args (cdr argl)))
|
|
||||||
(cond ((null? args)
|
|
||||||
(cond ((not (options:output-executable options))
|
|
||||||
(display "error: -o is a required argument")
|
|
||||||
(newline)
|
|
||||||
(usage (car argl)))
|
|
||||||
((not (options:input-image options))
|
|
||||||
(display "error: -i is a required argument")
|
|
||||||
(newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
((equal? (car args) "-i")
|
|
||||||
(cond ((not (null? (cdr args)))
|
|
||||||
(set-options:input-image options (cadr args))
|
|
||||||
(loop (cddr args)))
|
|
||||||
(else
|
|
||||||
(display "error: -i requires argument") (newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
((equal? (car args) "-o")
|
|
||||||
(cond ((not (null? (cdr args)))
|
|
||||||
(set-options:output-executable options (cadr args))
|
|
||||||
(loop (cddr args)))
|
|
||||||
(else
|
|
||||||
(display "error: -o requires argument") (newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
((equal? (car args) "--args")
|
|
||||||
(cond ((not (null? (cdr args)))
|
|
||||||
(set-options:args-parser options (cadr args))
|
|
||||||
(loop (cddr args)))
|
|
||||||
(else
|
|
||||||
(display "error: --args requires argument") (newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
((equal? (car args) "--temp")
|
|
||||||
(cond ((not (null? (cdr args)))
|
|
||||||
(set-options:temp-dir options (cadr args))
|
|
||||||
(loop (cddr args)))
|
|
||||||
(else
|
|
||||||
(display "error: --temp requires argument") (newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
((equal? (car args) "--cc")
|
|
||||||
(cond ((not (null? (cdr args)))
|
|
||||||
(set-options:cc-command options (cadr args))
|
|
||||||
(loop (cddr args)))
|
|
||||||
(else
|
|
||||||
(display "error: --cc requires argument") (newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
((equal? (car args) "--ld")
|
|
||||||
(cond ((not (null? (cdr args)))
|
|
||||||
(set-options:ld-command options (cadr args))
|
|
||||||
(loop (cddr args)))
|
|
||||||
(else
|
|
||||||
(display "error: --ld requires argument") (newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
((equal? (car args) "--libs")
|
|
||||||
(cond ((not (null? (cdr args)))
|
|
||||||
(set-options:libraries options (cadr args))
|
|
||||||
(loop (cddr args)))
|
|
||||||
(else
|
|
||||||
(display "error: --libs requires argument") (newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
(else
|
|
||||||
(format #t "error: unknown argument ~a" (car args))
|
|
||||||
(newline)
|
|
||||||
(usage (car argl)))))
|
|
||||||
(set-options:args-parser
|
|
||||||
options
|
|
||||||
(if (options:args-parser options)
|
|
||||||
(list (options:args-parser options))
|
|
||||||
'()))
|
|
||||||
(set-options:temp-dir
|
|
||||||
options
|
|
||||||
(or (options:temp-dir options)
|
|
||||||
(getenv "TMPDIR")
|
|
||||||
"/usr/tmp"))
|
|
||||||
(set-options:cc-command
|
|
||||||
options
|
|
||||||
(or (options:cc-command options)
|
|
||||||
(getenv "CC")
|
|
||||||
"gcc -O2"))
|
|
||||||
(set-options:ld-flags
|
|
||||||
options
|
|
||||||
(or (options:ld-flags options)
|
|
||||||
(getenv "LDFLAGS")
|
|
||||||
"-rdynamic"))
|
|
||||||
(set-options:libraries
|
|
||||||
options
|
|
||||||
(or (options:libraries options)
|
|
||||||
(getenv "LIBS")
|
|
||||||
"-lcrypt -lm "))
|
|
||||||
options))
|
|
||||||
|
|
||||||
;;; usage reporting
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
(define (usage program-name)
|
|
||||||
(format #t
|
|
||||||
(string-append
|
|
||||||
"usage: ~a ~%"
|
|
||||||
" [-i image]~%"
|
|
||||||
" [-o executable]~%"
|
|
||||||
" [--args object]~%"
|
|
||||||
" [--temp directory]~%"
|
|
||||||
" [--cc command]~%"
|
|
||||||
" [--ld command]~%"
|
|
||||||
" [--libs libraries]~%")
|
|
||||||
program-name)
|
|
||||||
(exit 1))
|
|
||||||
|
|
||||||
;;; options structure
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define-record options
|
|
||||||
(input-image #f) ; the input scheme image file
|
|
||||||
(output-executable #f) ; the output executable file
|
|
||||||
(args-parser #f) ; .o file for replacement process_args
|
|
||||||
(temp-dir #f) ; place for intermediate .c .o files
|
|
||||||
(cc-command #f) ; command to compile a .c file
|
|
||||||
(ld-flags #f) ; flags needed to link executable
|
|
||||||
(libraries #f) ; linbraries need to link executable
|
|
||||||
)
|
|
||||||
|
|
||||||
;;; heap structure
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define-record heap
|
|
||||||
(length 0)
|
|
||||||
(objects '())
|
|
||||||
)
|
|
||||||
|
|
||||||
;;; static-heap-linker1
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
(define (static-heap-linker1 options)
|
|
||||||
|
|
||||||
;;; munge some options into a more usable form
|
|
||||||
(set-options:temp-dir
|
|
||||||
options
|
|
||||||
(format #f "~a/scsh~s" (options:temp-dir options) (pid)))
|
|
||||||
(set-options:output-executable
|
|
||||||
options
|
|
||||||
(string-append (cwd) "/" (options:output-executable options)))
|
|
||||||
|
|
||||||
;;; Read the image
|
|
||||||
(let ((start ; entry point of image
|
|
||||||
(read-heap-image (options:input-image options))))
|
|
||||||
|
|
||||||
;;; Process the image
|
|
||||||
(receive (pure impure reloc externs)
|
|
||||||
(create-heaps-and-tables)
|
|
||||||
|
|
||||||
;;; Prepare for output
|
|
||||||
;;; if directory exists blow it away
|
|
||||||
;;; useful for repeated runs from within same scsh process
|
|
||||||
(if (file-exists? (options:temp-dir options))
|
|
||||||
(cond ((file-directory? (options:temp-dir otions))
|
|
||||||
(with-cwd (options:temp-dir options)
|
|
||||||
(let loop ((files (directory-files
|
|
||||||
(options:temp-dir options)
|
|
||||||
#t)))
|
|
||||||
(cond ((not (null? files))
|
|
||||||
(delete-file (car files))
|
|
||||||
(loop (cdr files))))))
|
|
||||||
(delete-directory (options:temp-dir options)))
|
|
||||||
(else
|
|
||||||
(delete-file (options:temp-dir options)))))
|
|
||||||
(create-directory (options:temp-dir options) #o755 #t)
|
|
||||||
|
|
||||||
;;; Process the info we gather to make it the output file
|
|
||||||
(with-cwd (options:temp-dir options)
|
|
||||||
(write-c-header-file pure impure externs)
|
|
||||||
(compile-main-c-file start reloc options)
|
|
||||||
(compile-c-image pure impure reloc externs options)
|
|
||||||
(link-files options)
|
|
||||||
(let loop ((files (directory-files
|
|
||||||
(options:temp-dir options) #t)))
|
|
||||||
(cond ((not (null? files))
|
|
||||||
(delete-file (car files))
|
|
||||||
(loop (cdr files))))))
|
|
||||||
(delete-directory (options:temp-dir options)))))
|
|
||||||
|
|
||||||
;;; read-heap-image
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; reads the scheme48 bytecode image into memory.
|
|
||||||
;;; returns entry point.
|
|
||||||
(define (read-heap-image infile)
|
|
||||||
(let ((bytes (file-info:size (file-info infile))))
|
|
||||||
(init (inexact->exact (floor (* 1.1 bytes))) infile)))
|
|
||||||
;; XXX the 1.1 is because we need a little extra space for find-all-xs
|
|
||||||
|
|
||||||
;;; create-heaps-and-tables
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; Walks over the in memory scheme 48 heap image.
|
|
||||||
;;; Returns
|
|
||||||
;;; 1.) vector of heaps describing pure heap objects
|
|
||||||
;;; 2.) vector of heaps describing impure heap objects
|
|
||||||
;;; 3.) vector of tables descibing relocations
|
|
||||||
;;; 4.) table of external references
|
|
||||||
(define (create-heaps-and-tables)
|
|
||||||
(let* ((n (nchunks)) ; number of chunks we have in image
|
|
||||||
( pure (make-vector n)) ; immutable bits of each chunk
|
|
||||||
(impure (make-vector n)) ; mutable bits of each chunk
|
|
||||||
(reloc (make-vector n)) ; relocation information
|
|
||||||
(externs (make-table))) ; external references
|
|
||||||
;; create empty heaps for each chunk
|
|
||||||
(let loop ((i 0))
|
|
||||||
(cond ((not (= i n))
|
|
||||||
(vector-set! pure i (make-heap))
|
|
||||||
(vector-set! impure i (make-heap))
|
|
||||||
(vector-set! reloc i (make-table))
|
|
||||||
(loop (+ i 1)))))
|
|
||||||
;; here is where we iterate through all the bits
|
|
||||||
;; we construct our own data structures describing the layout
|
|
||||||
(scsh-for-each-stored-object
|
|
||||||
(lambda (chunk)
|
|
||||||
(display "."))
|
|
||||||
(lambda (chunk x len)
|
|
||||||
(let* ((heap ; choose the appropriate heap
|
|
||||||
(vector-ref (if (mutable? x) impure pure) chunk)))
|
|
||||||
;; add the relocation information
|
|
||||||
(table-set! (vector-ref reloc chunk) x (heap:length heap))
|
|
||||||
;; add object reference to heap chunk
|
|
||||||
(set-heap:objects heap (cons x (heap:objects heap)))
|
|
||||||
;; update current heap chunk length
|
|
||||||
(set-heap:length heap (+ len (heap:length heap)))
|
|
||||||
;; if we have an external reference handle add it to the list
|
|
||||||
(if (= (header-type (stob-header x)) (enum stob external))
|
|
||||||
(table-set! externs
|
|
||||||
(external-value x)
|
|
||||||
(vm-string->string (external-name x))))))
|
|
||||||
(lambda (chunk) 'foo))
|
|
||||||
(newline)
|
|
||||||
;; put all the heaps in the correct order
|
|
||||||
(let loop ((i 0))
|
|
||||||
(cond ((not (= i n))
|
|
||||||
(let ((p (vector-ref pure i))
|
|
||||||
(i (vector-ref impure i)))
|
|
||||||
(set-heap:objects p (reverse (heap:objects p)))
|
|
||||||
(set-heap:objects i (reverse (heap:objects i))))
|
|
||||||
(loop (+ i 1)))))
|
|
||||||
(values pure impure reloc externs)))
|
|
||||||
|
|
||||||
;;; vm-string->string
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; converts a vm-string to a scheme one that we can handle
|
|
||||||
(define (vm-string->string x)
|
|
||||||
(cond ((vm-string? x)
|
|
||||||
(let ((len (vm-string-length x)))
|
|
||||||
(let loop ((i 0)
|
|
||||||
(l '()))
|
|
||||||
(cond ((= i len)
|
|
||||||
(list->string (reverse l)))
|
|
||||||
(else
|
|
||||||
(loop (+ i 1) (cons (vm-string-ref x i) l)))))))
|
|
||||||
(else
|
|
||||||
(message x " is not a vm-string"))))
|
|
||||||
|
|
||||||
;;; write-c-header-file
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; declares the c long arrays for each heap chunk
|
|
||||||
;;; declares the extern references to other c functions
|
|
||||||
(define (write-c-header-file pure impure externs)
|
|
||||||
(call-with-output-file "static.h"
|
|
||||||
(lambda (port)
|
|
||||||
(format port "/* Static Heap File Automatically Generated~%")
|
|
||||||
(format port " * by scsh/static.scm */~%")
|
|
||||||
;; declare the long arrays for each heap chunk
|
|
||||||
(let ((n (nchunks)))
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i n))
|
|
||||||
(format port "extern const long p~s[~s];~%" i
|
|
||||||
(quotient (heap:length (vector-ref pure i)) 4)))
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i n))
|
|
||||||
(format port "extern long i~s[~s];~%" i
|
|
||||||
(quotient (heap:length (vector-ref impure i)) 4))))
|
|
||||||
;; declare the external references
|
|
||||||
(table-walk
|
|
||||||
(lambda (address name)
|
|
||||||
(format port "const extern ~a();~%" name))
|
|
||||||
externs)
|
|
||||||
)))
|
|
||||||
|
|
||||||
;;; compile-main-c-file
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; creates the top level interfaces that scheme48 wants to see
|
|
||||||
;;; p_count i_count
|
|
||||||
;;; number of chunks
|
|
||||||
;;; p_areas i_areas
|
|
||||||
;;; pointers to each chunk
|
|
||||||
;;; p_sizes i_sizes
|
|
||||||
;;; sizes of each chunk
|
|
||||||
;;; entry
|
|
||||||
;;; the starting entry point
|
|
||||||
(define (compile-main-c-file start reloc options)
|
|
||||||
(let ((n (nchunks))
|
|
||||||
(cc (append (line->list (options:cc-command options)) '(-c))))
|
|
||||||
(call-with-output-file "static.c"
|
|
||||||
(lambda (port)
|
|
||||||
(format port "#include \"static.h\"~%")
|
|
||||||
(format port "const long p_count = ~s;~%" n)
|
|
||||||
(format port "const long i_count = ~s;~%" n)
|
|
||||||
|
|
||||||
(format port "const long * const p_areas[~s] = {" n)
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i n))
|
|
||||||
(format port "(const long *) &p~s, " i))
|
|
||||||
(format port "};~%")
|
|
||||||
(format port "long * const i_areas[~s] = {" n)
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i n))
|
|
||||||
(format port "(long *) &i~s, " i))
|
|
||||||
(format port "};~%")
|
|
||||||
|
|
||||||
(format port "const long p_sizes[~s] = {" n)
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i n))
|
|
||||||
(format port "sizeof(p~s), " i))
|
|
||||||
(format port "};~%")
|
|
||||||
(format port "const long i_sizes[~s] = {" n)
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i n))
|
|
||||||
(format port "sizeof(i~s), " i))
|
|
||||||
(format port "};~%")
|
|
||||||
|
|
||||||
(display "const long entry = " port)
|
|
||||||
(scsh-emit-descriptor start reloc port)
|
|
||||||
(write-char #\; port)
|
|
||||||
(newline port)))
|
|
||||||
(let ((command (append cc '("static.c"))))
|
|
||||||
(message command)
|
|
||||||
(run (,@command)))))
|
|
||||||
|
|
||||||
;;; compile-c-image
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; responsible for writing and compiling the pure and impure heaps
|
|
||||||
(define (compile-c-image pure impure reloc externs options)
|
|
||||||
(compile-c-image1 pure "p" "const " reloc externs options)
|
|
||||||
(compile-c-image1 impure "i" "" reloc externs options))
|
|
||||||
|
|
||||||
;;; compile-c-image1
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; writes and compiles the c long array
|
|
||||||
(define (compile-c-image1 heap name const reloc externs options)
|
|
||||||
(let* ((n (nchunks))
|
|
||||||
(process #f)
|
|
||||||
(cc (append (line->list (options:cc-command options)) '(-c))))
|
|
||||||
;; iterate over all the chunks for this part of heap
|
|
||||||
(let chunk-loop ((c 0))
|
|
||||||
(cond ((not (= c n))
|
|
||||||
(let ((filename (format #f "static-~a~s.c" name c)))
|
|
||||||
(call-with-output-file filename
|
|
||||||
(lambda (port)
|
|
||||||
(format port "#include \"static.h\"~%")
|
|
||||||
(format port "~a long ~a~s[]={~%" const name c)
|
|
||||||
(let ((heap (vector-ref heap c)))
|
|
||||||
;; iterate over each object
|
|
||||||
(let heap-loop ((l (heap:objects heap)))
|
|
||||||
(cond ((not (null? l))
|
|
||||||
(scsh-emit-initializer
|
|
||||||
(car l) reloc externs port)
|
|
||||||
(heap-loop (cdr l))))))
|
|
||||||
(display "};" port)
|
|
||||||
(newline port)))
|
|
||||||
;; wait for last compile before starting new one
|
|
||||||
(if process
|
|
||||||
(wait process))
|
|
||||||
(let ((command (append cc (list filename))))
|
|
||||||
(message command)
|
|
||||||
(set! process (& (,@command))))
|
|
||||||
(chunk-loop (+ 1 c))))
|
|
||||||
(else
|
|
||||||
(wait process))))))
|
|
||||||
|
|
||||||
;;; link-files
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; links the .o's from compile-c-files
|
|
||||||
;;; uses the provided flags and libraries
|
|
||||||
;;; produces outfile as executable
|
|
||||||
(define (link-files options)
|
|
||||||
(let ((n (nchunks))
|
|
||||||
(ld (append (line->list (options:cc-command options))
|
|
||||||
(line->list (options:ld-flags options))
|
|
||||||
`(-o ,(options:output-executable options))))
|
|
||||||
(libs (line->list (options:libraries options))))
|
|
||||||
(let ((command (append ld
|
|
||||||
(let loop ((i 0)
|
|
||||||
(l '()))
|
|
||||||
(cond ((not (= i n))
|
|
||||||
(loop (+ i 1)
|
|
||||||
(cons
|
|
||||||
(format #f "static-i~s.o" i)
|
|
||||||
(cons
|
|
||||||
(format #f "static-p~s.o" i)
|
|
||||||
l))))
|
|
||||||
(else
|
|
||||||
(reverse
|
|
||||||
(cons "static.o"
|
|
||||||
l)))))
|
|
||||||
(options:args-parser options)
|
|
||||||
'("-L" "/home/gasbichl/i386_fbsd40/scsh-0.6//lib/scsh" "-lscshvm")
|
|
||||||
libs)))
|
|
||||||
(message command)
|
|
||||||
(run (,@command)))))
|
|
||||||
|
|
||||||
;;; scsh-emit-initializer
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; see scheme48 emit-initialize below
|
|
||||||
(define (scsh-emit-initializer x reloc externs port)
|
|
||||||
;; emit the header
|
|
||||||
(write-hex port (stob-header x))
|
|
||||||
;; handle descriptor vectors and vm-strings.
|
|
||||||
;; everything else is a byte vector
|
|
||||||
(cond ((d-vector? x)
|
|
||||||
(scsh-emit-d-vector-initializer x reloc port))
|
|
||||||
((vm-string? x)
|
|
||||||
(scsh-emit-vm-string-initializer x port))
|
|
||||||
(else
|
|
||||||
(scsh-emit-b-vector-initializer x externs port)))
|
|
||||||
(if *comments?*
|
|
||||||
(begin (display " /* " port)
|
|
||||||
(writex x port)
|
|
||||||
(display " */" port)))
|
|
||||||
(newline port))
|
|
||||||
|
|
||||||
;;; scsh-emit-d-vector
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; descriptor vectors are pretty easy given scsh-emit-descriptor
|
|
||||||
(define (scsh-emit-d-vector-initializer x reloc port)
|
|
||||||
(let ((len (d-vector-length x)))
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i len))
|
|
||||||
(scsh-emit-descriptor (d-vector-ref x i) reloc port)
|
|
||||||
(write-char #\, port))))
|
|
||||||
|
|
||||||
;;; scsh-emit-descriptor
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; for descrriptors we consult the relocation table
|
|
||||||
(define (scsh-emit-descriptor x reloc port)
|
|
||||||
(if (stob? x)
|
|
||||||
(let ((n (chunk-number x)))
|
|
||||||
(display "(long)(&" port)
|
|
||||||
(if (immutable? x)
|
|
||||||
(display "p" port)
|
|
||||||
(display "i" port))
|
|
||||||
(display n port)
|
|
||||||
(display "[" port)
|
|
||||||
(display (quotient (table-ref (vector-ref reloc n) x) 4) port)
|
|
||||||
(display "])+7" port))
|
|
||||||
(format port
|
|
||||||
(if (negative? x) "-0x~a" "0x~a")
|
|
||||||
(number->string (abs x) 16))))
|
|
||||||
|
|
||||||
;;; scsh-emit-vm-string-initializer
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; vm-strings are converted to numbers and byte order adjusted
|
|
||||||
(define (scsh-emit-vm-string-initializer x port)
|
|
||||||
(let* ((len (vm-string-length x)) ; end is jawilson style hack
|
|
||||||
(end (- (cells->bytes (bytes->cells (+ len 1))) 4)))
|
|
||||||
(do ((i 0 (+ i 4)))
|
|
||||||
((= i end)
|
|
||||||
(case (- len end)
|
|
||||||
((0)
|
|
||||||
(write-hex port 0))
|
|
||||||
((1)
|
|
||||||
(write-hex
|
|
||||||
port
|
|
||||||
(net-to-host-32 (arithmetic-shift
|
|
||||||
(char->ascii (vm-string-ref x i)) 24))))
|
|
||||||
((2)
|
|
||||||
(write-hex
|
|
||||||
port
|
|
||||||
(net-to-host-32
|
|
||||||
(bitwise-ior
|
|
||||||
(arithmetic-shift
|
|
||||||
(char->ascii (vm-string-ref x i)) 24)
|
|
||||||
(arithmetic-shift
|
|
||||||
(char->ascii (vm-string-ref x (+ i 1))) 16)))))
|
|
||||||
((3)
|
|
||||||
(write-hex
|
|
||||||
port
|
|
||||||
(net-to-host-32
|
|
||||||
(bitwise-ior
|
|
||||||
(bitwise-ior
|
|
||||||
(arithmetic-shift
|
|
||||||
(char->ascii (vm-string-ref x i)) 24)
|
|
||||||
(arithmetic-shift
|
|
||||||
(char->ascii (vm-string-ref x (+ i 1))) 16))
|
|
||||||
(arithmetic-shift
|
|
||||||
(char->ascii (vm-string-ref x (+ i 2))) 8)))))))
|
|
||||||
(write-hex port
|
|
||||||
(net-to-host-32 (bitwise-ior
|
|
||||||
(bitwise-ior
|
|
||||||
(arithmetic-shift
|
|
||||||
(char->ascii
|
|
||||||
(vm-string-ref x i)) 24)
|
|
||||||
(arithmetic-shift
|
|
||||||
(char->ascii
|
|
||||||
(vm-string-ref x (+ i 1))) 16))
|
|
||||||
(bitwise-ior
|
|
||||||
(arithmetic-shift
|
|
||||||
(char->ascii
|
|
||||||
(vm-string-ref x (+ i 2))) 8)
|
|
||||||
(char->ascii
|
|
||||||
(vm-string-ref x (+ i 3))))))
|
|
||||||
))))
|
|
||||||
|
|
||||||
;;; scsh-emit-b-vector-initializer
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; byte vectors are byte order adjusted too
|
|
||||||
(define (scsh-emit-b-vector-initializer x externs port)
|
|
||||||
(cond ((and (code-vector? x)
|
|
||||||
(table-ref externs x)) =>
|
|
||||||
(lambda (name)
|
|
||||||
(format port "(long) *~a," name)))
|
|
||||||
(else
|
|
||||||
(let* ((len (b-vector-length x)) ;end is jawilson style hack
|
|
||||||
(end (- (cells->bytes (bytes->cells (+ len 1))) 4)))
|
|
||||||
(do ((i 0 (+ i 4)))
|
|
||||||
((= i end)
|
|
||||||
(case (- len end)
|
|
||||||
((1)
|
|
||||||
(write-hex
|
|
||||||
port
|
|
||||||
(net-to-host-32
|
|
||||||
(arithmetic-shift (b-vector-ref x i) 24))))
|
|
||||||
((2)
|
|
||||||
(write-hex
|
|
||||||
port
|
|
||||||
(net-to-host-32
|
|
||||||
(bitwise-ior
|
|
||||||
(arithmetic-shift (b-vector-ref x i) 24)
|
|
||||||
(arithmetic-shift (b-vector-ref x (+ i 1)) 16)))))
|
|
||||||
((3)
|
|
||||||
(write-hex
|
|
||||||
port
|
|
||||||
(net-to-host-32
|
|
||||||
(bitwise-ior
|
|
||||||
(bitwise-ior
|
|
||||||
(arithmetic-shift (b-vector-ref x i) 24)
|
|
||||||
(arithmetic-shift (b-vector-ref x (+ i 1)) 16))
|
|
||||||
(arithmetic-shift (b-vector-ref x (+ i 2)) 8)))
|
|
||||||
))))
|
|
||||||
(write-hex
|
|
||||||
port
|
|
||||||
(net-to-host-32 (bitwise-ior
|
|
||||||
(bitwise-ior
|
|
||||||
(arithmetic-shift
|
|
||||||
(b-vector-ref x i) 24)
|
|
||||||
(arithmetic-shift
|
|
||||||
(b-vector-ref x (+ i 1)) 16))
|
|
||||||
(bitwise-ior
|
|
||||||
(arithmetic-shift
|
|
||||||
(b-vector-ref x (+ i 2)) 8)
|
|
||||||
(b-vector-ref x (+ i 3))))))))
|
|
||||||
)))
|
|
||||||
|
|
||||||
;;; scsh-for-each-stored-object
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; see scheme48 for-each-stored-object
|
|
||||||
;;; Image traversal utility
|
|
||||||
|
|
||||||
(define (scsh-for-each-stored-object chunk-start proc chunk-end)
|
|
||||||
(let ((limit (heap-pointer)))
|
|
||||||
(let chunk-loop ((addr (newspace-begin))
|
|
||||||
(i 0)
|
|
||||||
(chunk (+ (newspace-begin) *chunk-size*)))
|
|
||||||
(if (addr< addr limit)
|
|
||||||
(begin (chunk-start i)
|
|
||||||
(let loop ((addr addr))
|
|
||||||
(if (and (addr< addr limit)
|
|
||||||
(addr< addr chunk))
|
|
||||||
(let* ((d (fetch addr))
|
|
||||||
(len (addr1+ (header-a-units d))))
|
|
||||||
(if (not (header? d))
|
|
||||||
(warn "heap is in an inconsistent state" d))
|
|
||||||
(proc i
|
|
||||||
(address->stob-descriptor (addr1+ addr))
|
|
||||||
len)
|
|
||||||
(loop (addr+ addr len)))
|
|
||||||
(begin (chunk-end i)
|
|
||||||
(chunk-loop addr
|
|
||||||
(+ i 1)
|
|
||||||
(+ chunk *chunk-size*))))))))))
|
|
||||||
;;; write-hex
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; utility routine to print a scheme number as a c hex number
|
|
||||||
(define (write-hex port x)
|
|
||||||
(format port
|
|
||||||
(if (negative? x) "-0x~a," "0x~a,")
|
|
||||||
(number->string (abs x) 16)))
|
|
||||||
|
|
||||||
;;; line->list
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; utility that takes a string and break it into a list at whitespace
|
|
||||||
;;; rewrite using scsh stuff?
|
|
||||||
(define (line->list line)
|
|
||||||
(let ((len (string-length line)))
|
|
||||||
(let loop ((start 0)
|
|
||||||
(end 0)
|
|
||||||
(l '()))
|
|
||||||
(cond ((>= end len)
|
|
||||||
(if (= start end)
|
|
||||||
l
|
|
||||||
(append l (list (substring line start end)))))
|
|
||||||
((and (= start end)
|
|
||||||
(or (char=? (string-ref line start) (ascii->char 32))
|
|
||||||
(char=? (string-ref line start) (ascii->char 9))))
|
|
||||||
(loop (+ 1 start)
|
|
||||||
(+ 1 end)
|
|
||||||
l))
|
|
||||||
((or (char=? (string-ref line end) (ascii->char 32))
|
|
||||||
(char=? (string-ref line end) (ascii->char 9)))
|
|
||||||
(loop (+ 1 end)
|
|
||||||
(+ 1 end)
|
|
||||||
(append l (list (substring line start end)))))
|
|
||||||
((< end len)
|
|
||||||
(loop start
|
|
||||||
(+ 1 end)
|
|
||||||
l))
|
|
||||||
(else (error "unexpected case in line->list"))))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; Debugging
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(define (bin n)
|
|
||||||
(number->string n 2))
|
|
||||||
|
|
||||||
(define (oct n)
|
|
||||||
(number->string n 8))
|
|
||||||
|
|
||||||
(define (dec n)
|
|
||||||
(number->string n 10))
|
|
||||||
|
|
||||||
(define (hex n)
|
|
||||||
(number->string n 16))
|
|
||||||
|
|
||||||
;;; Static Heap Code From Scheme48
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;;; The Scheme 48 version produced monolithic C files that even
|
|
||||||
;;; the GNU C Compiler couldn't handle, let alone standard vendor
|
|
||||||
;;; compilers...
|
|
||||||
;;; It also relied upon the C compiler to fill in some pointer
|
|
||||||
;;; information. Because I needed to break up the files, I had to
|
|
||||||
;;; calculate this information myself.
|
|
||||||
|
|
||||||
; For example:
|
|
||||||
; (do-it 100000 "~/s48/debug/little.image" "little-heap.c")
|
|
||||||
;
|
|
||||||
; The first argument to do-it should be somewhat larger than the size,
|
|
||||||
; in bytes, of the image file to be converted (which you can obtain with
|
|
||||||
; "ls -l").
|
|
||||||
;
|
|
||||||
; If the image contains 0-length stored objects, then the .c file will
|
|
||||||
; have to be compiled by gcc, since 0-length arrays aren't allowed in
|
|
||||||
; ANSI C. This wouldn't be difficult to work around.
|
|
||||||
|
|
||||||
(define *comments?* #f)
|
|
||||||
|
|
||||||
; 800,000 bytes => 200,000 words => at least 100,000 objects
|
|
||||||
; 50 chunks => 16,000 bytes per chunk => 2,000 objects per chunk
|
|
||||||
(define *chunk-size* 10000)
|
|
||||||
|
|
||||||
(define (do-it bytes infile outfile)
|
|
||||||
(let ((start (init bytes infile)))
|
|
||||||
(call-with-output-file outfile
|
|
||||||
(lambda (port)
|
|
||||||
(format port "#define D(x) (long)(&x)+7~%")
|
|
||||||
(format port "#define H unsigned long~%")
|
|
||||||
(emit-area-declarations "p" immutable? "const " port)
|
|
||||||
(emit-area-declarations "i" mutable? "" port)
|
|
||||||
(emit-area-initializers "p" immutable? "const " port)
|
|
||||||
(emit-area-initializers "i" mutable? "" port)
|
|
||||||
(display "const long entry = " port)
|
|
||||||
(emit-descriptor start port)
|
|
||||||
(write-char #\; port)
|
|
||||||
(newline port)))))
|
|
||||||
|
|
||||||
(define (init bytes infile)
|
|
||||||
(create-memory (quotient bytes 2) quiescent) ;Output of ls -l
|
|
||||||
(initialize-heap (memory-begin) (memory-size))
|
|
||||||
(let ((start (read-image infile 0)))
|
|
||||||
(message (nchunks)
|
|
||||||
" chunks")
|
|
||||||
start))
|
|
||||||
|
|
||||||
(define (nchunks) (+ (chunk-number (heap-pointer)) 1))
|
|
||||||
|
|
||||||
; emit struct declarations for areas
|
|
||||||
|
|
||||||
(define (emit-area-declarations name in-area? const port)
|
|
||||||
(for-each-stored-object
|
|
||||||
(lambda (chunk)
|
|
||||||
(message name chunk " declaration")
|
|
||||||
(display "struct " port) (display name port) (display chunk port)
|
|
||||||
(display " {" port) (newline port))
|
|
||||||
(lambda (x)
|
|
||||||
(if (in-area? x)
|
|
||||||
(emit-declaration x port)))
|
|
||||||
(lambda (chunk)
|
|
||||||
(display "};" port)
|
|
||||||
(newline port)
|
|
||||||
(display const port)
|
|
||||||
(display "extern struct " port) (display name port) (display chunk port)
|
|
||||||
(write-char #\space port) (display name port) (display chunk port)
|
|
||||||
(write-char #\; port) (newline port)
|
|
||||||
chunk)))
|
|
||||||
|
|
||||||
(define (emit-declaration x port)
|
|
||||||
(display " H x" port)
|
|
||||||
(writex x port)
|
|
||||||
(cond ((d-vector? x)
|
|
||||||
(display "; long d" port)
|
|
||||||
(writex x port)
|
|
||||||
(write-char #\[ port)
|
|
||||||
(write (d-vector-length x) port))
|
|
||||||
((vm-string? x)
|
|
||||||
(display "; char d" port)
|
|
||||||
(writex x port)
|
|
||||||
(write-char #\[ port)
|
|
||||||
;; Ensure alignment (thanks Ian)
|
|
||||||
(write (cells->bytes (bytes->cells (b-vector-length x)))
|
|
||||||
port))
|
|
||||||
(else
|
|
||||||
(display "; unsigned char d" port)
|
|
||||||
(writex x port)
|
|
||||||
(write-char #\[ port)
|
|
||||||
;; Ensure alignment
|
|
||||||
(write (cells->bytes (bytes->cells (b-vector-length x)))
|
|
||||||
port)))
|
|
||||||
(display "];" port)
|
|
||||||
(if *comments?*
|
|
||||||
(begin (display " /* " port)
|
|
||||||
(display (enumerand->name (stob-type x) stob) port)
|
|
||||||
(display " */" port)))
|
|
||||||
(newline port))
|
|
||||||
|
|
||||||
; Emit initializers for areas
|
|
||||||
|
|
||||||
(define (emit-area-initializers name in-area? const port)
|
|
||||||
(for-each-stored-object
|
|
||||||
(lambda (chunk)
|
|
||||||
(message name chunk " initializer")
|
|
||||||
|
|
||||||
(display const port)
|
|
||||||
(display "struct " port) (display name port) (write chunk port)
|
|
||||||
(write-char #\space port) (display name port) (write chunk port)
|
|
||||||
(display " =" port) (newline port)
|
|
||||||
|
|
||||||
(write-char #\{ port) (newline port))
|
|
||||||
(lambda (x)
|
|
||||||
(if (in-area? x)
|
|
||||||
(emit-initializer x port)))
|
|
||||||
(lambda (chunk)
|
|
||||||
(display "};" port) (newline port)))
|
|
||||||
|
|
||||||
(let ((n (nchunks)))
|
|
||||||
(format port "const long ~a_count = ~s;~%" name n)
|
|
||||||
(format port "~a long * const ~a_areas[~s] = {" const name n)
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i n))
|
|
||||||
(format port "(~a long *)&~a~s, " const name i))
|
|
||||||
(format port "};~%const long ~a_sizes[~s] = {" name n)
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i n))
|
|
||||||
(format port "sizeof(~a~s), " name i))
|
|
||||||
(format port "};~%")))
|
|
||||||
|
|
||||||
|
|
||||||
(define (message . stuff)
|
|
||||||
(for-each display stuff) (newline))
|
|
||||||
|
|
||||||
(define (emit-initializer x port)
|
|
||||||
(display " " port)
|
|
||||||
(write (stob-header x) port)
|
|
||||||
(write-char #\, port)
|
|
||||||
(cond ((d-vector? x)
|
|
||||||
(emit-d-vector-initializer x port))
|
|
||||||
((vm-string? x)
|
|
||||||
(write-char #\" port)
|
|
||||||
(let ((len (vm-string-length x)))
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i len) (write-char #\" port))
|
|
||||||
(let ((c (vm-string-ref x i)))
|
|
||||||
(cond ((or (char=? c #\") (char=? c #\\))
|
|
||||||
(write-char #\\ port))
|
|
||||||
((char=? c #\newline)
|
|
||||||
(display "\\n\\" port)))
|
|
||||||
(write-char c port)))))
|
|
||||||
(else
|
|
||||||
(write-char #\{ port)
|
|
||||||
(let ((len (b-vector-length x)))
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i len) (write-char #\} port))
|
|
||||||
(write (b-vector-ref x i) port)
|
|
||||||
(write-char #\, port)))))
|
|
||||||
(write-char #\, port)
|
|
||||||
(if *comments?*
|
|
||||||
(begin (display " /* " port)
|
|
||||||
(writex x port)
|
|
||||||
(display " */" port)))
|
|
||||||
(newline port))
|
|
||||||
|
|
||||||
(define (emit-d-vector-initializer x port)
|
|
||||||
(write-char #\{ port)
|
|
||||||
(let ((len (d-vector-length x)))
|
|
||||||
(do ((i 0 (+ i 1)))
|
|
||||||
((= i len) (write-char #\} port))
|
|
||||||
(emit-descriptor (d-vector-ref x i) port)
|
|
||||||
(write-char #\, port))))
|
|
||||||
|
|
||||||
(define (emit-descriptor x port)
|
|
||||||
(if (stob? x)
|
|
||||||
(begin (if (immutable? x)
|
|
||||||
(display "D(p" port)
|
|
||||||
(display "D(i" port))
|
|
||||||
(display (chunk-number x) port)
|
|
||||||
(display ".x" port)
|
|
||||||
(writex x port)
|
|
||||||
(write-char #\) port))
|
|
||||||
(write x port)))
|
|
||||||
|
|
||||||
|
|
||||||
; Foo
|
|
||||||
|
|
||||||
(define (writex x port)
|
|
||||||
(write (quotient (- (- x (memory-begin)) 7) 4) port))
|
|
||||||
|
|
||||||
(define (chunk-number x)
|
|
||||||
(quotient (- (- x (memory-begin)) 7) *chunk-size*))
|
|
||||||
|
|
||||||
|
|
||||||
; Image traversal utility
|
|
||||||
|
|
||||||
(define (for-each-stored-object chunk-start proc chunk-end)
|
|
||||||
(let ((limit (heap-pointer)))
|
|
||||||
(let chunk-loop ((addr (newspace-begin))
|
|
||||||
(i 0)
|
|
||||||
(chunk (+ (newspace-begin) *chunk-size*)))
|
|
||||||
(if (addr< addr limit)
|
|
||||||
(begin (chunk-start i)
|
|
||||||
(let loop ((addr addr))
|
|
||||||
(if (and (addr< addr limit)
|
|
||||||
(addr< addr chunk))
|
|
||||||
(let ((d (fetch addr)))
|
|
||||||
(if (not (header? d))
|
|
||||||
(warn "heap is in an inconsistent state" d))
|
|
||||||
(proc (address->stob-descriptor (addr1+ addr)))
|
|
||||||
(loop (addr1+ (addr+ addr (header-a-units d)))))
|
|
||||||
(begin (chunk-end i)
|
|
||||||
(chunk-loop addr
|
|
||||||
(+ i 1)
|
|
||||||
(+ chunk *chunk-size*))))))))))
|
|
||||||
|
|
||||||
(define (mutable? x) (not (immutable? x)))
|
|
||||||
|
|
||||||
;; End begin
|
|
||||||
))
|
|
||||||
Loading…
Reference in New Issue