v08i049: Elk (Extension Language Toolkit) part 01 of 14
Brandon S. Allbery - comp.sources.misc
allbery at uunet.UU.NET
Sun Sep 24 07:38:49 AEST 1989
Posting-number: Volume 8, Issue 49
Submitted-by: net at tub.UUCP (Oliver Laumann)
Archive-name: elk/part01
[Let this be a lesson to submitters: this was submitted as uuencoded,
compressed files. I lost the source information while unpacking it; this
is the best approximation I could come up with. ++bsa]
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 14)."
# Contents: RELEASE README INSTALL ORIGIN Makefile doc doc/oops.ms
# doc/compat.ms doc/xt.ms doc/stack.txt doc/tmac.scheme src
# src/env.c src/fixmul.c
# Wrapped by net at tub on Sun Sep 17 17:32:15 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f RELEASE -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"RELEASE\"
else
echo shar: Extracting \"RELEASE\" \(2698 characters\)
sed "s/^X//" >RELEASE <<'END_OF_RELEASE'
XElk Release Notes
X-----------------
X
X
XThis is release 1.0 of Elk (The Extension Language Kit).
XThis is a production release.
X
XElk is a Scheme interpreter intended to be used as a general extension
Xlanguage; it is also useful as a stand-alone implementation of Scheme.
X
XOne purpose of the Elk project is to end the recent proliferation of
Xmutually incompatible Lisp-like extension languages. Instead of
Xinventing and implementing yet another extension language, application
Xprogrammers can link the Scheme interpreter into their application
Xin order to make it extensible and highly customizable.
X
XThe Elk project was started in 1987 to support ISOTEXT, an ODA-based
Xdocument system (a WYSIWYG editor) that is being developed at the
XTechnical University of Berlin. Elk has been successfully demonstrated
Xas the extension language kernel of ISOTEXT, e.g. at the Hanover Fair 1989.
X
XWe feel that Scheme is better suited as a general extension language
Xthan other Lisp dialects: it is sufficiently small to not dwarf the
Xapplication it serves and to be fully understood with acceptable
Xeffort; it is orthogonal and well-defined. In addition, Scheme has
Xbeen recognized to be mature enough for national and international
Xstandardization (IEEE P1178, ISO/IEC JTC1/SC22/WG16).
X
XThe Elk Scheme interpreter is R^3RS compatible (with some minor exceptions
Xlisted in a separate document); future releases will conform to the R^4RS
Xand/or P1178 as soon as the respective standards become available.
X
XNon-standard features of the Scheme implementation include:
X
X o dynamic loading of object files
X o creation of an executable image from the running
X interpreter (``unexec'')
X o a macro facility
X o environments as first-class objects
X o dynamic-wind, fluid-let
X o autoloading, provide/require
X
XThe Scheme interpreter can easily be extended by application-specific
Xnew types and primitive procedures. Such extensions are typically
Xwritten in C or C++ and dynamically loaded into the running interpreter.
X
XThe current release of Elk includes several such extensions, e.g.
Xinterfaces to the X11 Xlib and to the application programmer interface
Xof the Xt intrinsics, and interfaces to the Athena widget set and the
XHP widget set.
X
XThe software currently runs on Sun-3s with SunOS, ISI 680x0 with 4.2BSD
Xor 4.3BSD, Vax with 4.3BSD or Ultrix, and Intel 80386 with System V
XRelease 3. Porting instructions are included. Dynamic loading of
Xobject modules is not supported under System V.
X
X--
XOliver Laumann, Technical University of Berlin, Germany
XCommunications and Operating Systems Research Group
X
Xnet at tub.BITNET Europe: unido!tub!net World: pyramid!tub!net
END_OF_RELEASE
if test 2698 -ne `wc -c <RELEASE`; then
echo shar: \"RELEASE\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f README -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"README\"
else
echo shar: Extracting \"README\" \(3073 characters\)
sed "s/^X//" >README <<'END_OF_README'
XThis directory holds the source code and documentation for the latest
Xrelease of the General Extension Language Interpreter (a Scheme interpreter).
X
XThe file RELEASE explains the purpose and release status of the software;
Xthe file ORIGIN contains its copyright status and acknowledgements.
X
XAll file names mentioned in this memo and in the INSTALL file are relative
Xto this directory.
X
Xsrc holds the source files of the interpreter proper. The current
X release of the interpreter is written entirely in C (plus a few
X lines of assembly code).
X
Xsrc/stack.s.*
X The part of the interpreter that has to be written in assembly;
X one file for each supported machine type.
X
Xsrc/alloca.s.*
X The implementation of the alloca() function for the supported
X machine types (if a file for a machine is empty, the alloca()
X from the C library can be used).
X
Xscm holds Scheme files that can be loaded into the interpreter
X (either explicitly by means of the "load" primitive or
X automatically).
X
Xlib holds the C programs that represent extensions of the interpreter.
X The corresponding .o-files can be loaded into the interpreter
X (or, when the operating system doesn't support loading of object
X files, be linked together with the core interpreter).
X
Xlib/xlib
X holds the Scheme-Xlib interface (the part written in C).
X It can be loaded with "(require 'xlib)".
X
Xlib/xlib/examples
X holds a number of simple Scheme demonstrations programs
X that make use of the Xlib integration.
X
Xlib/xt
X holds the Scheme-Xt interface. It can be loaded with
X "(require 'xt)".
X
Xlib/xt/examples
X holds a number of Scheme programs that demonstrate the interface
X to Xt and the Athena and HP widgets.
X
Xlib/xaw
Xlib/xhp
X these directories hold the interfaces to the Athena and Hp widgets,
X respectively. Look into the demonstration programs to see how
X individual widgets are loaded.
X
X The directories hold a file with the extension .d for each widget
X class. Running "make" creates a C file for each .d-file which is
X then compiled to a .o-file.
X
Xlib/util
X holds utility functions used by more than one extension.
X
Xdoc/ holds the documentation. Most of the documents must be formatted
X using nroff or troff with the "ms" macros (the first few lines of the
X .ms files may contain directions for mounting the appropriate fonts).
X
Xdoc/stack.txt
X describes how to write a new src/stack.s for a new type of processor
X
Xtst/ holds a number of trivial Scheme test programs and other small
X programs that have been obtained through USENET newsgroups or the
X Scheme mailing list.
X
Xstk/ holds two small test programs that can be used to verify that
X the assembly functions in src/stack.s are working correctly.
X
X
XThe file INSTALL in this directory explains how to compile and
Xinstall the interpreter and the extensions and how to port the
Xsources to processors and operating systems not supported by
Xthe current release.
END_OF_README
if test 3073 -ne `wc -c <README`; then
echo shar: \"README\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f INSTALL -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"INSTALL\"
else
echo shar: Extracting \"INSTALL\" \(13186 characters\)
sed "s/^X//" >INSTALL <<'END_OF_INSTALL'
XThis file describes how to install the Scheme interpreter and
Xthe extensions to the interpreter and how to port it to a
Xprocessor or operating system not supported by this release.
XYou want to read the release notes (RELEASE) and the files
XORIGIN and README in this directory before proceeding.
X
X
X
XSUPPORTED ENVIRONMENTS
X
XThe processor/operating system combinations on which this software
Xhas been tested are called "supported environments". While installing
Xthe software in a supported environment is simple (mainly a matter
Xof typing "make"), additional efforts may be required to install it
Xon a different processor or operating system. This may be as simple
Xas adding a line to a Makefile, or it may require you to write some
Xlines of assembly code.
X
XSupported environments of this release are
X
X Sun-3 with SunOS 4.0
X Integrated Solutions 680x0 with 4.2BSD or 4.3BSD
X Vax with 4.3BSD (or Ultrix)
X Intel 80386 with UNIX System V Release 3
X
XIt is expected that the software can be installed without modifications
Xin environments closely resembling those listed above, e.g. XENIX or
Xolder versions of SunOS.
X
XIf you want to install the software in an environment not supported by
Xthis release, you should first ask the author (me) whether it has
Xalready been ported by someone else since this release has been
Xpublished. This may save you the effort of applying the necessary
Xmodifications yourself, and it avoids duplication of work.
X
XLikewise, if you have ported the software to a new environment, you can
Xhelp saving other people's work if you send me the modifications (my
Xelectronic mail address is in the file ORIGIN). This helps me
Xincreasing the number of supported environments in the next release,
Xand it enables me to act as a "clearing house" for official
Xmodifications to the software.
X
XIf you want to port the software to a new environment, read the chapter
X"PORTING THE SOFTWARE" below, then come back to this point.
X
X
X
XINSTALLING THE SOFTWARE
X
XBefore compiling the sources, you have to modify a few lines in the
XMakefile in this directory. This Makefile invokes "make" on the
Xindividual Makefiles in the sub-directories to make the interpreter
Xand the extensions. Never modify one of the Makefiles in the
Xsub-directories or directly invoke "make" in a sub-directory, since
Xthe CFLAGS and other definitions are propagated from the top level
XMakefile to the "inferior" Makefiles.
X
X1) First insert the name of the directory where the Scheme files reside
X into the line beginning with SCHEME_DIR=. This is usually the
X top level directory of the distribution (the directory where you are
X now) with "/scm" appended. However, you might want to move the
X Scheme files to a different directory (e.g. /usr/local/lib/scm).
X Be careful to not delete any backslashes or quotes when editing
X this line.
X
X2) Insert a symbol indicating the type of processor into the line beginning
X with MACHTYPE=. In the current release, permitted values of MACHTYPE
X are 68k for the 680x0, vax for the Vax, and 386 for the Intel 80386.
X MACHTYPE is used to determine which of the assembly files in the src
X directory will be used; it is actually a file suffix.
X
X3) Decide which CFLAGS and LDFLAGS you want to use. Remove the '#' in
X front of the correct definitions for CFLAGS and LDFLAGS and comment
X the lines out that have previously been in effect. Note that under SunOS
X -Bstatic has to be used to make sure that the interpreter is statically
X linked. When you want to use the GNU C-compiler, on some systems
X it may be necessary to add -ftraditional in order to correctly compile
X the include file <sys/ioctl.h>.
X
X4) Type "make". This makes the interpreter (in src) and all extensions
X (lib, lib/xlib, lib/xt, lib/xaw and lib/xhp). If you don't want
X to compile everything (e.g. when you don't have the X window system)
X invoke "make" with a list of TARGETS, e.g. "make TARGETS=src" to
X only make the interpreter or "make 'TARGETS=lib/xaw lib/xhp'" to
X make the interfaces to the Athena and HP widgets. Never invoke
X "make" directly in one of the sub-directories since in this case
X the correct definitions for CFLAGS etc. will not be in effect.
X
X5) When the compilation has finished, the Scheme interpreter is in the
X file src/scheme. Invoke it and load some programs from the tst and
X scm directories to make sure that it works. If you have the X window
X system try to load the demonstration programs in lib/xlib/examples
X and lib/xt/examples. If "dumping" is supported on your system,
X try something like "(dump 'foo)", leave the interpreter, and then
X try to execute "foo".
X
X If everything works fine you should make the interpreter available
X to all users of your system by moving it to /usr/local (or
X where-ever you install new executables). Do not strip the
X executable; the symbol table is required for dynamic loading
X and "dumping".
X
X6) On systems that do not support dynamic loading (typically System V),
X the extensions that you are going to use (e.g. the interface to the
X Xlib) must be linked together with the interpreter statically, since
X they cannot be loaded during runtime. Since there is no rule in
X src/Makefile to accomplish this, you should either add the names of
X the object files (e.g. ../lib/xlib.o) to the rule for "scheme" or
X link the object files by hand:
X
X cd src
X cc -o scheme *.o ../lib/xlib.o [other extensions] -lm -x
X
X Then rename the interpreter to something different from "scheme"
X (e.g. "xscheme"). This causes the interpreter to initialize the
X extensions on startup (by reading its own symbol table and invoking
X all initialization functions and C++ static constructors).
X In general, this kind of initialization is performed when
X
X 1) INIT_OBJECTS is defined in src/config.h and
X 2) the name of the interpreter is not equal to "scheme".
X
X
X
XPORTING THE SOFTWARE
X
X0) Requirements on the target environment:
X
X The C language implementation must support alloca(). The semi-portable
X alloca() by Doug Gwyn cannot be used; alloca() must actually extend
X the stack.
X
X The C compiler must be able to accept long input lines (at least
X 2500 characters).
X
X The software probably cannot be easily ported to systems with less
X than 32 bits for the representation of pointers and integers. It
X has not yet been tested on systems with larger representations; in
X this case it may be necessary to modify the representation of Scheme
X objects (src/object.h).
X
X The representation of Scheme objects (src/object.h) currently assumes
X that only the VALBITS low order bits of a pointer are used. If some
X of the high order bits of a pointer are non-zero on your machine,
X the macros POINTER, SETPOINTER, and SET in the file src/object.h
X must be modified accordingly.
X
X The operating system must provide for blocking and re-enabling
X signals for critical sections without the danger of signals getting
X lost due to this blocking.
X
X1) If you are porting the software to a type of processor not mentioned
X in the list of supported environments, you must first provide a
X working version of the assembly file src/stack.s. The file
X doc/stack.txt contains instructions how to write a new stack.s; the
X directory "stk" holds two simple test programs that should be used
X to make sure that the new stack.s is working correctly.
X
X Then move the new stack.s to src/stack.s.MACH, where MACH identifies
X the type of the target system and insert MACH into the line beginning
X with MACHTYPE= in the top level Makefile.
X
X If you have to use your own implementation of alloca(), move it to
X src/alloca.s.MACH. Otherwise create an empty src/alloca.s.MACH.
X
X2) Find a predefined C preprocessor symbol that identifies your target
X environment (such as is68k, vax, i386, etc.); if you can't find
X such a symbol, invent one and define it in the top level Makefile's
X CFLAGS by means of the -D option.
X
X Put the relevant #define statements for the target environment into the
X configuration file src/config.h; enclose the group of definitions by
X
X #ifdef XYZ
X ...
X #endif
X
X where XYZ is the symbol identifying the type of environment.
X You may want to look at the definitions for the already supported
X environments in the same file. One or more of the following
X symbols can be #defined:
X
X
X VFORK indicates that your system has the vfork() library function.
X fork() will be used if VFORK is undefined.
X
X Define VPRINTF to indicate that your system has the vprintf()
X library function. If VPRINTF is undefined, vprintf() will be
X simulated by means of _doprnt(). If your system provides
X neither vprintf() nor _doprnt(), you will have to modify the
X relevant parts of src/print.c.
X
X BIG_ENDIAN indicates that your system is of type "big endian"
X (most significant bit first). "Least significant bit first"
X (LITTLE_ENDIAN) will be assumed if BIG_ENDIAN is undefined.
X
X TIME_H should hold the location of the system include file time.h.
X This usually is either <time.h> or <sys/time.h>.
X
X DIRENT indicates that the readdir() library function returns a
X pointer to a "struct dirent" and requires the include file
X <dirent.h>. If DIRENT is undefined, readdir() will be assumed to
X return a pointer to a "struct direct" and <sys/dir.h> will be included.
X
X TERMIO indicates that your system supports the "termio" terminal
X interface and ioctl commands. If TERMIO is undefined, the
X BSD-style interface will be used instead.
X
X Define UNISTD to indicate that usage of access() requires the
X file <unistd.h> to be included. If UNISTD is undefined, it will
X be assumed that the relevant constants are defined in <sys/file.h>.
X
X If USE_SIGNAL is defined, signal() will be used instead of sigblock()
X and sigsetmask() to block and re-enable signals.
X
X If the target system does not provide the BSD-style getrlimit()
X function to obtain the maximum size of the process's stack segment,
X STACK_SIZE can be defined to hold the maximum stack size as a constant
X (a reasonable value for STACK_SIZE is 512 KBytes).
X However, if your system provides a different function to obtain the
X maximum stack size, you should modify the function Get_Stack_Limit()
X in src/main.c accordingly.
X
X If your system does not provide the BSD-style getdtablesize()
X function, MAX_OFILES should indicate the maximum number of open
X files for a process.
X
X If there is no fchmod() library function on your system, define
X FCHMOD_BROKEN. In this case chmod() will be used instead.
X
X Dynamic loading:
X
X Define CAN_LOAD_OBJ if the target system enables dynamic loading
X of object files. This requires that the system linker (/bin/ld)
X supports the -A and -T options for incremental loading and that
X the data space in the interpreter is executable, i.e. that it is
X possible to derive a function pointer to an object that has been
X loaded into data space. In addition, it requires that your system
X supports the BSD-style a.out format; the current release of the
X software does not support dynamic loading for other a.out file
X formats (such as COFF).
X
X In addition to CAN_LOAD_OBJ you should define XFLAG_BROKEN if
X the system linker is broken so that the -x option cannot be
X used together with -A. This is true for certain releases
X of SunOS.
X
X If dynamic loading is not supported, you should define the symbol
X INIT_OBJECTS to instruct the interpreter to initialize statically
X linked extensions on startup. See also point 6) of INSTALLING
X THE SOFTWARE above.
X
X Dumping:
X
X Define the symbol CAN_DUMP if the target environment allows
X to create an executable file from a running process.
X Dumping requires that the a.out file format supported by
X the system is either the BSD-style a.out format or the COFF
X format. In the latter case, define the symbol COFF.
X If COFF is defined, it will be assumed that the "ld" library
X is present on your system (a collection of functions that provide
X access to the parts of an object file), and PAGESIZE must hold
X the system's page size (measured in bytes).
X
X If COFF is undefined, the symbols SEGMENT_SIZE, FILE_TEXT_START,
X MEM_TEXT_START, and TEXT_LENGTH_ADJ must be defined in addition
X to CAN_DUMP. SEGMENT_SIZE is the segment size of the system's
X memory management unit, i.e. the number to a multiple of which
X the size of an a.out segment (e.g. .text) is rounded up;
X FILE_TEXT_START is the file offset at which the text segment
X starts in an a.out file; MEM_TEXT_START is the starting address
X of the text segment in memory; TEXT_LENGTH_ADJ must be set to
X "sizeof (struct exec)" if the length of the text segment stored
X in the a.out header includes the a.out header itself.
X
X3) If everything is working, send me the "diffs" and especially the
X new stack.s so that I'm able to incorporate your modifications
X into the next release of the software.
END_OF_INSTALL
if test 13186 -ne `wc -c <INSTALL`; then
echo shar: \"INSTALL\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f ORIGIN -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"ORIGIN\"
else
echo shar: Extracting \"ORIGIN\" \(959 characters\)
sed "s/^X//" >ORIGIN <<'END_OF_ORIGIN'
XThis software is Copyright 1987, 1988, 1989, Nixdorf Computer AG
Xand Teles GmbH, Berlin.
X
XThis software has been written by Oliver Laumann (me) for TELES
XTelematic Services, Berlin, in a joint project between TELES and
XNixdorf Microprocessor Engineering, Berlin. I would like to thank
XClaus Bathe of NME Berlin for securing the permission from his
Xmanagement to publish this software, Prof. Dr. Sigram Schindler for
Xproviding the work environment for ISOTEXT and Elk, and Carsten
XBormann for his support and src/bignum.c.
X
XAny use of this software is permitted provided that this notice is not
Xremoved and that neither Oliver Laumann nor TELES nor Nixdorf are
Xdeemed to have made any representations as to the suitability of this
Xsoftware for any purpose nor are held responsible for any defects of
Xthis software. THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
X
XBerlin, July 1, 1989
X
XOliver Laumann net at TUB.BITNET net at tub.UUCP
END_OF_ORIGIN
if test 959 -ne `wc -c <ORIGIN`; then
echo shar: \"ORIGIN\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"Makefile\"
else
echo shar: Extracting \"Makefile\" \(1653 characters\)
sed "s/^X//" >Makefile <<'END_OF_Makefile'
XTARGETS= src lib lib/util lib/xlib lib/xt lib/xaw lib/xhp
X
XSCHEME_DIR= \\\"/f/net/scm/scm\\\"
XGENERIC= \"char*\"
XMACHTYPE= 68k # vax 68k 386
X
XINC= -I../src -I../../src
XDIR= -DDEF_LOAD_DIR=$(SCHEME_DIR)
XGEN= -DGENERIC=$(GENERIC)
X
X#CFLAGS= $(INC) $(DIR) $(GEN) -O -f -ga -X23 # IS68k 4.3 BSD; FPP
X#CFLAGS= $(INC) $(DIR) $(GEN) -O -ga -X23 # IS68k 4.3 BSD
X#CFLAGS= $(INC) $(DIR) $(GEN) -O -f -20 # IS68k 4.2 BSD; FPP
X#CFLAGS= $(INC) $(DIR) $(GEN) -O -20 # IS68k 4.2 BSD
X#CFLAGS= $(INC) $(DIR) $(GEN) -O # SunOS 4.0
X#CFLAGS= $(INC) $(DIR) $(GEN) -Dindex=strchr # System V
X CFLAGS= $(INC) $(DIR) $(GEN) -O -finline-functions # GNU cc IS68k
X
X LDFLAGS= -x # 4.n BSD
X#LDFLAGS= -Bstatic # SunOS 4.0
X#LDFLAGS= -x -lld # System V
X
XLINTFLAGS= $(INC) $(DIR) $(GEN)
X
Xall:
X @for i in $(TARGETS) ;\
X do \
X ( cd $$i ;\
X echo Making $$i ;\
X make "MACHTYPE=$(MACHTYPE)" "CC=$(CC)" "CFLAGS=$(CFLAGS)"\
X "LDFLAGS=$(LDFLAGS)" ) ;\
X done
X
Xlint:
X @for i in $(TARGETS) ;\
X do \
X ( cd $$i ;\
X echo Linting $$i ;\
X make "LINTFLAGS=$(LINTFLAGS)" lint );\
X done
X
Xclean:
X @for i in $(TARGETS) ;\
X do \
X ( cd $$i ;\
X echo Cleaning $$i ;\
X make clean ) ;\
X done
X
Xdist:
X gnutar -cvf scheme.tar -X ExcludeFiles RELEASE README INSTALL ORIGIN\
X Makefile doc src scm tst lib stk
X compress scheme.tar
X /@oda/usr/bin/uuencode scheme.tar.Z <scheme.tar.Z >scheme.tar.Z.uue
X rm scheme.tar.Z
X split -1000 scheme.tar.Z.uue
END_OF_Makefile
if test 1653 -ne `wc -c <Makefile`; then
echo shar: \"Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d doc ; then
echo shar: Creating directory \"doc\"
mkdir doc
fi
if test -f doc/oops.ms -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"doc/oops.ms\"
else
echo shar: Extracting \"doc/oops.ms\" \(9794 characters\)
sed "s/^X//" >doc/oops.ms <<'END_OF_doc/oops.ms'
X.so tmac.scheme
X.RP
X.TL
XThe \s-1OOPS\s0 Package for Scheme
X.AU
XOliver Laumann
X.AB
XThe \s-1OOPS\s0 package provides a minimal set of tools that enables
Xa Scheme programmer to program in an object oriented style.
XThe functionality of \s-1OOPS\s0 is similar to that of packages like
X\s-1CLOS\s0 and \s-1SCOOPS\s0, although the current version does
Xnot support multiple inheritance.
XThe rest of this memo serves as a reference guide to the
X\s-1OOPS\s0 package; the reader is assumed to be familiar with
Xthe terminology of object oriented programming.
X.AE
X.C Using \s-1OOPS\s0
X.LP
XPrograms that make use of the \s-1OOPS\s0 package should include
Xthe line
X.ss
X(require 'oops)
X.se
XSince this involves autoloading of an object file, it may be desirable
Xto dump Scheme after the \s-1OOPS\s0 package has been loaded.
X.C Defining Classes
X.PP
XNew classes are defined by means of the
X.S define-class
Xmacro.
XThe syntax of
X.S define-class
Xis
X.ss
X(define-class \f2class-name\fP . \f2options\fP)
X.se
Xwhere \f2class-name\fP is a symbol.
X\f2options\fP can be of the form
X.ss
X(super-class \f2class-name\fP)
X.se
Xwhere \f2class-name\fP is the name of the super-class (a symbol),
Xor
X.ss
X(class-vars . \f2var-specs\fP)
X.se
Xor
X.ss
X(instance-vars . \f2var-specs\fP)
X.se
Xto specify the class variables and instance variables of the newly
Xdefined class.
XEach \f2var-spec\fP is either a symbol (the name of the variable)
Xor of the form
X.ss
X(\f2symbol\fP \f2initializer\fP).
X.se
XVariables for which no initializer has been specified are initialized
Xto the empty list.
XThe initializers for class variables are evaluated immediately;
Xinitializers for instance variables are evaluated each time an
Xinstance of the newly defined class is created.
XEvaluation of initializers is performed in a way that the
Xinitializer of a variable can reference all variables appearing
Xat the left of the variable being initialized; for instance
X.ss
X(define-class foo (class-vars (a 10) (b (* a 2))))
X.se
Xwould initialize the class variable
X.S b
Xto 20.
X.PP
XA class inherits all class variables, instance variables, and
Xmethods of its super-class.
XWhen a class and its super-class each have an instance variable
Xwith the same name, the corresponding \f2var-specs\fP must either
Xboth have no initializer or initializers with the same value,
Xotherwise an ``initializer mismatch'' error is signaled by
X.S define-class .
X.PP
XEach instance of a class has an instance variable named
X.S self .
XThe value of
X.S self
Xis the instance with respect to which
X.S self
Xis evaluated.
X.S self
Xcan be used by methods as the argument to
X.S send
X(see below) to invoke another method within the current instance.
X.PP
X.S define-class
Xdoes not have a meaningful return value,
Xinstead it has a side-effect on the environment in which it
Xis invoked.
X.C Creating Instances of a Class
X.PP
XThe macro
X.S make-instance
Xis used to create an instance of
Xa class; it returns the instance as its value.
XThe syntax is
X.ss
X(make-instance \f2class\fP . \f2args\fP)
X.se
Xwhere \f2class\fP is the class of which an instance is to
Xbe created.
XEach \f2arg\fP of the form
X.ss
X(\f2symbol\fP\ \f2initializer\fP)
X.se
Xwhere \f2symbol\fP is the name of an instance variable of the class,
Xis used to initialize the specified instance variable in the
Xnewly created instance.
XIn this case the \f2initializer\fP supersedes any initializer
Xspecified in the call to
X.S define-class .
XThus it is possible to have instance variables with a \f2default
Xinitializer\fP that can be overridden for individual instances.
XThe initializers are evaluated in the current environment.
X.PP
X.S make-instance
Xinitializes the newly created instance by
Xinvoking the
X.S initialize-instance
Xmethod for the class
Xand all super-classes in super-class to sub-class order.
XThat is, the
X.S initialize-instance
Xmethod of the class specified in the call to
X.S make-instance is called after all other
X.S initialize-instance
Xmethods.
XThe arguments passed to the
X.S initialize-instance
Xmethod of a class are those arguments of the call to
X.S make-instance
Xthat do not represent an initialization form for an instance variable.
XThese arguments are evaluated in the current environment.
XIt is not required for a class to have an
X.S initialize-instance
Xmethod.
X.PP
XConsider the following example:
X.ss
X(require 'oops)
X.sp .5
X(define-class c (instance-vars a))
X(define-class d (instance-vars (b 10)) (super-class c))
X.sp .5
X(define-method c (initialize-instance . args)
X (print (cons 'c args)))
X.sp .5
X(define-method d (initialize-instance . args)
X (print (cons 'd args)))
X.sp .5
X.se
XIn this example evaluation of
X.ss
X(define x 99)
X(define i (make-instance d (a 20) 'foo (b x) x))
X.se
Xwould print
X.ss
X(c foo 99)
X(d foo 99)
X.se
X.PP
XNote that first the
X.S initialize-instance
Xmethod of
X.S c
Xis invoked and then that of the class
X.S d .
XThe instance variables
X.S a
Xand
X.S b
Xwould be initialized to 20 and 99, respectively.
X.C Defining Methods
X.PP
XA new method can be defined by means of the
X.S define-method
Xmacro.
XThe syntax is
X.ss
X(define-method \f2class\fP \f2lambda-list\fP . \f2body\fP)
X.se
Xwhere \f2class\fP is the class to which the method is to be
Xadded, \f2lambda-list\fP is a list specifying the method's
Xname and formal arguments (having the same syntax as the argument
Xof
X.S define ).
X.PP
X.S define-method
Xsimply creates a class-variable with the name
Xof the method, creates a lambda closure using the \f2lambda-list\fP
Xand the \f2body\fP forms, and binds the resulting procedure to
Xthe newly-created variable.
XWhen a message with the name of the method is sent to an instance
Xof the class, the method is invoked, and the \f2body\fP is evaluated
Xin the scope of the instance (so that it can access all instance
Xand class variables).
X.C Sending Messages
X.PP
XA message can be sent to an instance by means of the function
X.S send .
XThe syntax of
X.S send
Xis
X.ss
X(send \f2instance\fP \f2message\fP . \f2args\fP)
X.se
Xwhere \f2instance\fP is the instance to which the message is
Xto be sent, \f2method\fP is the name of the method to be
Xinvoked (a symbol), and \f2args\fP are the arguments to be
Xpassed to the method.
XExample:
X.ss
X(define-class c (instance-vars a) (class-vars (b 10)))
X.sp .5
X(define-method c (foo x)
X (cons (set! a x) b)) ; set! returns previous value
X.sp .5
X(define i (make-instance c (a 99)))
X.sp
X(send i 'foo 1) \f1returns (99 . 10)\fP
X(send i 'foo 2) \f1returns (1 . 10)\fP
X.se
X.PP
XWhen a message is sent to an instance for which no method has
Xbeen defined, a ``message not understood'' error is signaled.
X.PP
XThe function
X.S send-if-handles
Xis identical to
X.S send ,
Xexcept that it returns a list of one element, the return value
Xof the method, or
X.S #f
Xwhen the message is not understood by the instance.
X.C Evaluating Expressions within an Instance
X.PP
XThe macro
X.S with-instance
Xcan be used to evaluate expressions within the scope of an instance.
XThe syntax is
X.ss
X(with-instance \f2instance\fP . \f2body\fP).
X.se
XThe \f2body\fP forms are evaluated in the same environment in
Xwhich a method of \f2instance\fP would be evaluated,
Xi.\|e. they can access all and class and instance variables
X(including
X.S self ).
X.S with-instance
Xreturns the value of the last \f2body\fP form.
XExample:
X.ss
X(define-class c (class-vars (x 5)) (instance-vars y))
X.sp .5
X(define i (make-instance c (y 1)))
X.sp .5
X(define x 10)
X(with-instance i (cons x y)) \f1returns (5 . 1)\fP
X.se
X.C Setting Instance and Class Variables
X.PP
XGenerally class and instance variables are manipulated by methods
Xor, if applicable, from within a
X.S with-instance
Xform.
XIn addition, values can be assigned to class and instance variables
Xwithout involving a message send by means of the
X.S instance-set!
Xmacro.
XThe syntax of
X.S instance-set!
Xis
X.ss
X(instance-set! \f2instance\fP \f2variable\fP \f2value\fP)
X.se
Xwhere \f2variable\fP is a symbol, the name of the class or
Xinstance variable.
X.S instance-set!
Xreturns the previous value of the variable (like
X.S set! ).
X.PP
XClass variables can be modified without involving an instance
Xof the class by means of the macro
X.S class-set! :
X.ss
X(class-set! \f2class\fP \f2variable\fP \f2value\fP).
X.se
X\f2variable\fP must be the name of a class variable of \f2class\fP.
XNote that one difference between
X.ss
X(instance-set! i 'var x)
X.se
Xand
X.ss
X(with-instance i (set! var x))
X.se
Xis that in the former case
X.S x
Xis evaluated in the current environment while in the latter case
X.S x
Xis evaluated within the scope of the instance (here
X.S x
Xmight be a class or instance variable).
X.C Obtaining Information about Classes and Instances
X.PP
XThe function
X.S class-name
Xreturns the name of a class (a symbol) or, when applied to an instance,
Xthe name of the class of which it is an instance.
X.PP
XThe predicate
X.S method-known?
Xcan be used to check whether a method of a given name is known to a class.
XThe syntax is
X.ss
X(method-known? \f2method\fP \f2class\fP)
X.se
Xwhere \f2method\fP is a symbol.
X.PP
XThe type predicates
X.S class?
Xand
X.S instance?
Xcan be used to check whether an object is a class or an instance,
Xrespectively.
X.PP
XThe functions
X.ss
X(check-class \f2symbol\fP \f2object\fP)
X.se
Xand
X.ss
X(check-instance \f2symbol\fP \f2object\fP)
X.se
Xcheck whether \f2object\fP is a class (i.\|e. satisfies the predicate
X.S class? )
Xor an instance, respectively, and, if not, signal an error;
Xin this case \f2symbol\fP is used as the first argument to
X.S error .
X.PP
XThe functions
X.S describe-class
Xand
X.S describe-instance
Xprint the components (name, class/instance variables, etc.) of
Xa class or instance, respectively.
XThe function
X.S describe
Xhas been extended in way that when
X.S "(feature? 'oops)"
Xis true,
X.S describe-class
Xor
X.S describe-instance
Xare called when
X.S describe
Xis applied to an object that satisfies
X.S class?
Xor
X.S instance? ,
Xrespectively.
X.de PT
X..
X.bp
X.PX
END_OF_doc/oops.ms
if test 9794 -ne `wc -c <doc/oops.ms`; then
echo shar: \"doc/oops.ms\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/compat.ms -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"doc/compat.ms\"
else
echo shar: Extracting \"doc/compat.ms\" \(3053 characters\)
sed "s/^X//" >doc/compat.ms <<'END_OF_doc/compat.ms'
X.so tmac.scheme
X.TL
XDifferences Between the Elk Extension Language and the
X.br
XLanguage Scheme as Defined in the Revised\v'-.3m'3\v'.3m' Report
X.AU
XOliver Laumann
X.AB
XThis memo provides a short list of the differences between
Xthe Elk Extension Language and the Language described in
Xthe paper "\f2Revised\v'-.3m'3\v'.3m' Report on the Algorithmic
XLanguage Scheme\fP" by Jonathan Rees and William Clinger
X(editors).
X.AE
X.NH
XLexical Conventions
X.LP
XUpper and lower case letters in symbols are \f2always\fP distinguished.
X.NH
X``()''
X.LP
X``()'' is a legal expression; it evaluates to itself.
X.NH
X(if \f2test\fP \f2consequent\fP \f2alternate\fP)
X.LP
X\f2alternate\fP can be a sequence of expressions (implicit ``begin'').
X.NH
X(case \f2key\fP \f2clause\fP \f2clause\fP ...)
X.LP
XA \f2clause\fP can be of the form (\f2datum\fP \f2expr\fP \f2expr\fP ...).
XIn this case, the \f2key\fP is matched against the \f2datum\fP.
X.NH
Xlet, let*, etc.
X.LP
XThe \f2init\fP in a binding may be omitted, in this case it defaults to
Xthe empty list.
X.NH
XQuasiquotation
X.LP
XQuasiquotation can currently not be used to construct vectors.
X.NH
Xdefine
X.LP
XDefinitions are valid anywhere within a body (that is, not only
Xat the beginning of a body).
XThe \f2expression\fP may be omitted, in this case it defaults to ``void''
X(the non-printing object).
XA definition of the form
X.DS C
X(define (\f2form\fP . \f2expr\fP) \f2body\fP)
X.DE
Xis converted to
X.DS C
X(define \f2form\fP (lambda \f2expr\fP \f2body\fP)).
X.DE
XExample:
X.DS C
X(define ((f x) y) (cons x y))
X((f 1) 2) ==> (1 . 2)
X.DE
X.NH
Xnil, t
X.LP
X``nil'' and ``t'' are not provided. If needed, they can be
Xdefined as follows:
X.DS C
X(define nil #f)
X(define t #t)
X.DE
X.NH
Xcar, cdr
X.LP
XThe car (or cdr, respectively) of the empty list is the empty list.
X.NH
XRational and complex numbers
X.LP
XRational and complex numbers are not implemented.
X.NH
XExactness
X.LP
XAll numbers are inexact.
X.NH
X#b #o #d #x
X.LP
XRadix prefixes for real numbers are currently not implemented.
X.NH
X#e #i
X.LP
XPrefixes for exact and inexact constants are not implemented.
X.NH
Xexact\(mi>inexact, inexact\(mi>exact
X.LP
XNot implemented.
X.NH
Xnumber\(mi>string
X.LP
XCurrently not implemented.
XUse ``(format #f "~s" \f2number\fP)'' instead.
X.NH
Xstring\(mi>number
X.LP
XThe \f2exactness\fP and the \f2radix\fP argument are currently
Xnot supported.
X.NH
Xchar-upper-case?, char-lower-case?
X.LP
XThese procedures are defined on \f2all\fP characters.
X.NH
Xmake-string
X.LP
XA character must be supplied as second argument.
X.NH
X#(a b c)
X.LP
XVector constants may not be quoted. A vector constant evaluates
Xto itself.
X.NH
Xopen-input/output-file, call-with-input/output-file,
X.br
Xwith-input/output-from/to-file, load
X.LP
X\f2filename\fP may be a symbol, in this case
X``symbol\(mi>string'' is applied first.
X.NH
Xclose-input-port, close-output-port
X.LP
XUse ``close-port'' instead, this can be applied to input ports as
Xwell as output ports.
X.NH
Xchar-ready?
X.LP
XCurrently not implemented.
X.NH
Xtranscript-on, transcript-off
X.LP
XNot implemented; use the UNIX \f2script(1)\fP command instead.
END_OF_doc/compat.ms
if test 3053 -ne `wc -c <doc/compat.ms`; then
echo shar: \"doc/compat.ms\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/xt.ms -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"doc/xt.ms\"
else
echo shar: Extracting \"doc/xt.ms\" \(7394 characters\)
sed "s/^X//" >doc/xt.ms <<'END_OF_doc/xt.ms'
X.\" A font suitable for Scheme keywords and program examples
X.\" must be mounted on font position 5.
X.\" For example: .fp 5 TT (Typewriter font)
X.\" or: .fp 5 HR (Helvetica Roman)
X.\"
X.fp 5 HR
X.de f
X.br
X.ne 3
X.ft 5
X.nr x \w'\\$1'
X.sp -.5
X.ps 6
X\l'\\nxu'
X.ps
X.sp -.1
X\\$1
X.ft
X.LP
X.if !'\\$2'' \f2[\\$2]\fP
X.if !'\\$2'' .br
X..
X.de fa
X.br
X.ne 3
X.ft 5
X.nr x \w'\\$1'
X.sp -.5
X.ps 6
X\l'\\nxu'
X.ps
X.sp -.1
X\\$1
X.ft
X..
X.de fb
X.br
X.ne 3
X.ft 5
X.sp -.1
X\\$1
X.ft
X.LP
X.if !'\\$2'' \f2[\\$2]\fP
X.if !'\\$2'' .br
X..
X.TL
XFunctions Exported by the Scheme/Xt Interface
X.AU
XOliver Laumann
X.AB
XThis memo provides a list of the functions exported by the interface
Xto the Xt toolkit.
XIf a function is equivalent to a function of the C library, only
Xthe name of the corresponding C function is given (in square brackets).
X.AE
X.NH
XLoading the Interface
X.LP
XThe Xt-interface is loaded by evaluating
X.DS C
X.ft 5
X(require 'xwidgets).
X.ft
X.DE
XThis loads the Xlib-interface as well.
XIndividual widgets are loaded by the macro
X.DS C
X.ft 5
X(load-widgets . widget-class-names)
X.ft
X.DE
X.LP
XThe arguments are symbols (not quoted since \f5load-widgets\fP is a macro).
XThe widgets are loaded from subdirectories of ``scm/lib''; the directories
Xare searched according to the value of the variable \f5widget-load-path\fP.
XThe default for \f5widget-load-path\fP is ``(xaw xhp)'',
Xi.e. when there are an
XAthena widget and an HP widget of the same name, the Athena widget
Xwill be loaded.
X.NH
XCallback Functions
X
X.f "(add-callbacks widget callback-name . callback-functions)" XtAddCallbacks
XAdds the functions to a callback list of the specified widget.
X\f5callback-name\fP is a string or a symbol.
X
X.f "(add-callback widget callback-name callback-function)"
XCalls \f5add-callbacks\fP with the specified function.
X.NH
XFunctions Operating on Widget Classes
X
X.f "(class? x)"
XReturns #t if \f5x\fP is a class, #f otherwise.
X
X.f "(find-class name-of-class)"
XReturns the widget class of the specified name.
XThe name is a string or a symbol.
X
X.f "(class-resources widget-class)" XtGetResourceList
XReturns the resource list of the specified widget class.
XEach item in the list is a list of the resource name,
Xthe resource class, and the resource type.
X
X.f "(class-constraint-resources widget-class)" XtGetConstraintRespourceList
XSee \f5class-resources\fP above.
X
X.f "(class-sub-resources widget-class)"
XReturns the list of sub-resources (if there are any) for the
Xspecified widget class. See \f5class-resources\fP above.
X
X.f "(class-exists? name-of-class)"
XReturns #t if a widget class of the given name exists
X(i.e. has been loaded by means of \f5load-widgets\fP), #f otherwise.
X.NH
XApplication Contexts
X
X.f "(context? x)"
XReturns #t if \f5x\fP is a context, #f otherwise.
X
X.f "(create-context)" XtCreateApplicationContext
X
X.f "(destroy-context context)" XtDestroyApplicationContext
X
X.f "(initialize-display context display application-name application-class)" "XtDisplayInitialize, XtOpenDisplay"
XIf \f5display\fP is an object of type \f5display\fP, XtDisplayInitialize is
Xcalled.
XIf \f5display\fP is a display name (string or symbol) or #f,
XXtOpenDisplay is called (with a NULL display in the latter case),
Xand the newly opened display is returned.
X
X.f "(context-main-loop context)" XtAppMainLoop
X
X.f "(context-pending context)" XtAppPending
XReturns a list of symbols (\f5x-event\fP, \f5timer\fP, \f5alternate-input\fP).
X
X.f "(context-process-event context . mask)" XtProcessEvent
X\f5mask\fP is a list of symbols (see \f5context-pending\fP above).
XXtIMAll is used if no mask is given.
X
X.f "(context-add-work-proc context procedure)" XtAppAddWorkProc
XReturns an identifier that can be used as an argument to \f5remove-work-proc\fP.
X
X.f "(remove-work-proc work-proc-identifier)" XtRemoveWorkProc
X
X.f "(context-add-timeout context timer-value procedure)" XtAppAddTimeOut
X\f5timer-value\fP is an integer.
XReturns an identifier that can be used as an argument to \f5remove-timeout\fP.
X
X.f "(remove-timeout timeout-identifier)" XtRemoveTimeOut
X
X.f "(identifier? x)"
XReturns #t if \f5x\fP is an identifier (an opaque object returned by functions
Xlike \f5context-add-timeout\fP), #f otherwise.
X.NH
XPopup Shells
X
X.fa "(create-popup-shell widget-class parent-widget . args)"
X.fb "(create-popup-shell widget-name widget-class parent-widget . args)" XtCreatePopupShell
XIf no widget name is given, the name of the shell class is used.
XThe number of \f5args\fP must be even, the 1st, 3rd, etc. argument
Xis the name of a resource to be set (a string or a symbol); the
X2nd, 4th, etc. argument is the corresponding value.
X
X.f "(popup shell-widget grab-kind)" XtPopup
X\f5grab-kind\fP is a symbol (\f5grab-once\fP, \f5grab-nonexclusive\fP,
Xor \f5grab-exclusive\fP).
X
X.f "(popdown shell-widget)" XtPopdown
X.NH
XTranslations Tables
X
X.f "(augment-translations widget table)" XtAugmentTranslations
XThe translation table is a string; XtParseTranslationTable is
Xapplied to it.
X
X.f "(override-translations widget table)" XtOverrideTranslations
XSee \f5augment-translations\fP above.
X
X.f "(uninstall-translations widget)" XtUninstallTranslations
X.NH
XFunctions Operating on Widgets
X
X.f "(widget? x)"
XReturns #t if \f5x\fP is a widget, #f otherwise.
X
X.f "(destroy-widget widget)" XtDestroyWidget
X
X.f "(create-shell application-name application-class parent display . args)" XtAppCreateShell
X\f5application-name\fP and \f5application-class\fP are strings or symbols.
XFor the format of \f5args\fP see \f5create-popup-shell\fP above.
X
X.fa "(create-widget widget-class parent . args)"
X.fb "(create-widget widget-name widget-class parent . args)" XtCreateWidget
XIf no \f5widget-name\fP is given, the name of the widget class is used.
XFor the format of \f5args\fP see \f5create-popup-shell\fP above.
X
X.f "(create-managed-widget . args)"
XApplies \f5create-widget\fP to the arguments and then calls \f5manage-child\fP
Xwith the newly created widget.
X
X.f "(realize-widget widget)" XtRealizeWidget
X
X.f "(unrealize-widget widget)" XtUnrealizeWidget
X
X.f "(widget-realized? widget)" XtIsRealized
X
X.f "(widget-display widget)" XtDisplay
X
X.f "(widget-parent widget)" XtParent
X
X.f "(widget-window widget)" XtWindow
X
X.f "(widget-composite? widget)" XtIsComposite
X
X.f "(manage-children . widgets)" XtManageChildren
X
X.f "(manage-child widget)"
XCalls \f5manage-children\fP with the specified widget.
X
X.f "(unmanage-children . widgets)" XtUnmanageChildren
X
X.f "(unmanage-child widget)"
XCalls \f5unmanage-children\fP with the specified widget.
X
X.f "(widget-managed? widget)" XtIsManaged
X
X.f "(widget-class widget)" XtClass
X
X.f "(widget-superclass widget)" XtSuperclass
XIf the widget is an instance of ``widgetClass'', the symbol \f5none\fP
Xis returned.
X
X.f "(widget-subclass? widget class)" XtIsSubclass
X
X.f "(set-mapped-when-managed! widget managed?)" XtSetMappedWhenManaged
X
X.f "(map-widget widget)" XtMapWidget
X
X.f "(unmap-widget widget)" XtUnmapWidget
X
X.f "(set-values! widget . args)" XtSetValues
XFor the format of \f5args\fP see \f5create-popup-shell\fP above.
X
X.f "(get-values widget . args)" XtGetValues
XReturns a list of the values of the specified widget arguments.
X
X.f "(widget-context widget)" XtWidgetToApplicationContext
X
X.f "(set-sensitive! widget sensitive?)" XtSetSensitive
X
X.f "(widget-sensitive? widget)" XtIsSensitive
X
X.f "(window\(mi>widget window)" XtWindowToWidget
X
X.f "(name\(mi>widget root-widget name)" XtNameToWidget
X\f5name\fP is a string or a symbol.
END_OF_doc/xt.ms
if test 7394 -ne `wc -c <doc/xt.ms`; then
echo shar: \"doc/xt.ms\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/stack.txt -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"doc/stack.txt\"
else
echo shar: Extracting \"doc/stack.txt\" \(2794 characters\)
sed "s/^X//" >doc/stack.txt <<'END_OF_doc/stack.txt'
XThe file src/stack.s exports three small functions that are used by the
Xpart of the Scheme interpreter that implements continuations. Since
Xthese functions have to be written in assembly code, it may be
Xnecessary to write a new src/stack.s when the software is ported to an
Xenvironment that is currently not supported. See the file INSTALL in
Xthe top level directory of the distribution for more information about
Xporting the software.
X
XThe directory stk holds two small test programs (test1.c and test2.c)
Xthat should be compiled, linked together with the new stack.o, and
Xrun to make sure that the stack functions are working correctly.
XSee the comments at the beginning of test1.c and test2.c.
X
XThe functions exported by src/stack.s are:
X
X int stksize()
X int saveenv(char *buf)
X jmpenv(const char *buf, int retcode) (jmpenv does not return)
X
Xstack.s imports two variables:
X
X char *stkbase
X Object Special
X
X(see below).
X
Xsaveenv() and jmpenv() are an extension of setjmp() and longjmp().
Xsaveenv() copies the registers and part of the runtime stack into a
Xvariable in the data space ("buf"); jmpenv() copies the stack back to
Xthe original position, restores the registers, and returns to the point
Xwhere the corresponding saveenv() has been called (execution continues
Xas if the call to saveenv() had returned "retcode").
X
XCopying of the stack always starts at the location pointed to by the
Xglobal variable "char *stkbase". This variable is set by the interpreter
Xto point to a local variable of the function main() (see src/main.c).
X
XThe function stksize() is used to determine the size of a buffer passed
Xto saveenv(). Thus it returns the current size of the runtime stack
X(actually the difference between the stack pointer and the value of
Xstkbase) plus the space that is needed to store the registers plus a
Xsafety margin (stack size + 100 is a reasonable value for the 68k).
X
Xsaveenv() first saves all registers, the stack pointer, and the
XPC of the caller (the return address) into the low locations of
X"buf" (starting at &buf[4]). Then the runtime stack is copied
Xinto the locations behind the saved registers; copying starts
Xat the top of the stack and ends at stkbase.
X
XThe difference between the address of the top of the runtime stack and
Xthe address of the copy of the stack in "buf" is written into the first
Xword of "buf" (this is the "relocation offset", i.e. the number of
Xbytes the stack image has been moved in the data space). The
Xinterpreter needs the relocation offset to access variables in a copy
Xof the stack; the offset is retrieved by *(int *)buf.
X
Xsaveenv() returns the value of the global variable "Special".
X
Xjmpenv() simply copies back the saved stack image, restores the
Xregisters and the saved stack pointer, and returns to the saved PC.
END_OF_doc/stack.txt
if test 2794 -ne `wc -c <doc/stack.txt`; then
echo shar: \"doc/stack.txt\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f doc/tmac.scheme -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"doc/tmac.scheme\"
else
echo shar: Extracting \"doc/tmac.scheme\" \(716 characters\)
sed "s/^X//" >doc/tmac.scheme <<'END_OF_doc/tmac.scheme'
X.\" A font suitable for Scheme keywords and program examples
X.\" must be mounted on font position 5.
X.\" For example: .fp 5 TT (Typewriter font)
X.\" or: .fp 5 HR (Helvetica Roman)
X.\" or: .fp 5 C (Courier)
X.\"
X.fp 5 C
X.\" Scheme code start
X.de ss
X.KS
X.ta 8.5c
X.ft 5
X.ps -1
X.vs -1
X.nf
X.in 1c
X.sp .3c
X..
X.\" Scheme code end
X.de se
X.ft
X.ps
X.vs
X.fi
X.in
X.KE
X.sp .5
X..
X.\" Scheme keyword
X.de S
X.ft 5
X.ps -1
X.if \\n(.$=1 \&\\$1
X.if \\n(.$>1 \&\\$1\c
X.ft
X.ps
X.if \\n(.$>1 \&\\$2
X..
X.\" Underline page top
X.am PT
X.if \\n%-1 .tl ?\\v'-.6v'\\l'\\n(LLu\(ru'\\v'.6v'
X..
X.\" Chapter
X.de C
X.br
X.ne 2c
X.NH
X\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9
X.XS
X\\$1 \\$2 \\$3 \\$4 \\$5 \\$6 \\$7 \\$8 \\$9
X.XE
X..
END_OF_doc/tmac.scheme
if test 716 -ne `wc -c <doc/tmac.scheme`; then
echo shar: \"doc/tmac.scheme\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d src ; then
echo shar: Creating directory \"src\"
mkdir src
fi
if test -f src/env.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/env.c\"
else
echo shar: Extracting \"src/env.c\" \(4755 characters\)
sed "s/^X//" >src/env.c <<'END_OF_src/env.c'
X/* Environments
X */
X
X#include "scheme.h"
X
XObject The_Environment;
XObject Global_Environment;
X
XObject List_To_Env(), General_Define();
X
XInit_Env () {
X Global_Environment = The_Environment = List_To_Env (Cons (Null, Null));
X Global_GC_Link (Global_Environment);
X Global_GC_Link (The_Environment);
X}
X
XObject Env_To_List (env) Object env; {
X Object p;
X
X p = env;
X SETTYPE(p, T_Pair);
X return p;
X}
X
XObject List_To_Env (list) Object list; {
X Object e;
X
X e = list;
X SETTYPE(e, T_Environment);
X return e;
X}
X
XObject P_Env_List (env) Object env; {
X Check_Type (env, T_Environment);
X return Copy_List (Env_To_List (env));
X}
X
XObject P_Environmentp (x) Object x; {
X return TYPE(x) == T_Environment ? True : False;
X}
X
XPush_Frame (frame) Object frame; {
X Object e;
X
X Memoize_Frame (frame);
X e = Env_To_List (The_Environment);
X The_Environment = List_To_Env (Cons (frame, e));
X}
X
XPop_Frame () {
X Object e;
X
X e = Env_To_List (The_Environment);
X The_Environment = List_To_Env (Cdr (e));
X Forget_Frame (Car (e));
X}
X
XSwitch_Environment (to) Object to; {
X Object old, new;
X
X if (EQ(The_Environment,to))
X return;
X old = Env_To_List (The_Environment);
X new = Env_To_List (to);
X for ( ; !Nullp (old); old = Cdr (old)) {
X for (new = Env_To_List (to); !Nullp (new) && !EQ(new,old);
X new = Cdr (new))
X ;
X if (EQ(new,old))
X break;
X Forget_Frame (Car (old));
X }
X Memoize_Frames (Env_To_List (to), new);
X The_Environment = to;
X}
X
XMemoize_Frames (this, last) Object this, last; {
X if (Nullp (this) || EQ(this,last))
X return;
X Memoize_Frames (Cdr (this), last);
X Memoize_Frame (Car (this));
X}
X
XMemoize_Frame (frame) Object frame; {
X Object tail, binding;
X
X for (tail = frame; !Nullp (tail); tail = Cdr (tail)) {
X binding = Car (tail);
X SYMBOL(Car (binding))->value = Cdr (binding);
X }
X}
X
XForget_Frame (frame) Object frame; {
X Object tail;
X
X for (tail = frame; !Nullp (tail); tail = Cdr (tail))
X SYMBOL(Car (Car (tail)))->value = Unbound;
X}
X
XObject Add_Binding (frame, sym, val) Object frame, sym, val; {
X Object b;
X GC_Node;
X
X GC_Link (frame);
X b = Cons (sym, val);
X frame = Cons (b, frame);
X GC_Unlink;
X return frame;
X}
X
XObject Lookup_Symbol (sym, err) Object sym; {
X Object p, b;
X
X for (p = Env_To_List (The_Environment); !Nullp (p); p = Cdr (p)) {
X b = Assq (sym, Car (p));
X if (!EQ(b, False))
X return b;
X }
X if (err)
X Primitive_Error ("unbound variable: ~s", sym);
X return Null;
X}
X
XObject P_The_Environment () { return The_Environment; }
X
XObject P_Global_Environment () { return Global_Environment; }
X
XObject Define_Procedure (form, body, sym) Object form, body, sym; {
X Object ret;
X GC_Node3;
X
X GC_Link3 (form, body, sym);
X body = Cons (Cdr (form), body);
X body = Cons (sym, body);
X body = Cons (body, Null);
X body = Cons (Car (form), body);
X ret = General_Define (body, sym);
X GC_Unlink;
X return ret;
X}
X
XObject General_Define (argl, sym) Object argl, sym; {
X Object val, var, frame, binding;
X GC_Node3;
X
X var = Car (argl);
X val = Cdr (argl);
X if (TYPE(var) == T_Symbol) {
X frame = Null;
X GC_Link3 (var, val, frame);
X if (Nullp (val))
X val = Void;
X else
X val = Eval (Car (val));
X Set_Name (var, val);
X frame = Car (The_Environment);
X binding = Assq (var, frame);
X if (EQ(binding, False)) {
X frame = Add_Binding (frame, var, val);
X Car (The_Environment) = frame;
X } else
X Cdr (binding) = val;
X SYMBOL(var)->value = val;
X GC_Unlink;
X return var;
X } else if (TYPE(var) == T_Pair) {
X if (Nullp (val))
X Primitive_Error ("no sub-forms in compound: ~s", var);
X return Define_Procedure (var, val, sym);
X } else Wrong_Type_Combination (var, "symbol or pair");
X /*NOTREACHED*/
X}
X
XObject P_Define (argl) Object argl; {
X return General_Define (argl, Sym_Lambda);
X}
X
XObject P_Define_Macro (argl) Object argl; {
X return General_Define (argl, Sym_Macro);
X}
X
XObject P_Set (argl) Object argl; {
X Object val, var, binding, old;
X GC_Node3;
X
X var = Car (argl);
X val = Car (Cdr (argl));
X Check_Type (var, T_Symbol);
X binding = Lookup_Symbol (var, 1);
X old = Cdr (binding);
X GC_Link3 (var, binding, old);
X val = Eval (val);
X Set_Name (var, val);
X Cdr (binding) = val;
X SYMBOL(var)->value = val;
X GC_Unlink;
X return old;
X}
X
XSet_Name (var, val) Object var, val; {
X register t;
X
X t = TYPE(val);
X if (t == T_Compound) {
X if (Nullp (COMPOUND(val)->name))
X COMPOUND(val)->name = var;
X } else if (t == T_Macro) {
X if (Nullp (MACRO(val)->name))
X MACRO(val)->name = var;
X }
X}
X
XObject P_Boundp (x) Object x; {
X Check_Type (x, T_Symbol);
X return Nullp (Lookup_Symbol (x, 0)) ? False : True;
X}
END_OF_src/env.c
if test 4755 -ne `wc -c <src/env.c`; then
echo shar: \"src/env.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f src/fixmul.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"src/fixmul.c\"
else
echo shar: Extracting \"src/fixmul.c\" \(776 characters\)
sed "s/^X//" >src/fixmul.c <<'END_OF_src/fixmul.c'
X/* Fixnum multiplication
X */
X
X#include "scheme.h"
X
XObject Fixnum_Multiply (a, b) {
X register unsigned aa = a;
X register unsigned ab = b;
X register prod, prod2;
X register sign = 1;
X if (a < 0) {
X aa = -a;
X sign = -1;
X }
X if (b < 0) {
X ab = -b;
X sign = -sign;
X }
X prod = (aa & 0xFFFF) * (ab & 0xFFFF);
X if (aa & 0xFFFF0000) {
X if (ab & 0xFFFF0000)
X return Null;
X prod2 = (aa >> 16) * ab;
X } else {
X prod2 = aa * (ab >> 16);
X }
X prod2 += prod >> 16;
X prod &= 0xFFFF;
X if (prod2 > (1 << (VALBITS - 1 - 16)) - 1) {
X if (sign == 1 || prod2 != (1 << (VALBITS - 1 - 16)) || prod != 0)
X return Null;
X return Make_Fixnum (-SIGNBIT);
X }
X prod += prod2 << 16;
X if (sign == -1)
X prod = - prod;
X return Make_Fixnum (prod);
X}
END_OF_src/fixmul.c
if test 776 -ne `wc -c <src/fixmul.c`; then
echo shar: \"src/fixmul.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 1 \(of 14\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 14 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
More information about the Comp.sources.misc
mailing list